ipa-0.3: src/Language/IPA/Class.hs
{-# 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