IPA.hs

{-# 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 { .. } =
    either (const Nothing) toXSampa (parseIPA @(Syllable []) unIPA)

-- | Convert an 'XSampa' value to its equivalent in 'IPA'
xSampaToIpa :: XSampa -> Maybe IPA
xSampaToIpa XSampa { .. } =
    either (const Nothing) toIPA (parseXSampa @(Syllable []) 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' x = fromMaybe (throw $ InvalidIPA "Illegal IPA value") (toIPA 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' x = fromMaybe (throw $ InvalidXSampa "Illegal X-SAMPA value")
                        (toXSampa 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 t = either (const False) (const True) (parseIPA @a t)

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

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

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

-- | Tests if 'Segment' is sonorant, i.e. if it is created with an uninterrupted
-- flow of air
isSonorant :: Segment -> Bool
isSonorant = not . isObstruent

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

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

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

-- | Tests pulmonic 'Consonant' membership in the laryngeal class, whose
-- active articulator is the larynx
isLaryngeal :: Consonant -> Bool
isLaryngeal = \case
    Pulmonic _ place _ -> case place of
        Pharyngeal -> True
        Glottal    -> True
        _          -> False
    _                  -> 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 = \case
    Pulmonic Voiced Uvular (Fricative NonSibilant) -> True
    Pulmonic _ Uvular Trill -> True
    Pulmonic _ place manner
        | place `elem` [ Alveolar, Retroflex ] -> case manner of
            Approximant -> True
            Trill       -> True
            Flap        -> True
            _           -> False
        | otherwise -> False
    _ -> False

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