ipa 0.2 → 0.3

raw patch · 8 files changed

+2676/−1099 lines, 8 filesdep +attoparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec

API changes (from Hackage documentation)

Files

• CHANGELOG.org +17/−4
• README.org +6/−7
• ipa.cabal +6/−5
• src/Language/IPA.hs +174/−1037
• src/Language/IPA/Class.hs +1116/−0
• src/Language/IPA/Parser.hs +1103/−0
• src/Language/IPA/Types.hs +57/−10
• test/Main.hs +197/−36

@@ -1,8 +1,21 @@-* 0.1-+ Initial release+* 0.3++ Breaking changes:+  - ~parseIPA~ method added to ~ReprIPA~ typeclass to parse values from text in IPA+  - X-SAMPA-related methods have been moved from ~ReprIPA~ to the new ~ReprXSampa~ typeclass, which also includes the new ~parseXSampa~ method+  - ~toIPA'~ and ~toXSampa'~ have been removed as methods, and are now functions (with the same behavior as the previous default implementation) exported from ~Language.IPA~+  - New ~Vowel~ type with three variants: ~Pure~, ~Diphthongized~, and ~Triphthongized~. The ~Vowel~ constructor of ~Segment~ now takes a variant of this type as a parameter. There are also three new pattern synonyms that produce ~Segments~: ~PureVowel~, ~Diphthong~, and ~Triphthong~, corresponding to the ~Vowel~ constructors+  - Constraints for the ~ReprIPA~ for ~Syllable~ instance have changed: was previously just ~Traversable~, now also includes ~Monoid~ and ~Applicative~. This is to allow for polymorphism in the syllable parser+  - A data constructor has been added to ~Segment~: ~Optional~, which represents speech segments that are conventionally (and unofficially) written inside parentheses+  - ~SuperscriptNumeric~ has been removed; it is replaced by a new data constructor for ~SuprasegmentalFeature~: ~ToneNumber~++ Other changes:+  - New utilities for determining literal text validity, membership in different categories of segments, converting between different notations, etc...+  - ~ReprIPA~ is now in a separate module (~Language.IPA.Class~, along with ~ReprXSampa~); ~Language.IPA~ still re-exports it+  - New ~mkXSampa~ smart constructor validates that the underlying text value only contains ASCII characters * 0.2-+ Major changes:++ Breaking changes:   - ~toXSampa~ and ~toXSampa'~ added to ~ReprIPA~ typeclass. Most (but not all) of the ~Segment~, ~SegmentalFeature~, and ~SuprasegmentalFeature~ values representable in IPA now have an X-SAMPA equivalent-  - The partial ~toIPA'~ and ~toXSampa'~ methods now return the new ~IPAException~ in the event of failure, instead of simply ~error~+  - The partial ~toIPA'~ and ~toXSampa'~ methods now return the new ~IPAException~ in the event of failure, instead of simply calling ~error~ + Bugfixes:   - There were some issues with voiced/voiceless pairs in v0.1, where the wrong variant had the voiceless diacritic+* 0.1++ Initial release

@@ -1,6 +1,6 @@ * ipa ** About-~ipa~ is a Haskell library for dealing with International Phonetic Alphabet (IPA) transcriptions. It provides a set of datatypes for working with speech segments and suprasegmentals which can be represented using IPA transcription.+~ipa~ is a Haskell library for dealing with International Phonetic Alphabet (IPA) transcriptions. It provides a set of datatypes for working with speech segments and suprasegmentals which can be represented using IPA transcription. Speech sounds can be converted to their IPA representations or parsed from text written in IPA notation. It also supports most of the ASCII-only X-SAMPA transcription scheme. ** Usage IPA values can be created by constructing ~Segment~ or ~Syllable~ values and applying ~toIPA~. For instance:@@ -22,13 +22,12 @@ #+begin_src haskell someComplexVowel :: Segment someComplexVowel = WithSegmentalFeature -    (SuperScriptNumeric 255)     (WithSegmentalFeature       (Length OverLong)      (WithSegmentalFeature        Compressed-      (Vowel Close Back Unrounded)))--- ɯᵝːː²⁵⁵ +      (Vowel Close Back Unrounded))+-- ɯᵝːː     #+end_src ~IPA~ is an instance of ~Semigroup~, so values can be concatenated with ~<>~:@@ -55,8 +54,8 @@ This library is distributed under the BSD 3-Clause revised license. ** TODO TODO - [ ] Export constant values for common segments-- [ ] Convenience functions for wrapping IPA values in different trasncription delimiters (phonemic, phonetic, etc...)+- [ ] Convenience functions for wrapping IPA values in different transcription delimiters (phonemic, phonetic, etc...) - [X] Support for X-SAMPA transcription-- [ ] Support for IPA <-> X-SAMPA conversion-- [ ] Parsing and validation of user-supplied IPA and XSampa literals+- [X] Support for IPA <-> X-SAMPA conversion+- [X] Parsing and validation of user-supplied IPA and XSampa literals - [ ] Quasi quoter for making segment construction somewhat less painful

@@ -1,10 +1,8 @@ cabal-version:      2.4 name:               ipa-version:            0.2+version:            0.3 synopsis:           Internal Phonetic Alphabet (IPA)-description:-  Types and tools for working with the International Phonetic Alphabet (IPA)-+description:        See the README at https://gitlab.com/ngua/ipa-hs license:            BSD-3-Clause license-file:       LICENSE author:             Rory Tyler Hayford@@ -31,12 +29,15 @@ library   import:           common-options, common-extensions   build-depends:-    , base                >=4.10  && <=5+    , attoparsec          ^>=0.13.2+    , base                >=4.10   && <=5     , text                ^>=1.2.4     , unicode-transforms  ^>=0.3.7    exposed-modules:     Language.IPA+    Language.IPA.Class+    Language.IPA.Parser     Language.IPA.Types    hs-source-dirs:   src

@@ -1,1037 +1,174 @@-{-# 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 "-\\"+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- 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\/X-SAMPA transcriptions and phonetic/phonemic values+module Language.IPA+    (   -- * Utilities+        -- ** Conversion+      ipaToXSampa+    , xSampaToIpa+      -- ** Construction+    , toIPA'+    , toXSampa'+       -- ** Predicates+    , isValid+    , isValidSegment+    , isValidSyllable+    , isObstruent+    , isSonorant+    , isLabial+    , isCoronal+    , isDorsal+    , isLaryngeal+    , isRhotic+    , isLiquid+      -- * Re-exports+    , module M+    ) where++import           Control.Exception   ( throw )++import           Data.Maybe          ( fromMaybe )+import           Data.Text           ( Text )++import           Language.IPA.Class  as M+import           Language.IPA.Parser as M+import           Language.IPA.Types  as M++-- | Convert an 'IPA' value to its equivalent in 'XSampa'; note that several+-- features and segments that can be transcribed in IPA notation are missing+-- from X-SAMPA+ipaToXSampa :: IPA -> Maybe XSampa+ipaToXSampa IPA { .. } =+    either (const Nothing) toXSampa (parseIPA @(Syllable []) unIPA)++-- | Convert an 'XSampa' value to its equivalent in 'IPA'+xSampaToIpa :: XSampa -> Maybe IPA+xSampaToIpa XSampa { .. } =+    either (const Nothing) toIPA (parseXSampa @(Syllable []) unXSampa)++-- | Partial function for creating an 'IPA'. Useful if you are certain that+-- the sound in question is representable+toIPA' :: ReprIPA a => a -> IPA+toIPA' x = fromMaybe (throw $ InvalidIPA "Illegal IPA value") (toIPA x)++-- | Partial function for creating an 'XSampa'. NB: Certain segments that have+-- a defined 'IPA' representation have no 'XSampa' equivalent+toXSampa' :: ReprXSampa a => a -> XSampa+toXSampa' x = fromMaybe (throw $ InvalidXSampa "Illegal X-SAMPA value")+                        (toXSampa x)++-- | Does a text value in IPA notation represent a valid instance of 'ReprIPA'?+-- Note that you will need @-XTypeApplications@ to use this, and that this just+-- calls 'parseIPA' to determine validity+--+-- >>> isValid @Segment "L"+-- False+-- >>> isValid @Segment "ʟ"+-- True+isValid :: forall a. ReprIPA a => Text -> Bool+isValid t = either (const False) (const True) (parseIPA @a t)++-- | Does a text value represent valid individual IPA 'Segment'?+isValidSegment :: Text -> Bool+isValidSegment = isValid @Segment++-- | Is a text value a valid IPA 'Syllable'?+isValidSyllable :: Text -> Bool+isValidSyllable = isValid @(Syllable [])++-- | Tests if a 'Segment' is obstruent, i.e. formed by obstructing airflow+isObstruent :: Segment -> Bool+isObstruent = \case+    PulmonicConsonant _ _ manner -> case manner of+        Plosive     -> True+        Fricative _ -> True+        Affricate _ -> True+        _           -> False+    _ -> False++-- | Tests if 'Segment' is sonorant, i.e. if it is created with an uninterrupted+-- flow of air+isSonorant :: Segment -> Bool+isSonorant = not . isObstruent++-- | Tests pulmonic 'Consonant' membership in the labial category, whose+-- active articulator is one or both lips+isLabial :: Consonant -> Bool+isLabial = \case+    Pulmonic _ place _ -> case place of+        Bilabial     -> True+        LabioDental  -> True+        LinguoLabial -> True+        _            -> False+    _                  -> False++-- | Tests pulmonic 'Consonant' membership in the coronal class, whose+-- active articulator is the front of the tongue+isCoronal :: Consonant -> Bool+isCoronal = \case+    Pulmonic _ Palatal (Fricative Sibilant) -> True+    Pulmonic _ place _ -> case place of+        Dental       -> True+        Alveolar     -> True+        PostAlveolar -> True+        Retroflex    -> True+        _            -> False+    _ -> False++-- | Tests pulmonic 'Consonant' membership in the dorsal class, whose+-- active articulator is the dorsum (back of the tongue)+isDorsal :: Consonant -> Bool+isDorsal = \case+    Pulmonic _ place _ -> case place of+        Palatal -> True+        Velar   -> True+        Uvular  -> True+        _       -> False+    _                  -> False++-- | Tests pulmonic 'Consonant' membership in the laryngeal class, whose+-- active articulator is the larynx+isLaryngeal :: Consonant -> Bool+isLaryngeal = \case+    Pulmonic _ place _ -> case place of+        Pharyngeal -> True+        Glottal    -> True+        _          -> False+    _                  -> False++-- | Tests if 'Consonant' is rhotic, a vague category of R-like sounds typically+-- represented lexicographically by some variant of the Latin letter r+isRhotic :: Consonant -> Bool+isRhotic = \case+    Pulmonic Voiced Uvular (Fricative NonSibilant) -> True+    Pulmonic _ Uvular Trill -> True+    Pulmonic _ place manner+        | place `elem` [ Alveolar, Retroflex ] -> case manner of+            Approximant -> True+            Trill       -> True+            Flap        -> True+            _           -> False+        | otherwise -> False+    _ -> False++-- | Tests if a 'Consonant' is liquid, a category of rhotics and voiced+-- lateral approximants+isLiquid :: Consonant -> Bool+isLiquid c+    | isRhotic c = True+    | otherwise = case c of+        Pulmonic Voiced _ LateralApproximant -> True+        _ -> False

@@ -0,0 +1,1116 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Language.IPA.Class+-- Copyright   : (c) 2021 Rory Tyler Hayford+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Typeclass for representing speech sounds in IPA/X-Sampa notation+module Language.IPA.Class+    ( -- * Converting to IPA representations+      ReprIPA(..)+    , ReprXSampa(..)+    ) where++import           Data.Char           ( digitToInt )+import           Data.Function       ( on )+import           Data.Text           ( Text )+import qualified Data.Text           as T++import           Language.IPA.Parser+                 ( parseSegment+                 , parseSegmentXSampa+                 , parseSyllable+                 , parseSyllableXSampa+                 )+import           Language.IPA.Types++-- | 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++    -- | Parse text in IPA notation+    parseIPA :: Text -> Either IPAException a++-- | Entities representable through X-SAMPA transcription, an ASCII subset+-- of the IPA+class ReprXSampa a where+    -- | Similar to 'toIPA'; produces an 'XSampa' transcription given a valid 'Segment'.+    toXSampa :: a -> Maybe XSampa++    -- | Parse text in X-SAMPA notation+    parseXSampa :: Text -> Either IPAException a++instance MultiSegment t => ReprIPA (Syllable t) where+    toIPA = \case+        Syllable ss+            | null ss -> Nothing+            | otherwise -> foldr1 (<>) <$> traverse toIPA ss+        WithSuprasegmentalFeature feature s ->+            withSuprasegmentalFeature s feature++    parseIPA = parseSyllable++instance MultiSegment t => ReprXSampa (Syllable t) where+    toXSampa = \case+        Syllable ss+            | null ss -> Nothing+            | otherwise -> foldr1 (<>) <$> traverse toXSampa ss+        WithSuprasegmentalFeature feature s ->+            withSuprasegmentalFeatureXSampa s feature++    parseXSampa = parseSyllableXSampa++instance ReprIPA Segment where+    toIPA = \case+        Zero -> mkJustIPA "∅"+        Consonant c -> consonant c+        Vowel v -> vowel v+        WithSegmentalFeature feature s -> withSegmentalFeature s feature+        Optional s -> do+            IPA { .. } <- toIPA s+            return . mkIPA $ "(" <> unIPA <> ")"++    parseIPA = parseSegment++instance ReprXSampa Segment where+    toXSampa = \case+        Zero -> Nothing -- does not appear to have an X-SAMPA encoding+        Vowel v -> vowelXSampa v+        Consonant c -> consonantXSampa c+        WithSegmentalFeature feature s -> withSegmentalFeatureXSampa s feature+        Optional s -> do+            XSampa { .. } <- toXSampa s+            return . XSampa $ "(" <> unXSampa <> ")"++    parseXSampa = parseSegmentXSampa++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+    :: MultiSegment t => Syllable t -> SuprasegmentalFeature -> Maybe IPA+withSuprasegmentalFeature 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 not represented with 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++    ToneNumber 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++    Stress stress -> mkIPAOp ipaStress s stress+      where+        ipaStress Primary   = mkJustIPA "ˈ"+        ipaStress Secondary = mkJustIPA "ˌ"++    Break -> (<>) <$> toIPA s <*> mkJustIPA "."++    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+    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 "" --++doubleArticulated :: Text -> Text -> Text+doubleArticulated x y = x <> breve <> y+  where+    breve = "\x0361"++voiceless :: Bool -- Whether this character is descending or not+          -> Text+          -> Text+voiceless desc = (<> getC desc)+  where+    getC True  = "\x030a"+    getC False = "\x0325"++dentalized :: Text -> Text+dentalized = (<> "\x032a")++raisedMod :: Text -> Text+raisedMod = (<> "\x02d4")++raised :: Text -> Text+raised = (<> "\x031d")++retracted :: Text -> Text+retracted = (<> "\x0320")++flapped :: Text -> Text+flapped = (<> "\x0306")++consonant :: Consonant -> Maybe IPA+consonant = \case+    e@Ejective {} -> ejective e+    i@Implosive {} -> implosive i+    -- 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 $ doubleArticulated "p" "ɸ"+    Pulmonic Voiced Bilabial (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "b" "β"+    Pulmonic Voiceless Bilabial (Fricative NonSibilant) -> mkJustIPA "ɸ"+    Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkJustIPA "β"+    Pulmonic Voiced Bilabial Flap -> toIPA+        $ WithSegmentalFeature Advanced+                               (PulmonicConsonant Voiced LabioDental Flap)+    Pulmonic Voiceless Bilabial Trill -> mkJustIPA $ voiceless False "ʙ"+    Pulmonic Voiced Bilabial Trill -> mkJustIPA "ʙ"++    -- Labio-dentals+    Pulmonic Voiced LabioDental Nasal -> mkJustIPA "ɱ"+    Pulmonic v LabioDental Plosive -> toIPA+        $ WithSegmentalFeature Dentalized+                               (PulmonicConsonant v Bilabial Plosive)++    Pulmonic v LabioDental (Affricate NonSibilant) -> do+        IPA stop <- toIPA $ PulmonicConsonant v LabioDental Plosive+        IPA fricative <- toIPA+            $ PulmonicConsonant v LabioDental (Fricative NonSibilant)+        mkJustIPA $ doubleArticulated stop fricative+    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 manner+        | manner `elem` [ Nasal, Plosive, Fricative NonSibilant, Flap ] ->+            toIPA+            $ WithSegmentalFeature LinguoLabialized+                                   (PulmonicConsonant Voiced Alveolar manner)+    Pulmonic Voiceless LinguoLabial manner+        | manner `elem` [ Plosive, Fricative NonSibilant ] -> toIPA+            $ WithSegmentalFeature LinguoLabialized+                                   (PulmonicConsonant Voiceless+                                                      Alveolar+                                                      manner)++    -- Dentals+    Pulmonic Voiceless Dental (Affricate NonSibilant) -> mkJustIPA+        $ doubleArticulated (dentalized "t") "θ"+    Pulmonic Voiced Dental (Affricate NonSibilant) -> mkJustIPA+        $ doubleArticulated (dentalized "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 $ doubleArticulated "t" "s"+    Pulmonic Voiced Alveolar (Affricate Sibilant) ->+        mkJustIPA $ doubleArticulated "d" "z"+    Pulmonic Voiceless Alveolar (Affricate NonSibilant) -> mkJustIPA+        $ doubleArticulated "t" (raisedMod $ voiceless True "ɹ")+    Pulmonic Voiced Alveolar (Affricate NonSibilant) -> mkJustIPA+        $ doubleArticulated "d" (raisedMod "ɹ")+    Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkJustIPA "s"+    Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkJustIPA "z"+    Pulmonic Voiced Alveolar Approximant -> mkJustIPA "ɹ"+    Pulmonic Voiceless Alveolar Flap -> mkJustIPA $ voiceless False "ɾ"+    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 $ doubleArticulated "t" "ʃ"+    Pulmonic Voiced PostAlveolar (Affricate Sibilant) ->+        mkJustIPA $ doubleArticulated "d" "ʒ"+    Pulmonic Voiceless PostAlveolar (Affricate NonSibilant) -> mkJustIPA+        $ doubleArticulated "t" (raisedMod . voiceless True $ retracted "ɹ")+    Pulmonic Voiced PostAlveolar (Affricate NonSibilant) -> mkJustIPA+        $ doubleArticulated "d" (raisedMod $ retracted "ɹ")+    Pulmonic Voiceless PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʃ"+    Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʒ"+    Pulmonic Voiceless PostAlveolar (Fricative NonSibilant) ->+        mkJustIPA . raisedMod . voiceless True . retracted $ "ɹ"+    Pulmonic Voiced PostAlveolar (Fricative NonSibilant) ->+        mkJustIPA . raisedMod $ retracted "ɹ"++    -- 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 $ doubleArticulated "ʈ" "ʂ"+    Pulmonic Voiced Retroflex (Affricate Sibilant) ->+        mkJustIPA $ doubleArticulated "ɖ" "ʐ"+    Pulmonic Voiceless Retroflex (Fricative Sibilant) -> mkJustIPA "ʂ"+    Pulmonic Voiced Retroflex (Fricative Sibilant) -> mkJustIPA "ʐ"+    Pulmonic Voiced Retroflex (Fricative NonSibilant) ->+        mkJustIPA $ raisedMod "ɻ"+    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 $ voiceless True "ɽ" <> voiceless False "r"+    Pulmonic Voiced Retroflex Trill -> mkJustIPA "ɽr"+    Pulmonic Voiceless Retroflex LateralAffricate -> mkJustIPA+        $ "ʈ" <> (raisedMod . voiceless True $ "ɭ")+    Pulmonic Voiced Retroflex LateralAffricate ->+        mkJustIPA $ "ɖ" <> raisedMod "ɭ"+    Pulmonic Voiceless Retroflex LateralFricative ->+        mkJustIPA . raisedMod . voiceless True $ "ɭ"+    Pulmonic Voiced Retroflex LateralFricative -> mkJustIPA $ raisedMod "ɭ"+    Pulmonic Voiced Retroflex LateralApproximant -> mkJustIPA "ɭ"+    Pulmonic Voiceless Retroflex LateralFlap ->+        mkJustIPA . voiceless True $ flapped "ɭ"+    Pulmonic Voiced Retroflex LateralFlap -> mkJustIPA $ flapped "ɭ"++    -- 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 $ doubleArticulated "t" "ɕ"+    Pulmonic Voiced Palatal (Affricate Sibilant) ->+        mkJustIPA $ doubleArticulated "d" "ʑ"+    Pulmonic Voiceless Palatal (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "c" "ç"+    Pulmonic Voiced Palatal (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "ɟ" "ʝ"+    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" <> (voiceless True . raised $ "ʎ")+    Pulmonic Voiced Palatal LateralAffricate ->+        mkJustIPA $ "ɟ" <> raised "ʎ"+    Pulmonic Voiceless Palatal LateralFricative ->+        mkJustIPA . raised . voiceless True $ "ʎ"+    Pulmonic Voiced Palatal LateralFricative -> mkJustIPA $ raised "ʎ"+    Pulmonic Voiced Palatal LateralApproximant -> mkJustIPA "ʎ"+    Pulmonic Voiced Palatal LateralFlap -> mkJustIPA $ flapped "ʎ"++    -- 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 $ doubleArticulated "k" "x"+    Pulmonic Voiced Velar (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "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" <> (raised $ voiceless True "ʟ")+    Pulmonic Voiced Velar LateralAffricate -> mkJustIPA $ "ɡ" <> raised "ʟ"+    Pulmonic Voiceless Velar LateralFricative ->+        mkJustIPA . voiceless True $ raised "ʟ"+    Pulmonic Voiced Velar LateralFricative -> mkJustIPA $ raised "ʟ"+    Pulmonic Voiced Velar LateralApproximant -> mkJustIPA "ʟ"+    Pulmonic Voiced Velar LateralFlap -> mkJustIPA $ flapped "ʟ"++    -- Uvulars+    Pulmonic Voiced Uvular Nasal -> mkJustIPA "ɴ"+    Pulmonic Voiceless Uvular Plosive -> mkJustIPA "q"+    Pulmonic Voiced Uvular Plosive -> mkJustIPA "ɢ"+    Pulmonic Voiceless Uvular (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "q" "χ"+    Pulmonic Voiced Uvular (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "ɢ" "ʁ"+    Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustIPA "χ"+    Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustIPA "ʁ"+    Pulmonic Voiced Uvular Flap -> mkJustIPA $ flapped "ɢ"+    Pulmonic Voiceless Uvular Trill -> toIPA+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Uvular Trill)+    Pulmonic Voiced Uvular Trill -> mkJustIPA "ʀ"+    Pulmonic Voiced Uvular LateralApproximant -> mkJustIPA $ retracted "ʟ"++    -- Pharyngeals+    Pulmonic Voiceless Pharyngeal Plosive -> mkJustIPA "ʡ"+    Pulmonic Voiced Pharyngeal (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "ʡ" "ʢ"+    Pulmonic Voiceless Pharyngeal (Fricative NonSibilant) -> mkJustIPA "ħ"+    Pulmonic Voiced Pharyngeal (Fricative NonSibilant) -> mkJustIPA "ʕ"+    Pulmonic Voiced Pharyngeal Flap -> mkJustIPA $ flapped "ʡ"+    Pulmonic Voiceless Pharyngeal Trill -> mkJustIPA "ʜ"+    Pulmonic Voiced Pharyngeal Trill -> mkJustIPA "ʢ"++    -- Glottals+    Pulmonic Voiceless Glottal Plosive -> mkJustIPA "ʔ"+    Pulmonic Voiceless Glottal (Affricate NonSibilant) ->+        mkJustIPA $ doubleArticulated "ʔ" "h"+    Pulmonic Voiceless Glottal (Fricative NonSibilant) -> mkJustIPA "h"+    Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkJustIPA "ɦ"+    Pulmonic Voiced Glottal Approximant -> mkJustIPA $ "ʔ" <> "\x031e"++    -- Clicks+    Click Bilabial -> mkJustIPA "ʘ"+    Click Dental -> mkJustIPA "ǀ"+    Click Alveolar -> mkJustIPA "ǃ"+    Click PostAlveolar -> mkJustIPA "ǁ"+    Click Palatal -> mkJustIPA "ǂ"++    -- Double articulation+    DoublyArticulated Voiced Bilabial Alveolar Nasal ->+        mkJustIPA $ doubleArticulated "n" "m"+    DoublyArticulated Voiceless Bilabial Alveolar Plosive ->+        mkJustIPA $ doubleArticulated "t" "p"+    DoublyArticulated Voiced Bilabial Alveolar Plosive ->+        mkJustIPA $ doubleArticulated "d" "b"+    DoublyArticulated Voiced Bilabial Velar Nasal ->+        mkJustIPA $ doubleArticulated "ŋ" "m"+    DoublyArticulated Voiceless Bilabial Velar Plosive ->+        mkJustIPA $ doubleArticulated "k" "p"+    DoublyArticulated Voiced Bilabial Velar Plosive ->+        mkJustIPA $ doubleArticulated "g" "b"+    DoublyArticulated Voiceless Uvular Pharyngeal Plosive ->+        mkJustIPA $ doubleArticulated "q" "ʡ"+    DoublyArticulated Voiceless Bilabial Palatal (Fricative NonSibilant) ->+        mkJustIPA $ voiceless True "ɥ"+    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++implosive :: Consonant -> Maybe IPA+implosive (Implosive Voiceless place) = toIPA+    $ WithSegmentalFeature (Voicing Voiceless)+                           (ImplosiveConsonant Voiced place)+implosive c = case c of+    Implosive Voiced Bilabial -> mkJustIPA "ɓ"+    Implosive Voiced Alveolar -> mkJustIPA "ɗ"+    Implosive Voiced Retroflex -> mkJustIPA "ᶑ"+    Implosive Voiced Palatal -> mkJustIPA "ʄ"+    Implosive Voiced Velar -> mkJustIPA "ɠ"+    Implosive Voiced Uvular -> mkJustIPA "ʛ"+    Implosive Voiced Dental -> toIPA+        $ WithSegmentalFeature Dentalized (ImplosiveConsonant Voiced Alveolar)+    _ -> Nothing++ejective :: Consonant -> Maybe IPA+ejective c = (<>) <$> getEj c <*> pure ej >>= mkJustIPA+  where+    ej    = "\x02bc"++    getEj = \case+        Ejective Bilabial Plosive -> Just "p"+        Ejective Bilabial (Fricative NonSibilant) -> Just "ɸ"+        Ejective LabioDental (Affricate NonSibilant) -> Just+            $ doubleArticulated (dentalized "p") "f"+        Ejective LabioDental (Fricative NonSibilant) -> Just "f"+        Ejective Dental Plosive -> Just $ dentalized "t"+        Ejective Dental (Affricate NonSibilant) -> Just+            $ doubleArticulated (dentalized "t") "θ"+        Ejective Dental (Fricative NonSibilant) -> Just "θ"+        Ejective Alveolar Plosive -> Just "t"+        Ejective Alveolar (Affricate Sibilant) ->+            Just $ doubleArticulated "t" "s"+        Ejective Alveolar (Fricative Sibilant) -> Just "s"+        Ejective Alveolar LateralAffricate ->+            Just $ doubleArticulated "t" "ɬ"+        Ejective Alveolar LateralFricative -> Just "ɬ"+        Ejective PostAlveolar (Affricate Sibilant) ->+            Just $ doubleArticulated "t" "ʃ"+        Ejective PostAlveolar (Fricative Sibilant) -> Just "ʃ"+        Ejective Retroflex Plosive -> Just "ʈ"+        Ejective Retroflex (Affricate Sibilant) ->+            Just $ doubleArticulated "ʈ" "ʂ"+        Ejective Retroflex (Fricative Sibilant) -> Just "ʂ"+        Ejective Palatal Plosive -> Just "c"+        Ejective Palatal (Affricate Sibilant) ->+            Just $ doubleArticulated "t" "ɕ"+        Ejective Palatal (Fricative Sibilant) -> Just "ɕ"+        Ejective Palatal LateralAffricate -> Just+            $ "c" <> (raised $ voiceless True "ʎ")+        Ejective Velar Plosive -> Just "k"+        Ejective Velar (Affricate NonSibilant) ->+            Just $ doubleArticulated "k" "x"+        Ejective Velar (Fricative NonSibilant) -> Just "x"+        Ejective Velar LateralAffricate -> Just+            $ "k" <> (raised $ voiceless True "ʟ")+        Ejective Uvular Plosive -> Just "q"+        Ejective Uvular (Affricate NonSibilant) ->+            Just $ doubleArticulated "q" "χ"+        Ejective Uvular (Fricative NonSibilant) -> Just "χ"+        Ejective Pharyngeal Plosive -> Just "ʡ"+        _ -> Nothing++vowel :: Vowel -> Maybe IPA+vowel = \case+    Pure Close Front Unrounded -> mkJustIPA "i"+    Pure Close Front Rounded -> mkJustIPA "y"+    Pure Close Central Unrounded -> mkJustIPA "ɨ"+    Pure Close Central Rounded -> mkJustIPA "ʉ"+    Pure Close Back Unrounded -> mkJustIPA "ɯ"+    Pure Close Back Rounded -> mkJustIPA "u"+    Pure NearClose Front Unrounded -> mkJustIPA "ɪ"+    Pure NearClose Front Rounded -> mkJustIPA "ʏ"+    Pure NearClose Back Rounded -> mkJustIPA "ʊ"+    Pure CloseMid Front Unrounded -> mkJustIPA "e"+    Pure CloseMid Front Rounded -> mkJustIPA "ø"+    Pure CloseMid Central Unrounded -> mkJustIPA "ɘ"+    Pure CloseMid Central Rounded -> mkJustIPA "ɵ"+    Pure CloseMid Back Unrounded -> mkJustIPA "ɤ"+    Pure CloseMid Back Rounded -> mkJustIPA "o"+    Pure Mid Front Unrounded -> toIPA+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Front Unrounded)+    Pure Mid Front Rounded -> toIPA+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Front Rounded)+    Pure Mid Central Unrounded -> mkJustIPA "ə"+    Pure Mid Back Unrounded -> toIPA+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Back Unrounded)+    Pure Mid Back Rounded -> toIPA+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Back Rounded)+    Pure OpenMid Front Unrounded -> mkJustIPA "ɛ"+    Pure OpenMid Front Rounded -> mkJustIPA "œ"+    Pure OpenMid Central Unrounded -> mkJustIPA "ɜ"+    Pure OpenMid Central Rounded -> mkJustIPA "ɞ"+    Pure OpenMid Back Unrounded -> mkJustIPA "ʌ"+    Pure OpenMid Back Rounded -> mkJustIPA "ɔ"+    Pure NearOpen Front Unrounded -> mkJustIPA "æ"+    Pure NearOpen Central Unrounded -> mkJustIPA "ɐ"+    Pure Open Front Unrounded -> mkJustIPA "a"+    Pure Open Front Rounded -> mkJustIPA "ɶ"+    Pure Open Central Unrounded -> mkJustIPA "ä"+    Pure Open Back Unrounded -> mkJustIPA "ɑ"+    Pure Open Back Rounded -> mkJustIPA "ɒ"+    Diphthongized v1@Pure {} v2@Pure {} -> (<>) <$> toIPA (Vowel v1)+        <*> toIPA (Vowel v2)+    Triphthongized v1@Pure {} v2@Pure {} v3@Pure {} -> do+        first <- toIPA $ Vowel v1+        second <- toIPA $ Vowel v2+        third <- toIPA $ Vowel v3+        return $ first <> second <> third+    _ -> 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++    PureVowel Close Front Unrounded -> mkJustIPA "\x2071"+    PureVowel Close Front Rounded -> mkJustIPA "\x02b8"+    PureVowel Close Central Unrounded -> mkJustIPA "\x1da4"+    PureVowel Close Central Rounded -> mkJustIPA "\x1db6"+    PureVowel Close Back Unrounded -> mkJustIPA "\x1d5a"+    PureVowel Close Back Rounded -> mkJustIPA "\x1d58"+    PureVowel NearClose Front Unrounded -> mkJustIPA "\x1da6"+    PureVowel NearClose Central Unrounded -> mkJustIPA "\x1da7"+    PureVowel NearClose Back Rounded -> mkJustIPA "\x1db7"+    PureVowel Mid Central Unrounded -> mkJustIPA "\x1d4a"+    PureVowel Mid Central Rounded -> mkJustIPA "\x1d4a"+    PureVowel OpenMid Front Unrounded -> mkJustIPA "\x1d4b"+    PureVowel OpenMid Front Rounded -> mkJustIPA "\xa7f9"+    PureVowel OpenMid Central Unrounded -> mkJustIPA "\x1d9f"+    PureVowel OpenMid Back Unrounded -> mkJustIPA "\x1dba"+    PureVowel OpenMid Back Rounded -> mkJustIPA "\x1d53"+    PureVowel NearOpen Front Unrounded -> mkJustIPA "\x1d46"+    PureVowel NearOpen Central Unrounded -> mkJustIPA "\x1d44"+    PureVowel NearOpen Back Unrounded -> mkJustIPA "\x1d45"+    PureVowel NearOpen Back Rounded -> mkJustIPA "\x1d9b"+    PureVowel Open Front Unrounded -> mkJustIPA "\x1d43"+    PureVowel Open Back Rounded -> mkJustIPA "\x1d44"++    _ -> Nothing++-------------------------------------------------------------------------------+--                                  X-SAMPA                                  --+-------------------------------------------------------------------------------+mkXSampaOp :: ReprXSampa a => (b -> Maybe XSampa) -> a -> b -> Maybe XSampa+mkXSampaOp f x y = (<>) <$> toXSampa x <*> f y++doubleArticulatedXSampa :: Text -> Text -> Text+doubleArticulatedXSampa x y = x <> "_" <> y++-- X-SAMPA quite inexplicably uses a backslash as a semantic token+xSlash :: Text -> Text+xSlash = (<> "\\")++rhoticXSampa :: Text -> Text+rhoticXSampa = (<> "`")++vowelXSampa :: Vowel -> Maybe XSampa+vowelXSampa = \case+    Pure Close Front Unrounded -> mkXSampa "i"+    Pure Close Front Rounded -> mkXSampa "y"+    Pure Close Central Unrounded -> mkXSampa "1"+    Pure Close Central Rounded -> mkXSampa "}"+    Pure Close Back Unrounded -> mkXSampa "M"+    Pure Close Back Rounded -> mkXSampa "u"+    Pure NearClose Front Unrounded -> mkXSampa "I"+    Pure NearClose Front Rounded -> mkXSampa "Y"+    Pure NearClose Back Rounded -> mkXSampa "U"+    Pure CloseMid Front Unrounded -> mkXSampa "e"+    Pure CloseMid Front Rounded -> mkXSampa "2"+    Pure CloseMid Central Unrounded -> mkXSampa $ xSlash "@"+    Pure CloseMid Central Rounded -> mkXSampa "8"+    Pure CloseMid Back Unrounded -> mkXSampa "7"+    Pure CloseMid Back Rounded -> mkXSampa "o"+    Pure Mid Front Unrounded -> toXSampa+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Front Unrounded)+    Pure Mid Front Rounded -> toXSampa+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Front Rounded)+    Pure Mid Central Unrounded -> mkXSampa "@"+    Pure Mid Back Unrounded -> toXSampa+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Back Unrounded)+    Pure Mid Back Rounded -> toXSampa+        $ WithSegmentalFeature Lowered (Vowel $ Pure CloseMid Back Unrounded)+    Pure OpenMid Front Unrounded -> mkXSampa "E"+    Pure OpenMid Front Rounded -> mkXSampa "9"+    Pure OpenMid Central Unrounded -> mkXSampa "3"+    Pure OpenMid Central Rounded -> mkXSampa $ xSlash "3"+    Pure OpenMid Back Unrounded -> mkXSampa "V"+    Pure OpenMid Back Rounded -> mkXSampa "O"+    Pure NearOpen Front Unrounded -> mkXSampa "{"+    Pure NearOpen Central Unrounded -> mkXSampa "6"+    Pure Open Front Unrounded -> mkXSampa "a"+    Pure Open Front Rounded -> mkXSampa "&"+    Pure Open Back Unrounded -> mkXSampa "A"+    Pure Open Back Rounded -> mkXSampa "Q"+    Diphthongized v1@Pure {} v2@Pure {} -> (<>) <$> toXSampa (Vowel v1)+        <*> toXSampa (Vowel v2)+    Triphthongized v1@Pure {} v2@Pure {} v3@Pure {} -> do+        first <- toXSampa $ Vowel v1+        second <- toXSampa $ Vowel v2+        third <- toXSampa $ Vowel v3+        return $ first <> second <> third+    _ -> Nothing++consonantXSampa :: Consonant -> Maybe XSampa+consonantXSampa = \case+    e@Ejective {} -> ejectiveXSampa e+    i@Implosive {} -> implosiveXSampa i++    -- Pulmonic consonants+    -- Bilabials+    Pulmonic Voiceless Bilabial Nasal -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Bilabial Nasal)+    Pulmonic Voiced Bilabial Nasal -> mkXSampa "m"+    Pulmonic Voiced Bilabial Plosive -> mkXSampa "b"+    Pulmonic Voiceless Bilabial Plosive -> mkXSampa "p"+    Pulmonic Voiceless Bilabial (Fricative NonSibilant) ->+        mkXSampa $ xSlash "p"+    Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkXSampa "B"+    Pulmonic Voiced Bilabial Trill -> mkXSampa $ xSlash "B"++    -- Labio-dentals+    Pulmonic Voiced LabioDental Nasal -> mkXSampa "F"+    Pulmonic Voiceless LabioDental (Fricative NonSibilant) -> mkXSampa "f"+    Pulmonic Voiced LabioDental (Fricative NonSibilant) -> mkXSampa "v"+    Pulmonic Voiced LabioDental Approximant -> mkXSampa "P"++    -- Dentals+    Pulmonic Voiceless Dental (Fricative NonSibilant) -> mkXSampa "T"+    Pulmonic Voiced Dental (Fricative NonSibilant) -> mkXSampa "D"++    -- Alveolars+    Pulmonic Voiceless Alveolar Nasal -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Alveolar Nasal)+    Pulmonic Voiced Alveolar Nasal -> mkXSampa "n"+    Pulmonic Voiceless Alveolar Plosive -> mkXSampa "t"+    Pulmonic Voiced Alveolar Plosive -> mkXSampa "d"+    Pulmonic Voiceless Alveolar (Affricate Sibilant) ->+        mkXSampa $ doubleArticulatedXSampa "t" "s"+    Pulmonic Voiced Alveolar (Affricate Sibilant) ->+        mkXSampa $ doubleArticulatedXSampa "d" "z"+    Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkXSampa "s"+    Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkXSampa "z"+    Pulmonic Voiced Alveolar Approximant -> mkXSampa $ xSlash "r"+    Pulmonic Voiceless Alveolar Flap -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Alveolar Flap)+    Pulmonic Voiced Alveolar Flap -> mkXSampa "4"+    Pulmonic Voiced Alveolar Trill -> mkXSampa "r"+    Pulmonic Voiceless Alveolar Trill -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Alveolar Trill)+    Pulmonic Voiceless Alveolar LateralFricative -> mkXSampa "K"+    Pulmonic Voiced Alveolar LateralFricative -> mkXSampa $ xSlash "K"+    Pulmonic Voiced Alveolar LateralApproximant -> mkXSampa "l"++    -- Post-alveolars+    Pulmonic Voiceless PostAlveolar (Affricate Sibilant) ->+        mkXSampa $ doubleArticulatedXSampa "t" "S"+    Pulmonic Voiced PostAlveolar (Affricate Sibilant) ->+        mkXSampa $ doubleArticulatedXSampa "d" "Z"+    Pulmonic Voiceless PostAlveolar (Fricative Sibilant) -> mkXSampa "S"+    Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkXSampa "Z"++    -- Retroflexes+    Pulmonic Voiceless Retroflex Nasal -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Retroflex Nasal)+    Pulmonic Voiced Retroflex Nasal -> mkXSampa $ rhoticXSampa "n"+    Pulmonic Voiceless Retroflex Plosive -> mkXSampa $ rhoticXSampa "t"+    Pulmonic Voiced Retroflex Plosive -> mkXSampa $ rhoticXSampa "d"+    Pulmonic Voiceless Retroflex (Affricate Sibilant) -> mkXSampa+        $ (doubleArticulatedXSampa `on` rhoticXSampa) "t" "s"+    Pulmonic Voiced Retroflex (Affricate Sibilant) -> mkXSampa+        $ (doubleArticulatedXSampa `on` rhoticXSampa) "d" "z"+    Pulmonic Voiceless Retroflex (Fricative Sibilant) ->+        mkXSampa $ rhoticXSampa "s"+    Pulmonic Voiced Retroflex (Fricative Sibilant) ->+        mkXSampa $ rhoticXSampa "z"+    Pulmonic Voiced Retroflex Approximant ->+        mkXSampa . xSlash $ rhoticXSampa "r"+    Pulmonic Voiceless Retroflex Flap -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Retroflex Nasal)+    Pulmonic Voiced Retroflex Flap -> mkXSampa $ rhoticXSampa "r"+    Pulmonic Voiceless Retroflex LateralApproximant -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Retroflex Nasal)+    Pulmonic Voiced Retroflex LateralApproximant ->+        mkXSampa $ rhoticXSampa "l"++    -- Palatals+    Pulmonic Voiced Palatal Nasal -> mkXSampa "J"+    Pulmonic Voiceless Palatal Plosive -> mkXSampa "c"+    Pulmonic Voiced Palatal Plosive -> mkXSampa $ xSlash "J"+    Pulmonic Voiceless Palatal (Affricate Sibilant) -> mkXSampa+        $ doubleArticulatedXSampa "t" (xSlash "s")+    Pulmonic Voiced Palatal (Affricate Sibilant) -> mkXSampa+        $ doubleArticulatedXSampa "d" (xSlash "z")+    Pulmonic Voiceless Palatal (Fricative Sibilant) -> mkXSampa $ xSlash "s"+    Pulmonic Voiced Palatal (Fricative Sibilant) -> mkXSampa $ xSlash "z"+    Pulmonic Voiceless Palatal (Fricative NonSibilant) -> mkXSampa "C"+    Pulmonic Voiced Palatal (Fricative NonSibilant) -> mkXSampa $ xSlash "j"+    Pulmonic Voiced Palatal Approximant -> mkXSampa "j"+    Pulmonic Voiced Palatal LateralApproximant -> mkXSampa "L"++    -- Velars+    Pulmonic Voiceless Velar Nasal -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Velar Nasal)+    Pulmonic Voiced Velar Nasal -> mkXSampa "N"+    Pulmonic Voiceless Velar Plosive -> mkXSampa "k"+    Pulmonic Voiced Velar Plosive -> mkXSampa "g"+    Pulmonic Voiceless Velar (Affricate NonSibilant) ->+        mkXSampa $ doubleArticulatedXSampa "k" "x"+    Pulmonic Voiced Velar (Affricate NonSibilant) ->+        mkXSampa $ doubleArticulatedXSampa "g" "G"+    Pulmonic Voiceless Velar (Fricative NonSibilant) -> mkXSampa "x"+    Pulmonic Voiced Velar (Fricative NonSibilant) -> mkXSampa "G"+    Pulmonic Voiced Velar Approximant -> mkXSampa $ xSlash "m"+    Pulmonic Voiced Velar LateralApproximant -> mkXSampa $ xSlash "L"++    -- Uvulars+    Pulmonic Voiced Uvular Nasal -> mkXSampa $ xSlash "N"+    Pulmonic Voiceless Uvular Plosive -> mkXSampa "q"+    Pulmonic Voiced Uvular Plosive -> mkXSampa $ xSlash "G"+    Pulmonic Voiceless Uvular (Affricate NonSibilant) ->+        mkXSampa $ doubleArticulatedXSampa "q" "X"+    Pulmonic Voiced Uvular (Affricate NonSibilant) -> mkXSampa+        $ doubleArticulatedXSampa (xSlash "G") "R"+    Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkXSampa "X"+    Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkXSampa "R"+    Pulmonic Voiceless Uvular Trill -> toXSampa+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Uvular Trill)+    Pulmonic Voiced Uvular Trill -> mkXSampa $ xSlash "R"++    -- Pharyngeals+    Pulmonic Voiceless Pharyngeal (Fricative NonSibilant) ->+        mkXSampa $ xSlash "X"+    Pulmonic Voiced Pharyngeal (Fricative NonSibilant) ->+        mkXSampa $ xSlash "?"++    -- Glottals+    Pulmonic Voiceless Glottal Plosive -> mkXSampa "?"+    Pulmonic Voiceless Glottal (Affricate NonSibilant) -> mkXSampa+        $ doubleArticulatedXSampa "?" (xSlash "h")+    Pulmonic Voiceless Glottal (Fricative NonSibilant) -> mkXSampa "h"+    Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkXSampa $ xSlash "h"++    -- Implosives+    -- Clicks+    Click Bilabial -> mkXSampa $ xSlash "O"+    Click Dental -> mkXSampa $ xSlash "|"+    Click Alveolar -> mkXSampa $ xSlash "!"+    Click PostAlveolar -> mkXSampa $ xSlash "|" <> xSlash "|"+    Click Palatal -> mkXSampa $ xSlash "="++    -- Double articulation+    DoublyArticulated Voiced Bilabial Alveolar Nasal ->+        mkXSampa $ doubleArticulatedXSampa "n" "m"+    DoublyArticulated Voiceless Bilabial Alveolar Plosive ->+        mkXSampa $ doubleArticulatedXSampa "t" "p"+    DoublyArticulated Voiced Bilabial Alveolar Plosive ->+        mkXSampa $ doubleArticulatedXSampa "d" "b"+    DoublyArticulated Voiced Bilabial Velar Nasal ->+        mkXSampa $ doubleArticulatedXSampa "N" "m"+    DoublyArticulated Voiceless Bilabial Velar Plosive ->+        mkXSampa $ doubleArticulatedXSampa "k" "p"+    DoublyArticulated Voiced Bilabial Velar Plosive ->+        mkXSampa $ doubleArticulatedXSampa "g" "b"+    DoublyArticulated Voiceless Bilabial Palatal (Fricative NonSibilant) ->+        toXSampa+        $ WithSegmentalFeature --+        (Voicing Voiceless)+        (Consonant (DoublyArticulated Voiced Bilabial Palatal Approximant))+    DoublyArticulated Voiced Bilabial Palatal Approximant -> mkXSampa "H"+    DoublyArticulated Voiceless Bilabial Velar (Fricative NonSibilant) ->+        mkXSampa "W"+    DoublyArticulated Voiced Bilabial Velar Approximant -> mkXSampa "w"+    DoublyArticulated Voiceless PostAlveolar Velar (Fricative Sibilant) ->+        mkXSampa $ xSlash "x"+    DoublyArticulated Voiceless LabioDental Velar (Fricative Sibilant) ->+        mkXSampa $ xSlash "x"++    _ -> Nothing++ejectiveXSampa :: Consonant -> Maybe XSampa+ejectiveXSampa c = (<>) <$> getEj c <*> pure ej >>= mkXSampa+  where+    ej    = "_>"++    getEj = \case+        Ejective Bilabial Plosive -> Just "p"+        Ejective Bilabial (Fricative NonSibilant) -> Just $ xSlash "p"+        Ejective Dental (Fricative NonSibilant) -> Just "T"+        Ejective Alveolar Plosive -> Just "t"+        Ejective Alveolar (Affricate Sibilant) ->+            Just $ doubleArticulatedXSampa "t" "s"+        Ejective Alveolar (Fricative Sibilant) -> Just "s"+        Ejective PostAlveolar (Affricate Sibilant) ->+            Just $ doubleArticulatedXSampa "t" "S"+        Ejective PostAlveolar (Fricative Sibilant) -> Just "S"+        Ejective Retroflex Plosive -> Just $ rhoticXSampa "t"+        Ejective Retroflex (Affricate Sibilant) -> Just+            $ (doubleArticulatedXSampa `on` rhoticXSampa) "t" "s"+        Ejective Retroflex (Fricative Sibilant) -> Just $ rhoticXSampa "s"+        Ejective Palatal Plosive -> Just "c"+        Ejective Palatal (Affricate Sibilant) -> Just+            $ doubleArticulatedXSampa "t" (xSlash "s")+        Ejective Palatal (Fricative Sibilant) -> Just $ xSlash "s"+        Ejective Velar Plosive -> Just "k"+        Ejective Velar (Affricate NonSibilant) ->+            Just $ doubleArticulatedXSampa "k" "x"+        Ejective Velar (Fricative NonSibilant) -> Just "x"+        Ejective Uvular Plosive -> Just "q"+        Ejective Uvular (Affricate NonSibilant) ->+            Just $ doubleArticulatedXSampa "q" "X"+        Ejective Uvular (Fricative NonSibilant) -> Just "X"+        _ -> Nothing++implosiveXSampa :: Consonant -> Maybe XSampa+implosiveXSampa (Implosive Voiceless place) = toXSampa+    $ WithSegmentalFeature (Voicing Voiceless)+                           (ImplosiveConsonant Voiced place)+implosiveXSampa c = (<>) <$> getImpl c <*> pure impl >>= mkXSampa+  where+    impl    = "_<"++    getImpl = \case+        Implosive Voiced Bilabial -> Just "b"+        Implosive Voiced Alveolar -> Just "d"+        Implosive Voiced Retroflex -> Just $ rhoticXSampa "d"+        Implosive Voiced Palatal -> Just "f"+        Implosive Voiced Velar -> Just "g"+        Implosive Voiced Uvular -> Just "G"+        _ -> Nothing++withSegmentalFeatureXSampa :: Segment -> SegmentalFeature -> Maybe XSampa+withSegmentalFeatureXSampa s = \case+    Voicing v -> mkXSampaOp xSampaVoicing s v+      where+        xSampaVoicing = \case+            Voiceless -> mkXSampa "_0"+            Voiced    -> mkXSampa "_v"+    Length l -> mkXSampaOp xSampaLength s l+      where+        xSampaLength = \case+            OverLong   -> mkXSampa "::"+            Long       -> mkXSampa ":"+            HalfLong   -> mkXSampa $ xSlash ":"+            Short      -> mkXSampa mempty+            ExtraShort -> mkXSampa "_X"+    SecondaryArticulation _ -> Nothing+    feature -> (<>) <$> toXSampa s <*> case feature of+        Aspirated           -> mkXSampa "_h"+        MoreRounded         -> mkXSampa "_O"+        LessRounded         -> mkXSampa "_c"+        Advanced            -> mkXSampa "_+"+        Retracted           -> mkXSampa "_-"+        Centralized         -> mkXSampa "_\""+        MidCentralized      -> mkXSampa "_x"+        Syllabic            -> mkXSampa "="+        NonSyllabic         -> mkXSampa "_^"+        Rhotacized          -> mkXSampa "`"+        BreathyVoice        -> mkXSampa "_t"+        CreakyVoice         -> mkXSampa "_k"+        Labialized          -> mkXSampa "_w"+        Palatalized         -> mkXSampa "'"+        Velarized           -> mkXSampa "_G"+        Pharyngealized      -> mkXSampa $ xSlash "_?"+        Raised              -> mkXSampa "_r"+        Lowered             -> mkXSampa "_o"+        AdvancedTongueRoot  -> mkXSampa "_A"+        RetractedTongueRoot -> mkXSampa "_q"+        Dentalized          -> mkXSampa "_d"+        Apical              -> mkXSampa "_a"+        Laminal             -> mkXSampa "_m"+        Nasalized           -> mkXSampa "~"+        LateralRelease      -> mkXSampa "_l"+        NoAudibleRelease    -> mkXSampa "_}"+        _                   -> Nothing++withSuprasegmentalFeatureXSampa+    :: MultiSegment t => Syllable t -> SuprasegmentalFeature -> Maybe XSampa+withSuprasegmentalFeatureXSampa s = \case+    LevelLexicalTone tone -> mkXSampaOp xsampaTone s tone+      where+        xsampaTone = \case+            ExtraHighTone -> mkXSampa "_T"+            HighTone      -> mkXSampa "_H"+            MidTone       -> mkXSampa "_M"+            LowTone       -> mkXSampa "_L"+            ExtraLowTone  -> mkXSampa "_B"+            DownStep      -> mkXSampa "!"+            UpStep        -> mkXSampa "^"++    LevelLexicalToneDiacritic tone -> toXSampa+        $ WithSuprasegmentalFeature (LevelLexicalTone tone) s++    LexicalToneContour tone -> mkXSampaOp xsampaToneContour s tone+      where+        xsampaToneContour = \case+            Rising        -> mkXSampa "_R"+            Falling       -> mkXSampa "_F"+            HighRising    -> mkXSampa "_H_T"+            LowRising     -> mkXSampa "_B_L"+            HighFalling   -> mkXSampa "_H_F"+            LowFalling    -> mkXSampa "_L_B"+            RisingFalling -> mkXSampa "_R_F"+            FallingRising -> mkXSampa "_F_R"+            GlobalRise    -> mkXSampa "<R>"+            GlobalFall    -> mkXSampa "<F>"++    LexicalToneContourDiacritic tone -> toXSampa+        $ WithSuprasegmentalFeature (LexicalToneContour tone) s++    Stress stress -> mkXSampaOp xsampaStress s stress+      where+        xsampaStress Primary   = mkXSampa "\""+        xsampaStress Secondary = mkXSampa "%"++    -- Explicit syllable break+    Break -> (<>) <$> toXSampa s <*> mkXSampa "."++    -- Syllable non-break+    Linking -> (<>) <$> toXSampa s <*> mkXSampa (xSlash "-")++    _ -> Nothing+

@@ -0,0 +1,1103 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : Language.IPA.Parser+-- Copyright   : (c) 2021 Rory Tyler Hayford+--+-- License     : BSD-3-Clause+-- Maintainer  : rory.hayford@protonmail.com+-- Stability   : experimental+-- Portability : GHC+--+-- Parser for IPA literals+module Language.IPA.Parser+    ( -- * IPA parsing+      -- ** Parsing single segments+      parseSegment+    , segmentP+      -- ** Parsing syllables+    , parseSyllable+    , syllableP+    , parseSyllables+    , syllablesP+      -- * X-SAMPA parsing+      -- ** Parsing single segments+    , parseSegmentXSampa+    , segmentXSampaP+      -- ** Parsing syllables+    , parseSyllableXSampa+    , parseSyllablesXSampa+    , syllableXSampaP+    ) where++import           Control.Applicative  ( Alternative((<|>), some, many) )++import           Data.Attoparsec.Text ( IResult(Fail, Done, Partial), Parser )+import qualified Data.Attoparsec.Text as P+import           Data.Foldable        ( asum, foldl' )+import           Data.Functor         ( ($>), (<&>) )+import           Data.Text            ( Text )+import           Data.Text.Normalize  ( NormalizationMode(NFD), normalize )++import           Language.IPA.Types++-- | Parse a single literal segment in IPA notation, returning 'InvalidIPA' upon+-- failure and a 'Segment' upon success. Note that supplying two or more segment+-- literals will cause the parse to fail+--+-- >>> parseSegment "ɨːː"+-- Right (WithSegmentalFeature (Length OverLong) (Vowel Close Central Unrounded))+--+-- >>> parseSegment "ɨːːb"+-- Left (InvalidIPA "Failed to parse character 'b'")+parseSegment :: Text -> Either IPAException Segment+parseSegment t =+    handleResult InvalidIPA+                 msg+                 (P.parse (segmentP <* P.endOfInput) (normalize NFD t))+  where+    msg = "Failed to parse character(s):"++-- | Parse a literal syllable in IPA notation, returning 'InvalidIPA' upon+-- failure and a 'Syllable' upon success, where the syllable is parameterized by+-- some type @t@ satisfying a 'MultiSegment' constraint. Note that, as with+-- 'parseSegment', supplying two or more syllable literals will cause the parse+-- to fail+--+-- >>> parseSyllable @[] "ma˧˥"+-- Right (WithSuprasegmentalFeature (LexicalToneContour HighRising)+--       (Syllable [Consonant (Pulmonic Voiced Bilabial Nasal),Vowel Open Front Unrounded]))+parseSyllable :: MultiSegment t => Text -> Either IPAException (Syllable t)+parseSyllable t =+    handleResult InvalidIPA+                 msg+                 (P.parse (syllableP <* P.endOfInput) (normalize NFD t))+  where+    msg = "Failed to parse segment(s):"++-- | Parse several syllables into a container parameterized by the same type as that+-- parameterizing the individual 'Syllable's. Whitespace between syllables is interpreted+-- as a syllable boundary+--+-- >>> parseSyllables @[] "haːj˧ ɓaː˧"+-- Right [ WithSuprasegmentalFeature (LevelLexicalTone MidTone)+--           (Syllable [ Consonant (Pulmonic Voiceless Glottal (Fricative NonSibilant))+--                     , WithSegmentalFeature (Length Long) (Vowel Open Front Unrounded)+--                     , Consonant (Pulmonic Voiced Palatal Approximant)+--                     ])+--       , WithSuprasegmentalFeature (LevelLexicalTone MidTone)+--           (Syllable [ Consonant (Implosive Voiced Bilabial)+--                     , WithSegmentalFeature (Length Long) (Vowel Open Front Unrounded)+--                     ])+--       ]+parseSyllables :: (MultiSegment t, Monoid (t (Syllable t)))+               => Text+               -> Either IPAException (t (Syllable t))+parseSyllables t =+    handleResult InvalidIPA+                 msg+                 (P.parse (syllablesP <* P.endOfInput) (normalize NFD t))+  where+    msg = "Failed to parse syllable:"++-- | Parser for syllables. This function is exposed to allow users to create+-- more specific parsers for aggregations of multiple syllables+syllableP :: MultiSegment t => Parser (Syllable t)+syllableP = withStressP <|> withFeaturesP <|> Syllable <$> justSegments+  where+    justSegments = someT segmentP++    withFeaturesP = foldr WithSuprasegmentalFeature+        <$> (Syllable <$> justSegments)+        <*> some suprasegmentalFeatureP++    withStressP = foldr WithSuprasegmentalFeature <$> withStress+        <*> many suprasegmentalFeatureP+      where+        withStress = WithSuprasegmentalFeature <$> stressP+            <*> (Syllable <$> justSegments)++-- | Parser for segments. This function is exposed to allow users to create+-- more specific parsers for multi-segment sequences+segmentP :: Parser Segment+segmentP = withFeatureP <|> pureSegmentP <|> optionalP+  where+    pureSegmentP = vowelP <|> Consonant <$> consonantP++    withFeatureP =+        foldr WithSegmentalFeature <$> pureSegmentP <*> some segmentalFeatureP++    optionalP    = Optional+        <$> ("(" *> (withFeatureP <|> pureSegmentP) <* ")")++-- | Parser for poly-syllabic sequences, with individual syllables separated+-- by (optional) whitespace+syllablesP :: (MultiSegment t, Monoid (t (Syllable t)))+           => Parser (t (Syllable t))+syllablesP = someT withWS+  where+    withWS = syllableP <* many P.space++consonantP :: Parser Consonant+consonantP =+    clickP <|> implosiveP <|> ejectiveP <|> doublyArticulatedP <|> pulmonicP++vowelP :: Parser Segment+vowelP = triphthongP <|> diphthongP <|> Vowel <$> pureP+  where+    diphthongP  = Diphthong <$> pureP <*> pureP++    triphthongP = Triphthong <$> pureP <*> pureP <*> pureP++    pv          = Pure++    lowered     = diacriticP '\x031e'++    pureP       =+        asum [ "e" <* lowered $> pv Mid Front Unrounded+             , "ø" <* lowered $> pv Mid Front Rounded+             , "ɤ" <* lowered $> pv Mid Back Unrounded+             , "o" <* lowered $> pv Mid Back Rounded+             , "i" $> pv Close Front Unrounded+             , "y" $> pv Close Front Rounded+             , "ɨ" $> pv Close Central Unrounded+             , "ʉ" $> pv Close Central Rounded+             , "ɯ" $> pv Close Back Unrounded+             , "u" $> pv Close Back Rounded+             , "ɪ" $> pv NearClose Front Unrounded+             , "ʏ" $> pv NearClose Front Rounded+             , "ʊ" $> pv NearClose Back Rounded+             , "e" $> pv CloseMid Front Unrounded+             , "ø" $> pv CloseMid Front Rounded+             , "ɘ" $> pv CloseMid Central Unrounded+             , "ɵ" $> pv CloseMid Central Rounded+             , "ɤ" $> pv CloseMid Back Unrounded+             , "o" $> pv CloseMid Back Rounded+             , "ə" $> pv Mid Central Unrounded+             , "ɛ" $> pv OpenMid Front Unrounded+             , "œ" $> pv OpenMid Front Rounded+             , "ɜ" $> pv OpenMid Central Unrounded+             , "ɞ" $> pv OpenMid Central Rounded+             , "ʌ" $> pv OpenMid Back Unrounded+             , "ɔ" $> pv OpenMid Back Rounded+             , "æ" $> pv NearOpen Front Unrounded+             , "ɐ" $> pv NearOpen Central Unrounded+             , "a" $> pv Open Front Unrounded+             , "ɶ" $> pv Open Front Rounded+             , "ä" $> pv Open Central Unrounded+             , "ɑ" $> pv Open Back Unrounded+             , "ɒ" $> pv Open Back Rounded+             ]++pulmonicP :: Parser Consonant+pulmonicP =+    asum [ biliabialP+         , labioDentalP+         , dentalP+         , postAlveolarP+         , retroflexP+         , palatalP+         , velarP+         , uvularP+         , pharyngealP+         , glottalP+           -- Alveolars should go at the end; alveolar plosives appear in+           -- several affricates in other places of articulation+         , alveolarP+         ]+  where+    biliabialP = asum cs+      where+        bc v = Pulmonic v Bilabial++        cs   =+            [ "m" $> bc Voiced Nasal+            , doubleArticulated "p" "ɸ" $> bc Voiced (Affricate NonSibilant)+            , doubleArticulated "b" "β"+              $> bc Voiceless (Affricate NonSibilant)+            , "β" $> bc Voiced (Fricative NonSibilant)+            , "ɸ" $> bc Voiceless (Fricative NonSibilant)+            , "ʙ" $> bc Voiced Trill+            , "b" $> bc Voiced Plosive+            , "p" $> bc Voiceless Plosive+            ]++    labioDentalP = asum cs+      where+        ldc v = Pulmonic v LabioDental++        cs    = [ "ɱ" $> ldc Voiced Nasal+                , "f" $> ldc Voiceless (Fricative NonSibilant)+                , "v" $> ldc Voiced (Fricative NonSibilant)+                , "ʋ" $> ldc Voiced Approximant+                , "ⱱ" $> ldc Voiced Flap+                ]++    dentalP = "θ" $> dc Voiceless (Fricative NonSibilant)+        <|> "ð" $> dc Voiced (Fricative NonSibilant)+      where+        dc v = Pulmonic v Dental++    alveolarP = asum cs+      where+        ac v = Pulmonic v Alveolar++        cs   =+            [ "n" $> ac Voiced Nasal+            , doubleArticulated "t" "s" $> ac Voiced (Affricate Sibilant)+            , doubleArticulated "d" "z" $> ac Voiceless (Affricate Sibilant)+            , "s" $> ac Voiceless (Fricative Sibilant)+            , "z" $> ac Voiced (Fricative Sibilant)+            , "ɹ" $> ac Voiced Approximant+            , "ɾ" $> ac Voiced Flap+            , "r" $> ac Voiced Trill+            , "ɬ" $> ac Voiceless LateralFricative+            , "ɮ" $> ac Voiced LateralFricative+            , "l" $> ac Voiced LateralApproximant+            , "ɺ" $> ac Voiced LateralFlap+            , "tɬ" $> ac Voiceless LateralAffricate+            , "dɮ" $> ac Voiced LateralAffricate+            , "t" $> ac Voiceless Plosive+            , "d" $> ac Voiced Plosive+            ]++    postAlveolarP = doubleArticulated "t" "ʃ"+        $> pc Voiceless (Affricate Sibilant)+        <|> doubleArticulated "d" "ʒ" $> pc Voiced (Affricate Sibilant)+        <|> "ʃ" $> pc Voiceless (Fricative Sibilant)+        <|> "ʒ" $> pc Voiced (Fricative Sibilant)+      where+        pc v = Pulmonic v PostAlveolar++    retroflexP = asum cs+      where+        rc v = Pulmonic v Retroflex++        cs   =+            [ "ɳ" $> rc Voiced Nasal+            , doubleArticulated "ʈ" "ʂ" $> rc Voiceless (Affricate Sibilant)+            , doubleArticulated "ɖ" "ʐ" $> rc Voiced (Affricate Sibilant)+            , "ʂ" $> rc Voiceless (Fricative Sibilant)+            , "ʐ" $> rc Voiced (Fricative Sibilant)+            , "ɻ" $> rc Voiced Approximant+            , "ɽ" $> rc Voiced Flap+            , "ɽr" $> rc Voiced Trill+            , "ɭ" $> rc Voiced LateralApproximant+            , "ʈ" $> rc Voiceless Plosive+            , "ɖ" $> rc Voiced Plosive+            ]++    palatalP = asum cs+      where+        pc v = Pulmonic v Palatal++        cs   =+            [ "ɲ" $> pc Voiced Nasal+            , doubleArticulated "t" "ɕ" $> pc Voiceless (Affricate Sibilant)+            , doubleArticulated "d" "ʑ" $> pc Voiced (Affricate Sibilant)+            , doubleArticulated "c" "ç"+              $> pc Voiceless (Affricate NonSibilant)+            , doubleArticulated "ɟ" "ʝ" $> pc Voiced (Affricate NonSibilant)+            , "ɕ" $> pc Voiceless (Fricative Sibilant)+            , "ʑ" $> pc Voiced (Fricative Sibilant)+            , "ç" $> pc Voiceless (Fricative NonSibilant)+            , "ʝ" $> pc Voiced (Fricative NonSibilant)+            , "j" $> pc Voiced Approximant+            , "ʎ" $> pc Voiced LateralApproximant+            , "c" $> pc Voiceless Plosive+            , "ɟ" $> pc Voiced Plosive+            ]++    velarP = asum cs+      where+        vc v = Pulmonic v Velar++        cs   =+            [ "ŋ" $> vc Voiced Nasal+            , doubleArticulated "k" "x"+              $> vc Voiceless (Affricate NonSibilant)+            , doubleArticulated "g" "ɣ" $> vc Voiced (Affricate NonSibilant)+            , "x" $> vc Voiceless (Fricative NonSibilant)+            , "ɣ" $> vc Voiced (Fricative NonSibilant)+            , "ɰ" $> vc Voiced Approximant+            , "ʟ" $> vc Voiced LateralApproximant+            , "k" $> vc Voiceless Plosive+            , "g" $> vc Voiced Plosive+            ]++    uvularP = asum cs+      where+        uc v = Pulmonic v Uvular++        cs   =+            [ "ɴ" $> uc Voiced Nasal+            , doubleArticulated "q" "χ"+              $> uc Voiceless (Fricative NonSibilant)+            , doubleArticulated "ɢ" "ʁ" $> uc Voiced (Fricative NonSibilant)+            , "χ" $> uc Voiceless (Fricative NonSibilant)+            , "ʁ" $> uc Voiced (Fricative NonSibilant)+            , "ʀ" $> uc Voiced Trill+            , "q" $> uc Voiceless Plosive+            , "ɢ" $> uc Voiced Plosive+            ]++    pharyngealP = asum cs+      where+        pc v = Pulmonic v Pharyngeal++        cs   =+            [ doubleArticulated "ʡ" "ʢ" $> pc Voiced (Affricate NonSibilant)+            , "ħ" $> pc Voiceless (Fricative NonSibilant)+            , "ʕ" $> pc Voiced (Fricative NonSibilant)+            , "ʡ" $> pc Voiced Flap+            , "ʜ" $> pc Voiced Trill+            , "ʢ" $> pc Voiceless Trill+            , "ʡ" $> pc Voiceless Plosive+            ]++    glottalP = doubleArticulated "ʔ" "h"+        $> gc Voiceless (Affricate NonSibilant)+        <|> "ʔ" $> gc Voiceless Plosive+        <|> "h" $> gc Voiceless (Fricative NonSibilant)+        <|> "ɦ" $> gc Voiced (Fricative NonSibilant)+      where+        gc v = Pulmonic v Glottal++ejectiveP :: Parser Consonant+ejectiveP = asum cs <* ejective+  where+    ejective = diacriticP '\x02bc'++    ej       = Ejective++    cs       =+        [ doubleArticulated "t" "ɬ" $> ej Alveolar LateralAffricate+        , doubleArticulated "q" "χ" $> ej Uvular (Affricate NonSibilant)+        , doubleArticulated "t" "s" $> ej Alveolar (Affricate Sibilant)+        , doubleArticulated "t" "ʃ" $> ej PostAlveolar (Affricate Sibilant)+        , doubleArticulated "ʈ" "ʂ" $> ej Retroflex (Affricate Sibilant)+        , doubleArticulated "t" "ɕ" $> ej Palatal (Affricate Sibilant)+        , doubleArticulated "k" "x" $> ej Velar (Affricate NonSibilant)+        , "p" $> ej Bilabial Plosive+        , "ɸ" $> ej Bilabial (Fricative NonSibilant)+        , "f" $> ej LabioDental (Fricative NonSibilant)+        , "θ" $> ej Dental (Fricative NonSibilant)+        , "ɬ" $> ej Alveolar LateralFricative+        , "t" $> ej Alveolar Plosive+        , "s" $> ej Alveolar (Fricative Sibilant)+        , "ʃ" $> ej PostAlveolar (Fricative Sibilant)+        , "ʈ" $> ej Retroflex Plosive+        , "ʂ" $> ej Retroflex (Fricative Sibilant)+        , "c" $> ej Palatal Plosive+        , "ɕ" $> ej Palatal (Fricative Sibilant)+        , "k" $> ej Velar Plosive+        , "x" $> ej Velar (Fricative NonSibilant)+        , "q" $> ej Uvular Plosive+        , "χ" $> ej Uvular (Fricative NonSibilant)+        , "ʡ" $> ej Pharyngeal Plosive+        ]++implosiveP :: Parser Consonant+implosiveP = Implosive Voiceless <$> asum cs <* voiceless+    <|> Implosive Voiced <$> asum cs+  where+    voiceless = diacriticP '\x030a'++    cs        = [ "ɓ" $> Bilabial+                , "ɗ" $> Alveolar+                , "ᶑ" $> Retroflex+                , "ʄ" $> Palatal+                , "ɠ" $> Velar+                , "ʛ" $> Uvular+                ]++clickP :: Parser Consonant+clickP = Click+    <$> asum [ "ʘ" $> Bilabial+             , "ǀ" $> Dental+             , "ǃ" $> Alveolar+             , "ǁ" $> PostAlveolar+             , "ǂ" $> Palatal+             ]++doublyArticulatedP :: Parser Consonant+doublyArticulatedP = asum cs+  where+    da = DoublyArticulated++    cs =+        [ doubleArticulated "n" "m" $> da Voiced Bilabial Alveolar Nasal+        , doubleArticulated "t" "p" $> da Voiceless Bilabial Alveolar Plosive+        , doubleArticulated "d" "b" $> da Voiced Bilabial Alveolar Plosive+        , doubleArticulated "ŋ" "m" $> da Voiced Bilabial Velar Nasal+        , doubleArticulated "k" "p" $> da Voiceless Bilabial Velar Plosive+        , doubleArticulated "g" "b" $> da Voiced Bilabial Velar Plosive+        , doubleArticulated "q" "ʡ" $> da Voiceless Uvular Pharyngeal Plosive+        , "ɥ" <* P.char '\x030a'+          $> da Voiceless Bilabial Palatal (Fricative NonSibilant)+        , "ɥ" $> da Voiced Bilabial Palatal Approximant+        , "ʍ" $> da Voiceless Bilabial Velar (Fricative NonSibilant)+        , "w" $> da Voiced Bilabial Velar Approximant+        , "ɫ" $> da Voiced Alveolar Velar LateralApproximant+        , "ɧ" $> da Voiceless PostAlveolar Velar (Fricative Sibilant)+        ]++segmentalFeatureP :: Parser SegmentalFeature+segmentalFeatureP = secondaryArticulationP <|> asum fs+  where+    fs = [ "\x030a" $> Voicing Voiceless+         , "\x030c" $> Voicing Voiced+         , "\x2d0\x2d0" $> Length OverLong+         , "\x2d1" $> Length HalfLong+         , "\x2d0" $> Length Long+         , "\x0306" $> Length ExtraShort+         , "\x036a" $> Aspirated+         , "\x0339" $> MoreRounded+         , "\x031c" $> LessRounded+         , "\x031f" $> Advanced+         , "\x0320" $> Retracted+         , "\x0308" $> Centralized+         , "\x033d" $> MidCentralized+         , "\x1d5d" $> Compressed+         , "\x0329" $> Syllabic+         , "\x032f" $> NonSyllabic+         , "\x02de" $> Rhotacized+         , "\x0324" $> BreathyVoice+         , "\x0330" $> CreakyVoice+         , "\x033c" $> LinguoLabialized+         , "\x02b7" $> Labialized+         , "\x02b2" $> Palatalized+         , "\x02e0" $> Velarized+         , "\x02e4" $> Pharyngealized+         , "\x031d" $> Raised+         , "\x031e" $> Lowered+         , "\x0318" $> AdvancedTongueRoot+         , "\x0319" $> RetractedTongueRoot+         , "\x032a" $> Dentalized+         , "\x033a" $> Apical+         , "\x033b" $> Laminal+         , "\x0303" $> Nasalized+         , "\x207f" $> NasalRelease+         , "\x02e1" $> LateralRelease+         , "\x031a" $> NoAudibleRelease+         ]++secondaryArticulationP :: Parser SegmentalFeature+secondaryArticulationP = SecondaryArticulation <$> secondaryP+  where+    secondaryP = asum segments++    pc         = PulmonicConsonant++    pv         = PureVowel++    segments   =+        [ "\x1d50" $> pc Voiced Bilabial Nasal+        , "\x1dac" $> pc Voiced LabioDental Nasal+        , "\x207f" $> pc Voiced Alveolar Nasal+        , "\x1daf" $> pc Voiced Retroflex Nasal+        , "\x1dae" $> pc Voiced Palatal Nasal+        , "\x1d51" $> pc Voiced Velar Nasal+        , "\x1db0" $> pc Voiced Uvular Nasal+        , "\x1d56" $> pc Voiced Bilabial Plosive+        , "\x1d47" $> pc Voiceless Bilabial Plosive+        , "\x1d57" $> pc Voiceless Alveolar Plosive+        , "\x1d48" $> pc Voiced Alveolar Plosive+        , "\x1d9c" $> pc Voiceless Palatal Plosive+        , "\x1da1" $> pc Voiced Palatal Plosive+        , "\x1d4f" $> pc Voiceless Velar Plosive+        , "\x1da2" $> pc Voiced Velar Plosive+        , "\x02c0" $> pc Voiceless Glottal Plosive+        , "\x1db2" $> pc Voiced Bilabial (Fricative NonSibilant)+        , "\x1d5d" $> pc Voiceless Bilabial (Fricative NonSibilant)+        , "\x1da0" $> pc Voiced LabioDental (Fricative NonSibilant)+        , "\x1d5b" $> pc Voiceless LabioDental (Fricative NonSibilant)+        , "\x1dbf" $> pc Voiceless Dental (Fricative NonSibilant)+        , "\x1d9e" $> pc Voiced Dental (Fricative NonSibilant)+        , "\x02e2" $> pc Voiceless Alveolar (Fricative Sibilant)+        , "\x1dbb" $> pc Voiced Alveolar (Fricative Sibilant)+        , "\x1db4" $> pc Voiceless PostAlveolar (Fricative Sibilant)+        , "\x1dbe" $> pc Voiced PostAlveolar (Fricative Sibilant)+        , "\x1d9d" $> pc Voiceless Palatal (Fricative Sibilant)+        , "\x1dbd" $> pc Voiced Palatal (Fricative Sibilant)+        , "\x1d9c\x0327" $> pc Voiceless Palatal (Fricative NonSibilant)+        , "\x1da8" $> pc Voiced Palatal (Fricative NonSibilant)+        , "\x02e3" $> pc Voiceless Velar (Fricative NonSibilant)+        , "\x02e0" $> pc Voiced Velar (Fricative NonSibilant)+        , "\x1d61" $> pc Voiceless Uvular (Fricative NonSibilant)+        , "\x02b6" $> pc Voiced Uvular (Fricative NonSibilant)+        , "\x02b0" $> pc Voiceless Glottal (Fricative NonSibilant)+        , "\x02b1" $> pc Voiced Glottal (Fricative NonSibilant)+        , "\x1db9" $> pc Voiced LabioDental Approximant+        , "\x02b4" $> pc Voiced Alveolar Approximant+        , "\x02b5" $> pc Voiced Retroflex Approximant+        , "\x02b2" $> pc Voiced Palatal Approximant+        , "\xab69" $> pc Voiceless Velar Approximant+        , "\x1dad" $> pc Voiced Velar Approximant+        , "\x02b3" $> pc Voiced Alveolar Trill+        , "\x1df1"+          $> DoublyArticulatedConsonant Voiced Bilabial Velar Approximant+        , "\x2071" $> pv Close Front Unrounded+        , "\x02b8" $> pv Close Front Rounded+        , "\x1da4" $> pv Close Central Unrounded+        , "\x1db6" $> pv Close Central Rounded+        , "\x1d5a" $> pv Close Back Unrounded+        , "\x1d58" $> pv Close Back Rounded+        , "\x1da6" $> pv NearClose Front Unrounded+        , "\x1da7" $> pv NearClose Central Unrounded+        , "\x1db7" $> pv NearClose Back Rounded+        , "\x1d4a" $> pv Mid Central Unrounded+        , "\x1d4a" $> pv Mid Central Rounded+        , "\x1d4b" $> pv OpenMid Front Unrounded+        , "\xa7f9" $> pv OpenMid Front Rounded+        , "\x1d9f" $> pv OpenMid Central Unrounded+        , "\x1dba" $> pv OpenMid Back Unrounded+        , "\x1d53" $> pv OpenMid Back Rounded+        , "\x1d46" $> pv NearOpen Front Unrounded+        , "\x1d44" $> pv NearOpen Central Unrounded+        , "\x1d45" $> pv NearOpen Back Unrounded+        , "\x1d9b" $> pv NearOpen Back Rounded+        , "\x1d43" $> pv Open Front Unrounded+        , "\x1d44" $> pv Open Back Rounded+        ]++diacriticP :: Char -> Parser Char+diacriticP = P.char++doubleArticulated :: Text -> Text -> Parser Text+doubleArticulated x y = P.string $ x <> invertedBreve <> y+  where+    invertedBreve = "\x0361"++suprasegmentalFeatureP :: Parser SuprasegmentalFeature+suprasegmentalFeatureP = asum fs+  where+    fs = [ toneContourP+         , toneContourDiacriticP+         , levelToneP+         , levelToneDiacriticP+         , toneNumberP digits+         , "." $> Break+         , "\x203f" $> Linking+         ]++    levelToneP = LevelLexicalTone+        <$> asum [ "\x02e5" $> ExtraHighTone+                 , "\x02e6" $> HighTone+                 , "\x02e7" $> MidTone+                 , "\x02e8" $> LowTone+                 , "\x02e9" $> ExtraLowTone+                 ]++    levelToneDiacriticP = LevelLexicalToneDiacritic+        <$> asum [ "\x030b" $> ExtraHighTone+                 , "\x0341" $> HighTone+                 , "\x0304" $> MidTone+                 , "\x0340" $> LowTone+                 , "\x030f" $> ExtraLowTone+                 , "\xa71c" $> DownStep+                 , "\xa71b" $> UpStep+                 ]++    toneContourP = LexicalToneContour+        <$> asum [ "\x02e9\x02e5" $> Rising+                 , "\x02e5\x02e9" $> Falling+                 , "\x02e7\x02e5" $> HighRising+                 , "\x02e9\x02e7" $> LowRising+                 , "\x02e5\x02e7" $> HighFalling+                 , "\x02e7\x02e9" $> LowFalling+                 , "\x02e7\x02e6\x02e8" $> RisingFalling+                 , "\x02e7\x02e8\x02e6" $> FallingRising+                 , "\x2197" $> GlobalRise+                 , "\x2199" $> GlobalFall+                 ]++    toneContourDiacriticP = LexicalToneContourDiacritic+        <$> asum [ "\x0302" $> Rising+                 , "\x030c" $> Falling+                 , "\x1dc9" $> HighRising+                 , "\x1dc5" $> LowRising+                 , "\x1dc7" $> HighFalling+                 , "\x1dc6" $> LowFalling+                 , "\x1dc8" $> RisingFalling+                 , "\x1dc9" $> FallingRising+                 ]++    digits = [ "\x2070" $> 0+             , "\x00b9" $> 1+             , "\x00b2" $> 2+             , "\x00b3" $> 3+             , "\x2074" $> 4+             , "\x2075" $> 5+             , "\x2076" $> 6+             , "\x2077" $> 7+             , "\x2078" $> 8+             , "\x2079" $> 9+             ]++stressP :: Parser SuprasegmentalFeature+stressP = "\x02c8" $> Stress Primary <|> "\x02cc" $> Stress Secondary++toneNumberP :: (Foldable t) => t (Parser Int) -> Parser SuprasegmentalFeature+toneNumberP digits = ToneNumber+    <$> (some (asum digits) <&> foldl' (\a b -> b + a * 10) 0)++consT :: (Applicative t, Monoid (t a)) => a -> t a -> t a+consT x xs = pure x <> xs++manyT :: (Applicative t, Monoid (t a), Alternative f) => f a -> f (t a)+manyT v = manyT'+  where+    manyT' = someT' <|> pure mempty++    someT' = consT <$> v <*> manyT'++someT :: (Applicative t, Monoid (t a), Alternative f) => f a -> f (t a)+someT v = consT <$> v <*> manyT v++handleResult :: (Text -> IPAException)+             -> Text+             -> IResult Text b+             -> Either IPAException b+handleResult ty t i = case i of+    Done _ r    -> Right r+    Fail ch _ _ -> Left . ty $ mconcat [ t, " ", "'", ch, "'" ]+    Partial p   -> handleResult ty t (p mempty)++-------------------------------------------------------------------------------+--                               X-SAMPA Parser                              --+-------------------------------------------------------------------------------+-- | As 'parseSegment', but in X-SAMPA notation+parseSegmentXSampa :: Text -> Either IPAException Segment+parseSegmentXSampa t =+    handleResult InvalidXSampa+                 msg+                 (P.parse (segmentXSampaP <* P.endOfInput) t)+  where+    msg = "Failed to parse character(s):"++-- | As 'parseSyllable', but in X-SAMPA notation+parseSyllableXSampa+    :: MultiSegment t => Text -> Either IPAException (Syllable t)+parseSyllableXSampa t =+    handleResult InvalidXSampa+                 msg+                 (P.parse (syllableXSampaP <* P.endOfInput) t)+  where+    msg = "Failed to parse segment(s):"++-- | As 'parseSyllables', but in X-SAMPA notation+parseSyllablesXSampa :: (MultiSegment t, Monoid (t (Syllable t)))+                     => Text+                     -> Either IPAException (t (Syllable t))+parseSyllablesXSampa t =+    handleResult InvalidXSampa+                 msg+                 (P.parse (syllablesXSampaP <* P.endOfInput) t)+  where+    msg = "Failed to parse syllable:"++-- | As 'segmentP', but in X-SAMPA notation+segmentXSampaP :: Parser Segment+segmentXSampaP = withFeatureP <|> pureSegmentP <|> optionalP+  where+    pureSegmentP = vowelXSampaP <|> Consonant <$> consonantXSampaP++    withFeatureP = foldr WithSegmentalFeature <$> pureSegmentP+        <*> some segmentalFeatureXSampaP++    optionalP    = Optional+        <$> ("(" *> (withFeatureP <|> pureSegmentP) <* ")")++-- | As 'syllableP', but in X-SAMPA notation+syllableXSampaP :: MultiSegment t => Parser (Syllable t)+syllableXSampaP = withStressP <|> withFeaturesP <|> Syllable <$> justSegments+  where+    justSegments = someT segmentXSampaP++    withFeaturesP = foldr WithSuprasegmentalFeature+        <$> (Syllable <$> justSegments)+        <*> some suprasegmentalFeatureXSampaP++    withStressP = foldr WithSuprasegmentalFeature <$> withStress+        <*> many suprasegmentalFeatureXSampaP+      where+        withStress = WithSuprasegmentalFeature <$> stressXSampaP+            <*> (Syllable <$> justSegments)++syllablesXSampaP :: (MultiSegment t, Monoid (t (Syllable t)))+                 => Parser (t (Syllable t))+syllablesXSampaP = someT withWS+  where+    withWS = syllableXSampaP <* many P.space++consonantXSampaP :: Parser Consonant+consonantXSampaP = clickXSampaP+    <|> implosiveXSampaP+    <|> ejectiveXSampaP+    <|> doublyArticulatedXSampaP+    <|> pulmonicXSampaP++vowelXSampaP :: Parser Segment+vowelXSampaP = triphthongP <|> diphthongP <|> Vowel <$> pureP+  where+    diphthongP  = Diphthong <$> pureP <*> pureP++    triphthongP = Triphthong <$> pureP <*> pureP <*> pureP++    pv          = Pure++    lowered     = "_o"++    pureP       =+        asum [ "e" <* lowered $> pv Mid Front Unrounded+             , "2" <* lowered $> pv Mid Front Rounded+             , "7" <* lowered $> pv Mid Back Unrounded+             , "o" <* lowered $> pv Mid Back Rounded+             , "i" $> pv Close Front Unrounded+             , "y" $> pv Close Front Rounded+             , "1" $> pv Close Central Unrounded+             , "}" $> pv Close Central Rounded+             , "M" $> pv Close Back Unrounded+             , "u" $> pv Close Back Rounded+             , "I" $> pv NearClose Front Unrounded+             , "Y" $> pv NearClose Front Rounded+             , "U" $> pv NearClose Back Rounded+             , "e" $> pv CloseMid Front Unrounded+             , "2" $> pv CloseMid Front Rounded+             , "@" *> slash $> pv CloseMid Central Unrounded+             , "8" $> pv CloseMid Central Rounded+             , "7" $> pv CloseMid Back Unrounded+             , "o" $> pv CloseMid Back Rounded+             , "@" $> pv Mid Central Unrounded+             , "E" $> pv OpenMid Front Unrounded+             , "9" $> pv OpenMid Front Rounded+             , "3" *> slash $> pv OpenMid Central Unrounded+             , "3" *> slash $> pv OpenMid Central Rounded+             , "V" $> pv OpenMid Back Unrounded+             , "O" $> pv OpenMid Back Rounded+             , "{" $> pv NearOpen Front Unrounded+             , "6" $> pv NearOpen Central Unrounded+             , "a" $> pv Open Front Unrounded+             , "&" $> pv Open Front Rounded+             , "A" $> pv Open Back Unrounded+             , "Q" $> pv Open Back Rounded+             ]++pulmonicXSampaP :: Parser Consonant+pulmonicXSampaP =+    asum [ biliabialP+         , labioDentalP+         , dentalP+         , postAlveolarP+         , retroflexP+         , palatalP+         , velarP+         , uvularP+         , pharyngealP+         , glottalP+         , alveolarP+         ]+  where+    biliabialP = asum cs+      where+        bc v = Pulmonic v Bilabial++        cs   = [ "m" $> bc Voiced Nasal+               , doubleArticulatedXSampa "p" "p" *> slash+                 $> bc Voiceless (Affricate NonSibilant)+               , doubleArticulatedXSampa "b" "B"+                 $> bc Voiced (Affricate NonSibilant)+               , "B" $> bc Voiced (Fricative NonSibilant)+               , "p" *> slash $> bc Voiceless (Fricative NonSibilant)+               , "B" *> slash $> bc Voiced Trill+               , "b" $> bc Voiced Plosive+               , "p" $> bc Voiceless Plosive+               ]++    labioDentalP = asum cs+      where+        ldc v = Pulmonic v LabioDental++        cs    = [ "F" $> ldc Voiced Nasal+                , "f" $> ldc Voiceless (Fricative NonSibilant)+                , "v" $> ldc Voiced (Fricative NonSibilant)+                , "P" $> ldc Voiced Approximant+                ]++    dentalP = "T" $> dc Voiceless (Fricative NonSibilant)+        <|> "D" $> dc Voiced (Fricative NonSibilant)+      where+        dc v = Pulmonic v Dental++    alveolarP = asum cs+      where+        ac v = Pulmonic v Alveolar++        cs   = [ "n" $> ac Voiced Nasal+               , doubleArticulatedXSampa "t" "s"+                 $> ac Voiced (Affricate Sibilant)+               , doubleArticulatedXSampa "d" "z"+                 $> ac Voiceless (Affricate Sibilant)+               , "s" $> ac Voiceless (Fricative Sibilant)+               , "z" $> ac Voiced (Fricative Sibilant)+               , "r" *> slash $> ac Voiced Approximant+               , "4" $> ac Voiced Flap+               , "r" $> ac Voiced Trill+               , "K" $> ac Voiceless LateralFricative+               , "K" *> slash $> ac Voiced LateralFricative+               , "l" $> ac Voiced LateralApproximant+               , "t" $> ac Voiceless Plosive+               , "d" $> ac Voiced Plosive+               ]++    postAlveolarP = doubleArticulatedXSampa "t" "S"+        $> pc Voiceless (Affricate Sibilant)+        <|> doubleArticulatedXSampa "d" "Z" $> pc Voiced (Affricate Sibilant)+        <|> "S" $> pc Voiceless (Fricative Sibilant)+        <|> "Z" $> pc Voiced (Fricative Sibilant)+      where+        pc v = Pulmonic v PostAlveolar++    retroflexP = asum cs+      where+        rc v = Pulmonic v Retroflex++        retroflexDiacritic = diacriticP '`'++        cs                 =+            [ "n" *> retroflexDiacritic $> rc Voiced Nasal+            , doubleArticulatedXSampa "t`" "s" *> retroflexDiacritic+              $> rc Voiceless (Affricate Sibilant)+            , doubleArticulatedXSampa "d`" "s" *> retroflexDiacritic+              $> rc Voiced (Affricate Sibilant)+            , "s" *> retroflexDiacritic $> rc Voiceless (Fricative Sibilant)+            , "z" *> retroflexDiacritic $> rc Voiced (Fricative Sibilant)+            , "r" *> slash *> retroflexDiacritic $> rc Voiced Approximant+            , "r" *> retroflexDiacritic $> rc Voiced Flap+            , "l" *> retroflexDiacritic $> rc Voiced LateralApproximant+            , "t" *> retroflexDiacritic $> rc Voiceless Plosive+            , "d" *> retroflexDiacritic $> rc Voiced Plosive+            ]++    palatalP = asum cs+      where+        pc v = Pulmonic v Palatal++        cs   = [ "J" $> pc Voiced Nasal+               , doubleArticulatedXSampa "t" "s" *> slash+                 $> pc Voiceless (Affricate Sibilant)+               , doubleArticulatedXSampa "d" "z" *> slash+                 $> pc Voiced (Affricate Sibilant)+               , "s" *> slash $> pc Voiceless (Fricative Sibilant)+               , "z" *> slash $> pc Voiced (Fricative Sibilant)+               , "C" $> pc Voiceless (Fricative NonSibilant)+               , "j" *> slash $> pc Voiced (Fricative NonSibilant)+               , "j" $> pc Voiced Approximant+               , "L" $> pc Voiced LateralApproximant+               , "c" $> pc Voiceless Plosive+               , "J" *> slash $> pc Voiced Plosive+               ]++    velarP = asum cs+      where+        vc v = Pulmonic v Velar++        cs   = [ "N" $> vc Voiced Nasal+               , doubleArticulatedXSampa "k" "x"+                 $> vc Voiceless (Affricate NonSibilant)+               , doubleArticulatedXSampa "g" "G"+                 $> vc Voiced (Affricate NonSibilant)+               , "x" $> vc Voiceless (Fricative NonSibilant)+               , "G" $> vc Voiced (Fricative NonSibilant)+               , "m" *> slash $> vc Voiced Approximant+               , "L" *> slash $> vc Voiced LateralApproximant+               , "k" $> vc Voiceless Plosive+               , "g" $> vc Voiced Plosive+               ]++    uvularP = asum cs+      where+        uc v = Pulmonic v Uvular++        cs   = [ "N" *> slash $> uc Voiced Nasal+               , doubleArticulatedXSampa "q" "X"+                 $> uc Voiceless (Fricative NonSibilant)+               , doubleArticulatedXSampa "G\\" "R"+                 $> uc Voiced (Fricative NonSibilant)+               , "X" $> uc Voiceless (Fricative NonSibilant)+               , "R" $> uc Voiced (Fricative NonSibilant)+               , "R" *> slash $> uc Voiced Trill+               , "q" $> uc Voiceless Plosive+               , "G" *> slash $> uc Voiced Plosive+               ]++    pharyngealP = "X" *> slash $> pc Voiceless (Fricative NonSibilant)+        <|> "?" *> slash $> pc Voiced (Fricative NonSibilant)+      where+        pc v = Pulmonic v Pharyngeal++    glottalP = doubleArticulatedXSampa "?" "h" *> slash+        $> gc Voiceless (Affricate NonSibilant)+        <|> "?" $> gc Voiceless Plosive+        <|> "h" $> gc Voiceless (Fricative NonSibilant)+        <|> "h" *> slash $> gc Voiced (Fricative NonSibilant)+      where+        gc v = Pulmonic v Glottal++ejectiveXSampaP :: Parser Consonant+ejectiveXSampaP = asum cs <* ejective+  where+    ejective = "_>"++    ej       = Ejective++    cs       =+        [ doubleArticulatedXSampa "q" "X" $> ej Uvular (Affricate NonSibilant)+        , doubleArticulatedXSampa "t" "s" $> ej Alveolar (Affricate Sibilant)+        , doubleArticulatedXSampa "t" "S"+          $> ej PostAlveolar (Affricate Sibilant)+        , doubleArticulatedXSampa "t`" "s`"+          $> ej Retroflex (Affricate Sibilant)+        , doubleArticulatedXSampa "t" "s" *> slash+          $> ej Palatal (Affricate Sibilant)+        , doubleArticulatedXSampa "k" "x" $> ej Velar (Affricate NonSibilant)+        , "p" $> ej Bilabial Plosive+        , "p" *> slash $> ej Bilabial (Fricative NonSibilant)+        , "f" $> ej LabioDental (Fricative NonSibilant)+        , "T" $> ej Dental (Fricative NonSibilant)+        , "t" $> ej Alveolar Plosive+        , "s" $> ej Alveolar (Fricative Sibilant)+        , "S" $> ej PostAlveolar (Fricative Sibilant)+        , "t`" $> ej Retroflex Plosive+        , "s`" $> ej Retroflex (Fricative Sibilant)+        , "c" $> ej Palatal Plosive+        , "s" *> slash $> ej Palatal (Fricative Sibilant)+        , "k" $> ej Velar Plosive+        , "x" $> ej Velar (Fricative NonSibilant)+        , "q" $> ej Uvular Plosive+        , "X" $> ej Uvular (Fricative NonSibilant)+        ]++implosiveXSampaP :: Parser Consonant+implosiveXSampaP = Implosive Voiceless <$> asum cs <* implosive <* voiceless+    <|> Implosive Voiced <$> asum cs <* implosive+  where+    voiceless = "_0"++    implosive = "_<"++    cs        = [ "b" $> Bilabial+                , "d" $> Alveolar+                , "d`" $> Retroflex+                , "f" $> Palatal+                , "g" $> Velar+                , "G" $> Uvular+                ]++clickXSampaP :: Parser Consonant+clickXSampaP = Click+    <$> asum [ "O" $> Bilabial+             , "|" $> Dental+             , "!" $> Alveolar+             , "|" *> slash *> "|" $> PostAlveolar+             , "=" $> Palatal+             ]+    <* slash++doublyArticulatedXSampaP :: Parser Consonant+doublyArticulatedXSampaP = asum cs+  where+    da = DoublyArticulated++    cs =+        [ doubleArticulatedXSampa "n" "m" $> da Voiced Bilabial Alveolar Nasal+        , doubleArticulatedXSampa "t" "p"+          $> da Voiceless Bilabial Alveolar Plosive+        , doubleArticulatedXSampa "d" "b"+          $> da Voiced Bilabial Alveolar Plosive+        , doubleArticulatedXSampa "N" "m" $> da Voiced Bilabial Velar Nasal+        , doubleArticulatedXSampa "k" "p"+          $> da Voiceless Bilabial Velar Plosive+        , doubleArticulatedXSampa "g" "b" $> da Voiced Bilabial Velar Plosive+        , "H_0" $> da Voiceless Bilabial Palatal (Fricative NonSibilant)+        , "H" $> da Voiced Bilabial Palatal Approximant+        , "W" $> da Voiceless Bilabial Velar (Fricative NonSibilant)+        , "w" $> da Voiced Bilabial Velar Approximant+        , "x" *> slash $> da Voiceless PostAlveolar Velar (Fricative Sibilant)+        ]++segmentalFeatureXSampaP :: Parser SegmentalFeature+segmentalFeatureXSampaP = secondaryArticulationP <|> asum fs+  where+    fs = [ "_0" $> Voicing Voiceless+         , "_v" $> Voicing Voiced+         , "::" $> Length OverLong+         , ":" *> slash $> Length HalfLong+         , ":" $> Length Long+         , "_X" $> Length ExtraShort+         , "_h" $> Aspirated+         , "_O" $> MoreRounded+         , "_c" $> LessRounded+         , "_+" $> Advanced+         , "_-" $> Retracted+         , "_\"" $> Centralized+         , "_x" $> MidCentralized+         , "=" $> Syllabic+         , "_^" $> NonSyllabic+         , "`" $> Rhotacized+         , "_t" $> BreathyVoice+         , "_k" $> CreakyVoice+         , "_w" $> Labialized+         , "'" $> Palatalized+         , "_G" $> Velarized+         , "_?" *> slash $> Pharyngealized+         , "_r" $> Raised+         , "_o" $> Lowered+         , "_A" $> AdvancedTongueRoot+         , "_q" $> RetractedTongueRoot+         , "_d" $> Dentalized+         , "_a" $> Apical+         , "_m" $> Laminal+         , "~" $> Nasalized+         , "_l" $> LateralRelease+         , "_}" $> NoAudibleRelease+         ]++suprasegmentalFeatureXSampaP :: Parser SuprasegmentalFeature+suprasegmentalFeatureXSampaP = asum fs+  where+    fs           =+        [ toneContourP, levelToneP, "." $> Break, "-" *> slash $> Linking ]++    levelToneP   = LevelLexicalTone+        <$> asum [ "_T" $> ExtraHighTone+                 , "_H" $> HighTone+                 , "_M" $> MidTone+                 , "_L" $> LowTone+                 , "_B" $> ExtraLowTone+                 , "!" $> DownStep+                 , "^" $> UpStep+                 ]++    toneContourP = LexicalToneContour+        <$> asum [ "_R" $> Rising+                 , "_F" $> Falling+                 , "_H_T" $> HighRising+                 , "_B_L" $> LowRising+                 , "_H_F" $> HighFalling+                 , "_L_B" $> LowFalling+                 , "_R_F" $> RisingFalling+                 , "_F_R" $> FallingRising+                 , "<R>" $> GlobalRise+                 , "<F>" $> GlobalFall+                 ]++slash :: Parser Char+slash = P.char '\\'++doubleArticulatedXSampa :: Text -> Text -> Parser Text+doubleArticulatedXSampa x y = P.string $ x <> "_" <> y++stressXSampaP :: Parser SuprasegmentalFeature+stressXSampaP = ("\"" <|> "\'") $> Stress Primary <|> "%" $> Stress Secondary

@@ -1,3 +1,4 @@+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -8,7 +9,6 @@ -- | -- Module      : Language.IPA.Types -- Copyright   : (c) 2021 Rory Tyler Hayford--- -- License     : BSD-3-Clause -- Maintainer  : rory.hayford@protonmail.com -- Stability   : experimental@@ -19,27 +19,36 @@     ( -- * Notation systems       IPA(..)     , mkIPA-    , XSampa(XSampa)+    , XSampa(..)+    , mkXSampa       -- * Segments     , Segment(..)       -- ** Consonants (pulmonic and non-pulmonic)     , Consonant(..)-      -- **** Convenience patterns+      -- *** Convenience patterns       -- $pat     , pattern PulmonicConsonant     , pattern EjectiveConsonant     , pattern ClickConsonant     , pattern ImplosiveConsonant+    , pattern DoublyArticulatedConsonant       -- *** Consonant features     , Manner(..)     , Place(..)     , Phonation(..)     , Sibilance(..)-      -- ** Vowel features+      -- ** Vowels+    , Vowel(..)+      -- *** Convenience patterns+    , pattern PureVowel+    , pattern Diphthong+    , pattern Triphthong+      -- *** Vowel features     , Height(..)     , Backness(..)     , Roundedness(..)       -- * Suprasegmentals+    , MultiSegment     , Syllable(..)       -- ** Suprasegmental features     , SuprasegmentalFeature(..)@@ -55,7 +64,9 @@  import           Control.Exception   ( Exception ) +import           Data.Char           ( isAscii ) import           Data.Text           ( Text )+import qualified Data.Text           as T import           Data.Text.Normalize ( NormalizationMode(NFC), normalize )  import           GHC.Generics        ( Generic )@@ -77,20 +88,31 @@  -- | X-SAMPA is an ASCII encoding of the IPA (ca. 1993). Note that fewer -- transcriptions are possible using X-SAMPA than the IPA, so certain valid--- 'IPA' 'Segments's have no direct equivalence using 'XSampa'. As with 'IPA',+-- 'IPA' 'Segment's have no direct equivalence using 'XSampa'. As with 'IPA', -- 'XSampa' is an instance of 'Semigroup' newtype XSampa = XSampa     { unXSampa :: Text-      -- ^ The wrapped 'Text' should only contained 7-bit ASCII characters+      -- ^ The wrapped 'Text' should only contain ASCII characters     }     deriving ( Show, Eq, Generic, Semigroup ) +-- | Wraps a 'Text' value in 'XSampa', provided the text only contains ASCII+-- characters+mkXSampa :: Text -> Maybe XSampa+mkXSampa t+    | T.all isAscii t = Just $ XSampa t+    | otherwise = Nothing+ -- | A single segment, or combination of a segment and articulatory feature data Segment     = Consonant Consonant -- ^ Pulmonic and non-pulmonic consonants-    | Vowel Height Backness Roundedness+    | Vowel Vowel -- ^ Monoph-, diph-, and triphthongs     | Zero -- ^ A null/zero phone     | WithSegmentalFeature SegmentalFeature Segment -- ^ Various other articulatory features+    | Optional Segment+      -- ^ A segment that is conventionally surrounded by parentheses. This is not an+      -- official part of the IPA, but is nevertheless encountered fairly frequently+      -- in IPA notation in the wild     deriving ( Show, Eq, Generic )  -- | Multiple segments, or combination of multiple segments with@@ -106,19 +128,22 @@  deriving instance Eq (t Segment) => Eq (Syllable t) +-- | Constraint synonym for syllable containers+type MultiSegment t = (Applicative t, Traversable t, Monoid (t Segment))+ -- | Pulmonic and non-pulmonic consonants data Consonant     = Pulmonic Phonation Place Manner     | Ejective Place Manner     | Implosive Phonation Place-    | Click Place+    | Click Place -- ^ 'PostAlveolar' place represents a lateral click     | DoublyArticulated Phonation Place Place Manner     deriving ( Show, Eq, Generic )  -- $pat -- These are convenience patterns for creating different types of 'Consonant' -- 'Segment's, as the nesting of data constructors might otherwise be somewhat--- troublesome+-- tiresome pattern PulmonicConsonant :: Phonation -> Place -> Manner -> Segment pattern PulmonicConsonant ph pl m = Consonant (Pulmonic ph pl m) @@ -131,6 +156,11 @@ pattern ImplosiveConsonant :: Phonation -> Place -> Segment pattern ImplosiveConsonant ph pl = Consonant (Implosive ph pl) +pattern DoublyArticulatedConsonant+    :: Phonation -> Place -> Place -> Manner -> Segment+pattern DoublyArticulatedConsonant ph pl1 pl2 m =+    Consonant (DoublyArticulated ph pl1 pl2 m)+ -- | Consonantal manner of articulation data Manner     = Nasal@@ -170,6 +200,23 @@ data Sibilance = Sibilant | NonSibilant     deriving ( Show, Eq, Generic ) +-- | Vowel type. Note that this type does not prevent the construction of+-- non-sensical vowel values such as @Diphthong (Diphthong ...) (Diphthong ...)@+data Vowel+    = Pure Height Backness Roundedness+    | Diphthongized Vowel Vowel+    | Triphthongized Vowel Vowel Vowel+    deriving ( Show, Eq, Generic )++pattern PureVowel :: Height -> Backness -> Roundedness -> Segment+pattern PureVowel h b r = Vowel (Pure h b r)++pattern Diphthong :: Vowel -> Vowel -> Segment+pattern Diphthong v1 v2 = Vowel (Diphthongized v1 v2)++pattern Triphthong :: Vowel -> Vowel -> Vowel -> Segment+pattern Triphthong v1 v2 v3 = Vowel (Triphthongized v1 v2 v3)+ -- | Vowel height data Height = Close | NearClose | CloseMid | Mid | OpenMid | NearOpen | Open     deriving ( Show, Eq, Generic )@@ -229,7 +276,6 @@     = Voicing Phonation     | Length Length     | SecondaryArticulation Segment-    | SuperScriptNumeric Int     | Aspirated     | MoreRounded     | LessRounded@@ -274,6 +320,7 @@     | LexicalToneContourDiacritic ToneContour       -- ^ Lexical tone contours, as diacritics. Each contour is a combining       -- character+    | ToneNumber Int     | Stress Stress -- ^ Syllable stress     | Break -- ^ Explicit syllable break     | Linking -- ^ Absence of a break

@@ -1,33 +1,13 @@-{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeApplications #-}  -- | module Main where -import           Data.Foldable ( traverse_ )+import           Data.Either   ( isLeft )+import           Data.Foldable ( for_, traverse_ ) import           Data.Maybe    ( isNothing )  import           Language.IPA-                 ( Backness(..)-                 , Height(..)-                 , IPA(IPA)-                 , Length(..)-                 , Manner(..)-                 , Phonation(..)-                 , Place(..)-                 , ReprIPA(toIPA', toIPA, toXSampa', toXSampa)-                 , Roundedness(..)-                 , Segment(..)-                 , SegmentalFeature(..)-                 , Sibilance(..)-                 , Stress(Primary)-                 , SuprasegmentalFeature(..)-                 , Syllable(..)-                 , ToneContour(..)-                 , XSampa(XSampa)-                 , mkIPA-                 , pattern ImplosiveConsonant-                 , pattern PulmonicConsonant-                 )  import           Test.Hspec    ( describe                                , hspec@@ -38,7 +18,7 @@  {- HLINT ignore "Redundant do" -} main :: IO ()-main = ipa >> xsampa+main = ipa >> xsampa >> parser >> parserXSampa  ipa :: IO () ipa = hspec $ do@@ -51,21 +31,21 @@                         , PulmonicConsonant Voiced Velar Flap                         , PulmonicConsonant Voiced Pharyngeal Plosive                         , PulmonicConsonant Voiceless Glottal Trill-                        , Vowel NearClose Central Unrounded-                        , Vowel NearOpen Back Rounded+                        , PureVowel NearClose Central Unrounded+                        , PureVowel NearOpen Back Rounded                         ]             traverse_ (`shouldSatisfy` isNothing) phones      describe "Segmental features" $ do         it "Correctly makes 'Short' a noop" $ do-            let vcfu   = Vowel Close Front Unrounded+            let vcfu   = PureVowel Close Front Unrounded                 i      = toIPA' vcfu                 iShort = toIPA' $ WithSegmentalFeature (Length Short) vcfu              i `shouldBe` iShort          it "Chains articulatory features" $ do-            let vowel       = Vowel Close Back Unrounded+            let vowel       = PureVowel Close Back Unrounded                 IPA chained = toIPA'                     $ WithSegmentalFeature (Length OverLong)                                            (WithSegmentalFeature Compressed@@ -75,7 +55,7 @@     describe "Suprasegmentals" $ do         it "Preserves individual segments and order" $ do             let segments     = [ ImplosiveConsonant Voiced Bilabial-                               , Vowel CloseMid Back Unrounded+                               , PureVowel CloseMid Back Unrounded                                ]                 IPA syllable = toIPA' $ Syllable segments             syllable `shouldBe` "ɓɤ"@@ -83,7 +63,7 @@     describe "Suprasegmental features" $ do         it "Chains articulatory features" $ do             let segments    = [ PulmonicConsonant Voiced Alveolar Plosive-                              , Vowel CloseMid Back Rounded+                              , PureVowel CloseMid Back Rounded                               ]                 syllable    = Syllable segments                 tone        = LexicalToneContour Rising@@ -104,21 +84,21 @@     describe "Suprasegmentals" $ do         it "Preserves individual segments and order" $ do             let segments        = [ ImplosiveConsonant Voiced Bilabial-                                  , Vowel CloseMid Back Unrounded+                                  , PureVowel CloseMid Back Unrounded                                   ]                 XSampa syllable = toXSampa' $ Syllable segments             syllable `shouldBe` "b_<7"      describe "Segmental features" $ do         it "Correctly makes 'Short' a noop" $ do-            let vcfu   = Vowel Close Front Unrounded+            let vcfu   = PureVowel Close Front Unrounded                 i      = toXSampa' vcfu                 iShort = toXSampa' $ WithSegmentalFeature (Length Short) vcfu              i `shouldBe` iShort          it "Chains articulatory features" $ do-            let vowel          = Vowel Close Back Unrounded+            let vowel          = PureVowel Close Back Unrounded                 XSampa chained = toXSampa'                     $ WithSegmentalFeature (Length OverLong)                                            (WithSegmentalFeature Lowered vowel)@@ -133,15 +113,15 @@                         , PulmonicConsonant Voiced Velar Flap                         , PulmonicConsonant Voiced Pharyngeal Plosive                         , PulmonicConsonant Voiceless Glottal Trill-                        , Vowel NearClose Central Unrounded-                        , Vowel NearOpen Back Rounded+                        , PureVowel NearClose Central Unrounded+                        , PureVowel NearOpen Back Rounded                         ]             traverse_ (`shouldSatisfy` isNothing) phones      describe "Suprasegmental features" $ do         it "Chains articulatory features" $ do             let segments       = [ PulmonicConsonant Voiced Alveolar Plosive-                                 , Vowel CloseMid Back Rounded+                                 , PureVowel CloseMid Back Rounded                                  ]                 syllable       = Syllable segments                 tone           = LexicalToneContour Rising@@ -150,3 +130,184 @@                     (Stress Primary)                     (WithSuprasegmentalFeature tone syllable)             chained `shouldBe` "do_R\""++parser :: IO ()+parser = hspec $ do+    describe "Segment parser" $ do+        it "Parses individual segments" $ do+            let char   = "β"+                parsed = parseIPA char+            parsed+                `shouldBe` Right --+                (PulmonicConsonant Voiced Bilabial (Fricative NonSibilant))++        it "Rejects multiple adjacent segments" $ do+            let char   = "ββ"+                parsed = parseIPA @Segment char+            parsed `shouldSatisfy` isLeft++        it "Parses segmental features" $ do+            let char   = "oʲ"+                parsed = parseIPA @Segment char+                j      = PulmonicConsonant Voiced Palatal Approximant+                o      = PureVowel CloseMid Back Rounded+            parsed+                `shouldBe` Right --+                (WithSegmentalFeature (SecondaryArticulation j) o)++        it "Parses multiple segmental features" $ do+            let char   = "ãͪ"+                parsed = parseIPA char+                a      = PureVowel Open Front Unrounded+            parsed+                `shouldBe` Right --+                (WithSegmentalFeature Nasalized+                                      (WithSegmentalFeature Aspirated a))++        it "Parses specific phones first" $ do+            let chars  = [ "k", "k͡x", "k͡xʼ" ]+                parsed = parseIPA <$> chars++                phones = [ PulmonicConsonant Voiceless Velar Plosive+                         , PulmonicConsonant Voiceless+                                             Velar+                                             (Affricate NonSibilant)+                         , EjectiveConsonant Velar (Affricate NonSibilant)+                         ]+            for_ (zip parsed phones) $ \(p, ph) -> p `shouldBe` Right ph++        it "Rejects invalid segments" $ do+            let chars  = [ "L", "Z", "C", "0" ]+                parsed = parseIPA @Segment <$> chars+            traverse_ (`shouldSatisfy` isLeft) parsed++    describe "Syllable parser" $ do+        it "Parses syllables" $ do+            let syllable = "ɣa"+                parsed   = parseIPA syllable+                gamma    =+                    PulmonicConsonant Voiced Velar (Fricative NonSibilant)+                a        = PureVowel Open Front Unrounded+            parsed `shouldBe` Right (Syllable [ gamma, a ])++        it "Parses suprasegmental features" $ do+            let syllable = "o˨"+                parsed   = parseIPA syllable+                o        = PureVowel CloseMid Back Rounded+                tone     = LevelLexicalTone LowTone+            parsed+                `shouldBe` Right --+                (WithSuprasegmentalFeature tone (Syllable [ o ]))++        it "Parses multiple suprasegmental features" $ do+            let syllable = "ˈő"+                parsed   = parseIPA syllable+                tone     = LevelLexicalToneDiacritic ExtraHighTone+                o        = PureVowel CloseMid Back Rounded+            parsed+                `shouldBe` Right --+                (WithSuprasegmentalFeature --+                 tone+                 (WithSuprasegmentalFeature (Stress Primary) (Syllable [ o ])))++        it "Rejects invalid syllables" $ do+            let syllable = "aL"+                parsed   = parseIPA @(Syllable []) syllable+            parsed `shouldSatisfy` isLeft++        it "Rejects multiple adjacent syllables" $ do+            let syllable = "aw.a"+                parsed   = parseIPA @(Syllable []) syllable+            parsed `shouldSatisfy` isLeft++        it "Parses multiple syllables" $ do+            let syllables = "bɤ bɤ"+                parsed    = parseSyllables syllables+                syllable  = [ PulmonicConsonant Voiced Bilabial Plosive+                            , PureVowel CloseMid Back Unrounded+                            ]+            parsed `shouldBe` Right [ Syllable syllable, Syllable syllable ]++parserXSampa :: IO ()+parserXSampa = hspec $ do+    describe "Segment parser" $ do+        it "Parses individual segments" $ do+            let char   = "B"+                parsed = parseXSampa char+            parsed+                `shouldBe` Right --+                (PulmonicConsonant Voiced Bilabial (Fricative NonSibilant))++        it "Rejects multiple adjacent segments" $ do+            let char   = "BB"+                parsed = parseIPA @Segment char+            parsed `shouldSatisfy` isLeft++        it "Parses segmental features" $ do+            let char   = "o_G"+                parsed = parseXSampa @Segment char+                o      = PureVowel CloseMid Back Rounded+            parsed `shouldBe` Right (WithSegmentalFeature Velarized o)++        it "Parses multiple segmental features" $ do+            let char   = "a~_h"+                parsed = parseXSampa char+                a      = PureVowel Open Front Unrounded+            parsed+                `shouldBe` Right --+                (WithSegmentalFeature Nasalized+                                      (WithSegmentalFeature Aspirated a))++        it "Parses specific phones first" $ do+            let chars  = [ "k", "k_x", "k_x_>" ]+                parsed = parseXSampa <$> chars++                phones = [ PulmonicConsonant Voiceless Velar Plosive+                         , PulmonicConsonant Voiceless+                                             Velar+                                             (Affricate NonSibilant)+                         , EjectiveConsonant Velar (Affricate NonSibilant)+                         ]+            for_ (zip parsed phones) $ \(p, ph) -> p `shouldBe` Right ph++    describe "Syllable parser" $ do+        it "Parses syllables" $ do+            let syllable = "Ga"+                parsed   = parseXSampa syllable+                gamma    =+                    PulmonicConsonant Voiced Velar (Fricative NonSibilant)+                a        = PureVowel Open Front Unrounded+            parsed `shouldBe` Right (Syllable [ gamma, a ])++        it "Parses suprasegmental features" $ do+            let syllable = "o_L"+                parsed   = parseXSampa syllable+                o        = PureVowel CloseMid Back Rounded+                tone     = LevelLexicalTone LowTone+            parsed+                `shouldBe` Right --+                (WithSuprasegmentalFeature tone (Syllable [ o ]))++        it "Parses multiple suprasegmental features" $ do+            let syllable = "'o_T"+                parsed   = parseXSampa syllable+                tone     = LevelLexicalTone ExtraHighTone+                o        = PureVowel CloseMid Back Rounded+            parsed+                `shouldBe` Right --+                (WithSuprasegmentalFeature --+                 tone+                 (WithSuprasegmentalFeature (Stress Primary) (Syllable [ o ])))++        it "Rejects multiple adjacent syllables" $ do+            let syllable = "aw.a"+                parsed   = parseXSampa @(Syllable []) syllable+            parsed `shouldSatisfy` isLeft++        it "Parses multiple syllables" $ do+            let syllables = "b7 b7"+                parsed    = parseSyllablesXSampa syllables+                syllable  = [ PulmonicConsonant Voiced Bilabial Plosive+                            , PureVowel CloseMid Back Unrounded+                            ]+            parsed `shouldBe` Right [ Syllable syllable, Syllable syllable ]