{-# LANGUAGE LambdaCase #-} {-# 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 Data.Char ( digitToInt ) import Data.Text ( Text ) import qualified Data.Text as T import Language.IPA.Types as M -- | 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' _ = error "Illegal/unrepresentable value" instance Traversable t => ReprIPA (Syllable t) where toIPA = \case -- Syllable without any suprasegmental information Syllable ss | null ss -> Nothing | otherwise -> foldr1 (<>) <$> traverse toIPA ss WithSuprasegmentalFeature feature s -> withSuprasegmentalFeature s feature instance ReprIPA Segment where toIPA = \case Zero -> mkJustIPA "∅" Consonant c -> consonant c v@Vowel {} -> vowel v WithSegmentalFeature feature s -> withSegmentalFeature 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 withSuprasegmentalFeature :: Traversable t => Syllable t -> SuprasegmentalFeature -> Maybe IPA withSuprasegmentalFeature s = \case -- Level tones, non-diacritic 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 -- Level tones, diacritic. The text value inside the 'IPA' is a -- combining character 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 "ꜛ" -- Tone contours, non-diacritic 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 "↙" -- Tone contours, diacritic 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 -- Syllable stress Stress stress -> mkIPAOp ipaStress s stress where ipaStress Primary = mkJustIPA "ˈ" ipaStress Secondary = mkJustIPA "ˌ" -- Explicit syllable break Break -> (<>) <$> toIPA s <*> mkJustIPA "." -- Syllable non-break Linking -> (<>) <$> toIPA s <*> mkJustIPA "‿" withSegmentalFeature :: Segment -> SegmentalFeature -> Maybe IPA withSegmentalFeature 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 secondaryArticulation 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 "" -- consonant :: Consonant -> Maybe IPA consonant = \case -- Pulmonic consonants -- Bilabials Pulmonic Voiceless Bilabial Nasal -> mkJustIPA "m̥" 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 -> mkJustIPA "n̼" Pulmonic Voiceless LinguoLabial Plosive -> mkJustIPA "t̼" Pulmonic Voiced LinguoLabial Plosive -> mkJustIPA "d̼" Pulmonic Voiceless LinguoLabial (Fricative NonSibilant) -> mkJustIPA "θ̼ " Pulmonic Voiced LinguoLabial (Fricative NonSibilant) -> mkJustIPA "ð̼" Pulmonic Voiced LinguoLabial Flap -> mkJustIPA "ɾ̼" -- 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 -> mkJustIPA "n̥" 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 -> mkJustIPA "r" 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 -> mkJustIPA "ɺ̥" 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 -> mkJustIPA "ɳ̊" 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 -> mkJustIPA "ɽ̊" 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 -> mkJustIPA "ɲ̊" 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 -> mkJustIPA "ŋ̊" 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 -> mkJustIPA "ʀ" 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 -> mkJustIPA "ƥ" Implosive Voiced Bilabial -> mkJustIPA "ɓ" Implosive Voiceless Dental -> mkJustIPA "ƭ̪" Implosive Voiced Dental -> mkJustIPA "ɗ̪" Implosive Voiceless Alveolar -> mkJustIPA "ɗ" Implosive Voiced Alveolar -> mkJustIPA "ƭ" Implosive Voiceless Retroflex -> mkJustIPA "ᶑ" Implosive Voiced Retroflex -> mkJustIPA "ƭ̢" Implosive Voiceless Palatal -> mkJustIPA "ƈ" Implosive Voiced Palatal -> mkJustIPA "ʄ" Implosive Voiceless Velar -> mkJustIPA "ƙ" Implosive Voiced Velar -> mkJustIPA "ɠ" Implosive Voiceless Uvular -> mkJustIPA "ʠ" 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 vowel :: Segment -> Maybe IPA vowel = \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 -> mkJustIPA "e̞" Vowel Mid Front Rounded -> mkJustIPA "ø̞" Vowel Mid Central Unrounded -> mkJustIPA "ə" Vowel Mid Central Rounded -> mkJustIPA "ə" Vowel Mid Back Unrounded -> mkJustIPA "ɤ̞" Vowel Mid Back Rounded -> mkJustIPA "o̞" 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 secondaryArticulation :: Segment -> Maybe IPA secondaryArticulation = \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