{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Language.IPA
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Working with IPA\/X-SAMPA transcriptions and phonetic/phonemic values
module Language.IPA
    (   -- * Utilities
        -- ** Conversion
      ipaToXSampa
    , xSampaToIpa
      -- ** Construction
    , toIPA'
    , toXSampa'
       -- ** Predicates
    , isValid
    , isValidSegment
    , isValidSyllable
    , isObstruent
    , isSonorant
    , isLabial
    , isCoronal
    , isDorsal
    , isLaryngeal
    , isRhotic
    , isLiquid
      -- * Re-exports
    , module M
    ) where

import           Control.Exception   ( throw )

import           Data.Maybe          ( fromMaybe )
import           Data.Text           ( Text )

import           Language.IPA.Class  as M
import           Language.IPA.Parser as M
import           Language.IPA.Types  as M

-- | Convert an 'IPA' value to its equivalent in 'XSampa'; note that several
-- features and segments that can be transcribed in IPA notation are missing
-- from X-SAMPA
ipaToXSampa :: IPA -> Maybe XSampa
ipaToXSampa :: IPA -> Maybe XSampa
ipaToXSampa IPA { .. } =
    (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)

-- | Convert an 'XSampa' value to its equivalent in 'IPA'
xSampaToIpa :: XSampa -> Maybe IPA
xSampaToIpa :: XSampa -> Maybe IPA
xSampaToIpa XSampa { .. } =
    (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)

-- | Partial function for creating an 'IPA'. Useful if you are certain that
-- the sound in question is representable
toIPA' :: ReprIPA a => a -> IPA
toIPA' :: a -> IPA
toIPA' x :: 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 "Illegal IPA value") (a -> Maybe IPA
forall a. ReprIPA a => a -> Maybe IPA
toIPA a
x)

-- | Partial function for creating an 'XSampa'. NB: Certain segments that have
-- a defined 'IPA' representation have no 'XSampa' equivalent
toXSampa' :: ReprXSampa a => a -> XSampa
toXSampa' :: a -> XSampa
toXSampa' x :: 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 "Illegal X-SAMPA value")
                        (a -> Maybe XSampa
forall a. ReprXSampa a => a -> Maybe XSampa
toXSampa a
x)

-- | Does a text value in IPA notation represent a valid instance of 'ReprIPA'?
-- Note that you will need @-XTypeApplications@ to use this, and that this just
-- calls 'parseIPA' to determine validity
--
-- >>> isValid @Segment "L"
-- False
-- >>> isValid @Segment "ʟ"
-- True
isValid :: forall a. ReprIPA a => Text -> Bool
isValid :: Text -> Bool
isValid t :: 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)

-- | Does a text value represent valid individual IPA 'Segment'?
isValidSegment :: Text -> Bool
isValidSegment :: Text -> Bool
isValidSegment = ReprIPA Segment => Text -> Bool
forall a. ReprIPA a => Text -> Bool
isValid @Segment

-- | Is a text value a valid IPA 'Syllable'?
isValidSyllable :: Text -> Bool
isValidSyllable :: Text -> Bool
isValidSyllable = ReprIPA (Syllable []) => Text -> Bool
forall a. ReprIPA a => Text -> Bool
isValid @(Syllable [])

-- | Tests if a 'Segment' is obstruent, i.e. formed by obstructing airflow
isObstruent :: Segment -> Bool
isObstruent :: Segment -> Bool
isObstruent = \case
    PulmonicConsonant _ _ manner :: Manner
manner -> case Manner
manner of
        Plosive     -> Bool
True
        Fricative _ -> Bool
True
        Affricate _ -> Bool
True
        _           -> Bool
False
    _ -> Bool
False

-- | Tests if 'Segment' is sonorant, i.e. if it is created with an uninterrupted
-- flow of air
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

-- | Tests pulmonic 'Consonant' membership in the labial category, whose
-- active articulator is one or both lips
isLabial :: Consonant -> Bool
isLabial :: Consonant -> Bool
isLabial = \case
    Pulmonic _ place :: Place
place _ -> case Place
place of
        Bilabial     -> Bool
True
        LabioDental  -> Bool
True
        LinguoLabial -> Bool
True
        _            -> Bool
False
    _                  -> Bool
False

-- | Tests pulmonic 'Consonant' membership in the coronal class, whose
-- active articulator is the front of the tongue
isCoronal :: Consonant -> Bool
isCoronal :: Consonant -> Bool
isCoronal = \case
    Pulmonic _ Palatal (Fricative Sibilant) -> Bool
True
    Pulmonic _ place :: Place
place _ -> case Place
place of
        Dental       -> Bool
True
        Alveolar     -> Bool
True
        PostAlveolar -> Bool
True
        Retroflex    -> Bool
True
        _            -> Bool
False
    _ -> Bool
False

-- | Tests pulmonic 'Consonant' membership in the dorsal class, whose
-- active articulator is the dorsum (back of the tongue)
isDorsal :: Consonant -> Bool
isDorsal :: Consonant -> Bool
isDorsal = \case
    Pulmonic _ place :: Place
place _ -> case Place
place of
        Palatal -> Bool
True
        Velar   -> Bool
True
        Uvular  -> Bool
True
        _       -> Bool
False
    _                  -> Bool
False

-- | Tests pulmonic 'Consonant' membership in the laryngeal class, whose
-- active articulator is the larynx
isLaryngeal :: Consonant -> Bool
isLaryngeal :: Consonant -> Bool
isLaryngeal = \case
    Pulmonic _ place :: Place
place _ -> case Place
place of
        Pharyngeal -> Bool
True
        Glottal    -> Bool
True
        _          -> Bool
False
    _                  -> Bool
False

-- | Tests if 'Consonant' is rhotic, a vague category of R-like sounds typically
-- represented lexicographically by some variant of the Latin letter r
isRhotic :: Consonant -> Bool
isRhotic :: Consonant -> Bool
isRhotic = \case
    Pulmonic Voiced Uvular (Fricative NonSibilant) -> Bool
True
    Pulmonic _ Uvular Trill -> Bool
True
    Pulmonic _ place :: Place
place manner :: 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
            Approximant -> Bool
True
            Trill       -> Bool
True
            Flap        -> Bool
True
            _           -> Bool
False
        | Bool
otherwise -> Bool
False
    _ -> Bool
False

-- | Tests if a 'Consonant' is liquid, a category of rhotics and voiced
-- lateral approximants
isLiquid :: Consonant -> Bool
isLiquid :: Consonant -> Bool
isLiquid c :: Consonant
c
    | Consonant -> Bool
isRhotic Consonant
c = Bool
True
    | Bool
otherwise = case Consonant
c of
        Pulmonic Voiced _ LateralApproximant -> Bool
True
        _ -> Bool
False