ipa 0.1.0.1 → 0.2

raw patch · 6 files changed

+630/−89 lines, 6 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.org +7/−1
• README.org +5/−3
• ipa.cabal +1/−1
• src/Language/IPA.hs +508/−59
• src/Language/IPA/Types.hs +35/−13
• test/Main.hs +74/−12

@@ -1,2 +1,8 @@-* 0.1.0.0+* 0.1 + Initial release+* 0.2++ Major 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~++ Bugfixes:+  - There were some issues with voiced/voiceless pairs in v0.1, where the wrong variant had the voiceless diacritic

@@ -38,7 +38,7 @@   where     syllable1 =         WithSuprasegmentalFeature Linking-                                  (Syllable [ WithSegmentalFeature --+                                  (Syllable [ WithSegmentalFeature                                                (Length Long)                                               (Vowel Close Back Rounded)                                             ])@@ -56,5 +56,7 @@ ** TODO TODO - [ ] Export constant values for common segments - [ ] Convenience functions for wrapping IPA values in different trasncription delimiters (phonemic, phonetic, etc...)-- [ ] Support for XSampa transcription and IPA-XSampa conversion-- [ ] Parsing and validation of user-supplied IPA literals+- [X] Support for X-SAMPA transcription+- [ ] Support for IPA <-> X-SAMPA conversion+- [ ] Parsing and validation of user-supplied IPA and XSampa literals+- [ ] Quasi quoter for making segment construction somewhat less painful

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               ipa-version:            0.1.0.1+version:            0.2 synopsis:           Internal Phonetic Alphabet (IPA) description:   Types and tools for working with the International Phonetic Alphabet (IPA)

@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}  -- |@@ -17,11 +18,38 @@     , 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@@ -34,34 +62,54 @@     -- the sound in question is representable     toIPA' :: a -> IPA     toIPA' (toIPA -> Just x) = x-    toIPA' _                 = error "Illegal/unrepresentable value"+    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 without any suprasegmental information         Syllable ss             | null ss -> Nothing             | otherwise -> foldr1 (<>) <$> traverse toIPA ss         WithSuprasegmentalFeature feature s ->-            withSuprasegmentalFeature s feature+            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 -> consonant c-        v@Vowel {} -> vowel v-        WithSegmentalFeature feature s -> withSegmentalFeature s feature+        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 -withSuprasegmentalFeature+withSuprasegmentalFeatureIPA     :: Traversable t => Syllable t -> SuprasegmentalFeature -> Maybe IPA-withSuprasegmentalFeature s = \case-    -- Level tones, non-diacritic+withSuprasegmentalFeatureIPA s = \case     LevelLexicalTone tone -> mkIPAOp ipaTone s tone       where         ipaTone = \case@@ -74,8 +122,6 @@             -- diacritics, not tone characters             _             -> Nothing -    -- Level tones, diacritic. The text value inside the 'IPA' is a-    -- combining character     LevelLexicalToneDiacritic tone -> mkIPAOp ipaTone s tone       where         ipaTone = \case@@ -87,7 +133,6 @@             DownStep      -> mkJustIPA "ꜜ"             UpStep        -> mkJustIPA "ꜛ" -    -- Tone contours, non-diacritic     LexicalToneContour tone -> mkIPAOp ipaToneContour s tone       where         ipaToneContour = \case@@ -102,7 +147,6 @@             GlobalRise    -> mkJustIPA "↗"             GlobalFall    -> mkJustIPA "↙" -    -- Tone contours, diacritic     LexicalToneContourDiacritic tone -> mkIPAOp ipaToneContour s tone       where         ipaToneContour = \case@@ -118,20 +162,17 @@             -- diacritic representations             _             -> Nothing -    -- Syllable stress     Stress stress -> mkIPAOp ipaStress s stress       where         ipaStress Primary   = mkJustIPA "ˈ"         ipaStress Secondary = mkJustIPA "ˌ" -    -- Explicit syllable break     Break -> (<>) <$> toIPA s <*> mkJustIPA "." -    -- Syllable non-break     Linking -> (<>) <$> toIPA s <*> mkJustIPA "‿" -withSegmentalFeature :: Segment -> SegmentalFeature -> Maybe IPA-withSegmentalFeature s = \case+withSegmentalFeatureIPA :: Segment -> SegmentalFeature -> Maybe IPA+withSegmentalFeatureIPA s = \case     Voicing v -> mkIPAOp ipaVoicing s v       where         ipaVoicing = \case@@ -145,7 +186,7 @@             Long       -> mkJustIPA "ː"             Short      -> mkJustIPA mempty             ExtraShort -> mkJustIPA "\x0306" -- ◌ ̆-    SecondaryArticulation sa -> mkIPAOp secondaryArticulation s sa+    SecondaryArticulation sa -> mkIPAOp secondaryArticulationIPA s sa     SuperScriptNumeric ns -> (<>) <$> toIPA s <*> mkJustIPA digits       where         digits = T.concat $ T.pack <$> (code . digitToInt <$> show ns)@@ -195,11 +236,13 @@         NoAudibleRelease    -> mkJustIPA "\x031a" -- ◌̚         _                   -> mkJustIPA "" -- -consonant :: Consonant -> Maybe IPA-consonant = \case+consonantIPA :: Consonant -> Maybe IPA+consonantIPA = \case     -- Pulmonic consonants     -- Bilabials-    Pulmonic Voiceless Bilabial Nasal -> mkJustIPA "m̥"+    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"@@ -224,14 +267,30 @@     Pulmonic Voiced LabioDental Flap -> mkJustIPA "ⱱ"      -- Linguo-labials-    Pulmonic Voiced LinguoLabial Nasal -> mkJustIPA "n̼"-    Pulmonic Voiceless LinguoLabial Plosive -> mkJustIPA "t̼"-    Pulmonic Voiced LinguoLabial Plosive -> mkJustIPA "d̼"-    Pulmonic Voiceless LinguoLabial (Fricative NonSibilant) ->-        mkJustIPA "θ̼ "-    Pulmonic Voiced LinguoLabial (Fricative NonSibilant) -> mkJustIPA "ð̼"-    Pulmonic Voiced LinguoLabial Flap -> mkJustIPA "ɾ̼"+    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̼͡ð"@@ -239,7 +298,9 @@     Pulmonic Voiced Dental (Fricative NonSibilant) -> mkJustIPA "ð"      -- Alveolars-    Pulmonic Voiceless Alveolar Nasal -> mkJustIPA "n̥"+    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"@@ -253,14 +314,18 @@     Pulmonic Voiced Alveolar Approximant -> mkJustIPA "ɹ"     Pulmonic Voiceless Alveolar Flap -> mkJustIPA "ɾ̥"     Pulmonic Voiced Alveolar Flap -> mkJustIPA "ɾ"-    Pulmonic Voiceless Alveolar Trill -> mkJustIPA "r"-    Pulmonic Voiced Alveolar Trill -> mkJustIPA "r̥"+    Pulmonic Voiceless Alveolar 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 -> mkJustIPA "ɺ̥"+    Pulmonic Voiceless Alveolar LateralFlap -> toIPA+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Alveolar LateralFlap)     Pulmonic Voiced Alveolar LateralFlap -> mkJustIPA "ɺ"      -- Post-alveolars@@ -277,7 +342,9 @@     Pulmonic Voiced PostAlveolar (Fricative NonSibilant) -> mkJustIPA "ɹ̠˔"      -- Retroflexes-    Pulmonic Voiceless Retroflex Nasal -> mkJustIPA "ɳ̊"+    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 "ɖ"@@ -287,7 +354,9 @@     Pulmonic Voiced Retroflex (Fricative Sibilant) -> mkJustIPA "ʐ"     Pulmonic Voiced Retroflex (Fricative NonSibilant) -> mkJustIPA "ɻ˔"     Pulmonic Voiced Retroflex Approximant -> mkJustIPA "ɻ"-    Pulmonic Voiceless Retroflex Flap -> 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"@@ -300,7 +369,9 @@     Pulmonic Voiced Retroflex LateralFlap -> mkJustIPA "ɭ̆"      -- Palatals-    Pulmonic Voiceless Palatal Nasal -> mkJustIPA "ɲ̊"+    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 "ɟ"@@ -321,7 +392,9 @@     Pulmonic Voiced Palatal LateralFlap -> mkJustIPA "ʎ̆"      -- Velars-    Pulmonic Voiceless Velar Nasal -> mkJustIPA "ŋ̊"+    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"@@ -346,8 +419,10 @@     Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustIPA "χ"     Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustIPA "ʁ"     Pulmonic Voiced Uvular Flap -> mkJustIPA "ɢ̆"-    Pulmonic Voiceless Uvular Trill -> mkJustIPA "ʀ"-    Pulmonic Voiced Uvular Trill -> mkJustIPA "ʀ̥"+    Pulmonic Voiceless Uvular Trill -> toIPA+        $ WithSegmentalFeature (Voicing Voiceless)+                               (PulmonicConsonant Voiced Uvular Trill)+    Pulmonic Voiced Uvular Trill -> mkJustIPA "ʀ"     Pulmonic Voiced Uvular LateralApproximant -> mkJustIPA "ʟ̠"      -- Pharyngeals@@ -414,22 +489,37 @@     Ejective Uvular (Fricative NonSibilant) -> mkJustIPA "χʼ"      -- Pharyngeals-    Ejective Pharyngeal Plosive -> mkJustIPA "ʡʼ "+    Ejective Pharyngeal Plosive -> mkJustIPA "ʡʼ"      -- Implosives-    Implosive Voiceless Bilabial -> mkJustIPA "ƥ"+    Implosive Voiceless Bilabial -> toIPA+        $ WithSegmentalFeature (Voicing Voiceless)+                               (ImplosiveConsonant Voiced Alveolar)     Implosive Voiced Bilabial -> mkJustIPA "ɓ"-    Implosive Voiceless Dental -> mkJustIPA "ƭ̪"-    Implosive Voiced Dental -> mkJustIPA "ɗ̪"-    Implosive Voiceless Alveolar -> mkJustIPA "ɗ"-    Implosive Voiced Alveolar -> mkJustIPA "ƭ"-    Implosive Voiceless Retroflex -> mkJustIPA "ᶑ"-    Implosive Voiced Retroflex -> mkJustIPA "ƭ̢"-    Implosive Voiceless Palatal -> mkJustIPA "ƈ"+    Implosive 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 -> mkJustIPA "ƙ"+    Implosive Voiceless Velar -> toIPA+        $ WithSegmentalFeature (Voicing Voiceless)+                               (ImplosiveConsonant Voiced Velar)     Implosive Voiced Velar -> mkJustIPA "ɠ"-    Implosive Voiceless Uvular -> mkJustIPA "ʠ"+    Implosive Voiceless Uvular -> toIPA+        $ WithSegmentalFeature (Voicing Voiceless)+                               (ImplosiveConsonant Voiced Uvular)     Implosive Voiced Uvular -> mkJustIPA "ʛ"      -- Clicks@@ -464,8 +554,8 @@      _ -> Nothing -vowel :: Segment -> Maybe IPA-vowel = \case+vowelIPA :: Segment -> Maybe IPA+vowelIPA = \case     Vowel Close Front Unrounded -> mkJustIPA "i"     Vowel Close Front Rounded -> mkJustIPA "y"     Vowel Close Central Unrounded -> mkJustIPA "ɨ"@@ -481,12 +571,15 @@     Vowel CloseMid Central Rounded -> mkJustIPA "ɵ"     Vowel CloseMid Back Unrounded -> mkJustIPA "ɤ"     Vowel CloseMid Back Rounded -> mkJustIPA "o"-    Vowel Mid Front Unrounded -> mkJustIPA "e̞"-    Vowel Mid Front Rounded -> mkJustIPA "ø̞"+    Vowel Mid 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 Central Rounded -> mkJustIPA "ə"-    Vowel Mid Back Unrounded -> mkJustIPA "ɤ̞"-    Vowel Mid Back Rounded -> mkJustIPA "o̞"+    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 "ɜ"@@ -502,8 +595,8 @@     Vowel Open Back Rounded -> mkJustIPA "ɒ"     _ -> Nothing -secondaryArticulation :: Segment -> Maybe IPA-secondaryArticulation = \case+secondaryArticulationIPA :: Segment -> Maybe IPA+secondaryArticulationIPA = \case     Consonant c -> case c of         Pulmonic Voiced Bilabial Nasal -> mkJustIPA "\x1d50"         Pulmonic Voiced LabioDental Nasal -> mkJustIPA "\x1dac"@@ -586,3 +679,359 @@      _ -> 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 "-\\"

@@ -49,8 +49,12 @@       -- ** Segmental articulatory features     , Length(..)     , SegmentalFeature(..)+      -- * Errors+    , IPAException(..)     ) where +import           Control.Exception   ( Exception )+ import           Data.Text           ( Text ) import           Data.Text.Normalize ( NormalizationMode(NFC), normalize ) @@ -60,16 +64,26 @@ -- zero or more articulatory features; encoded in IPA transcription. Note this -- has a 'Semigroup' instance, so various 'IPA's can conveniently be concatenated -- with @<>@-newtype IPA = IPA { unIPA :: Text }+newtype IPA = IPA+    { unIPA :: Text+      -- ^ The 'Text' value should be 'normalize'd to 'NFC'+    }     deriving ( Show, Eq, Generic, Semigroup ) --- | Normalizes text value to NFC before wrapping it in 'IPA'. This is to ensure--- the comparability of 'IPA' values+-- | 'normalize's 'Text' value to 'NFC' before wrapping it in 'IPA'. This is to+-- ensure the comparability of 'IPA' values mkIPA :: Text -> IPA mkIPA = IPA . normalize NFC -newtype XSampa = XSampa Text-    deriving ( Show, Eq, Generic )+-- | 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',+-- 'XSampa' is an instance of 'Semigroup'+newtype XSampa = XSampa+    { unXSampa :: Text+      -- ^ The wrapped 'Text' should only contained 7-bit ASCII characters+    }+    deriving ( Show, Eq, Generic, Semigroup )  -- | A single segment, or combination of a segment and articulatory feature data Segment@@ -82,7 +96,8 @@ -- | Multiple segments, or combination of multiple segments with -- suprasegmental feature data Syllable t-    = Syllable (t Segment) -- ^ A grouping of segments+    = Syllable (t Segment)+      -- ^ A grouping of segments without extra suprasegmental information     | WithSuprasegmentalFeature SuprasegmentalFeature (Syllable t)       -- ^ Articulatory features that affect/encompass the entire syllable     deriving ( Generic )@@ -250,14 +265,21 @@     deriving ( Show, Eq, Generic, Ord )  data SuprasegmentalFeature-    = LevelLexicalTone LevelTone -- ^ Level lexical tone+    = LevelLexicalTone LevelTone+      -- ^ Level lexical tones in Chao letters     | LevelLexicalToneDiacritic LevelTone-      -- ^ Level lexical tone, diactritic notation-    | LexicalToneContour ToneContour-- ^ Lexical tone as a contour+      -- ^ Level lexical tones, diacritic. The tone is a combining character+    | LexicalToneContour ToneContour+      -- ^ Lexical tone contours in Chao letters     | LexicalToneContourDiacritic ToneContour-      -- ^ Lexical tone as a contour, diacritic notation-    | Stress Stress-    | Break-    | Linking+      -- ^ Lexical tone contours, as diacritics. Each contour is a combining+      -- character+    | Stress Stress -- ^ Syllable stress+    | Break -- ^ Explicit syllable break+    | Linking -- ^ Absence of a break     deriving ( Show, Eq, Generic ) +data IPAException = InvalidIPA Text | InvalidXSampa Text+    deriving ( Show, Eq, Generic )++instance Exception IPAException

@@ -3,11 +3,10 @@ -- | module Main where -import           Data.Foldable      ( traverse_ )-import           Data.Maybe         ( isNothing )+import           Data.Foldable ( traverse_ )+import           Data.Maybe    ( isNothing ) -import           Language.IPA       ( ReprIPA(toIPA', toIPA) )-import           Language.IPA.Types+import           Language.IPA                  ( Backness(..)                  , Height(..)                  , IPA(IPA)@@ -15,6 +14,7 @@                  , Manner(..)                  , Phonation(..)                  , Place(..)+                 , ReprIPA(toIPA', toIPA, toXSampa', toXSampa)                  , Roundedness(..)                  , Segment(..)                  , SegmentalFeature(..)@@ -23,21 +23,25 @@                  , SuprasegmentalFeature(..)                  , Syllable(..)                  , ToneContour(..)+                 , XSampa(XSampa)+                 , mkIPA                  , pattern ImplosiveConsonant                  , pattern PulmonicConsonant                  ) -import           Test.Hspec-                 ( describe-                 , hspec-                 , it-                 , shouldBe-                 , shouldSatisfy-                 )+import           Test.Hspec    ( describe+                               , hspec+                               , it+                               , shouldBe+                               , shouldSatisfy+                               )  {- HLINT ignore "Redundant do" -} main :: IO ()-main = hspec $ do+main = ipa >> xsampa++ipa :: IO ()+ipa = hspec $ do     describe "Segments" $ do         it "Rejects nonsense segments" $ do             let phones = toIPA@@ -88,3 +92,61 @@                     (Stress Primary)                     (WithSuprasegmentalFeature tone syllable)             chained `shouldBe` "do˩˥ˈ"++    describe "IPA normalization" $ do+        it "Normalizes IPA values to NFC" $ do+            let oRisingNFD     = "o\x0301" -- decomposed form+                IPA oRisingIPA = mkIPA oRisingNFD+            oRisingIPA `shouldBe` "\x00f3"++xsampa :: IO ()+xsampa = hspec $ do+    describe "Suprasegmentals" $ do+        it "Preserves individual segments and order" $ do+            let segments        = [ ImplosiveConsonant Voiced Bilabial+                                  , Vowel 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+                i      = toXSampa' vcfu+                iShort = toXSampa' $ WithSegmentalFeature (Length Short) vcfu++            i `shouldBe` iShort++        it "Chains articulatory features" $ do+            let vowel          = Vowel Close Back Unrounded+                XSampa chained = toXSampa'+                    $ WithSegmentalFeature (Length OverLong)+                                           (WithSegmentalFeature Lowered vowel)+            chained `shouldBe` "M_o::"++    describe "Segments" $ do+        it "Rejects nonsense segments" $ do+            let phones = toXSampa+                    <$> [ PulmonicConsonant Voiceless+                                            Uvular+                                            (Fricative Sibilant)+                        , PulmonicConsonant Voiced Velar Flap+                        , PulmonicConsonant Voiced Pharyngeal Plosive+                        , PulmonicConsonant Voiceless Glottal Trill+                        , Vowel NearClose Central Unrounded+                        , Vowel 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+                                 ]+                syllable       = Syllable segments+                tone           = LexicalToneContour Rising+                XSampa chained = toXSampa'+                    $ WithSuprasegmentalFeature --+                    (Stress Primary)+                    (WithSuprasegmentalFeature tone syllable)+            chained `shouldBe` "do_R\""