{-# 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 :: Syllable t -> Maybe IPA
toIPA = \case
        Syllable t Segment
ss
            | t Segment -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Segment
ss -> Maybe IPA
forall a. Maybe a
Nothing
            | Bool
otherwise -> (IPA -> IPA -> IPA) -> t IPA -> IPA
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (t IPA -> IPA) -> Maybe (t IPA) -> Maybe IPA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Segment -> Maybe IPA) -> t Segment -> Maybe (t IPA)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA t Segment
ss
        WithSuprasegmentalFeature SuprasegmentalFeature
feature Syllable t
s ->
            Syllable t -> SuprasegmentalFeature -> Maybe IPA
forall (t :: * -> *).
MultiSegment t =>
Syllable t -> SuprasegmentalFeature -> Maybe IPA
withSuprasegmentalFeature Syllable t
s SuprasegmentalFeature
feature

    parseIPA :: Text -> Either IPAException (Syllable t)
parseIPA = Text -> Either IPAException (Syllable t)
forall (t :: * -> *).
MultiSegment t =>
Text -> Either IPAException (Syllable t)
parseSyllable

instance MultiSegment t => ReprXSampa (Syllable t) where
    toXSampa :: Syllable t -> Maybe XSampa
toXSampa = \case
        Syllable t Segment
ss
            | t Segment -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Segment
ss -> Maybe XSampa
forall a. Maybe a
Nothing
            | Bool
otherwise -> (XSampa -> XSampa -> XSampa) -> t XSampa -> XSampa
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
(<>) (t XSampa -> XSampa) -> Maybe (t XSampa) -> Maybe XSampa
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Segment -> Maybe XSampa) -> t Segment -> Maybe (t XSampa)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa t Segment
ss
        WithSuprasegmentalFeature SuprasegmentalFeature
feature Syllable t
s ->
            Syllable t -> SuprasegmentalFeature -> Maybe XSampa
forall (t :: * -> *).
MultiSegment t =>
Syllable t -> SuprasegmentalFeature -> Maybe XSampa
withSuprasegmentalFeatureXSampa Syllable t
s SuprasegmentalFeature
feature

    parseXSampa :: Text -> Either IPAException (Syllable t)
parseXSampa = Text -> Either IPAException (Syllable t)
forall (t :: * -> *).
MultiSegment t =>
Text -> Either IPAException (Syllable t)
parseSyllableXSampa

instance ReprIPA Segment where
    toIPA :: Segment -> Maybe IPA
toIPA = \case
        Segment
Zero -> Text -> Maybe IPA
mkJustIPA Text
"∅"
        Consonant Consonant
c -> Consonant -> Maybe IPA
consonant Consonant
c
        Vowel Vowel
v -> Vowel -> Maybe IPA
vowel Vowel
v
        WithSegmentalFeature SegmentalFeature
feature Segment
s -> Segment -> SegmentalFeature -> Maybe IPA
withSegmentalFeature Segment
s SegmentalFeature
feature
        Optional Segment
s -> do
            IPA { Text
unIPA :: IPA -> Text
unIPA :: Text
.. } <- Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA Segment
s
            IPA -> Maybe IPA
forall (m :: * -> *) a. Monad m => a -> m a
return (IPA -> Maybe IPA) -> (Text -> IPA) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IPA
mkIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unIPA Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

    parseIPA :: Text -> Either IPAException Segment
parseIPA = Text -> Either IPAException Segment
parseSegment

instance ReprXSampa Segment where
    toXSampa :: Segment -> Maybe XSampa
toXSampa = \case
        Segment
Zero -> Maybe XSampa
forall a. Maybe a
Nothing -- does not appear to have an X-SAMPA encoding
        Vowel Vowel
v -> Vowel -> Maybe XSampa
vowelXSampa Vowel
v
        Consonant Consonant
c -> Consonant -> Maybe XSampa
consonantXSampa Consonant
c
        WithSegmentalFeature SegmentalFeature
feature Segment
s -> Segment -> SegmentalFeature -> Maybe XSampa
withSegmentalFeatureXSampa Segment
s SegmentalFeature
feature
        Optional Segment
s -> do
            XSampa { Text
unXSampa :: XSampa -> Text
unXSampa :: Text
.. } <- Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa Segment
s
            XSampa -> Maybe XSampa
forall (m :: * -> *) a. Monad m => a -> m a
return (XSampa -> Maybe XSampa)
-> (Text -> XSampa) -> Text -> Maybe XSampa
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> XSampa
XSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unXSampa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

    parseXSampa :: Text -> Either IPAException Segment
parseXSampa = Text -> Either IPAException Segment
parseSegmentXSampa

mkJustIPA :: Text -> Maybe IPA
mkJustIPA :: Text -> Maybe IPA
mkJustIPA = IPA -> Maybe IPA
forall a. a -> Maybe a
Just (IPA -> Maybe IPA) -> (Text -> IPA) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IPA
mkIPA

mkIPAOp :: ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp :: (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp b -> Maybe IPA
f a
x b
y = IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (IPA -> IPA -> IPA) -> Maybe IPA -> Maybe (IPA -> IPA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA a
x Maybe (IPA -> IPA) -> Maybe IPA -> Maybe IPA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe IPA
f b
y

withSuprasegmentalFeature
    :: MultiSegment t => Syllable t -> SuprasegmentalFeature -> Maybe IPA
withSuprasegmentalFeature :: Syllable t -> SuprasegmentalFeature -> Maybe IPA
withSuprasegmentalFeature Syllable t
s = \case
    LevelLexicalTone LevelTone
tone -> (LevelTone -> Maybe IPA) -> Syllable t -> LevelTone -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp LevelTone -> Maybe IPA
ipaTone Syllable t
s LevelTone
tone
      where
        ipaTone :: LevelTone -> Maybe IPA
ipaTone = \case
            LevelTone
ExtraHighTone -> Text -> Maybe IPA
mkJustIPA Text
"˥"
            LevelTone
HighTone      -> Text -> Maybe IPA
mkJustIPA Text
"˦"
            LevelTone
MidTone       -> Text -> Maybe IPA
mkJustIPA Text
"˧"
            LevelTone
LowTone       -> Text -> Maybe IPA
mkJustIPA Text
"˨"
            LevelTone
ExtraLowTone  -> Text -> Maybe IPA
mkJustIPA Text
"˩"
            -- Down-step and up-step are not represented with tone characters
            LevelTone
_             -> Maybe IPA
forall a. Maybe a
Nothing

    LevelLexicalToneDiacritic LevelTone
tone -> (LevelTone -> Maybe IPA) -> Syllable t -> LevelTone -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp LevelTone -> Maybe IPA
ipaTone Syllable t
s LevelTone
tone
      where
        ipaTone :: LevelTone -> Maybe IPA
ipaTone = \case
            LevelTone
ExtraHighTone -> Text -> Maybe IPA
mkJustIPA Text
"\x030b" -- ◌̋
            LevelTone
HighTone      -> Text -> Maybe IPA
mkJustIPA Text
"\x0341" -- ◌́
            LevelTone
MidTone       -> Text -> Maybe IPA
mkJustIPA Text
"\x0304" -- ◌̄
            LevelTone
LowTone       -> Text -> Maybe IPA
mkJustIPA Text
"\x0340" -- ◌̀
            LevelTone
ExtraLowTone  -> Text -> Maybe IPA
mkJustIPA Text
"\x030f" -- ◌̏
            LevelTone
DownStep      -> Text -> Maybe IPA
mkJustIPA Text
"ꜜ"
            LevelTone
UpStep        -> Text -> Maybe IPA
mkJustIPA Text
"ꜛ"

    LexicalToneContour ToneContour
tone -> (ToneContour -> Maybe IPA)
-> Syllable t -> ToneContour -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp ToneContour -> Maybe IPA
ipaToneContour Syllable t
s ToneContour
tone
      where
        ipaToneContour :: ToneContour -> Maybe IPA
ipaToneContour = \case
            ToneContour
Rising        -> Text -> Maybe IPA
mkJustIPA Text
"˩˥"
            ToneContour
Falling       -> Text -> Maybe IPA
mkJustIPA Text
"˥˩"
            ToneContour
HighRising    -> Text -> Maybe IPA
mkJustIPA Text
"˧˥"
            ToneContour
LowRising     -> Text -> Maybe IPA
mkJustIPA Text
"˩˧"
            ToneContour
HighFalling   -> Text -> Maybe IPA
mkJustIPA Text
"˥˧"
            ToneContour
LowFalling    -> Text -> Maybe IPA
mkJustIPA Text
"˧˩"
            ToneContour
RisingFalling -> Text -> Maybe IPA
mkJustIPA Text
"˧˦˨"
            ToneContour
FallingRising -> Text -> Maybe IPA
mkJustIPA Text
"˧˨˦"
            ToneContour
GlobalRise    -> Text -> Maybe IPA
mkJustIPA Text
"↗"
            ToneContour
GlobalFall    -> Text -> Maybe IPA
mkJustIPA Text
"↙"

    LexicalToneContourDiacritic ToneContour
tone -> (ToneContour -> Maybe IPA)
-> Syllable t -> ToneContour -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp ToneContour -> Maybe IPA
ipaToneContour Syllable t
s ToneContour
tone
      where
        ipaToneContour :: ToneContour -> Maybe IPA
ipaToneContour = \case
            ToneContour
Rising        -> Text -> Maybe IPA
mkJustIPA Text
"\x0302" -- ◌̂
            ToneContour
Falling       -> Text -> Maybe IPA
mkJustIPA Text
"\x030c" -- ◌̌
            ToneContour
HighRising    -> Text -> Maybe IPA
mkJustIPA Text
"\x1dc9" -- ◌᷉
            ToneContour
LowRising     -> Text -> Maybe IPA
mkJustIPA Text
"\x1dc5" -- ◌᷅
            ToneContour
HighFalling   -> Text -> Maybe IPA
mkJustIPA Text
"\x1dc7" -- ◌᷇
            ToneContour
LowFalling    -> Text -> Maybe IPA
mkJustIPA Text
"\x1dc6" -- ◌᷆
            ToneContour
RisingFalling -> Text -> Maybe IPA
mkJustIPA Text
"\x1dc8" -- ◌᷈
            ToneContour
FallingRising -> Text -> Maybe IPA
mkJustIPA Text
"\x1dc9" -- ◌᷉
            -- 'GlobalRise' and 'GlobalFall' don't have
            -- diacritic representations
            ToneContour
_             -> Maybe IPA
forall a. Maybe a
Nothing

    ToneNumber Int
ns -> IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (IPA -> IPA -> IPA) -> Maybe IPA -> Maybe (IPA -> IPA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Syllable t -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA Syllable t
s Maybe (IPA -> IPA) -> Maybe IPA -> Maybe IPA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe IPA
mkJustIPA Text
digits
      where
        digits :: Text
digits = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> String
code (Int -> String) -> (Char -> Int) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String
forall a. Show a => a -> String
show Int
ns)

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

    Stress Stress
stress -> (Stress -> Maybe IPA) -> Syllable t -> Stress -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp Stress -> Maybe IPA
ipaStress Syllable t
s Stress
stress
      where
        ipaStress :: Stress -> Maybe IPA
ipaStress Stress
Primary   = Text -> Maybe IPA
mkJustIPA Text
"ˈ"
        ipaStress Stress
Secondary = Text -> Maybe IPA
mkJustIPA Text
"ˌ"

    SuprasegmentalFeature
Break -> IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (IPA -> IPA -> IPA) -> Maybe IPA -> Maybe (IPA -> IPA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Syllable t -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA Syllable t
s Maybe (IPA -> IPA) -> Maybe IPA -> Maybe IPA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe IPA
mkJustIPA Text
"."

    SuprasegmentalFeature
Linking -> IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (IPA -> IPA -> IPA) -> Maybe IPA -> Maybe (IPA -> IPA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Syllable t -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA Syllable t
s Maybe (IPA -> IPA) -> Maybe IPA -> Maybe IPA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe IPA
mkJustIPA Text
"‿"

withSegmentalFeature :: Segment -> SegmentalFeature -> Maybe IPA
withSegmentalFeature :: Segment -> SegmentalFeature -> Maybe IPA
withSegmentalFeature Segment
s = \case
    Voicing Phonation
v -> (Phonation -> Maybe IPA) -> Segment -> Phonation -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp Phonation -> Maybe IPA
ipaVoicing Segment
s Phonation
v
      where
        ipaVoicing :: Phonation -> Maybe IPA
ipaVoicing = \case
            Phonation
Voiceless -> Text -> Maybe IPA
mkJustIPA Text
"\x030a" -- ◌̊
            Phonation
Voiced    -> Text -> Maybe IPA
mkJustIPA Text
"\x030c" -- ◌̌
    Length Length
l -> (Length -> Maybe IPA) -> Segment -> Length -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp Length -> Maybe IPA
ipaLength Segment
s Length
l
      where
        ipaLength :: Length -> Maybe IPA
ipaLength = \case
            Length
OverLong   -> Text -> Maybe IPA
mkJustIPA Text
"ːː"
            Length
HalfLong   -> Text -> Maybe IPA
mkJustIPA Text
"ˑ"
            Length
Long       -> Text -> Maybe IPA
mkJustIPA Text
"ː"
            Length
Short      -> Text -> Maybe IPA
mkJustIPA Text
forall a. Monoid a => a
mempty
            Length
ExtraShort -> Text -> Maybe IPA
mkJustIPA Text
"\x0306" -- ◌ ̆
    SecondaryArticulation Segment
sa -> (Segment -> Maybe IPA) -> Segment -> Segment -> Maybe IPA
forall a b. ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA
mkIPAOp Segment -> Maybe IPA
secondaryArticulation Segment
s Segment
sa
    SegmentalFeature
feature -> IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (IPA -> IPA -> IPA) -> Maybe IPA -> Maybe (IPA -> IPA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA Segment
s Maybe (IPA -> IPA) -> Maybe IPA -> Maybe IPA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case SegmentalFeature
feature of
        SegmentalFeature
Aspirated           -> Text -> Maybe IPA
mkJustIPA Text
"\x02b0" -- ◌ʰ
        SegmentalFeature
MoreRounded         -> Text -> Maybe IPA
mkJustIPA Text
"\x0339" -- ◌̹
        SegmentalFeature
LessRounded         -> Text -> Maybe IPA
mkJustIPA Text
"\x031c" -- ◌̜
        SegmentalFeature
Advanced            -> Text -> Maybe IPA
mkJustIPA Text
"\x031f" -- ◌̟
        SegmentalFeature
Retracted           -> Text -> Maybe IPA
mkJustIPA Text
"\x0320" -- ◌̠
        SegmentalFeature
Centralized         -> Text -> Maybe IPA
mkJustIPA Text
"\x0308" -- ◌̈
        SegmentalFeature
MidCentralized      -> Text -> Maybe IPA
mkJustIPA Text
"\x033d" -- ◌̽
        SegmentalFeature
Compressed          -> Text -> Maybe IPA
mkJustIPA Text
"\x1d5d" -- ◌ᵝ
        SegmentalFeature
Syllabic            -> Text -> Maybe IPA
mkJustIPA Text
"\x0329" -- ◌̩
        SegmentalFeature
NonSyllabic         -> Text -> Maybe IPA
mkJustIPA Text
"\x032f" -- ◌̯
        SegmentalFeature
Rhotacized          -> Text -> Maybe IPA
mkJustIPA Text
"\x02de" -- ◌˞
        SegmentalFeature
BreathyVoice        -> Text -> Maybe IPA
mkJustIPA Text
"\x0324" -- ◌̤
        SegmentalFeature
CreakyVoice         -> Text -> Maybe IPA
mkJustIPA Text
"\x0330" -- ◌̰
        SegmentalFeature
LinguoLabialized    -> Text -> Maybe IPA
mkJustIPA Text
"\x033c" -- ◌̼
        SegmentalFeature
Labialized          -> Text -> Maybe IPA
mkJustIPA Text
"\x02b7" -- ◌ʷ
        SegmentalFeature
Palatalized         -> Text -> Maybe IPA
mkJustIPA Text
"\x02b2" -- ◌ʲ
        SegmentalFeature
Velarized           -> Text -> Maybe IPA
mkJustIPA Text
"\x02e0" -- ◌ˠ
        SegmentalFeature
Pharyngealized      -> Text -> Maybe IPA
mkJustIPA Text
"\x02e4" -- ◌ˤ
        SegmentalFeature
Raised              -> Text -> Maybe IPA
mkJustIPA Text
"\x031d" -- ◌̝
        SegmentalFeature
Lowered             -> Text -> Maybe IPA
mkJustIPA Text
"\x031e" -- ◌̞
        SegmentalFeature
AdvancedTongueRoot  -> Text -> Maybe IPA
mkJustIPA Text
"\x0318" -- ◌̘
        SegmentalFeature
RetractedTongueRoot -> Text -> Maybe IPA
mkJustIPA Text
"\x0319" -- ◌̙
        SegmentalFeature
Dentalized          -> Text -> Maybe IPA
mkJustIPA Text
"\x032a" -- ◌̪
        SegmentalFeature
Apical              -> Text -> Maybe IPA
mkJustIPA Text
"\x033a" -- ◌̺
        SegmentalFeature
Laminal             -> Text -> Maybe IPA
mkJustIPA Text
"\x033b" -- ◌̻
        SegmentalFeature
Nasalized           -> Text -> Maybe IPA
mkJustIPA Text
"\x0303" -- ◌̃
        SegmentalFeature
NasalRelease        -> Text -> Maybe IPA
mkJustIPA Text
"\x207f" -- ◌ⁿ
        SegmentalFeature
LateralRelease      -> Text -> Maybe IPA
mkJustIPA Text
"\x02e1" -- ◌ˡ
        SegmentalFeature
NoAudibleRelease    -> Text -> Maybe IPA
mkJustIPA Text
"\x031a" -- ◌̚
        SegmentalFeature
_                   -> Text -> Maybe IPA
mkJustIPA Text
"" --

doubleArticulated :: Text -> Text -> Text
doubleArticulated :: Text -> Text -> Text
doubleArticulated Text
x Text
y = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
breve Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y
  where
    breve :: Text
breve = Text
"\x0361"

voiceless :: Bool -- Whether this character is descending or not
          -> Text
          -> Text
voiceless :: Bool -> Text -> Text
voiceless Bool
desc = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall p. IsString p => Bool -> p
getC Bool
desc)
  where
    getC :: Bool -> p
getC Bool
True  = p
"\x030a"
    getC Bool
False = p
"\x0325"

dentalized :: Text -> Text
dentalized :: Text -> Text
dentalized = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x032a")

raisedMod :: Text -> Text
raisedMod :: Text -> Text
raisedMod = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x02d4")

raised :: Text -> Text
raised :: Text -> Text
raised = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x031d")

retracted :: Text -> Text
retracted :: Text -> Text
retracted = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x0320")

flapped :: Text -> Text
flapped :: Text -> Text
flapped = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x0306")

consonant :: Consonant -> Maybe IPA
consonant :: Consonant -> Maybe IPA
consonant = \case
    e :: Consonant
e@Ejective {} -> Consonant -> Maybe IPA
ejective Consonant
e
    i :: Consonant
i@Implosive {} -> Consonant -> Maybe IPA
implosive Consonant
i
    -- Pulmonic consonants
    -- Bilabials
    Pulmonic Phonation
Voiceless Place
Bilabial Manner
Nasal -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Bilabial Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"m"
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"b"
    Pulmonic Phonation
Voiceless Place
Bilabial Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"p"
    Pulmonic Phonation
Voiceless Place
Bilabial (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"p" Text
"ɸ"
    Pulmonic Phonation
Voiced Place
Bilabial (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"b" Text
"β"
    Pulmonic Phonation
Voiceless Place
Bilabial (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ɸ"
    Pulmonic Phonation
Voiced Place
Bilabial (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"β"
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Flap -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Advanced
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
LabioDental Manner
Flap)
    Pulmonic Phonation
Voiceless Place
Bilabial Manner
Trill -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
False Text
"ʙ"
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"ʙ"

    -- Labio-dentals
    Pulmonic Phonation
Voiced Place
LabioDental Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"ɱ"
    Pulmonic Phonation
v Place
LabioDental Manner
Plosive -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Dentalized
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
v Place
Bilabial Manner
Plosive)

    Pulmonic Phonation
v Place
LabioDental (Affricate Sibilance
NonSibilant) -> do
        IPA Text
stop <- Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
v Place
LabioDental Manner
Plosive
        IPA Text
fricative <- Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
            (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
v Place
LabioDental (Sibilance -> Manner
Fricative Sibilance
NonSibilant)
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
stop Text
fricative
    Pulmonic Phonation
Voiceless Place
LabioDental (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"f"
    Pulmonic Phonation
Voiced Place
LabioDental (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"v"
    Pulmonic Phonation
Voiced Place
LabioDental Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"ʋ"
    Pulmonic Phonation
Voiced Place
LabioDental Manner
Flap -> Text -> Maybe IPA
mkJustIPA Text
"ⱱ"

    -- Linguo-labials
    Pulmonic Phonation
Voiced Place
LinguoLabial Manner
manner
        | Manner
manner Manner -> [Manner] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Manner
Nasal, Manner
Plosive, Sibilance -> Manner
Fricative Sibilance
NonSibilant, Manner
Flap ] ->
            Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
            (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
LinguoLabialized
                                   (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
manner)
    Pulmonic Phonation
Voiceless Place
LinguoLabial Manner
manner
        | Manner
manner Manner -> [Manner] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Manner
Plosive, Sibilance -> Manner
Fricative Sibilance
NonSibilant ] -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
            (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
LinguoLabialized
                                   (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiceless
                                                      Place
Alveolar
                                                      Manner
manner)

    -- Dentals
    Pulmonic Phonation
Voiceless Place
Dental (Affricate Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated (Text -> Text
dentalized Text
"t") Text
"θ"
    Pulmonic Phonation
Voiced Place
Dental (Affricate Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated (Text -> Text
dentalized Text
"d") Text
"ð"
    Pulmonic Phonation
Voiceless Place
Dental (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"θ"
    Pulmonic Phonation
Voiced Place
Dental (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ð"

    -- Alveolars
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Nasal -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"n"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"t"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"d"
    Pulmonic Phonation
Voiceless Place
Alveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"s"
    Pulmonic Phonation
Voiced Place
Alveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"d" Text
"z"
    Pulmonic Phonation
Voiceless Place
Alveolar (Affricate Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" (Text -> Text
raisedMod (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
True Text
"ɹ")
    Pulmonic Phonation
Voiced Place
Alveolar (Affricate Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"d" (Text -> Text
raisedMod Text
"ɹ")
    Pulmonic Phonation
Voiceless Place
Alveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"s"
    Pulmonic Phonation
Voiced Place
Alveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"z"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"ɹ"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Flap -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
False Text
"ɾ"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Flap -> Text -> Maybe IPA
mkJustIPA Text
"ɾ"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Trill -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
Trill)
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"r"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
LateralAffricate -> Text -> Maybe IPA
mkJustIPA Text
"tɬ"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
LateralAffricate -> Text -> Maybe IPA
mkJustIPA Text
"dɮ"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
LateralFricative -> Text -> Maybe IPA
mkJustIPA Text
"ɬ"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
LateralFricative -> Text -> Maybe IPA
mkJustIPA Text
"ɮ"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
LateralApproximant -> Text -> Maybe IPA
mkJustIPA Text
"l"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
LateralFlap -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
LateralFlap)
    Pulmonic Phonation
Voiced Place
Alveolar Manner
LateralFlap -> Text -> Maybe IPA
mkJustIPA Text
"ɺ"

    -- Post-alveolars
    Pulmonic Phonation
Voiceless Place
PostAlveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"ʃ"
    Pulmonic Phonation
Voiced Place
PostAlveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"d" Text
"ʒ"
    Pulmonic Phonation
Voiceless Place
PostAlveolar (Affricate Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" (Text -> Text
raisedMod (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
retracted Text
"ɹ")
    Pulmonic Phonation
Voiced Place
PostAlveolar (Affricate Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"d" (Text -> Text
raisedMod (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
retracted Text
"ɹ")
    Pulmonic Phonation
Voiceless Place
PostAlveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʃ"
    Pulmonic Phonation
Voiced Place
PostAlveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʒ"
    Pulmonic Phonation
Voiceless Place
PostAlveolar (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> (Text -> Text) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
raisedMod (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
retracted (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ɹ"
    Pulmonic Phonation
Voiced Place
PostAlveolar (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> (Text -> Text) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
raisedMod (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
retracted Text
"ɹ"

    -- Retroflexes
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Nasal -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Retroflex Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"ɳ"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"ʈ"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"ɖ"
    Pulmonic Phonation
Voiceless Place
Retroflex (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ʈ" Text
"ʂ"
    Pulmonic Phonation
Voiced Place
Retroflex (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ɖ" Text
"ʐ"
    Pulmonic Phonation
Voiceless Place
Retroflex (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʂ"
    Pulmonic Phonation
Voiced Place
Retroflex (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʐ"
    Pulmonic Phonation
Voiced Place
Retroflex (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
raisedMod Text
"ɻ"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"ɻ"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Flap -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Retroflex Manner
Flap)
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Flap -> Text -> Maybe IPA
mkJustIPA Text
"ɽ"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Trill ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
True Text
"ɽ" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text -> Text
voiceless Bool
False Text
"r"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"ɽr"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
LateralAffricate -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ʈ" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
raisedMod (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"ɭ")
    Pulmonic Phonation
Voiced Place
Retroflex Manner
LateralAffricate ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ɖ" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
raisedMod Text
"ɭ"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
LateralFricative ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> (Text -> Text) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
raisedMod (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ɭ"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
LateralFricative -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
raisedMod Text
"ɭ"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
LateralApproximant -> Text -> Maybe IPA
mkJustIPA Text
"ɭ"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
LateralFlap ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> (Text -> Text) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
flapped Text
"ɭ"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
LateralFlap -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
flapped Text
"ɭ"

    -- Palatals
    Pulmonic Phonation
Voiceless Place
Palatal Manner
Nasal -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Palatal Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Palatal Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"ɲ"
    Pulmonic Phonation
Voiceless Place
Palatal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"c"
    Pulmonic Phonation
Voiced Place
Palatal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"ɟ"
    Pulmonic Phonation
Voiceless Place
Palatal (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"ɕ"
    Pulmonic Phonation
Voiced Place
Palatal (Affricate Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"d" Text
"ʑ"
    Pulmonic Phonation
Voiceless Place
Palatal (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"c" Text
"ç"
    Pulmonic Phonation
Voiced Place
Palatal (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ɟ" Text
"ʝ"
    Pulmonic Phonation
Voiceless Place
Palatal (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ɕ"
    Pulmonic Phonation
Voiced Place
Palatal (Fricative Sibilance
Sibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʑ"
    Pulmonic Phonation
Voiceless Place
Palatal (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ç"
    Pulmonic Phonation
Voiced Place
Palatal (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʝ"
    Pulmonic Phonation
Voiced Place
Palatal Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"j"
    Pulmonic Phonation
Voiceless Place
Palatal Manner
LateralAffricate -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"c" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Bool -> Text -> Text
voiceless Bool
True (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
raised (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"ʎ")
    Pulmonic Phonation
Voiced Place
Palatal Manner
LateralAffricate ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ɟ" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
raised Text
"ʎ"
    Pulmonic Phonation
Voiceless Place
Palatal Manner
LateralFricative ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> (Text -> Text) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
raised (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ʎ"
    Pulmonic Phonation
Voiced Place
Palatal Manner
LateralFricative -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
raised Text
"ʎ"
    Pulmonic Phonation
Voiced Place
Palatal Manner
LateralApproximant -> Text -> Maybe IPA
mkJustIPA Text
"ʎ"
    Pulmonic Phonation
Voiced Place
Palatal Manner
LateralFlap -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
flapped Text
"ʎ"

    -- Velars
    Pulmonic Phonation
Voiceless Place
Velar Manner
Nasal -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Velar Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Velar Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"ŋ"
    Pulmonic Phonation
Voiceless Place
Velar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"k"
    Pulmonic Phonation
Voiced Place
Velar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"g"
    Pulmonic Phonation
Voiceless Place
Velar (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"k" Text
"x"
    Pulmonic Phonation
Voiced Place
Velar (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"g" Text
"ɣ"
    Pulmonic Phonation
Voiceless Place
Velar (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"x"
    Pulmonic Phonation
Voiced Place
Velar (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ɣ"
    Pulmonic Phonation
Voiced Place
Velar Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"ɰ"
    Pulmonic Phonation
Voiceless Place
Velar Manner
LateralAffricate -> Text -> Maybe IPA
mkJustIPA
        (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"k" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
raised (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
True Text
"ʟ")
    Pulmonic Phonation
Voiced Place
Velar Manner
LateralAffricate -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ɡ" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
raised Text
"ʟ"
    Pulmonic Phonation
Voiceless Place
Velar Manner
LateralFricative ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> (Text -> Text) -> Text -> Maybe IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> Text
voiceless Bool
True (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
raised Text
"ʟ"
    Pulmonic Phonation
Voiced Place
Velar Manner
LateralFricative -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
raised Text
"ʟ"
    Pulmonic Phonation
Voiced Place
Velar Manner
LateralApproximant -> Text -> Maybe IPA
mkJustIPA Text
"ʟ"
    Pulmonic Phonation
Voiced Place
Velar Manner
LateralFlap -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
flapped Text
"ʟ"

    -- Uvulars
    Pulmonic Phonation
Voiced Place
Uvular Manner
Nasal -> Text -> Maybe IPA
mkJustIPA Text
"ɴ"
    Pulmonic Phonation
Voiceless Place
Uvular Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"q"
    Pulmonic Phonation
Voiced Place
Uvular Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"ɢ"
    Pulmonic Phonation
Voiceless Place
Uvular (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"q" Text
"χ"
    Pulmonic Phonation
Voiced Place
Uvular (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ɢ" Text
"ʁ"
    Pulmonic Phonation
Voiceless Place
Uvular (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"χ"
    Pulmonic Phonation
Voiced Place
Uvular (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʁ"
    Pulmonic Phonation
Voiced Place
Uvular Manner
Flap -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
flapped Text
"ɢ"
    Pulmonic Phonation
Voiceless Place
Uvular Manner
Trill -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Uvular Manner
Trill)
    Pulmonic Phonation
Voiced Place
Uvular Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"ʀ"
    Pulmonic Phonation
Voiced Place
Uvular Manner
LateralApproximant -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
retracted Text
"ʟ"

    -- Pharyngeals
    Pulmonic Phonation
Voiceless Place
Pharyngeal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"ʡ"
    Pulmonic Phonation
Voiced Place
Pharyngeal (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ʡ" Text
"ʢ"
    Pulmonic Phonation
Voiceless Place
Pharyngeal (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ħ"
    Pulmonic Phonation
Voiced Place
Pharyngeal (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ʕ"
    Pulmonic Phonation
Voiced Place
Pharyngeal Manner
Flap -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text
flapped Text
"ʡ"
    Pulmonic Phonation
Voiceless Place
Pharyngeal Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"ʜ"
    Pulmonic Phonation
Voiced Place
Pharyngeal Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"ʢ"

    -- Glottals
    Pulmonic Phonation
Voiceless Place
Glottal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"ʔ"
    Pulmonic Phonation
Voiceless Place
Glottal (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ʔ" Text
"h"
    Pulmonic Phonation
Voiceless Place
Glottal (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"h"
    Pulmonic Phonation
Voiced Place
Glottal (Fricative Sibilance
NonSibilant) -> Text -> Maybe IPA
mkJustIPA Text
"ɦ"
    Pulmonic Phonation
Voiced Place
Glottal Manner
Approximant -> Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text
"ʔ" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x031e"

    -- Clicks
    Click Place
Bilabial -> Text -> Maybe IPA
mkJustIPA Text
"ʘ"
    Click Place
Dental -> Text -> Maybe IPA
mkJustIPA Text
"ǀ"
    Click Place
Alveolar -> Text -> Maybe IPA
mkJustIPA Text
"ǃ"
    Click Place
PostAlveolar -> Text -> Maybe IPA
mkJustIPA Text
"ǁ"
    Click Place
Palatal -> Text -> Maybe IPA
mkJustIPA Text
"ǂ"

    -- Double articulation
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Alveolar Manner
Nasal ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"n" Text
"m"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Alveolar Manner
Plosive ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"p"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Alveolar Manner
Plosive ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"d" Text
"b"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Velar Manner
Nasal ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ŋ" Text
"m"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Velar Manner
Plosive ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"k" Text
"p"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Velar Manner
Plosive ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"g" Text
"b"
    DoublyArticulated Phonation
Voiceless Place
Uvular Place
Pharyngeal Manner
Plosive ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"q" Text
"ʡ"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Palatal (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA (Text -> Maybe IPA) -> Text -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
True Text
"ɥ"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Palatal Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"ɥ"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Velar (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe IPA
mkJustIPA Text
"ʍ"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Velar Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"w"
    DoublyArticulated Phonation
Voiced Place
Alveolar Place
Velar Manner
LateralApproximant ->
        Text -> Maybe IPA
mkJustIPA Text
"ɫ"
    -- The sj-sound in Swedish phonology; actual realization is contested
    -- and appears to vary between dialects
    DoublyArticulated Phonation
Voiceless Place
PostAlveolar Place
Velar (Fricative Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA Text
"ɧ"
    DoublyArticulated Phonation
Voiceless Place
LabioDental Place
Velar (Fricative Sibilance
Sibilant) ->
        Text -> Maybe IPA
mkJustIPA Text
"ɧ"

    Consonant
_ -> Maybe IPA
forall a. Maybe a
Nothing

implosive :: Consonant -> Maybe IPA
implosive :: Consonant -> Maybe IPA
implosive (Implosive Phonation
Voiceless Place
place) = Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
    (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                           (Phonation -> Place -> Segment
ImplosiveConsonant Phonation
Voiced Place
place)
implosive Consonant
c = case Consonant
c of
    Implosive Phonation
Voiced Place
Bilabial -> Text -> Maybe IPA
mkJustIPA Text
"ɓ"
    Implosive Phonation
Voiced Place
Alveolar -> Text -> Maybe IPA
mkJustIPA Text
"ɗ"
    Implosive Phonation
Voiced Place
Retroflex -> Text -> Maybe IPA
mkJustIPA Text
"ᶑ"
    Implosive Phonation
Voiced Place
Palatal -> Text -> Maybe IPA
mkJustIPA Text
"ʄ"
    Implosive Phonation
Voiced Place
Velar -> Text -> Maybe IPA
mkJustIPA Text
"ɠ"
    Implosive Phonation
Voiced Place
Uvular -> Text -> Maybe IPA
mkJustIPA Text
"ʛ"
    Implosive Phonation
Voiced Place
Dental -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Dentalized (Phonation -> Place -> Segment
ImplosiveConsonant Phonation
Voiced Place
Alveolar)
    Consonant
_ -> Maybe IPA
forall a. Maybe a
Nothing

ejective :: Consonant -> Maybe IPA
ejective :: Consonant -> Maybe IPA
ejective Consonant
c = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text) -> Maybe Text -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Consonant -> Maybe Text
getEj Consonant
c Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ej Maybe Text -> (Text -> Maybe IPA) -> Maybe IPA
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe IPA
mkJustIPA
  where
    ej :: Text
ej    = Text
"\x02bc"

    getEj :: Consonant -> Maybe Text
getEj = \case
        Ejective Place
Bilabial Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"p"
        Ejective Place
Bilabial (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ɸ"
        Ejective Place
LabioDental (Affricate Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just
            (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated (Text -> Text
dentalized Text
"p") Text
"f"
        Ejective Place
LabioDental (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"f"
        Ejective Place
Dental Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
dentalized Text
"t"
        Ejective Place
Dental (Affricate Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just
            (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated (Text -> Text
dentalized Text
"t") Text
"θ"
        Ejective Place
Dental (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"θ"
        Ejective Place
Alveolar Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"t"
        Ejective Place
Alveolar (Affricate Sibilance
Sibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"s"
        Ejective Place
Alveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"s"
        Ejective Place
Alveolar Manner
LateralAffricate ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"ɬ"
        Ejective Place
Alveolar Manner
LateralFricative -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ɬ"
        Ejective Place
PostAlveolar (Affricate Sibilance
Sibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"ʃ"
        Ejective Place
PostAlveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ʃ"
        Ejective Place
Retroflex Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ʈ"
        Ejective Place
Retroflex (Affricate Sibilance
Sibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"ʈ" Text
"ʂ"
        Ejective Place
Retroflex (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ʂ"
        Ejective Place
Palatal Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"c"
        Ejective Place
Palatal (Affricate Sibilance
Sibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"t" Text
"ɕ"
        Ejective Place
Palatal (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ɕ"
        Ejective Place
Palatal Manner
LateralAffricate -> Text -> Maybe Text
forall a. a -> Maybe a
Just
            (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"c" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
raised (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
True Text
"ʎ")
        Ejective Place
Velar Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"k"
        Ejective Place
Velar (Affricate Sibilance
NonSibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"k" Text
"x"
        Ejective Place
Velar (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"x"
        Ejective Place
Velar Manner
LateralAffricate -> Text -> Maybe Text
forall a. a -> Maybe a
Just
            (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"k" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
raised (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Text
voiceless Bool
True Text
"ʟ")
        Ejective Place
Uvular Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"q"
        Ejective Place
Uvular (Affricate Sibilance
NonSibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulated Text
"q" Text
"χ"
        Ejective Place
Uvular (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"χ"
        Ejective Place
Pharyngeal Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ʡ"
        Consonant
_ -> Maybe Text
forall a. Maybe a
Nothing

vowel :: Vowel -> Maybe IPA
vowel :: Vowel -> Maybe IPA
vowel = \case
    Pure Height
Close Backness
Front Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"i"
    Pure Height
Close Backness
Front Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"y"
    Pure Height
Close Backness
Central Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɨ"
    Pure Height
Close Backness
Central Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ʉ"
    Pure Height
Close Backness
Back Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɯ"
    Pure Height
Close Backness
Back Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"u"
    Pure Height
NearClose Backness
Front Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɪ"
    Pure Height
NearClose Backness
Front Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ʏ"
    Pure Height
NearClose Backness
Back Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ʊ"
    Pure Height
CloseMid Backness
Front Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"e"
    Pure Height
CloseMid Backness
Front Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ø"
    Pure Height
CloseMid Backness
Central Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɘ"
    Pure Height
CloseMid Backness
Central Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ɵ"
    Pure Height
CloseMid Backness
Back Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɤ"
    Pure Height
CloseMid Backness
Back Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"o"
    Pure Height
Mid Backness
Front Roundedness
Unrounded -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Front Roundedness
Unrounded)
    Pure Height
Mid Backness
Front Roundedness
Rounded -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Front Roundedness
Rounded)
    Pure Height
Mid Backness
Central Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ə"
    Pure Height
Mid Backness
Back Roundedness
Unrounded -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Back Roundedness
Unrounded)
    Pure Height
Mid Backness
Back Roundedness
Rounded -> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA
        (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Back Roundedness
Rounded)
    Pure Height
OpenMid Backness
Front Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɛ"
    Pure Height
OpenMid Backness
Front Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"œ"
    Pure Height
OpenMid Backness
Central Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɜ"
    Pure Height
OpenMid Backness
Central Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ɞ"
    Pure Height
OpenMid Backness
Back Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ʌ"
    Pure Height
OpenMid Backness
Back Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ɔ"
    Pure Height
NearOpen Backness
Front Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"æ"
    Pure Height
NearOpen Backness
Central Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɐ"
    Pure Height
Open Backness
Front Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"a"
    Pure Height
Open Backness
Front Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ɶ"
    Pure Height
Open Backness
Central Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ä"
    Pure Height
Open Backness
Back Roundedness
Unrounded -> Text -> Maybe IPA
mkJustIPA Text
"ɑ"
    Pure Height
Open Backness
Back Roundedness
Rounded -> Text -> Maybe IPA
mkJustIPA Text
"ɒ"
    Diphthongized v1 :: Vowel
v1@Pure {} v2 :: Vowel
v2@Pure {} -> IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
(<>) (IPA -> IPA -> IPA) -> Maybe IPA -> Maybe (IPA -> IPA)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Vowel -> Segment
Vowel Vowel
v1)
        Maybe (IPA -> IPA) -> Maybe IPA -> Maybe IPA
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Vowel -> Segment
Vowel Vowel
v2)
    Triphthongized v1 :: Vowel
v1@Pure {} v2 :: Vowel
v2@Pure {} v3 :: Vowel
v3@Pure {} -> do
        IPA
first <- Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Vowel -> Segment
Vowel Vowel
v1
        IPA
second <- Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Vowel -> Segment
Vowel Vowel
v2
        IPA
third <- Segment -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Segment -> Maybe IPA) -> Segment -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ Vowel -> Segment
Vowel Vowel
v3
        IPA -> Maybe IPA
forall (m :: * -> *) a. Monad m => a -> m a
return (IPA -> Maybe IPA) -> IPA -> Maybe IPA
forall a b. (a -> b) -> a -> b
$ IPA
first IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
<> IPA
second IPA -> IPA -> IPA
forall a. Semigroup a => a -> a -> a
<> IPA
third
    Vowel
_ -> Maybe IPA
forall a. Maybe a
Nothing

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

        Pulmonic Phonation
Voiced Place
Bilabial Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1d56"
        Pulmonic Phonation
Voiceless Place
Bilabial Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1d47"
        Pulmonic Phonation
Voiceless Place
Alveolar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1d57"
        Pulmonic Phonation
Voiced Place
Alveolar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1d48"
        Pulmonic Phonation
Voiceless Place
Palatal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1d9c"
        Pulmonic Phonation
Voiced Place
Palatal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1da1"
        Pulmonic Phonation
Voiceless Place
Velar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1d4f"
        Pulmonic Phonation
Voiced Place
Velar Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x1da2"
        Pulmonic Phonation
Voiceless Place
Glottal Manner
Plosive -> Text -> Maybe IPA
mkJustIPA Text
"\x02c0"

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

        Pulmonic Phonation
Voiced Place
LabioDental Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"\x1db9"
        Pulmonic Phonation
Voiced Place
Alveolar Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"\x02b4"
        Pulmonic Phonation
Voiced Place
Retroflex Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"\x02b5"
        Pulmonic Phonation
Voiced Place
Palatal Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"\x02b2"
        Pulmonic Phonation
Voiceless Place
Velar Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"\xab69"
        Pulmonic Phonation
Voiced Place
Velar Manner
Approximant -> Text -> Maybe IPA
mkJustIPA Text
"\x1dad"

        Pulmonic Phonation
Voiced Place
Alveolar Manner
Trill -> Text -> Maybe IPA
mkJustIPA Text
"\x02b3"

        Consonant
_ -> Maybe IPA
forall a. Maybe a
Nothing

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

    Segment
_ -> Maybe IPA
forall a. Maybe a
Nothing

-------------------------------------------------------------------------------
--                                  X-SAMPA                                  --
-------------------------------------------------------------------------------
mkXSampaOp :: ReprXSampa a => (b -> Maybe XSampa) -> a -> b -> Maybe XSampa
mkXSampaOp :: (b -> Maybe XSampa) -> a -> b -> Maybe XSampa
mkXSampaOp b -> Maybe XSampa
f a
x b
y = XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
(<>) (XSampa -> XSampa -> XSampa)
-> Maybe XSampa -> Maybe (XSampa -> XSampa)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa a
x Maybe (XSampa -> XSampa) -> Maybe XSampa -> Maybe XSampa
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Maybe XSampa
f b
y

doubleArticulatedXSampa :: Text -> Text -> Text
doubleArticulatedXSampa :: Text -> Text -> Text
doubleArticulatedXSampa Text
x Text
y = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y

-- X-SAMPA quite inexplicably uses a backslash as a semantic token
xSlash :: Text -> Text
xSlash :: Text -> Text
xSlash = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\")

rhoticXSampa :: Text -> Text
rhoticXSampa :: Text -> Text
rhoticXSampa = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`")

vowelXSampa :: Vowel -> Maybe XSampa
vowelXSampa :: Vowel -> Maybe XSampa
vowelXSampa = \case
    Pure Height
Close Backness
Front Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"i"
    Pure Height
Close Backness
Front Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"y"
    Pure Height
Close Backness
Central Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"1"
    Pure Height
Close Backness
Central Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"}"
    Pure Height
Close Backness
Back Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"M"
    Pure Height
Close Backness
Back Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"u"
    Pure Height
NearClose Backness
Front Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"I"
    Pure Height
NearClose Backness
Front Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"Y"
    Pure Height
NearClose Backness
Back Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"U"
    Pure Height
CloseMid Backness
Front Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"e"
    Pure Height
CloseMid Backness
Front Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"2"
    Pure Height
CloseMid Backness
Central Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"@"
    Pure Height
CloseMid Backness
Central Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"8"
    Pure Height
CloseMid Backness
Back Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"7"
    Pure Height
CloseMid Backness
Back Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"o"
    Pure Height
Mid Backness
Front Roundedness
Unrounded -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Front Roundedness
Unrounded)
    Pure Height
Mid Backness
Front Roundedness
Rounded -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Front Roundedness
Rounded)
    Pure Height
Mid Backness
Central Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"@"
    Pure Height
Mid Backness
Back Roundedness
Unrounded -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Back Roundedness
Unrounded)
    Pure Height
Mid Backness
Back Roundedness
Rounded -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature SegmentalFeature
Lowered (Vowel -> Segment
Vowel (Vowel -> Segment) -> Vowel -> Segment
forall a b. (a -> b) -> a -> b
$ Height -> Backness -> Roundedness -> Vowel
Pure Height
CloseMid Backness
Back Roundedness
Unrounded)
    Pure Height
OpenMid Backness
Front Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"E"
    Pure Height
OpenMid Backness
Front Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"9"
    Pure Height
OpenMid Backness
Central Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"3"
    Pure Height
OpenMid Backness
Central Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"3"
    Pure Height
OpenMid Backness
Back Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"V"
    Pure Height
OpenMid Backness
Back Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"O"
    Pure Height
NearOpen Backness
Front Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"{"
    Pure Height
NearOpen Backness
Central Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"6"
    Pure Height
Open Backness
Front Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"a"
    Pure Height
Open Backness
Front Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"&"
    Pure Height
Open Backness
Back Roundedness
Unrounded -> Text -> Maybe XSampa
mkXSampa Text
"A"
    Pure Height
Open Backness
Back Roundedness
Rounded -> Text -> Maybe XSampa
mkXSampa Text
"Q"
    Diphthongized v1 :: Vowel
v1@Pure {} v2 :: Vowel
v2@Pure {} -> XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
(<>) (XSampa -> XSampa -> XSampa)
-> Maybe XSampa -> Maybe (XSampa -> XSampa)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa (Vowel -> Segment
Vowel Vowel
v1)
        Maybe (XSampa -> XSampa) -> Maybe XSampa -> Maybe XSampa
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa (Vowel -> Segment
Vowel Vowel
v2)
    Triphthongized v1 :: Vowel
v1@Pure {} v2 :: Vowel
v2@Pure {} v3 :: Vowel
v3@Pure {} -> do
        XSampa
first <- Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Vowel -> Segment
Vowel Vowel
v1
        XSampa
second <- Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Vowel -> Segment
Vowel Vowel
v2
        XSampa
third <- Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Vowel -> Segment
Vowel Vowel
v3
        XSampa -> Maybe XSampa
forall (m :: * -> *) a. Monad m => a -> m a
return (XSampa -> Maybe XSampa) -> XSampa -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ XSampa
first XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
<> XSampa
second XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
<> XSampa
third
    Vowel
_ -> Maybe XSampa
forall a. Maybe a
Nothing

consonantXSampa :: Consonant -> Maybe XSampa
consonantXSampa :: Consonant -> Maybe XSampa
consonantXSampa = \case
    e :: Consonant
e@Ejective {} -> Consonant -> Maybe XSampa
ejectiveXSampa Consonant
e
    i :: Consonant
i@Implosive {} -> Consonant -> Maybe XSampa
implosiveXSampa Consonant
i

    -- Pulmonic consonants
    -- Bilabials
    Pulmonic Phonation
Voiceless Place
Bilabial Manner
Nasal -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Bilabial Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Nasal -> Text -> Maybe XSampa
mkXSampa Text
"m"
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"b"
    Pulmonic Phonation
Voiceless Place
Bilabial Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"p"
    Pulmonic Phonation
Voiceless Place
Bilabial (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"p"
    Pulmonic Phonation
Voiced Place
Bilabial (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"B"
    Pulmonic Phonation
Voiced Place
Bilabial Manner
Trill -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"B"

    -- Labio-dentals
    Pulmonic Phonation
Voiced Place
LabioDental Manner
Nasal -> Text -> Maybe XSampa
mkXSampa Text
"F"
    Pulmonic Phonation
Voiceless Place
LabioDental (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"f"
    Pulmonic Phonation
Voiced Place
LabioDental (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"v"
    Pulmonic Phonation
Voiced Place
LabioDental Manner
Approximant -> Text -> Maybe XSampa
mkXSampa Text
"P"

    -- Dentals
    Pulmonic Phonation
Voiceless Place
Dental (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"T"
    Pulmonic Phonation
Voiced Place
Dental (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"D"

    -- Alveolars
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Nasal -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Nasal -> Text -> Maybe XSampa
mkXSampa Text
"n"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"t"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"d"
    Pulmonic Phonation
Voiceless Place
Alveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" Text
"s"
    Pulmonic Phonation
Voiced Place
Alveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"d" Text
"z"
    Pulmonic Phonation
Voiceless Place
Alveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa Text
"s"
    Pulmonic Phonation
Voiced Place
Alveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa Text
"z"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Approximant -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"r"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Flap -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
Flap)
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Flap -> Text -> Maybe XSampa
mkXSampa Text
"4"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
Trill -> Text -> Maybe XSampa
mkXSampa Text
"r"
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
Trill -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Alveolar Manner
Trill)
    Pulmonic Phonation
Voiceless Place
Alveolar Manner
LateralFricative -> Text -> Maybe XSampa
mkXSampa Text
"K"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
LateralFricative -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"K"
    Pulmonic Phonation
Voiced Place
Alveolar Manner
LateralApproximant -> Text -> Maybe XSampa
mkXSampa Text
"l"

    -- Post-alveolars
    Pulmonic Phonation
Voiceless Place
PostAlveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" Text
"S"
    Pulmonic Phonation
Voiced Place
PostAlveolar (Affricate Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"d" Text
"Z"
    Pulmonic Phonation
Voiceless Place
PostAlveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa Text
"S"
    Pulmonic Phonation
Voiced Place
PostAlveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa Text
"Z"

    -- Retroflexes
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Nasal -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Retroflex Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Nasal -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"n"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Plosive -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"t"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Plosive -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"d"
    Pulmonic Phonation
Voiceless Place
Retroflex (Affricate Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa
        (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text
doubleArticulatedXSampa (Text -> Text -> Text) -> (Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
rhoticXSampa) Text
"t" Text
"s"
    Pulmonic Phonation
Voiced Place
Retroflex (Affricate Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa
        (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text
doubleArticulatedXSampa (Text -> Text -> Text) -> (Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
rhoticXSampa) Text
"d" Text
"z"
    Pulmonic Phonation
Voiceless Place
Retroflex (Fricative Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"s"
    Pulmonic Phonation
Voiced Place
Retroflex (Fricative Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"z"
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Approximant ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> (Text -> Text) -> Text -> Maybe XSampa
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
xSlash (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"r"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
Flap -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Retroflex Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Retroflex Manner
Flap -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"r"
    Pulmonic Phonation
Voiceless Place
Retroflex Manner
LateralApproximant -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Retroflex Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Retroflex Manner
LateralApproximant ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"l"

    -- Palatals
    Pulmonic Phonation
Voiced Place
Palatal Manner
Nasal -> Text -> Maybe XSampa
mkXSampa Text
"J"
    Pulmonic Phonation
Voiceless Place
Palatal Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"c"
    Pulmonic Phonation
Voiced Place
Palatal Manner
Plosive -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"J"
    Pulmonic Phonation
Voiceless Place
Palatal (Affricate Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa
        (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" (Text -> Text
xSlash Text
"s")
    Pulmonic Phonation
Voiced Place
Palatal (Affricate Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa
        (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"d" (Text -> Text
xSlash Text
"z")
    Pulmonic Phonation
Voiceless Place
Palatal (Fricative Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"s"
    Pulmonic Phonation
Voiced Place
Palatal (Fricative Sibilance
Sibilant) -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"z"
    Pulmonic Phonation
Voiceless Place
Palatal (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"C"
    Pulmonic Phonation
Voiced Place
Palatal (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"j"
    Pulmonic Phonation
Voiced Place
Palatal Manner
Approximant -> Text -> Maybe XSampa
mkXSampa Text
"j"
    Pulmonic Phonation
Voiced Place
Palatal Manner
LateralApproximant -> Text -> Maybe XSampa
mkXSampa Text
"L"

    -- Velars
    Pulmonic Phonation
Voiceless Place
Velar Manner
Nasal -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Velar Manner
Nasal)
    Pulmonic Phonation
Voiced Place
Velar Manner
Nasal -> Text -> Maybe XSampa
mkXSampa Text
"N"
    Pulmonic Phonation
Voiceless Place
Velar Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"k"
    Pulmonic Phonation
Voiced Place
Velar Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"g"
    Pulmonic Phonation
Voiceless Place
Velar (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"k" Text
"x"
    Pulmonic Phonation
Voiced Place
Velar (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"g" Text
"G"
    Pulmonic Phonation
Voiceless Place
Velar (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"x"
    Pulmonic Phonation
Voiced Place
Velar (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"G"
    Pulmonic Phonation
Voiced Place
Velar Manner
Approximant -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"m"
    Pulmonic Phonation
Voiced Place
Velar Manner
LateralApproximant -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"L"

    -- Uvulars
    Pulmonic Phonation
Voiced Place
Uvular Manner
Nasal -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"N"
    Pulmonic Phonation
Voiceless Place
Uvular Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"q"
    Pulmonic Phonation
Voiced Place
Uvular Manner
Plosive -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"G"
    Pulmonic Phonation
Voiceless Place
Uvular (Affricate Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"q" Text
"X"
    Pulmonic Phonation
Voiced Place
Uvular (Affricate Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa
        (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa (Text -> Text
xSlash Text
"G") Text
"R"
    Pulmonic Phonation
Voiceless Place
Uvular (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"X"
    Pulmonic Phonation
Voiced Place
Uvular (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"R"
    Pulmonic Phonation
Voiceless Place
Uvular Manner
Trill -> Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                               (Phonation -> Place -> Manner -> Segment
PulmonicConsonant Phonation
Voiced Place
Uvular Manner
Trill)
    Pulmonic Phonation
Voiced Place
Uvular Manner
Trill -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"R"

    -- Pharyngeals
    Pulmonic Phonation
Voiceless Place
Pharyngeal (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"X"
    Pulmonic Phonation
Voiced Place
Pharyngeal (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"?"

    -- Glottals
    Pulmonic Phonation
Voiceless Place
Glottal Manner
Plosive -> Text -> Maybe XSampa
mkXSampa Text
"?"
    Pulmonic Phonation
Voiceless Place
Glottal (Affricate Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa
        (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"?" (Text -> Text
xSlash Text
"h")
    Pulmonic Phonation
Voiceless Place
Glottal (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa Text
"h"
    Pulmonic Phonation
Voiced Place
Glottal (Fricative Sibilance
NonSibilant) -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"h"

    -- Implosives
    -- Clicks
    Click Place
Bilabial -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"O"
    Click Place
Dental -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"|"
    Click Place
Alveolar -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"!"
    Click Place
PostAlveolar -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
xSlash Text
"|"
    Click Place
Palatal -> Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"="

    -- Double articulation
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Alveolar Manner
Nasal ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"n" Text
"m"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Alveolar Manner
Plosive ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" Text
"p"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Alveolar Manner
Plosive ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"d" Text
"b"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Velar Manner
Nasal ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"N" Text
"m"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Velar Manner
Plosive ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"k" Text
"p"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Velar Manner
Plosive ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"g" Text
"b"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Palatal (Fricative Sibilance
NonSibilant) ->
        Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature --
        (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
        (Consonant -> Segment
Consonant (Phonation -> Place -> Place -> Manner -> Consonant
DoublyArticulated Phonation
Voiced Place
Bilabial Place
Palatal Manner
Approximant))
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Palatal Manner
Approximant -> Text -> Maybe XSampa
mkXSampa Text
"H"
    DoublyArticulated Phonation
Voiceless Place
Bilabial Place
Velar (Fricative Sibilance
NonSibilant) ->
        Text -> Maybe XSampa
mkXSampa Text
"W"
    DoublyArticulated Phonation
Voiced Place
Bilabial Place
Velar Manner
Approximant -> Text -> Maybe XSampa
mkXSampa Text
"w"
    DoublyArticulated Phonation
Voiceless Place
PostAlveolar Place
Velar (Fricative Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"x"
    DoublyArticulated Phonation
Voiceless Place
LabioDental Place
Velar (Fricative Sibilance
Sibilant) ->
        Text -> Maybe XSampa
mkXSampa (Text -> Maybe XSampa) -> Text -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"x"

    Consonant
_ -> Maybe XSampa
forall a. Maybe a
Nothing

ejectiveXSampa :: Consonant -> Maybe XSampa
ejectiveXSampa :: Consonant -> Maybe XSampa
ejectiveXSampa Consonant
c = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text) -> Maybe Text -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Consonant -> Maybe Text
getEj Consonant
c Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
ej Maybe Text -> (Text -> Maybe XSampa) -> Maybe XSampa
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe XSampa
mkXSampa
  where
    ej :: Text
ej    = Text
"_>"

    getEj :: Consonant -> Maybe Text
getEj = \case
        Ejective Place
Bilabial Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"p"
        Ejective Place
Bilabial (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"p"
        Ejective Place
Dental (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"T"
        Ejective Place
Alveolar Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"t"
        Ejective Place
Alveolar (Affricate Sibilance
Sibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" Text
"s"
        Ejective Place
Alveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"s"
        Ejective Place
PostAlveolar (Affricate Sibilance
Sibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" Text
"S"
        Ejective Place
PostAlveolar (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"S"
        Ejective Place
Retroflex Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"t"
        Ejective Place
Retroflex (Affricate Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just
            (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text
doubleArticulatedXSampa (Text -> Text -> Text) -> (Text -> Text) -> Text -> Text -> Text
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
rhoticXSampa) Text
"t" Text
"s"
        Ejective Place
Retroflex (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"s"
        Ejective Place
Palatal Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"c"
        Ejective Place
Palatal (Affricate Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just
            (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"t" (Text -> Text
xSlash Text
"s")
        Ejective Place
Palatal (Fricative Sibilance
Sibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
xSlash Text
"s"
        Ejective Place
Velar Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"k"
        Ejective Place
Velar (Affricate Sibilance
NonSibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"k" Text
"x"
        Ejective Place
Velar (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"x"
        Ejective Place
Uvular Manner
Plosive -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"q"
        Ejective Place
Uvular (Affricate Sibilance
NonSibilant) ->
            Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
doubleArticulatedXSampa Text
"q" Text
"X"
        Ejective Place
Uvular (Fricative Sibilance
NonSibilant) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"X"
        Consonant
_ -> Maybe Text
forall a. Maybe a
Nothing

implosiveXSampa :: Consonant -> Maybe XSampa
implosiveXSampa :: Consonant -> Maybe XSampa
implosiveXSampa (Implosive Phonation
Voiceless Place
place) = Segment -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
    (Segment -> Maybe XSampa) -> Segment -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SegmentalFeature -> Segment -> Segment
WithSegmentalFeature (Phonation -> SegmentalFeature
Voicing Phonation
Voiceless)
                           (Phonation -> Place -> Segment
ImplosiveConsonant Phonation
Voiced Place
place)
implosiveXSampa Consonant
c = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text) -> Maybe Text -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Consonant -> Maybe Text
getImpl Consonant
c Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
impl Maybe Text -> (Text -> Maybe XSampa) -> Maybe XSampa
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe XSampa
mkXSampa
  where
    impl :: Text
impl    = Text
"_<"

    getImpl :: Consonant -> Maybe Text
getImpl = \case
        Implosive Phonation
Voiced Place
Bilabial -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"b"
        Implosive Phonation
Voiced Place
Alveolar -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"d"
        Implosive Phonation
Voiced Place
Retroflex -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
rhoticXSampa Text
"d"
        Implosive Phonation
Voiced Place
Palatal -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"f"
        Implosive Phonation
Voiced Place
Velar -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"g"
        Implosive Phonation
Voiced Place
Uvular -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"G"
        Consonant
_ -> Maybe Text
forall a. Maybe a
Nothing

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

withSuprasegmentalFeatureXSampa
    :: MultiSegment t => Syllable t -> SuprasegmentalFeature -> Maybe XSampa
withSuprasegmentalFeatureXSampa :: Syllable t -> SuprasegmentalFeature -> Maybe XSampa
withSuprasegmentalFeatureXSampa Syllable t
s = \case
    LevelLexicalTone LevelTone
tone -> (LevelTone -> Maybe XSampa)
-> Syllable t -> LevelTone -> Maybe XSampa
forall a b.
ReprXSampa a =>
(b -> Maybe XSampa) -> a -> b -> Maybe XSampa
mkXSampaOp LevelTone -> Maybe XSampa
xsampaTone Syllable t
s LevelTone
tone
      where
        xsampaTone :: LevelTone -> Maybe XSampa
xsampaTone = \case
            LevelTone
ExtraHighTone -> Text -> Maybe XSampa
mkXSampa Text
"_T"
            LevelTone
HighTone      -> Text -> Maybe XSampa
mkXSampa Text
"_H"
            LevelTone
MidTone       -> Text -> Maybe XSampa
mkXSampa Text
"_M"
            LevelTone
LowTone       -> Text -> Maybe XSampa
mkXSampa Text
"_L"
            LevelTone
ExtraLowTone  -> Text -> Maybe XSampa
mkXSampa Text
"_B"
            LevelTone
DownStep      -> Text -> Maybe XSampa
mkXSampa Text
"!"
            LevelTone
UpStep        -> Text -> Maybe XSampa
mkXSampa Text
"^"

    LevelLexicalToneDiacritic LevelTone
tone -> Syllable t -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Syllable t -> Maybe XSampa) -> Syllable t -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SuprasegmentalFeature -> Syllable t -> Syllable t
forall (t :: * -> *).
SuprasegmentalFeature -> Syllable t -> Syllable t
WithSuprasegmentalFeature (LevelTone -> SuprasegmentalFeature
LevelLexicalTone LevelTone
tone) Syllable t
s

    LexicalToneContour ToneContour
tone -> (ToneContour -> Maybe XSampa)
-> Syllable t -> ToneContour -> Maybe XSampa
forall a b.
ReprXSampa a =>
(b -> Maybe XSampa) -> a -> b -> Maybe XSampa
mkXSampaOp ToneContour -> Maybe XSampa
xsampaToneContour Syllable t
s ToneContour
tone
      where
        xsampaToneContour :: ToneContour -> Maybe XSampa
xsampaToneContour = \case
            ToneContour
Rising        -> Text -> Maybe XSampa
mkXSampa Text
"_R"
            ToneContour
Falling       -> Text -> Maybe XSampa
mkXSampa Text
"_F"
            ToneContour
HighRising    -> Text -> Maybe XSampa
mkXSampa Text
"_H_T"
            ToneContour
LowRising     -> Text -> Maybe XSampa
mkXSampa Text
"_B_L"
            ToneContour
HighFalling   -> Text -> Maybe XSampa
mkXSampa Text
"_H_F"
            ToneContour
LowFalling    -> Text -> Maybe XSampa
mkXSampa Text
"_L_B"
            ToneContour
RisingFalling -> Text -> Maybe XSampa
mkXSampa Text
"_R_F"
            ToneContour
FallingRising -> Text -> Maybe XSampa
mkXSampa Text
"_F_R"
            ToneContour
GlobalRise    -> Text -> Maybe XSampa
mkXSampa Text
"<R>"
            ToneContour
GlobalFall    -> Text -> Maybe XSampa
mkXSampa Text
"<F>"

    LexicalToneContourDiacritic ToneContour
tone -> Syllable t -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa
        (Syllable t -> Maybe XSampa) -> Syllable t -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ SuprasegmentalFeature -> Syllable t -> Syllable t
forall (t :: * -> *).
SuprasegmentalFeature -> Syllable t -> Syllable t
WithSuprasegmentalFeature (ToneContour -> SuprasegmentalFeature
LexicalToneContour ToneContour
tone) Syllable t
s

    Stress Stress
stress -> (Stress -> Maybe XSampa) -> Syllable t -> Stress -> Maybe XSampa
forall a b.
ReprXSampa a =>
(b -> Maybe XSampa) -> a -> b -> Maybe XSampa
mkXSampaOp Stress -> Maybe XSampa
xsampaStress Syllable t
s Stress
stress
      where
        xsampaStress :: Stress -> Maybe XSampa
xsampaStress Stress
Primary   = Text -> Maybe XSampa
mkXSampa Text
"\""
        xsampaStress Stress
Secondary = Text -> Maybe XSampa
mkXSampa Text
"%"

    -- Explicit syllable break
    SuprasegmentalFeature
Break -> XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
(<>) (XSampa -> XSampa -> XSampa)
-> Maybe XSampa -> Maybe (XSampa -> XSampa)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Syllable t -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa Syllable t
s Maybe (XSampa -> XSampa) -> Maybe XSampa -> Maybe XSampa
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe XSampa
mkXSampa Text
"."

    -- Syllable non-break
    SuprasegmentalFeature
Linking -> XSampa -> XSampa -> XSampa
forall a. Semigroup a => a -> a -> a
(<>) (XSampa -> XSampa -> XSampa)
-> Maybe XSampa -> Maybe (XSampa -> XSampa)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Syllable t -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa Syllable t
s Maybe (XSampa -> XSampa) -> Maybe XSampa -> Maybe XSampa
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe XSampa
mkXSampa (Text -> Text
xSlash Text
"-")

    SuprasegmentalFeature
_ -> Maybe XSampa
forall a. Maybe a
Nothing