packages feed

ipa-0.2: src/Language/IPA.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Language.IPA
-- Copyright   : (c) 2021 Rory Tyler Hayford
--
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Working with IPA transcriptions
module Language.IPA
    ( module M
      -- * Converting to IPA representations
    , ReprIPA(..)
    ) where

import           Control.Exception  ( throw )

import           Data.Char          ( digitToInt )
import           Data.Text          ( Text )
import qualified Data.Text          as T

import           Language.IPA.Types as M
                 ( Backness(..)
                 , Consonant(..)
                 , Height(..)
                 , IPA(..)
                 , IPAException(..)
                 , Length(..)
                 , LevelTone(..)
                 , Manner(..)
                 , Phonation(..)
                 , Place(..)
                 , Roundedness(..)
                 , Segment(..)
                 , SegmentalFeature(..)
                 , Sibilance(..)
                 , Stress(..)
                 , SuprasegmentalFeature(..)
                 , Syllable(..)
                 , ToneContour(..)
                 , XSampa(..)
                 , mkIPA
                 , pattern ClickConsonant
                 , pattern EjectiveConsonant
                 , pattern ImplosiveConsonant
                 , pattern PulmonicConsonant
                 )

-- | Entities representable through IPA transcription
class ReprIPA a where
    -- | Produces an 'IPA' transcription given a valid 'Segment'; a result
    -- of @Nothing@ indicates either an unattested-yet-possible segment, or one
    -- considered impossible
    toIPA :: a -> Maybe IPA

    -- | Partial function for creating an 'IPA'. Useful if you are certain that
    -- the sound in question is representable
    toIPA' :: a -> IPA
    toIPA' (toIPA -> Just x) = x
    toIPA' _                 = throw $ InvalidIPA "Illegal IPA value"

    -- | Similar to 'toIPA'; produces an 'XSampa' transcription given a valid 'Segment'.
    toXSampa :: a -> Maybe XSampa

    -- | Partial function for creating an 'XSampa'. NB: Certain segments that have
    -- a defined 'IPA' representation have no 'XSampa' equivalent
    toXSampa' :: a -> XSampa
    toXSampa' (toXSampa -> Just x) = x
    toXSampa' _ = throw $ InvalidXSampa "Illegal IPA value"

instance Traversable t => ReprIPA (Syllable t) where
    toIPA = \case
        Syllable ss
            | null ss -> Nothing
            | otherwise -> foldr1 (<>) <$> traverse toIPA ss
        WithSuprasegmentalFeature feature s ->
            withSuprasegmentalFeatureIPA s feature

    toXSampa = \case
        Syllable ss
            | null ss -> Nothing
            | otherwise -> foldr1 (<>) <$> traverse toXSampa ss
        WithSuprasegmentalFeature feature s ->
            withSuprasegmentalFeatureXSampa s feature

instance ReprIPA Segment where
    toIPA = \case
        Zero -> mkJustIPA "∅"
        Consonant c -> consonantIPA c
        v@Vowel {} -> vowelIPA v
        WithSegmentalFeature feature s -> withSegmentalFeatureIPA s feature

    toXSampa = \case
        Zero -> Nothing -- does not appear to have an X-SAMPA encoding
        v@Vowel {} -> vowelXSampa v
        Consonant c -> consonantXSampa c
        WithSegmentalFeature feature s -> withSegmentalFeatureXSampa s feature

mkJustIPA :: Text -> Maybe IPA
mkJustIPA = Just . mkIPA

mkIPAOp :: ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp f x y = (<>) <$> toIPA x <*> f y

withSuprasegmentalFeatureIPA
    :: Traversable t => Syllable t -> SuprasegmentalFeature -> Maybe IPA
withSuprasegmentalFeatureIPA s = \case
    LevelLexicalTone tone -> mkIPAOp ipaTone s tone
      where
        ipaTone = \case
            ExtraHighTone -> mkJustIPA "˥"
            HighTone      -> mkJustIPA "˦"
            MidTone       -> mkJustIPA "˧"
            LowTone       -> mkJustIPA "˨"
            ExtraLowTone  -> mkJustIPA "˩"
            -- Down-step and up-step are represented with
            -- diacritics, not tone characters
            _             -> Nothing

    LevelLexicalToneDiacritic tone -> mkIPAOp ipaTone s tone
      where
        ipaTone = \case
            ExtraHighTone -> mkJustIPA "\x030b" -- ◌̋
            HighTone      -> mkJustIPA "\x0341" -- ◌́
            MidTone       -> mkJustIPA "\x0304" -- ◌̄
            LowTone       -> mkJustIPA "\x0340" -- ◌̀
            ExtraLowTone  -> mkJustIPA "\x030f" -- ◌̏
            DownStep      -> mkJustIPA "ꜜ"
            UpStep        -> mkJustIPA "ꜛ"

    LexicalToneContour tone -> mkIPAOp ipaToneContour s tone
      where
        ipaToneContour = \case
            Rising        -> mkJustIPA "˩˥"
            Falling       -> mkJustIPA "˥˩"
            HighRising    -> mkJustIPA "˧˥"
            LowRising     -> mkJustIPA "˩˧"
            HighFalling   -> mkJustIPA "˥˧"
            LowFalling    -> mkJustIPA "˧˩"
            RisingFalling -> mkJustIPA "˧˦˨"
            FallingRising -> mkJustIPA "˧˨˦"
            GlobalRise    -> mkJustIPA "↗"
            GlobalFall    -> mkJustIPA "↙"

    LexicalToneContourDiacritic tone -> mkIPAOp ipaToneContour s tone
      where
        ipaToneContour = \case
            Rising        -> mkJustIPA "\x0302" -- ◌̂
            Falling       -> mkJustIPA "\x030c" -- ◌̌
            HighRising    -> mkJustIPA "\x1dc9" -- ◌᷉
            LowRising     -> mkJustIPA "\x1dc5" -- ◌᷅
            HighFalling   -> mkJustIPA "\x1dc7" -- ◌᷇
            LowFalling    -> mkJustIPA "\x1dc6" -- ◌᷆
            RisingFalling -> mkJustIPA "\x1dc8" -- ◌᷈
            FallingRising -> mkJustIPA "\x1dc9" -- ◌᷉
            -- 'GlobalRise' and 'GlobalFall' don't have
            -- diacritic representations
            _             -> Nothing

    Stress stress -> mkIPAOp ipaStress s stress
      where
        ipaStress Primary   = mkJustIPA "ˈ"
        ipaStress Secondary = mkJustIPA "ˌ"

    Break -> (<>) <$> toIPA s <*> mkJustIPA "."

    Linking -> (<>) <$> toIPA s <*> mkJustIPA "‿"

withSegmentalFeatureIPA :: Segment -> SegmentalFeature -> Maybe IPA
withSegmentalFeatureIPA s = \case
    Voicing v -> mkIPAOp ipaVoicing s v
      where
        ipaVoicing = \case
            Voiceless -> mkJustIPA "\x030a" -- ◌̊
            Voiced    -> mkJustIPA "\x030c" -- ◌̌
    Length l -> mkIPAOp ipaLength s l
      where
        ipaLength = \case
            OverLong   -> mkJustIPA "ːː"
            HalfLong   -> mkJustIPA "ˑ"
            Long       -> mkJustIPA "ː"
            Short      -> mkJustIPA mempty
            ExtraShort -> mkJustIPA "\x0306" -- ◌ ̆
    SecondaryArticulation sa -> mkIPAOp secondaryArticulationIPA s sa
    SuperScriptNumeric ns -> (<>) <$> toIPA s <*> mkJustIPA digits
      where
        digits = T.concat $ T.pack <$> (code . digitToInt <$> show ns)

        code   = \case
            0 -> "\x2070"
            1 -> "\x00b9"
            2 -> "\x00b2"
            3 -> "\x00b3"
            4 -> "\x2074"
            5 -> "\x2075"
            6 -> "\x2076"
            7 -> "\x2077"
            8 -> "\x2078"
            9 -> "\x2079"
            _ -> mempty

    feature -> (<>) <$> toIPA s <*> case feature of
        Aspirated           -> mkJustIPA "\x02b0" -- ◌ʰ
        MoreRounded         -> mkJustIPA "\x0339" -- ◌̹
        LessRounded         -> mkJustIPA "\x031c" -- ◌̜
        Advanced            -> mkJustIPA "\x031f" -- ◌̟
        Retracted           -> mkJustIPA "\x0320" -- ◌̠
        Centralized         -> mkJustIPA "\x0308" -- ◌̈
        MidCentralized      -> mkJustIPA "\x033d" -- ◌̽
        Compressed          -> mkJustIPA "\x1d5d" -- ◌ᵝ
        Syllabic            -> mkJustIPA "\x0329" -- ◌̩
        NonSyllabic         -> mkJustIPA "\x032f" -- ◌̯
        Rhotacized          -> mkJustIPA "\x02de" -- ◌˞
        BreathyVoice        -> mkJustIPA "\x0324" -- ◌̤
        CreakyVoice         -> mkJustIPA "\x0330" -- ◌̰
        LinguoLabialized    -> mkJustIPA "\x033c" -- ◌̼
        Labialized          -> mkJustIPA "\x02b7" -- ◌ʷ
        Palatalized         -> mkJustIPA "\x02b2" -- ◌ʲ
        Velarized           -> mkJustIPA "\x02e0" -- ◌ˠ
        Pharyngealized      -> mkJustIPA "\x02e4" -- ◌ˤ
        Raised              -> mkJustIPA "\x031d" -- ◌̝
        Lowered             -> mkJustIPA "\x031e" -- ◌̞
        AdvancedTongueRoot  -> mkJustIPA "\x0318" -- ◌̘
        RetractedTongueRoot -> mkJustIPA "\x0319" -- ◌̙
        Dentalized          -> mkJustIPA "\x032a" -- ◌̪
        Apical              -> mkJustIPA "\x033a" -- ◌̺
        Laminal             -> mkJustIPA "\x033b" -- ◌̻
        Nasalized           -> mkJustIPA "\x0303" -- ◌̃
        NasalRelease        -> mkJustIPA "\x207f" -- ◌ⁿ
        LateralRelease      -> mkJustIPA "\x02e1" -- ◌ˡ
        NoAudibleRelease    -> mkJustIPA "\x031a" -- ◌̚
        _                   -> mkJustIPA "" --

consonantIPA :: Consonant -> Maybe IPA
consonantIPA = \case
    -- Pulmonic consonants
    -- Bilabials
    Pulmonic Voiceless Bilabial Nasal -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Bilabial Nasal)
    Pulmonic Voiced Bilabial Nasal -> mkJustIPA "m"
    Pulmonic Voiced Bilabial Plosive -> mkJustIPA "b"
    Pulmonic Voiceless Bilabial Plosive -> mkJustIPA "p"
    Pulmonic Voiceless Bilabial (Affricate NonSibilant) -> mkJustIPA "p͡ɸ"
    Pulmonic Voiced Bilabial (Affricate NonSibilant) -> mkJustIPA "b͡β"
    Pulmonic Voiceless Bilabial (Fricative NonSibilant) -> mkJustIPA "ɸ"
    Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkJustIPA "β"
    Pulmonic Voiced Bilabial Flap -> mkJustIPA "ⱱ̟"
    Pulmonic Voiceless Bilabial Trill -> mkJustIPA "ʙ̥"
    Pulmonic Voiced Bilabial Trill -> mkJustIPA "ʙ"

    -- Labio-dentals
    Pulmonic Voiced LabioDental Nasal -> mkJustIPA "ɱ"
    Pulmonic Voiceless LabioDental Plosive -> mkJustIPA "p̪"
    Pulmonic Voiced LabioDental Plosive -> mkJustIPA "b̪"
    Pulmonic Voiceless LabioDental (Affricate NonSibilant) ->
        mkJustIPA "p̪͡f"
    Pulmonic Voiced LabioDental (Affricate NonSibilant) -> mkJustIPA "b̪͡v"
    Pulmonic Voiceless LabioDental (Fricative NonSibilant) -> mkJustIPA "f"
    Pulmonic Voiced LabioDental (Fricative NonSibilant) -> mkJustIPA "v"
    Pulmonic Voiced LabioDental Approximant -> mkJustIPA "ʋ"
    Pulmonic Voiced LabioDental Flap -> mkJustIPA "ⱱ"

    -- Linguo-labials
    Pulmonic Voiced LinguoLabial Nasal -> toIPA
        $ WithSegmentalFeature LinguoLabialized
                               (PulmonicConsonant Voiced Alveolar Nasal)
    Pulmonic Voiceless LinguoLabial Plosive -> toIPA
        $ WithSegmentalFeature LinguoLabialized
                               (PulmonicConsonant Voiceless Alveolar Plosive)
    Pulmonic Voiced LinguoLabial Plosive -> toIPA
        $ WithSegmentalFeature LinguoLabialized
                               (PulmonicConsonant Voiced Alveolar Plosive)
    Pulmonic Voiceless LinguoLabial (Fricative NonSibilant) -> toIPA
        $ WithSegmentalFeature LinguoLabialized
                               (PulmonicConsonant Voiceless
                                                  Alveolar
                                                  (Fricative NonSibilant))

    Pulmonic Voiced LinguoLabial (Fricative NonSibilant) -> toIPA
        $ WithSegmentalFeature LinguoLabialized
                               (PulmonicConsonant Voiced
                                                  Alveolar
                                                  (Fricative NonSibilant))
    Pulmonic Voiced LinguoLabial Flap -> toIPA
        $ WithSegmentalFeature LinguoLabialized
                               (PulmonicConsonant Voiced Alveolar Flap)

    -- Dentals
    Pulmonic Voiceless Dental (Affricate NonSibilant) -> mkJustIPA "t̼͡θ"
    Pulmonic Voiced Dental (Affricate NonSibilant) -> mkJustIPA "d̼͡ð"
    Pulmonic Voiceless Dental (Fricative NonSibilant) -> mkJustIPA "θ"
    Pulmonic Voiced Dental (Fricative NonSibilant) -> mkJustIPA "ð"

    -- Alveolars
    Pulmonic Voiceless Alveolar Nasal -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Alveolar Nasal)
    Pulmonic Voiced Alveolar Nasal -> mkJustIPA "n"
    Pulmonic Voiceless Alveolar Plosive -> mkJustIPA "t"
    Pulmonic Voiced Alveolar Plosive -> mkJustIPA "d"
    Pulmonic Voiceless Alveolar (Affricate Sibilant) -> mkJustIPA "t͡s"
    Pulmonic Voiced Alveolar (Affricate Sibilant) -> mkJustIPA "d͡z"
    Pulmonic Voiceless Alveolar (Affricate NonSibilant) ->
        mkJustIPA "t͡ɹ̝̊"
    Pulmonic Voiced Alveolar (Affricate NonSibilant) -> mkJustIPA "d͡ɹ̝"
    Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkJustIPA "s"
    Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkJustIPA "z"
    Pulmonic Voiced Alveolar Approximant -> mkJustIPA "ɹ"
    Pulmonic Voiceless Alveolar Flap -> mkJustIPA "ɾ̥"
    Pulmonic Voiced Alveolar Flap -> mkJustIPA "ɾ"
    Pulmonic Voiceless Alveolar Trill -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Alveolar Trill)
    Pulmonic Voiced Alveolar Trill -> mkJustIPA "r"
    Pulmonic Voiceless Alveolar LateralAffricate -> mkJustIPA "tɬ"
    Pulmonic Voiced Alveolar LateralAffricate -> mkJustIPA "dɮ"
    Pulmonic Voiceless Alveolar LateralFricative -> mkJustIPA "ɬ"
    Pulmonic Voiced Alveolar LateralFricative -> mkJustIPA "ɮ"
    Pulmonic Voiced Alveolar LateralApproximant -> mkJustIPA "l"
    Pulmonic Voiceless Alveolar LateralFlap -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Alveolar LateralFlap)
    Pulmonic Voiced Alveolar LateralFlap -> mkJustIPA "ɺ"

    -- Post-alveolars
    Pulmonic Voiceless PostAlveolar (Affricate Sibilant) -> mkJustIPA "t͡ʃ"
    Pulmonic Voiced PostAlveolar (Affricate Sibilant) -> mkJustIPA "d͡ʒ"
    Pulmonic Voiceless PostAlveolar (Affricate NonSibilant) ->
        mkJustIPA "tɹ̠̊˔"
    Pulmonic Voiced PostAlveolar (Affricate NonSibilant) ->
        mkJustIPA "d͡ɹ̠˔"
    Pulmonic Voiceless PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʃ"
    Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʒ"
    Pulmonic Voiceless PostAlveolar (Fricative NonSibilant) ->
        mkJustIPA "ɹ̠̊˔"
    Pulmonic Voiced PostAlveolar (Fricative NonSibilant) -> mkJustIPA "ɹ̠˔"

    -- Retroflexes
    Pulmonic Voiceless Retroflex Nasal -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Retroflex Nasal)
    Pulmonic Voiced Retroflex Nasal -> mkJustIPA "ɳ"
    Pulmonic Voiceless Retroflex Plosive -> mkJustIPA "ʈ"
    Pulmonic Voiced Retroflex Plosive -> mkJustIPA "ɖ"
    Pulmonic Voiceless Retroflex (Affricate Sibilant) -> mkJustIPA "ʈ͡ʂ"
    Pulmonic Voiced Retroflex (Affricate Sibilant) -> mkJustIPA "ɖ͡ʐ"
    Pulmonic Voiceless Retroflex (Fricative Sibilant) -> mkJustIPA "ʂ"
    Pulmonic Voiced Retroflex (Fricative Sibilant) -> mkJustIPA "ʐ"
    Pulmonic Voiced Retroflex (Fricative NonSibilant) -> mkJustIPA "ɻ˔"
    Pulmonic Voiced Retroflex Approximant -> mkJustIPA "ɻ"
    Pulmonic Voiceless Retroflex Flap -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Retroflex Flap)
    Pulmonic Voiced Retroflex Flap -> mkJustIPA "ɽ"
    Pulmonic Voiceless Retroflex Trill -> mkJustIPA "ɽ̊r̥"
    Pulmonic Voiced Retroflex Trill -> mkJustIPA "ɽr"
    Pulmonic Voiceless Retroflex LateralAffricate -> mkJustIPA "ʈɭ̊˔"
    Pulmonic Voiced Retroflex LateralAffricate -> mkJustIPA "ɖɭ˔"
    Pulmonic Voiceless Retroflex LateralFricative -> mkJustIPA "ɭ̊˔"
    Pulmonic Voiced Retroflex LateralFricative -> mkJustIPA "ɭ˔"
    Pulmonic Voiced Retroflex LateralApproximant -> mkJustIPA "ɭ"
    Pulmonic Voiceless Retroflex LateralFlap -> mkJustIPA "ɭ̥̆"
    Pulmonic Voiced Retroflex LateralFlap -> mkJustIPA "ɭ̆"

    -- Palatals
    Pulmonic Voiceless Palatal Nasal -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Palatal Nasal)
    Pulmonic Voiced Palatal Nasal -> mkJustIPA "ɲ"
    Pulmonic Voiceless Palatal Plosive -> mkJustIPA "c"
    Pulmonic Voiced Palatal Plosive -> mkJustIPA "ɟ"
    Pulmonic Voiceless Palatal (Affricate Sibilant) -> mkJustIPA "t͡ɕ"
    Pulmonic Voiced Palatal (Affricate Sibilant) -> mkJustIPA "d͡ʑ"
    Pulmonic Voiceless Palatal (Affricate NonSibilant) -> mkJustIPA "c͡ç"
    Pulmonic Voiced Palatal (Affricate NonSibilant) -> mkJustIPA "ɟ͡ʝ"
    Pulmonic Voiceless Palatal (Fricative Sibilant) -> mkJustIPA "ɕ"
    Pulmonic Voiced Palatal (Fricative Sibilant) -> mkJustIPA "ʑ"
    Pulmonic Voiceless Palatal (Fricative NonSibilant) -> mkJustIPA "ç"
    Pulmonic Voiced Palatal (Fricative NonSibilant) -> mkJustIPA "ʝ"
    Pulmonic Voiced Palatal Approximant -> mkJustIPA "j"
    Pulmonic Voiceless Palatal LateralAffricate -> mkJustIPA "cʎ̝̊"
    Pulmonic Voiced Palatal LateralAffricate -> mkJustIPA "ɟʎ̝"
    Pulmonic Voiceless Palatal LateralFricative -> mkJustIPA "ʎ̝̊"
    Pulmonic Voiced Palatal LateralFricative -> mkJustIPA "ʎ̝"
    Pulmonic Voiced Palatal LateralApproximant -> mkJustIPA "ʎ"
    Pulmonic Voiced Palatal LateralFlap -> mkJustIPA "ʎ̆"

    -- Velars
    Pulmonic Voiceless Velar Nasal -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Velar Nasal)
    Pulmonic Voiced Velar Nasal -> mkJustIPA "ŋ"
    Pulmonic Voiceless Velar Plosive -> mkJustIPA "k"
    Pulmonic Voiced Velar Plosive -> mkJustIPA "g"
    Pulmonic Voiceless Velar (Affricate NonSibilant) -> mkJustIPA "k͡x"
    Pulmonic Voiced Velar (Affricate NonSibilant) -> mkJustIPA "g͡ɣ"
    Pulmonic Voiceless Velar (Fricative NonSibilant) -> mkJustIPA "x"
    Pulmonic Voiced Velar (Fricative NonSibilant) -> mkJustIPA "ɣ"
    Pulmonic Voiced Velar Approximant -> mkJustIPA "ɰ"
    Pulmonic Voiceless Velar LateralAffricate -> mkJustIPA "kʟ̝̊"
    Pulmonic Voiced Velar LateralAffricate -> mkJustIPA "ɡʟ̝"
    Pulmonic Voiceless Velar LateralFricative -> mkJustIPA "ʟ̝̊"
    Pulmonic Voiced Velar LateralFricative -> mkJustIPA "ʟ̝"
    Pulmonic Voiced Velar LateralApproximant -> mkJustIPA "ʟ"
    Pulmonic Voiced Velar LateralFlap -> mkJustIPA "ʟ̆"

    -- Uvulars
    Pulmonic Voiced Uvular Nasal -> mkJustIPA "ɴ"
    Pulmonic Voiceless Uvular Plosive -> mkJustIPA "q"
    Pulmonic Voiced Uvular Plosive -> mkJustIPA "ɢ"
    Pulmonic Voiceless Uvular (Affricate NonSibilant) -> mkJustIPA "q͡χ"
    Pulmonic Voiced Uvular (Affricate NonSibilant) -> mkJustIPA "ɢ͡ʁ"
    Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustIPA "χ"
    Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustIPA "ʁ"
    Pulmonic Voiced Uvular Flap -> mkJustIPA "ɢ̆"
    Pulmonic Voiceless Uvular Trill -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Uvular Trill)
    Pulmonic Voiced Uvular Trill -> mkJustIPA "ʀ"
    Pulmonic Voiced Uvular LateralApproximant -> mkJustIPA "ʟ̠"

    -- Pharyngeals
    Pulmonic Voiceless Pharyngeal Plosive -> mkJustIPA "ʡ"
    Pulmonic Voiced Pharyngeal (Affricate NonSibilant) -> mkJustIPA "ʡ͡ʢ"
    Pulmonic Voiceless Pharyngeal (Fricative NonSibilant) -> mkJustIPA "ħ"
    Pulmonic Voiced Pharyngeal (Fricative NonSibilant) -> mkJustIPA "ʕ"
    Pulmonic Voiced Pharyngeal Flap -> mkJustIPA "̆ʡ̆"
    Pulmonic Voiceless Pharyngeal Trill -> mkJustIPA "ʜ"
    Pulmonic Voiced Pharyngeal Trill -> mkJustIPA "ʢ"

    -- Glottals
    Pulmonic Voiceless Glottal Plosive -> mkJustIPA "ʔ"
    Pulmonic Voiceless Glottal (Affricate NonSibilant) -> mkJustIPA "ʔ͡h"
    Pulmonic Voiceless Glottal (Fricative NonSibilant) -> mkJustIPA "h"
    Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkJustIPA "ɦ"
    Pulmonic Voiced Glottal Approximant -> mkJustIPA "̆̆ʔ̞"

    -- Ejectives
    -- Bilabials
    Ejective Bilabial Plosive -> mkJustIPA "pʼ"
    Ejective Bilabial (Fricative NonSibilant) -> mkJustIPA "ɸʼ"

    -- Labio-dentals
    Ejective LabioDental (Affricate NonSibilant) -> mkJustIPA "p̪͡fʼ"
    Ejective LabioDental (Fricative NonSibilant) -> mkJustIPA "fʼ"

    -- Dentals
    Ejective Dental Plosive -> mkJustIPA "t̪ʼ"
    Ejective Dental (Affricate NonSibilant) -> mkJustIPA "t̪͡θʼ"
    Ejective Dental (Fricative NonSibilant) -> mkJustIPA "θʼ"

    -- Alveolars
    Ejective Alveolar Plosive -> mkJustIPA "tʼ"
    Ejective Alveolar (Affricate Sibilant) -> mkJustIPA "t͡sʼ"
    Ejective Alveolar (Fricative Sibilant) -> mkJustIPA "sʼ"
    Ejective Alveolar LateralAffricate -> mkJustIPA "t͡ɬʼ"
    Ejective Alveolar LateralFricative -> mkJustIPA "ɬʼ"

    -- Post-alveolars
    Ejective PostAlveolar (Affricate Sibilant) -> mkJustIPA "t͡ʃʼ"
    Ejective PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʃʼ"

    -- Retroflexes
    Ejective Retroflex Plosive -> mkJustIPA "ʈʼ"
    Ejective Retroflex (Affricate Sibilant) -> mkJustIPA "ʈ͡ʂʼ"
    Ejective Retroflex (Fricative Sibilant) -> mkJustIPA "ʂʼ"

    -- Palatals
    Ejective Palatal Plosive -> mkJustIPA "cʼ"
    Ejective Palatal (Affricate Sibilant) -> mkJustIPA "t͡ɕʼ"
    Ejective Palatal (Fricative Sibilant) -> mkJustIPA "ɕʼ"
    Ejective Palatal LateralAffricate -> mkJustIPA "cʎ̝̊ʼ"

    -- Velars
    Ejective Velar Plosive -> mkJustIPA "kʼ"
    Ejective Velar (Affricate NonSibilant) -> mkJustIPA "k͡xʼ"
    Ejective Velar (Fricative NonSibilant) -> mkJustIPA "xʼ"
    Ejective Velar LateralAffricate -> mkJustIPA "kʟ̝̊ʼ"

    -- Uvulars
    Ejective Uvular Plosive -> mkJustIPA "qʼ"
    Ejective Uvular (Affricate NonSibilant) -> mkJustIPA "q͡χʼ"
    Ejective Uvular (Fricative NonSibilant) -> mkJustIPA "χʼ"

    -- Pharyngeals
    Ejective Pharyngeal Plosive -> mkJustIPA "ʡʼ"

    -- Implosives
    Implosive Voiceless Bilabial -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Alveolar)
    Implosive Voiced Bilabial -> mkJustIPA "ɓ"
    Implosive Voiceless Dental -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Dental)
    Implosive Voiced Dental -> toIPA
        $ WithSegmentalFeature Dentalized (ImplosiveConsonant Voiced Alveolar)
    Implosive Voiced Alveolar -> mkJustIPA "ɗ"
    Implosive Voiceless Alveolar -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Alveolar)
    Implosive Voiced Retroflex -> mkJustIPA "ᶑ"
    Implosive Voiceless Retroflex -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Retroflex)
    Implosive Voiceless Palatal -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Palatal)
    Implosive Voiced Palatal -> mkJustIPA "ʄ"
    Implosive Voiceless Velar -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Velar)
    Implosive Voiced Velar -> mkJustIPA "ɠ"
    Implosive Voiceless Uvular -> toIPA
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Uvular)
    Implosive Voiced Uvular -> mkJustIPA "ʛ"

    -- Clicks
    Click Bilabial -> mkJustIPA "ʘ"
    Click Dental -> mkJustIPA "ǀ"
    Click Alveolar -> mkJustIPA "ǃ"
    Click PostAlveolar -> mkJustIPA "ǁ" -- lateral click
    Click Palatal -> mkJustIPA "ǂ"

    -- Double articulation
    DoublyArticulated Voiced Bilabial Alveolar Nasal -> mkJustIPA "n͡m"
    DoublyArticulated Voiceless Bilabial Alveolar Plosive -> mkJustIPA "t͡p"
    DoublyArticulated Voiced Bilabial Alveolar Plosive -> mkJustIPA "d͡b"
    DoublyArticulated Voiced Bilabial Velar Nasal -> mkJustIPA "ŋ͡m"
    DoublyArticulated Voiceless Bilabial Velar Plosive -> mkJustIPA "k͡p"
    DoublyArticulated Voiced Bilabial Velar Plosive -> mkJustIPA "g͡b"
    DoublyArticulated Voiceless Uvular Pharyngeal Plosive -> mkJustIPA "q͡ʡ"
    DoublyArticulated Voiceless Bilabial Palatal (Fricative NonSibilant) ->
        mkJustIPA "ɥ̊"
    DoublyArticulated Voiced Bilabial Palatal Approximant -> mkJustIPA "ɥ"
    DoublyArticulated Voiceless Bilabial Velar (Fricative NonSibilant) ->
        mkJustIPA "ʍ"
    DoublyArticulated Voiced Bilabial Velar Approximant -> mkJustIPA "w"
    DoublyArticulated Voiced Alveolar Velar LateralApproximant ->
        mkJustIPA "ɫ"
    -- The sj-sound in Swedish phonology; actual realization is contested
    -- and appears to vary between dialects
    DoublyArticulated Voiceless PostAlveolar Velar (Fricative Sibilant) ->
        mkJustIPA "ɧ"
    DoublyArticulated Voiceless LabioDental Velar (Fricative Sibilant) ->
        mkJustIPA "ɧ"

    _ -> Nothing

vowelIPA :: Segment -> Maybe IPA
vowelIPA = \case
    Vowel Close Front Unrounded -> mkJustIPA "i"
    Vowel Close Front Rounded -> mkJustIPA "y"
    Vowel Close Central Unrounded -> mkJustIPA "ɨ"
    Vowel Close Central Rounded -> mkJustIPA "ʉ"
    Vowel Close Back Unrounded -> mkJustIPA "ɯ"
    Vowel Close Back Rounded -> mkJustIPA "u"
    Vowel NearClose Front Unrounded -> mkJustIPA "ɪ"
    Vowel NearClose Front Rounded -> mkJustIPA "ʏ"
    Vowel NearClose Back Rounded -> mkJustIPA "ʊ"
    Vowel CloseMid Front Unrounded -> mkJustIPA "e"
    Vowel CloseMid Front Rounded -> mkJustIPA "ø"
    Vowel CloseMid Central Unrounded -> mkJustIPA "ɘ"
    Vowel CloseMid Central Rounded -> mkJustIPA "ɵ"
    Vowel CloseMid Back Unrounded -> mkJustIPA "ɤ"
    Vowel CloseMid Back Rounded -> mkJustIPA "o"
    Vowel Mid Front Unrounded -> toIPA
        $ WithSegmentalFeature Lowered (Vowel CloseMid Front Unrounded)
    Vowel Mid Front Rounded -> toIPA
        $ WithSegmentalFeature Lowered (Vowel CloseMid Front Rounded)
    Vowel Mid Central Unrounded -> mkJustIPA "ə"
    Vowel Mid Back Unrounded -> toIPA
        $ WithSegmentalFeature Lowered (Vowel CloseMid Back Unrounded)
    Vowel Mid Back Rounded -> toIPA
        $ WithSegmentalFeature Lowered (Vowel CloseMid Back Rounded)
    Vowel OpenMid Front Unrounded -> mkJustIPA "ɛ"
    Vowel OpenMid Front Rounded -> mkJustIPA "œ"
    Vowel OpenMid Central Unrounded -> mkJustIPA "ɜ"
    Vowel OpenMid Central Rounded -> mkJustIPA "ɞ"
    Vowel OpenMid Back Unrounded -> mkJustIPA "ʌ"
    Vowel OpenMid Back Rounded -> mkJustIPA "ɔ"
    Vowel NearOpen Front Unrounded -> mkJustIPA "æ"
    Vowel NearOpen Central Unrounded -> mkJustIPA "ɐ"
    Vowel Open Front Unrounded -> mkJustIPA "a"
    Vowel Open Front Rounded -> mkJustIPA "ɶ"
    Vowel Open Central Unrounded -> mkJustIPA "ä"
    Vowel Open Back Unrounded -> mkJustIPA "ɑ"
    Vowel Open Back Rounded -> mkJustIPA "ɒ"
    _ -> Nothing

secondaryArticulationIPA :: Segment -> Maybe IPA
secondaryArticulationIPA = \case
    Consonant c -> case c of
        Pulmonic Voiced Bilabial Nasal -> mkJustIPA "\x1d50"
        Pulmonic Voiced LabioDental Nasal -> mkJustIPA "\x1dac"
        Pulmonic Voiced Alveolar Nasal -> mkJustIPA "\x207f"
        Pulmonic Voiced Retroflex Nasal -> mkJustIPA "\x1daf"
        Pulmonic Voiced Palatal Nasal -> mkJustIPA "\x1dae"
        Pulmonic Voiced Velar Nasal -> mkJustIPA "\x1d51"
        Pulmonic Voiced Uvular Nasal -> mkJustIPA "\x1db0"

        Pulmonic Voiced Bilabial Plosive -> mkJustIPA "\x1d56"
        Pulmonic Voiceless Bilabial Plosive -> mkJustIPA "\x1d47"
        Pulmonic Voiceless Alveolar Plosive -> mkJustIPA "\x1d57"
        Pulmonic Voiced Alveolar Plosive -> mkJustIPA "\x1d48"
        Pulmonic Voiceless Palatal Plosive -> mkJustIPA "\x1d9c"
        Pulmonic Voiced Palatal Plosive -> mkJustIPA "\x1da1"
        Pulmonic Voiceless Velar Plosive -> mkJustIPA "\x1d4f"
        Pulmonic Voiced Velar Plosive -> mkJustIPA "\x1da2"
        Pulmonic Voiceless Glottal Plosive -> mkJustIPA "\x02c0"

        Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkJustIPA "\x1db2"
        Pulmonic Voiceless Bilabial (Fricative NonSibilant) ->
            mkJustIPA "\x1d5d"
        Pulmonic Voiced LabioDental (Fricative NonSibilant) ->
            mkJustIPA "\x1da0"
        Pulmonic Voiceless LabioDental (Fricative NonSibilant) ->
            mkJustIPA "\x1d5b"
        Pulmonic Voiceless Dental (Fricative NonSibilant) -> mkJustIPA "\x1dbf"
        Pulmonic Voiced Dental (Fricative NonSibilant) -> mkJustIPA "\x1d9e"
        Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkJustIPA "\x02e2"
        Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkJustIPA "\x1dbb"
        Pulmonic Voiceless PostAlveolar (Fricative Sibilant) ->
            mkJustIPA "\x1db4"
        Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkJustIPA "\x1dbe"
        Pulmonic Voiceless Palatal (Fricative Sibilant) -> mkJustIPA "\x1d9d"
        Pulmonic Voiced Palatal (Fricative Sibilant) -> mkJustIPA "\x1dbd"
        Pulmonic Voiceless Palatal (Fricative NonSibilant) ->
            mkJustIPA "\x1d9c\x0327"
        Pulmonic Voiced Palatal (Fricative NonSibilant) -> mkJustIPA "\x1da8"
        Pulmonic Voiceless Velar (Fricative NonSibilant) -> mkJustIPA "\x02e3"
        Pulmonic Voiced Velar (Fricative NonSibilant) -> mkJustIPA "\x02e0"
        Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustIPA "\x1d61"
        Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustIPA "\x02b6"
        Pulmonic Voiceless Glottal (Fricative NonSibilant) ->
            mkJustIPA "\x02b0"
        Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkJustIPA "\x02b1"

        Pulmonic Voiced LabioDental Approximant -> mkJustIPA "\x1db9"
        Pulmonic Voiced Alveolar Approximant -> mkJustIPA "\x02b4"
        Pulmonic Voiced Retroflex Approximant -> mkJustIPA "\x02b5"
        Pulmonic Voiced Palatal Approximant -> mkJustIPA "\x02b2"
        Pulmonic Voiceless Velar Approximant -> mkJustIPA "\xab69"
        Pulmonic Voiced Velar Approximant -> mkJustIPA "\x1dad"

        Pulmonic Voiced Alveolar Trill -> mkJustIPA "\x02b3"

        _ -> Nothing

    Vowel Close Front Unrounded -> mkJustIPA "\x2071"
    Vowel Close Front Rounded -> mkJustIPA "\x02b8"
    Vowel Close Central Unrounded -> mkJustIPA "\x1da4"
    Vowel Close Central Rounded -> mkJustIPA "\x1db6"
    Vowel Close Back Unrounded -> mkJustIPA "\x1d5a"
    Vowel Close Back Rounded -> mkJustIPA "\x1d58"
    Vowel NearClose Front Unrounded -> mkJustIPA "\x1da6"
    Vowel NearClose Central Unrounded -> mkJustIPA "\x1da7"
    Vowel NearClose Back Rounded -> mkJustIPA "\x1db7"
    Vowel Mid Central Unrounded -> mkJustIPA "\x1d4a"
    Vowel Mid Central Rounded -> mkJustIPA "\x1d4a"
    Vowel OpenMid Front Unrounded -> mkJustIPA "\x1d4b"
    Vowel OpenMid Front Rounded -> mkJustIPA "\xa7f9"
    Vowel OpenMid Central Unrounded -> mkJustIPA "\x1d9f"
    Vowel OpenMid Back Unrounded -> mkJustIPA "\x1dba"
    Vowel OpenMid Back Rounded -> mkJustIPA "\x1d53"
    Vowel NearOpen Front Unrounded -> mkJustIPA "\x1d46"
    Vowel NearOpen Central Unrounded -> mkJustIPA "\x1d44"
    Vowel NearOpen Back Unrounded -> mkJustIPA "\x1d45"
    Vowel NearOpen Back Rounded -> mkJustIPA "\x1d9b"
    Vowel Open Front Unrounded -> mkJustIPA "\x1d43"
    Vowel Open Back Rounded -> mkJustIPA "\x1d44"

    _ -> Nothing

mkJustXSampa :: Text -> Maybe XSampa
mkJustXSampa = Just . XSampa

mkXSampaOp :: ReprIPA a => (b -> Maybe XSampa) -> a -> b -> Maybe XSampa
mkXSampaOp f x y = (<>) <$> toXSampa x <*> f y

vowelXSampa :: Segment -> Maybe XSampa
vowelXSampa = \case
    Vowel Close Front Unrounded -> mkJustXSampa "i"
    Vowel Close Front Rounded -> mkJustXSampa "y"
    Vowel Close Central Unrounded -> mkJustXSampa "1"
    Vowel Close Central Rounded -> mkJustXSampa "}"
    Vowel Close Back Unrounded -> mkJustXSampa "M"
    Vowel Close Back Rounded -> mkJustXSampa "u"
    Vowel NearClose Front Unrounded -> mkJustXSampa "I"
    Vowel NearClose Front Rounded -> mkJustXSampa "Y"
    Vowel NearClose Back Rounded -> mkJustXSampa "U"
    Vowel CloseMid Front Unrounded -> mkJustXSampa "e"
    Vowel CloseMid Front Rounded -> mkJustXSampa "2"
    Vowel CloseMid Central Unrounded -> mkJustXSampa "@\\"
    Vowel CloseMid Central Rounded -> mkJustXSampa "8"
    Vowel CloseMid Back Unrounded -> mkJustXSampa "7"
    Vowel CloseMid Back Rounded -> mkJustXSampa "o"
    Vowel Mid Front Unrounded -> toXSampa
        $ WithSegmentalFeature Lowered (Vowel CloseMid Front Unrounded)
    Vowel Mid Front Rounded -> toXSampa
        $ WithSegmentalFeature Lowered (Vowel CloseMid Front Rounded)
    Vowel Mid Central Unrounded -> mkJustXSampa "@"
    Vowel Mid Back Unrounded -> toXSampa
        $ WithSegmentalFeature Lowered (Vowel CloseMid Back Unrounded)
    Vowel Mid Back Rounded -> toXSampa
        $ WithSegmentalFeature Lowered (Vowel CloseMid Back Unrounded)
    Vowel OpenMid Front Unrounded -> mkJustXSampa "E"
    Vowel OpenMid Front Rounded -> mkJustXSampa "9"
    Vowel OpenMid Central Unrounded -> mkJustXSampa "3"
    Vowel OpenMid Central Rounded -> mkJustXSampa "3\\"
    Vowel OpenMid Back Unrounded -> mkJustXSampa "V"
    Vowel OpenMid Back Rounded -> mkJustXSampa "O"
    Vowel NearOpen Front Unrounded -> mkJustXSampa "{"
    Vowel NearOpen Central Unrounded -> mkJustXSampa "6"
    Vowel Open Front Unrounded -> mkJustXSampa "a"
    Vowel Open Front Rounded -> mkJustXSampa "&"
    Vowel Open Back Unrounded -> mkJustXSampa "A"
    Vowel Open Back Rounded -> mkJustXSampa "Q"
    _ -> Nothing

consonantXSampa :: Consonant -> Maybe XSampa
consonantXSampa = \case
    -- Pulmonic consonants
    -- Bilabials
    Pulmonic Voiceless Bilabial Nasal -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Bilabial Nasal)
    Pulmonic Voiced Bilabial Nasal -> mkJustXSampa "m"
    Pulmonic Voiced Bilabial Plosive -> mkJustXSampa "b"
    Pulmonic Voiceless Bilabial Plosive -> mkJustXSampa "p"
    Pulmonic Voiceless Bilabial (Fricative NonSibilant) -> mkJustXSampa "p\\"
    Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkJustXSampa "B"
    Pulmonic Voiced Bilabial Trill -> mkJustXSampa "B\\"

    -- Labio-dentals
    Pulmonic Voiced LabioDental Nasal -> mkJustXSampa "F"
    Pulmonic Voiceless LabioDental (Fricative NonSibilant) -> mkJustXSampa "f"
    Pulmonic Voiced LabioDental (Fricative NonSibilant) -> mkJustXSampa "v"
    Pulmonic Voiced LabioDental Approximant -> mkJustXSampa "P"

    -- Dentals
    Pulmonic Voiceless Dental (Fricative NonSibilant) -> mkJustXSampa "T"
    Pulmonic Voiced Dental (Fricative NonSibilant) -> mkJustXSampa "D"

    -- Alveolars
    Pulmonic Voiceless Alveolar Nasal -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Alveolar Nasal)
    Pulmonic Voiced Alveolar Nasal -> mkJustXSampa "n"
    Pulmonic Voiceless Alveolar Plosive -> mkJustXSampa "t"
    Pulmonic Voiced Alveolar Plosive -> mkJustXSampa "d"
    Pulmonic Voiceless Alveolar (Affricate Sibilant) -> mkJustXSampa "t_s"
    Pulmonic Voiced Alveolar (Affricate Sibilant) -> mkJustXSampa "d_z"
    Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkJustXSampa "s"
    Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkJustXSampa "z"
    Pulmonic Voiced Alveolar Approximant -> mkJustXSampa "r\\"
    Pulmonic Voiceless Alveolar Flap -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Alveolar Flap)
    Pulmonic Voiced Alveolar Flap -> mkJustXSampa "4"
    Pulmonic Voiced Alveolar Trill -> mkJustXSampa "r"
    Pulmonic Voiceless Alveolar Trill -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Alveolar Trill)
    Pulmonic Voiceless Alveolar LateralFricative -> mkJustXSampa "K"
    Pulmonic Voiced Alveolar LateralFricative -> mkJustXSampa "K\\"
    Pulmonic Voiced Alveolar LateralApproximant -> mkJustXSampa "l"

    -- Post-alveolars
    Pulmonic Voiceless PostAlveolar (Affricate Sibilant) -> mkJustXSampa "t_S"
    Pulmonic Voiced PostAlveolar (Affricate Sibilant) -> mkJustXSampa "d_Z"
    Pulmonic Voiceless PostAlveolar (Fricative Sibilant) -> mkJustXSampa "S"
    Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkJustXSampa "Z"

    -- Retroflexes
    Pulmonic Voiceless Retroflex Nasal -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Retroflex Nasal)
    Pulmonic Voiced Retroflex Nasal -> mkJustXSampa "n`"
    Pulmonic Voiceless Retroflex Plosive -> mkJustXSampa "t`"
    Pulmonic Voiced Retroflex Plosive -> mkJustXSampa "d`"
    Pulmonic Voiceless Retroflex (Affricate Sibilant) -> mkJustXSampa "t`_s`"
    Pulmonic Voiced Retroflex (Affricate Sibilant) -> mkJustXSampa "d`_z`"
    Pulmonic Voiceless Retroflex (Fricative Sibilant) -> mkJustXSampa "s`"
    Pulmonic Voiced Retroflex (Fricative Sibilant) -> mkJustXSampa "z`"
    Pulmonic Voiced Retroflex Approximant -> mkJustXSampa "r\\`"
    Pulmonic Voiceless Retroflex Flap -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Retroflex Nasal)
    Pulmonic Voiced Retroflex Flap -> mkJustXSampa "r`"
    Pulmonic Voiceless Retroflex LateralApproximant -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Retroflex Nasal)
    Pulmonic Voiced Retroflex LateralApproximant -> mkJustXSampa "l`"

    -- Palatals
    Pulmonic Voiced Palatal Nasal -> mkJustXSampa "J"
    Pulmonic Voiceless Palatal Plosive -> mkJustXSampa "c"
    Pulmonic Voiced Palatal Plosive -> mkJustXSampa "J\\"
    Pulmonic Voiceless Palatal (Affricate Sibilant) -> mkJustXSampa "t_s\\"
    Pulmonic Voiced Palatal (Affricate Sibilant) -> mkJustXSampa "d_z\\"
    Pulmonic Voiceless Palatal (Fricative Sibilant) -> mkJustXSampa "s\\"
    Pulmonic Voiced Palatal (Fricative Sibilant) -> mkJustXSampa "z\\"
    Pulmonic Voiceless Palatal (Fricative NonSibilant) -> mkJustXSampa "C"
    Pulmonic Voiced Palatal (Fricative NonSibilant) -> mkJustXSampa "j\\"
    Pulmonic Voiced Palatal Approximant -> mkJustXSampa "j"
    Pulmonic Voiced Palatal LateralApproximant -> mkJustXSampa "L"

    -- Velars
    Pulmonic Voiceless Velar Nasal -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Velar Nasal)
    Pulmonic Voiced Velar Nasal -> mkJustXSampa "N"
    Pulmonic Voiceless Velar Plosive -> mkJustXSampa "k"
    Pulmonic Voiced Velar Plosive -> mkJustXSampa "g"
    Pulmonic Voiceless Velar (Affricate NonSibilant) -> mkJustXSampa "k_x"
    Pulmonic Voiced Velar (Affricate NonSibilant) -> mkJustXSampa "g_G"
    Pulmonic Voiceless Velar (Fricative NonSibilant) -> mkJustXSampa "x"
    Pulmonic Voiced Velar (Fricative NonSibilant) -> mkJustXSampa "G"
    Pulmonic Voiced Velar Approximant -> mkJustXSampa "m\\"
    Pulmonic Voiced Velar LateralApproximant -> mkJustXSampa "L\\"

    -- Uvulars
    Pulmonic Voiced Uvular Nasal -> mkJustXSampa "N\\"
    Pulmonic Voiceless Uvular Plosive -> mkJustXSampa "q"
    Pulmonic Voiced Uvular Plosive -> mkJustXSampa "G\\"
    Pulmonic Voiceless Uvular (Affricate NonSibilant) -> mkJustXSampa "q_X"
    Pulmonic Voiced Uvular (Affricate NonSibilant) -> mkJustXSampa "G\\_R"
    Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustXSampa "X"
    Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustXSampa "R"
    Pulmonic Voiceless Uvular Trill -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (PulmonicConsonant Voiced Uvular Trill)
    Pulmonic Voiced Uvular Trill -> mkJustXSampa "R\\"

    -- Pharyngeals
    Pulmonic Voiceless Pharyngeal (Fricative NonSibilant) -> mkJustXSampa "X\\"
    Pulmonic Voiced Pharyngeal (Fricative NonSibilant) -> mkJustXSampa "?\\"

    -- Glottals
    Pulmonic Voiceless Glottal Plosive -> mkJustXSampa "?"
    Pulmonic Voiceless Glottal (Affricate NonSibilant) -> mkJustXSampa "?_h\\"
    Pulmonic Voiceless Glottal (Fricative NonSibilant) -> mkJustXSampa "h"
    Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkJustXSampa "h\\"

    -- Ejectives
    -- Bilabials
    Ejective Bilabial Plosive -> mkJustXSampa "p_>"
    Ejective Bilabial (Fricative NonSibilant) -> mkJustXSampa "p\\_>"

    -- Dentals
    Ejective Dental (Fricative NonSibilant) -> mkJustXSampa "T_>"

    -- Alveolars
    Ejective Alveolar Plosive -> mkJustXSampa "t_>"
    Ejective Alveolar (Affricate Sibilant) -> mkJustXSampa "t_s_>"
    Ejective Alveolar (Fricative Sibilant) -> mkJustXSampa "s_>"

    -- Post-alveolars
    Ejective PostAlveolar (Affricate Sibilant) -> mkJustXSampa "t_S_>"
    Ejective PostAlveolar (Fricative Sibilant) -> mkJustXSampa "S_>"

    -- Retroflexes
    Ejective Retroflex Plosive -> mkJustXSampa "t`_>"
    Ejective Retroflex (Affricate Sibilant) -> mkJustXSampa "t`_s`_>"
    Ejective Retroflex (Fricative Sibilant) -> mkJustXSampa "s`_>"

    -- Palatals
    Ejective Palatal Plosive -> mkJustXSampa "c_>"
    Ejective Palatal (Affricate Sibilant) -> mkJustXSampa "t_s\\_>"
    Ejective Palatal (Fricative Sibilant) -> mkJustXSampa "s\\_>"

    -- Velars
    Ejective Velar Plosive -> mkJustXSampa "k_>"
    Ejective Velar (Affricate NonSibilant) -> mkJustXSampa "k_x_>"
    Ejective Velar (Fricative NonSibilant) -> mkJustXSampa "x_>"

    -- Uvulars
    Ejective Uvular Plosive -> mkJustXSampa "q_>"
    Ejective Uvular (Affricate NonSibilant) -> mkJustXSampa "q_X_>"
    Ejective Uvular (Fricative NonSibilant) -> mkJustXSampa "X_>"

    -- Implosives
    Implosive Voiceless Bilabial -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Bilabial)
    Implosive Voiced Bilabial -> mkJustXSampa "b_<"
    Implosive Voiceless Alveolar -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Alveolar)
    Implosive Voiced Alveolar -> mkJustXSampa "d_<"
    Implosive Voiceless Retroflex -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Retroflex)
    Implosive Voiced Retroflex -> mkJustXSampa "d`_<"
    Implosive Voiceless Palatal -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Palatal)
    Implosive Voiced Palatal -> mkJustXSampa "f_<"
    Implosive Voiceless Velar -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Palatal)
    Implosive Voiced Velar -> mkJustXSampa "g_<"
    Implosive Voiceless Uvular -> toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (ImplosiveConsonant Voiced Uvular)
    Implosive Voiced Uvular -> mkJustXSampa "G_<"

    -- Clicks
    Click Bilabial -> mkJustXSampa "O\\"
    Click Dental -> mkJustXSampa "|\\"
    Click Alveolar -> mkJustXSampa "ǃ\\"
    Click PostAlveolar -> mkJustXSampa "|\\|\\" -- lateral click
    Click Palatal -> mkJustXSampa "=\\"

    -- Double articulation
    DoublyArticulated Voiced Bilabial Alveolar Nasal -> mkJustXSampa "n_m"
    DoublyArticulated Voiceless Bilabial Alveolar Plosive -> mkJustXSampa "t_p"
    DoublyArticulated Voiced Bilabial Alveolar Plosive -> mkJustXSampa "d_b"
    DoublyArticulated Voiced Bilabial Velar Nasal -> mkJustXSampa "N_m"
    DoublyArticulated Voiceless Bilabial Velar Plosive -> mkJustXSampa "k_p"
    DoublyArticulated Voiced Bilabial Velar Plosive -> mkJustXSampa "g_b"
    DoublyArticulated Voiceless Bilabial Palatal (Fricative NonSibilant) ->
        toXSampa
        $ WithSegmentalFeature (Voicing Voiceless)
                               (Consonant (DoublyArticulated Voiced
                                                             Bilabial
                                                             Palatal
                                                             Approximant))
    DoublyArticulated Voiced Bilabial Palatal Approximant -> mkJustXSampa "H"
    DoublyArticulated Voiceless Bilabial Velar (Fricative NonSibilant) ->
        mkJustXSampa "W"
    DoublyArticulated Voiced Bilabial Velar Approximant -> mkJustXSampa "w"
    DoublyArticulated Voiceless PostAlveolar Velar (Fricative Sibilant) ->
        mkJustXSampa "x\\"
    DoublyArticulated Voiceless LabioDental Velar (Fricative Sibilant) ->
        mkJustXSampa "x\\"

    _ -> Nothing

withSegmentalFeatureXSampa :: Segment -> SegmentalFeature -> Maybe XSampa
withSegmentalFeatureXSampa s = \case
    Voicing v -> mkXSampaOp xSampaVoicing s v
      where
        xSampaVoicing = \case
            Voiceless -> mkJustXSampa "_0"
            Voiced    -> mkJustXSampa "_v"
    Length l -> mkXSampaOp xSampaLength s l
      where
        xSampaLength = \case
            OverLong   -> mkJustXSampa "::"
            Long       -> mkJustXSampa ":"
            HalfLong   -> mkJustXSampa ":\\"
            Short      -> mkJustXSampa mempty
            ExtraShort -> mkJustXSampa "_X"
    SecondaryArticulation _ -> Nothing
    SuperScriptNumeric _ -> Nothing
    feature -> (<>) <$> toXSampa s <*> case feature of
        Aspirated           -> mkJustXSampa "_h"
        MoreRounded         -> mkJustXSampa "_O"
        LessRounded         -> mkJustXSampa "_c"
        Advanced            -> mkJustXSampa "_+"
        Retracted           -> mkJustXSampa "_-"
        Centralized         -> mkJustXSampa "_\""
        MidCentralized      -> mkJustXSampa "_x"
        Syllabic            -> mkJustXSampa "="
        NonSyllabic         -> mkJustXSampa "_^"
        Rhotacized          -> mkJustXSampa "`"
        BreathyVoice        -> mkJustXSampa "_t"
        CreakyVoice         -> mkJustXSampa "_k"
        Labialized          -> mkJustXSampa "_w"
        Palatalized         -> mkJustXSampa "'"
        Velarized           -> mkJustXSampa "_G"
        Pharyngealized      -> mkJustXSampa "_?\\"
        Raised              -> mkJustXSampa "_r"
        Lowered             -> mkJustXSampa "_o"
        AdvancedTongueRoot  -> mkJustXSampa "_A"
        RetractedTongueRoot -> mkJustXSampa "_q"
        Dentalized          -> mkJustXSampa "_d"
        Apical              -> mkJustXSampa "_a"
        Laminal             -> mkJustXSampa "_m"
        Nasalized           -> mkJustXSampa "~"
        LateralRelease      -> mkJustXSampa "_l"
        NoAudibleRelease    -> mkJustXSampa "_}"
        _                   -> Nothing

withSuprasegmentalFeatureXSampa
    :: Traversable t => Syllable t -> SuprasegmentalFeature -> Maybe XSampa
withSuprasegmentalFeatureXSampa s = \case
    LevelLexicalTone tone -> mkXSampaOp ipaTone s tone
      where
        ipaTone = \case
            ExtraHighTone -> mkJustXSampa "_T"
            HighTone      -> mkJustXSampa "_H"
            MidTone       -> mkJustXSampa "_M"
            LowTone       -> mkJustXSampa "_L"
            ExtraLowTone  -> mkJustXSampa "_B"
            DownStep      -> mkJustXSampa "!"
            UpStep        -> mkJustXSampa "^"

    LevelLexicalToneDiacritic tone -> toXSampa
        $ WithSuprasegmentalFeature (LevelLexicalTone tone) s

    LexicalToneContour tone -> mkXSampaOp ipaToneContour s tone
      where
        ipaToneContour = \case
            Rising        -> mkJustXSampa "_R"
            Falling       -> mkJustXSampa "_F"
            HighRising    -> mkJustXSampa "_H_T"
            LowRising     -> mkJustXSampa "_B_L"
            HighFalling   -> mkJustXSampa "_H_F"
            LowFalling    -> mkJustXSampa "_L_B"
            RisingFalling -> mkJustXSampa "_R_F"
            FallingRising -> mkJustXSampa "_F_R"
            GlobalRise    -> mkJustXSampa "<R>"
            GlobalFall    -> mkJustXSampa "<F>"

    LexicalToneContourDiacritic tone -> toXSampa
        $ WithSuprasegmentalFeature (LexicalToneContour tone) s

    Stress stress -> mkXSampaOp ipaStress s stress
      where
        ipaStress Primary   = mkJustXSampa "\""
        ipaStress Secondary = mkJustXSampa "%"

    -- Explicit syllable break
    Break -> (<>) <$> toXSampa s <*> mkJustXSampa "."

    -- Syllable non-break
    Linking -> (<>) <$> toXSampa s <*> mkJustXSampa "-\\"