{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Language.IPA
(
transcribe
, transcribeXSampa
, ipaToXSampa
, xSampaToIpa
, toIPA'
, toXSampa'
, isValid
, isValidSegment
, isValidSyllable
, isObstruent
, isSonorant
, isLabial
, isCoronal
, isDorsal
, isLaryngeal
, isRhotic
, isLiquid
, module M
) where
import Control.Exception ( throw )
import Data.Maybe ( fromMaybe )
import Data.Text ( Text )
import Language.IPA.Class as M
import Language.IPA.Parser as M
import Language.IPA.QQ as M
import Language.IPA.Types as M
transcribe :: Delimiter -> IPA -> Text
transcribe :: Delimiter -> IPA -> Text
transcribe Delimiter
delim IPA { Text
unIPA :: IPA -> Text
unIPA :: Text
.. } = Text
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unIPA Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end
where
(Text
start, Text
end) = Delimiter -> (Text, Text)
showDelims Delimiter
delim
transcribeXSampa :: Delimiter -> XSampa -> Text
transcribeXSampa :: Delimiter -> XSampa -> Text
transcribeXSampa Delimiter
delim XSampa { Text
unXSampa :: XSampa -> Text
unXSampa :: Text
.. } = Text
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unXSampa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
end
where
(Text
start, Text
end) = Delimiter -> (Text, Text)
showDelims Delimiter
delim
ipaToXSampa :: IPA -> Maybe XSampa
ipaToXSampa :: IPA -> Maybe XSampa
ipaToXSampa IPA { Text
unIPA :: Text
unIPA :: IPA -> Text
.. } =
(IPAException -> Maybe XSampa)
-> (Syllable [] -> Maybe XSampa)
-> Either IPAException (Syllable [])
-> Maybe XSampa
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe XSampa -> IPAException -> Maybe XSampa
forall a b. a -> b -> a
const Maybe XSampa
forall a. Maybe a
Nothing) Syllable [] -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa (Text -> Either IPAException (Syllable [])
forall a. ReprIPA a => Text -> Either IPAException a
parseIPA @(Syllable []) Text
unIPA)
xSampaToIpa :: XSampa -> Maybe IPA
xSampaToIpa :: XSampa -> Maybe IPA
xSampaToIpa XSampa { Text
unXSampa :: Text
unXSampa :: XSampa -> Text
.. } =
(IPAException -> Maybe IPA)
-> (Syllable [] -> Maybe IPA)
-> Either IPAException (Syllable [])
-> Maybe IPA
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe IPA -> IPAException -> Maybe IPA
forall a b. a -> b -> a
const Maybe IPA
forall a. Maybe a
Nothing) Syllable [] -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA (Text -> Either IPAException (Syllable [])
forall a. ReprXSampa a => Text -> Either IPAException a
parseXSampa @(Syllable []) Text
unXSampa)
toIPA' :: ReprIPA a => a -> IPA
toIPA' :: a -> IPA
toIPA' a
x = IPA -> Maybe IPA -> IPA
forall a. a -> Maybe a -> a
fromMaybe (IPAException -> IPA
forall a e. Exception e => e -> a
throw (IPAException -> IPA) -> IPAException -> IPA
forall a b. (a -> b) -> a -> b
$ Text -> IPAException
InvalidIPA Text
"Illegal IPA value") (a -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA a
x)
toXSampa' :: ReprXSampa a => a -> XSampa
toXSampa' :: a -> XSampa
toXSampa' a
x = XSampa -> Maybe XSampa -> XSampa
forall a. a -> Maybe a -> a
fromMaybe (IPAException -> XSampa
forall a e. Exception e => e -> a
throw (IPAException -> XSampa) -> IPAException -> XSampa
forall a b. (a -> b) -> a -> b
$ Text -> IPAException
InvalidXSampa Text
"Illegal X-SAMPA value")
(a -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa a
x)
isValid :: forall a. ReprIPA a => Text -> Bool
isValid :: Text -> Bool
isValid Text
t = (IPAException -> Bool)
-> (a -> Bool) -> Either IPAException a -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> IPAException -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True) (Text -> Either IPAException a
forall a. ReprIPA a => Text -> Either IPAException a
parseIPA @a Text
t)
isValidSegment :: Text -> Bool
isValidSegment :: Text -> Bool
isValidSegment = ReprIPA Segment => Text -> Bool
forall a. ReprIPA a => Text -> Bool
isValid @Segment
isValidSyllable :: Text -> Bool
isValidSyllable :: Text -> Bool
isValidSyllable = ReprIPA (Syllable []) => Text -> Bool
forall a. ReprIPA a => Text -> Bool
isValid @(Syllable [])
isObstruent :: Segment -> Bool
isObstruent :: Segment -> Bool
isObstruent = \case
PulmonicConsonant Phonation
_ Place
_ Manner
manner -> case Manner
manner of
Manner
Plosive -> Bool
True
Fricative Sibilance
_ -> Bool
True
Affricate Sibilance
_ -> Bool
True
Manner
_ -> Bool
False
Segment
_ -> Bool
False
isSonorant :: Segment -> Bool
isSonorant :: Segment -> Bool
isSonorant = Bool -> Bool
not (Bool -> Bool) -> (Segment -> Bool) -> Segment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Segment -> Bool
isObstruent
isLabial :: Consonant -> Bool
isLabial :: Consonant -> Bool
isLabial = \case
Pulmonic Phonation
_ Place
place Manner
_ -> case Place
place of
Place
Bilabial -> Bool
True
Place
LabioDental -> Bool
True
Place
LinguoLabial -> Bool
True
Place
_ -> Bool
False
Consonant
_ -> Bool
False
isCoronal :: Consonant -> Bool
isCoronal :: Consonant -> Bool
isCoronal = \case
Pulmonic Phonation
_ Place
Palatal (Fricative Sibilance
Sibilant) -> Bool
True
Pulmonic Phonation
_ Place
place Manner
_ -> case Place
place of
Place
Dental -> Bool
True
Place
Alveolar -> Bool
True
Place
PostAlveolar -> Bool
True
Place
Retroflex -> Bool
True
Place
_ -> Bool
False
Consonant
_ -> Bool
False
isDorsal :: Consonant -> Bool
isDorsal :: Consonant -> Bool
isDorsal = \case
Pulmonic Phonation
_ Place
place Manner
_ -> case Place
place of
Place
Palatal -> Bool
True
Place
Velar -> Bool
True
Place
Uvular -> Bool
True
Place
_ -> Bool
False
Consonant
_ -> Bool
False
isLaryngeal :: Consonant -> Bool
isLaryngeal :: Consonant -> Bool
isLaryngeal = \case
Pulmonic Phonation
_ Place
place Manner
_ -> case Place
place of
Place
Pharyngeal -> Bool
True
Place
Glottal -> Bool
True
Place
_ -> Bool
False
Consonant
_ -> Bool
False
isRhotic :: Consonant -> Bool
isRhotic :: Consonant -> Bool
isRhotic = \case
Pulmonic Phonation
Voiced Place
Uvular (Fricative Sibilance
NonSibilant) -> Bool
True
Pulmonic Phonation
_ Place
Uvular Manner
Trill -> Bool
True
Pulmonic Phonation
_ Place
place Manner
manner
| Place
place Place -> [Place] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Place
Alveolar, Place
Retroflex ] -> case Manner
manner of
Manner
Approximant -> Bool
True
Manner
Trill -> Bool
True
Manner
Flap -> Bool
True
Manner
_ -> Bool
False
| Bool
otherwise -> Bool
False
Consonant
_ -> Bool
False
isLiquid :: Consonant -> Bool
isLiquid :: Consonant -> Bool
isLiquid Consonant
c
| Consonant -> Bool
isRhotic Consonant
c = Bool
True
| Bool
otherwise = case Consonant
c of
Pulmonic Phonation
Voiced Place
_ Manner
LateralApproximant -> Bool
True
Consonant
_ -> Bool
False
showDelims :: Delimiter -> (Text, Text)
showDelims :: Delimiter -> (Text, Text)
showDelims Delimiter
Phonetic = (Text
"[", Text
"]")
showDelims Delimiter
Phonemic = (Text
"/", Text
"/")