{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Language.IPA.Types
-- Copyright   : (c) 2021 Rory Tyler Hayford
--
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
--  Types representing segments representable in the IPA
module Language.IPA.Types
    ( -- * Notation systems
      IPA(..)
    , mkIPA
    , XSampa(XSampa)
      -- * Segments
    , Segment(..)
      -- ** Consonants (pulmonic and non-pulmonic)
    , Consonant(..)
      -- **** Convenience patterns
      -- $pat
    , pattern PulmonicConsonant
    , pattern EjectiveConsonant
    , pattern ClickConsonant
    , pattern ImplosiveConsonant
      -- *** Consonant features
    , Manner(..)
    , Place(..)
    , Phonation(..)
    , Sibilance(..)
      -- ** Vowel features
    , Height(..)
    , Backness(..)
    , Roundedness(..)
      -- * Suprasegmentals
    , Syllable(..)
      -- ** Suprasegmental features
    , SuprasegmentalFeature(..)
    , ToneContour(..)
    , LevelTone(..)
    , Stress(..)
      -- ** Segmental articulatory features
    , Length(..)
    , SegmentalFeature(..)
      -- * Errors
    , IPAException(..)
    ) where

import           Control.Exception   ( Exception )

import           Data.Text           ( Text )
import           Data.Text.Normalize ( NormalizationMode(NFC), normalize )

import           GHC.Generics        ( Generic )

-- | Textual representation of a speech segment or grouping of segments, with
-- zero or more articulatory features; encoded in IPA transcription. Note this
-- has a 'Semigroup' instance, so various 'IPA's can conveniently be concatenated
-- with @<>@
newtype IPA = IPA
    { IPA -> Text
unIPA :: Text
      -- ^ The 'Text' value should be 'normalize'd to 'NFC'
    }
    deriving ( Int -> IPA -> ShowS
[IPA] -> ShowS
IPA -> String
(Int -> IPA -> ShowS)
-> (IPA -> String) -> ([IPA] -> ShowS) -> Show IPA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPA] -> ShowS
$cshowList :: [IPA] -> ShowS
show :: IPA -> String
$cshow :: IPA -> String
showsPrec :: Int -> IPA -> ShowS
$cshowsPrec :: Int -> IPA -> ShowS
Show, IPA -> IPA -> Bool
(IPA -> IPA -> Bool) -> (IPA -> IPA -> Bool) -> Eq IPA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPA -> IPA -> Bool
$c/= :: IPA -> IPA -> Bool
== :: IPA -> IPA -> Bool
$c== :: IPA -> IPA -> Bool
Eq, (forall x. IPA -> Rep IPA x)
-> (forall x. Rep IPA x -> IPA) -> Generic IPA
forall x. Rep IPA x -> IPA
forall x. IPA -> Rep IPA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IPA x -> IPA
$cfrom :: forall x. IPA -> Rep IPA x
Generic, b -> IPA -> IPA
NonEmpty IPA -> IPA
IPA -> IPA -> IPA
(IPA -> IPA -> IPA)
-> (NonEmpty IPA -> IPA)
-> (forall b. Integral b => b -> IPA -> IPA)
-> Semigroup IPA
forall b. Integral b => b -> IPA -> IPA
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> IPA -> IPA
$cstimes :: forall b. Integral b => b -> IPA -> IPA
sconcat :: NonEmpty IPA -> IPA
$csconcat :: NonEmpty IPA -> IPA
<> :: IPA -> IPA -> IPA
$c<> :: IPA -> IPA -> IPA
Semigroup )

-- | 'normalize's 'Text' value to 'NFC' before wrapping it in 'IPA'. This is to
-- ensure the comparability of 'IPA' values
mkIPA :: Text -> IPA
mkIPA :: Text -> IPA
mkIPA = Text -> IPA
IPA (Text -> IPA) -> (Text -> Text) -> Text -> IPA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizationMode -> Text -> Text
normalize NormalizationMode
NFC

-- | X-SAMPA is an ASCII encoding of the IPA (ca. 1993). Note that fewer
-- transcriptions are possible using X-SAMPA than the IPA, so certain valid
-- 'IPA' 'Segments's have no direct equivalence using 'XSampa'. As with 'IPA',
-- 'XSampa' is an instance of 'Semigroup'
newtype XSampa = XSampa
    { XSampa -> Text
unXSampa :: Text
      -- ^ The wrapped 'Text' should only contained 7-bit ASCII characters
    }
    deriving ( Int -> XSampa -> ShowS
[XSampa] -> ShowS
XSampa -> String
(Int -> XSampa -> ShowS)
-> (XSampa -> String) -> ([XSampa] -> ShowS) -> Show XSampa
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XSampa] -> ShowS
$cshowList :: [XSampa] -> ShowS
show :: XSampa -> String
$cshow :: XSampa -> String
showsPrec :: Int -> XSampa -> ShowS
$cshowsPrec :: Int -> XSampa -> ShowS
Show, XSampa -> XSampa -> Bool
(XSampa -> XSampa -> Bool)
-> (XSampa -> XSampa -> Bool) -> Eq XSampa
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XSampa -> XSampa -> Bool
$c/= :: XSampa -> XSampa -> Bool
== :: XSampa -> XSampa -> Bool
$c== :: XSampa -> XSampa -> Bool
Eq, (forall x. XSampa -> Rep XSampa x)
-> (forall x. Rep XSampa x -> XSampa) -> Generic XSampa
forall x. Rep XSampa x -> XSampa
forall x. XSampa -> Rep XSampa x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XSampa x -> XSampa
$cfrom :: forall x. XSampa -> Rep XSampa x
Generic, b -> XSampa -> XSampa
NonEmpty XSampa -> XSampa
XSampa -> XSampa -> XSampa
(XSampa -> XSampa -> XSampa)
-> (NonEmpty XSampa -> XSampa)
-> (forall b. Integral b => b -> XSampa -> XSampa)
-> Semigroup XSampa
forall b. Integral b => b -> XSampa -> XSampa
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> XSampa -> XSampa
$cstimes :: forall b. Integral b => b -> XSampa -> XSampa
sconcat :: NonEmpty XSampa -> XSampa
$csconcat :: NonEmpty XSampa -> XSampa
<> :: XSampa -> XSampa -> XSampa
$c<> :: XSampa -> XSampa -> XSampa
Semigroup )

-- | A single segment, or combination of a segment and articulatory feature
data Segment
    = Consonant Consonant -- ^ Pulmonic and non-pulmonic consonants
    | Vowel Height Backness Roundedness
    | Zero -- ^ A null/zero phone
    | WithSegmentalFeature SegmentalFeature Segment -- ^ Various other articulatory features
    deriving ( Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
(Int -> Segment -> ShowS)
-> (Segment -> String) -> ([Segment] -> ShowS) -> Show Segment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment] -> ShowS
$cshowList :: [Segment] -> ShowS
show :: Segment -> String
$cshow :: Segment -> String
showsPrec :: Int -> Segment -> ShowS
$cshowsPrec :: Int -> Segment -> ShowS
Show, Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c== :: Segment -> Segment -> Bool
Eq, (forall x. Segment -> Rep Segment x)
-> (forall x. Rep Segment x -> Segment) -> Generic Segment
forall x. Rep Segment x -> Segment
forall x. Segment -> Rep Segment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Segment x -> Segment
$cfrom :: forall x. Segment -> Rep Segment x
Generic )

-- | Multiple segments, or combination of multiple segments with
-- suprasegmental feature
data Syllable t
    = Syllable (t Segment)
      -- ^ A grouping of segments without extra suprasegmental information
    | WithSuprasegmentalFeature SuprasegmentalFeature (Syllable t)
      -- ^ Articulatory features that affect/encompass the entire syllable
    deriving ( (forall x. Syllable t -> Rep (Syllable t) x)
-> (forall x. Rep (Syllable t) x -> Syllable t)
-> Generic (Syllable t)
forall x. Rep (Syllable t) x -> Syllable t
forall x. Syllable t -> Rep (Syllable t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (t :: * -> *) x. Rep (Syllable t) x -> Syllable t
forall (t :: * -> *) x. Syllable t -> Rep (Syllable t) x
$cto :: forall (t :: * -> *) x. Rep (Syllable t) x -> Syllable t
$cfrom :: forall (t :: * -> *) x. Syllable t -> Rep (Syllable t) x
Generic )

deriving instance Show (t Segment) => Show (Syllable t)

deriving instance Eq (t Segment) => Eq (Syllable t)

-- | Pulmonic and non-pulmonic consonants
data Consonant
    = Pulmonic Phonation Place Manner
    | Ejective Place Manner
    | Implosive Phonation Place
    | Click Place
    | DoublyArticulated Phonation Place Place Manner
    deriving ( Int -> Consonant -> ShowS
[Consonant] -> ShowS
Consonant -> String
(Int -> Consonant -> ShowS)
-> (Consonant -> String)
-> ([Consonant] -> ShowS)
-> Show Consonant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Consonant] -> ShowS
$cshowList :: [Consonant] -> ShowS
show :: Consonant -> String
$cshow :: Consonant -> String
showsPrec :: Int -> Consonant -> ShowS
$cshowsPrec :: Int -> Consonant -> ShowS
Show, Consonant -> Consonant -> Bool
(Consonant -> Consonant -> Bool)
-> (Consonant -> Consonant -> Bool) -> Eq Consonant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Consonant -> Consonant -> Bool
$c/= :: Consonant -> Consonant -> Bool
== :: Consonant -> Consonant -> Bool
$c== :: Consonant -> Consonant -> Bool
Eq, (forall x. Consonant -> Rep Consonant x)
-> (forall x. Rep Consonant x -> Consonant) -> Generic Consonant
forall x. Rep Consonant x -> Consonant
forall x. Consonant -> Rep Consonant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Consonant x -> Consonant
$cfrom :: forall x. Consonant -> Rep Consonant x
Generic )

-- $pat
-- These are convenience patterns for creating different types of 'Consonant'
-- 'Segment's, as the nesting of data constructors might otherwise be somewhat
-- troublesome
pattern PulmonicConsonant :: Phonation -> Place -> Manner -> Segment
pattern $bPulmonicConsonant :: Phonation -> Place -> Manner -> Segment
$mPulmonicConsonant :: forall r.
Segment -> (Phonation -> Place -> Manner -> r) -> (Void# -> r) -> r
PulmonicConsonant ph pl m = Consonant (Pulmonic ph pl m)

pattern EjectiveConsonant :: Place -> Manner -> Segment
pattern $bEjectiveConsonant :: Place -> Manner -> Segment
$mEjectiveConsonant :: forall r. Segment -> (Place -> Manner -> r) -> (Void# -> r) -> r
EjectiveConsonant pl m = Consonant (Ejective pl m)

pattern ClickConsonant :: Place -> Segment
pattern $bClickConsonant :: Place -> Segment
$mClickConsonant :: forall r. Segment -> (Place -> r) -> (Void# -> r) -> r
ClickConsonant pl = Consonant (Click pl)

pattern ImplosiveConsonant :: Phonation -> Place -> Segment
pattern $bImplosiveConsonant :: Phonation -> Place -> Segment
$mImplosiveConsonant :: forall r. Segment -> (Phonation -> Place -> r) -> (Void# -> r) -> r
ImplosiveConsonant ph pl = Consonant (Implosive ph pl)

-- | Consonantal manner of articulation
data Manner
    = Nasal
    | Plosive
    | Fricative Sibilance
    | Affricate Sibilance
    | Approximant
    | Flap
    | Trill
    | LateralAffricate
    | LateralFricative
    | LateralApproximant
    | LateralFlap
    deriving ( Int -> Manner -> ShowS
[Manner] -> ShowS
Manner -> String
(Int -> Manner -> ShowS)
-> (Manner -> String) -> ([Manner] -> ShowS) -> Show Manner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Manner] -> ShowS
$cshowList :: [Manner] -> ShowS
show :: Manner -> String
$cshow :: Manner -> String
showsPrec :: Int -> Manner -> ShowS
$cshowsPrec :: Int -> Manner -> ShowS
Show, Manner -> Manner -> Bool
(Manner -> Manner -> Bool)
-> (Manner -> Manner -> Bool) -> Eq Manner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Manner -> Manner -> Bool
$c/= :: Manner -> Manner -> Bool
== :: Manner -> Manner -> Bool
$c== :: Manner -> Manner -> Bool
Eq, (forall x. Manner -> Rep Manner x)
-> (forall x. Rep Manner x -> Manner) -> Generic Manner
forall x. Rep Manner x -> Manner
forall x. Manner -> Rep Manner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Manner x -> Manner
$cfrom :: forall x. Manner -> Rep Manner x
Generic )

-- | Consonantal place of articulation
data Place
    = Bilabial
    | LabioDental
    | LinguoLabial
    | Dental
    | Alveolar
    | PostAlveolar
    | Retroflex
    | Palatal
    | Velar
    | Uvular
    | Pharyngeal
    | Glottal
    deriving ( Int -> Place -> ShowS
[Place] -> ShowS
Place -> String
(Int -> Place -> ShowS)
-> (Place -> String) -> ([Place] -> ShowS) -> Show Place
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Place] -> ShowS
$cshowList :: [Place] -> ShowS
show :: Place -> String
$cshow :: Place -> String
showsPrec :: Int -> Place -> ShowS
$cshowsPrec :: Int -> Place -> ShowS
Show, Place -> Place -> Bool
(Place -> Place -> Bool) -> (Place -> Place -> Bool) -> Eq Place
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Place -> Place -> Bool
$c/= :: Place -> Place -> Bool
== :: Place -> Place -> Bool
$c== :: Place -> Place -> Bool
Eq, (forall x. Place -> Rep Place x)
-> (forall x. Rep Place x -> Place) -> Generic Place
forall x. Rep Place x -> Place
forall x. Place -> Rep Place x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Place x -> Place
$cfrom :: forall x. Place -> Rep Place x
Generic, Eq Place
Eq Place =>
(Place -> Place -> Ordering)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Bool)
-> (Place -> Place -> Place)
-> (Place -> Place -> Place)
-> Ord Place
Place -> Place -> Bool
Place -> Place -> Ordering
Place -> Place -> Place
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Place -> Place -> Place
$cmin :: Place -> Place -> Place
max :: Place -> Place -> Place
$cmax :: Place -> Place -> Place
>= :: Place -> Place -> Bool
$c>= :: Place -> Place -> Bool
> :: Place -> Place -> Bool
$c> :: Place -> Place -> Bool
<= :: Place -> Place -> Bool
$c<= :: Place -> Place -> Bool
< :: Place -> Place -> Bool
$c< :: Place -> Place -> Bool
compare :: Place -> Place -> Ordering
$ccompare :: Place -> Place -> Ordering
$cp1Ord :: Eq Place
Ord )

-- | Phonation (voicing)
data Phonation = Voiced | Voiceless
    deriving ( Int -> Phonation -> ShowS
[Phonation] -> ShowS
Phonation -> String
(Int -> Phonation -> ShowS)
-> (Phonation -> String)
-> ([Phonation] -> ShowS)
-> Show Phonation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phonation] -> ShowS
$cshowList :: [Phonation] -> ShowS
show :: Phonation -> String
$cshow :: Phonation -> String
showsPrec :: Int -> Phonation -> ShowS
$cshowsPrec :: Int -> Phonation -> ShowS
Show, Phonation -> Phonation -> Bool
(Phonation -> Phonation -> Bool)
-> (Phonation -> Phonation -> Bool) -> Eq Phonation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phonation -> Phonation -> Bool
$c/= :: Phonation -> Phonation -> Bool
== :: Phonation -> Phonation -> Bool
$c== :: Phonation -> Phonation -> Bool
Eq, (forall x. Phonation -> Rep Phonation x)
-> (forall x. Rep Phonation x -> Phonation) -> Generic Phonation
forall x. Rep Phonation x -> Phonation
forall x. Phonation -> Rep Phonation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Phonation x -> Phonation
$cfrom :: forall x. Phonation -> Rep Phonation x
Generic )

-- | Sibilance for fricative consonants
data Sibilance = Sibilant | NonSibilant
    deriving ( Int -> Sibilance -> ShowS
[Sibilance] -> ShowS
Sibilance -> String
(Int -> Sibilance -> ShowS)
-> (Sibilance -> String)
-> ([Sibilance] -> ShowS)
-> Show Sibilance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sibilance] -> ShowS
$cshowList :: [Sibilance] -> ShowS
show :: Sibilance -> String
$cshow :: Sibilance -> String
showsPrec :: Int -> Sibilance -> ShowS
$cshowsPrec :: Int -> Sibilance -> ShowS
Show, Sibilance -> Sibilance -> Bool
(Sibilance -> Sibilance -> Bool)
-> (Sibilance -> Sibilance -> Bool) -> Eq Sibilance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sibilance -> Sibilance -> Bool
$c/= :: Sibilance -> Sibilance -> Bool
== :: Sibilance -> Sibilance -> Bool
$c== :: Sibilance -> Sibilance -> Bool
Eq, (forall x. Sibilance -> Rep Sibilance x)
-> (forall x. Rep Sibilance x -> Sibilance) -> Generic Sibilance
forall x. Rep Sibilance x -> Sibilance
forall x. Sibilance -> Rep Sibilance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sibilance x -> Sibilance
$cfrom :: forall x. Sibilance -> Rep Sibilance x
Generic )

-- | Vowel height
data Height = Close | NearClose | CloseMid | Mid | OpenMid | NearOpen | Open
    deriving ( Int -> Height -> ShowS
[Height] -> ShowS
Height -> String
(Int -> Height -> ShowS)
-> (Height -> String) -> ([Height] -> ShowS) -> Show Height
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Height] -> ShowS
$cshowList :: [Height] -> ShowS
show :: Height -> String
$cshow :: Height -> String
showsPrec :: Int -> Height -> ShowS
$cshowsPrec :: Int -> Height -> ShowS
Show, Height -> Height -> Bool
(Height -> Height -> Bool)
-> (Height -> Height -> Bool) -> Eq Height
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Height -> Height -> Bool
$c/= :: Height -> Height -> Bool
== :: Height -> Height -> Bool
$c== :: Height -> Height -> Bool
Eq, (forall x. Height -> Rep Height x)
-> (forall x. Rep Height x -> Height) -> Generic Height
forall x. Rep Height x -> Height
forall x. Height -> Rep Height x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Height x -> Height
$cfrom :: forall x. Height -> Rep Height x
Generic )

-- | Vowel backness
data Backness = Front | NearFront | Central | NearBack | Back
    deriving ( Int -> Backness -> ShowS
[Backness] -> ShowS
Backness -> String
(Int -> Backness -> ShowS)
-> (Backness -> String) -> ([Backness] -> ShowS) -> Show Backness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backness] -> ShowS
$cshowList :: [Backness] -> ShowS
show :: Backness -> String
$cshow :: Backness -> String
showsPrec :: Int -> Backness -> ShowS
$cshowsPrec :: Int -> Backness -> ShowS
Show, Backness -> Backness -> Bool
(Backness -> Backness -> Bool)
-> (Backness -> Backness -> Bool) -> Eq Backness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backness -> Backness -> Bool
$c/= :: Backness -> Backness -> Bool
== :: Backness -> Backness -> Bool
$c== :: Backness -> Backness -> Bool
Eq, (forall x. Backness -> Rep Backness x)
-> (forall x. Rep Backness x -> Backness) -> Generic Backness
forall x. Rep Backness x -> Backness
forall x. Backness -> Rep Backness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Backness x -> Backness
$cfrom :: forall x. Backness -> Rep Backness x
Generic, Eq Backness
Eq Backness =>
(Backness -> Backness -> Ordering)
-> (Backness -> Backness -> Bool)
-> (Backness -> Backness -> Bool)
-> (Backness -> Backness -> Bool)
-> (Backness -> Backness -> Bool)
-> (Backness -> Backness -> Backness)
-> (Backness -> Backness -> Backness)
-> Ord Backness
Backness -> Backness -> Bool
Backness -> Backness -> Ordering
Backness -> Backness -> Backness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Backness -> Backness -> Backness
$cmin :: Backness -> Backness -> Backness
max :: Backness -> Backness -> Backness
$cmax :: Backness -> Backness -> Backness
>= :: Backness -> Backness -> Bool
$c>= :: Backness -> Backness -> Bool
> :: Backness -> Backness -> Bool
$c> :: Backness -> Backness -> Bool
<= :: Backness -> Backness -> Bool
$c<= :: Backness -> Backness -> Bool
< :: Backness -> Backness -> Bool
$c< :: Backness -> Backness -> Bool
compare :: Backness -> Backness -> Ordering
$ccompare :: Backness -> Backness -> Ordering
$cp1Ord :: Eq Backness
Ord )

-- | Vowel roundedness
data Roundedness = Rounded | Unrounded
    deriving ( Int -> Roundedness -> ShowS
[Roundedness] -> ShowS
Roundedness -> String
(Int -> Roundedness -> ShowS)
-> (Roundedness -> String)
-> ([Roundedness] -> ShowS)
-> Show Roundedness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Roundedness] -> ShowS
$cshowList :: [Roundedness] -> ShowS
show :: Roundedness -> String
$cshow :: Roundedness -> String
showsPrec :: Int -> Roundedness -> ShowS
$cshowsPrec :: Int -> Roundedness -> ShowS
Show, Roundedness -> Roundedness -> Bool
(Roundedness -> Roundedness -> Bool)
-> (Roundedness -> Roundedness -> Bool) -> Eq Roundedness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Roundedness -> Roundedness -> Bool
$c/= :: Roundedness -> Roundedness -> Bool
== :: Roundedness -> Roundedness -> Bool
$c== :: Roundedness -> Roundedness -> Bool
Eq, (forall x. Roundedness -> Rep Roundedness x)
-> (forall x. Rep Roundedness x -> Roundedness)
-> Generic Roundedness
forall x. Rep Roundedness x -> Roundedness
forall x. Roundedness -> Rep Roundedness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Roundedness x -> Roundedness
$cfrom :: forall x. Roundedness -> Rep Roundedness x
Generic )

-- | Lexical tone with Chao-style tone letters
data LevelTone
    = ExtraHighTone
    | HighTone
    | MidTone
    | LowTone
    | ExtraLowTone
    | DownStep
    | UpStep
    deriving ( Int -> LevelTone -> ShowS
[LevelTone] -> ShowS
LevelTone -> String
(Int -> LevelTone -> ShowS)
-> (LevelTone -> String)
-> ([LevelTone] -> ShowS)
-> Show LevelTone
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LevelTone] -> ShowS
$cshowList :: [LevelTone] -> ShowS
show :: LevelTone -> String
$cshow :: LevelTone -> String
showsPrec :: Int -> LevelTone -> ShowS
$cshowsPrec :: Int -> LevelTone -> ShowS
Show, LevelTone -> LevelTone -> Bool
(LevelTone -> LevelTone -> Bool)
-> (LevelTone -> LevelTone -> Bool) -> Eq LevelTone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LevelTone -> LevelTone -> Bool
$c/= :: LevelTone -> LevelTone -> Bool
== :: LevelTone -> LevelTone -> Bool
$c== :: LevelTone -> LevelTone -> Bool
Eq, (forall x. LevelTone -> Rep LevelTone x)
-> (forall x. Rep LevelTone x -> LevelTone) -> Generic LevelTone
forall x. Rep LevelTone x -> LevelTone
forall x. LevelTone -> Rep LevelTone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LevelTone x -> LevelTone
$cfrom :: forall x. LevelTone -> Rep LevelTone x
Generic, Eq LevelTone
Eq LevelTone =>
(LevelTone -> LevelTone -> Ordering)
-> (LevelTone -> LevelTone -> Bool)
-> (LevelTone -> LevelTone -> Bool)
-> (LevelTone -> LevelTone -> Bool)
-> (LevelTone -> LevelTone -> Bool)
-> (LevelTone -> LevelTone -> LevelTone)
-> (LevelTone -> LevelTone -> LevelTone)
-> Ord LevelTone
LevelTone -> LevelTone -> Bool
LevelTone -> LevelTone -> Ordering
LevelTone -> LevelTone -> LevelTone
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LevelTone -> LevelTone -> LevelTone
$cmin :: LevelTone -> LevelTone -> LevelTone
max :: LevelTone -> LevelTone -> LevelTone
$cmax :: LevelTone -> LevelTone -> LevelTone
>= :: LevelTone -> LevelTone -> Bool
$c>= :: LevelTone -> LevelTone -> Bool
> :: LevelTone -> LevelTone -> Bool
$c> :: LevelTone -> LevelTone -> Bool
<= :: LevelTone -> LevelTone -> Bool
$c<= :: LevelTone -> LevelTone -> Bool
< :: LevelTone -> LevelTone -> Bool
$c< :: LevelTone -> LevelTone -> Bool
compare :: LevelTone -> LevelTone -> Ordering
$ccompare :: LevelTone -> LevelTone -> Ordering
$cp1Ord :: Eq LevelTone
Ord )

-- | Lexical tone represented as a contour
data ToneContour
    = Rising
    | Falling
    | HighRising
    | LowRising
    | HighFalling
    | LowFalling
    | RisingFalling
    | FallingRising
    | GlobalRise
    | GlobalFall
    deriving ( Int -> ToneContour -> ShowS
[ToneContour] -> ShowS
ToneContour -> String
(Int -> ToneContour -> ShowS)
-> (ToneContour -> String)
-> ([ToneContour] -> ShowS)
-> Show ToneContour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToneContour] -> ShowS
$cshowList :: [ToneContour] -> ShowS
show :: ToneContour -> String
$cshow :: ToneContour -> String
showsPrec :: Int -> ToneContour -> ShowS
$cshowsPrec :: Int -> ToneContour -> ShowS
Show, ToneContour -> ToneContour -> Bool
(ToneContour -> ToneContour -> Bool)
-> (ToneContour -> ToneContour -> Bool) -> Eq ToneContour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToneContour -> ToneContour -> Bool
$c/= :: ToneContour -> ToneContour -> Bool
== :: ToneContour -> ToneContour -> Bool
$c== :: ToneContour -> ToneContour -> Bool
Eq, (forall x. ToneContour -> Rep ToneContour x)
-> (forall x. Rep ToneContour x -> ToneContour)
-> Generic ToneContour
forall x. Rep ToneContour x -> ToneContour
forall x. ToneContour -> Rep ToneContour x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ToneContour x -> ToneContour
$cfrom :: forall x. ToneContour -> Rep ToneContour x
Generic, Eq ToneContour
Eq ToneContour =>
(ToneContour -> ToneContour -> Ordering)
-> (ToneContour -> ToneContour -> Bool)
-> (ToneContour -> ToneContour -> Bool)
-> (ToneContour -> ToneContour -> Bool)
-> (ToneContour -> ToneContour -> Bool)
-> (ToneContour -> ToneContour -> ToneContour)
-> (ToneContour -> ToneContour -> ToneContour)
-> Ord ToneContour
ToneContour -> ToneContour -> Bool
ToneContour -> ToneContour -> Ordering
ToneContour -> ToneContour -> ToneContour
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ToneContour -> ToneContour -> ToneContour
$cmin :: ToneContour -> ToneContour -> ToneContour
max :: ToneContour -> ToneContour -> ToneContour
$cmax :: ToneContour -> ToneContour -> ToneContour
>= :: ToneContour -> ToneContour -> Bool
$c>= :: ToneContour -> ToneContour -> Bool
> :: ToneContour -> ToneContour -> Bool
$c> :: ToneContour -> ToneContour -> Bool
<= :: ToneContour -> ToneContour -> Bool
$c<= :: ToneContour -> ToneContour -> Bool
< :: ToneContour -> ToneContour -> Bool
$c< :: ToneContour -> ToneContour -> Bool
compare :: ToneContour -> ToneContour -> Ordering
$ccompare :: ToneContour -> ToneContour -> Ordering
$cp1Ord :: Eq ToneContour
Ord )

-- | Vowel length; also serves as a notation for consonant gemination in the IPA
data Length
    = OverLong
    | HalfLong
    | Long
    | Short
      -- ^ The default/unmarked length; using this constructor doesn't affect the
      -- default IPA representation of the segment
    | ExtraShort
    deriving ( Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
(Int -> Length -> ShowS)
-> (Length -> String) -> ([Length] -> ShowS) -> Show Length
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> String
$cshow :: Length -> String
showsPrec :: Int -> Length -> ShowS
$cshowsPrec :: Int -> Length -> ShowS
Show, Length -> Length -> Bool
(Length -> Length -> Bool)
-> (Length -> Length -> Bool) -> Eq Length
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq, (forall x. Length -> Rep Length x)
-> (forall x. Rep Length x -> Length) -> Generic Length
forall x. Rep Length x -> Length
forall x. Length -> Rep Length x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Length x -> Length
$cfrom :: forall x. Length -> Rep Length x
Generic, Eq Length
Eq Length =>
(Length -> Length -> Ordering)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Bool)
-> (Length -> Length -> Length)
-> (Length -> Length -> Length)
-> Ord Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmax :: Length -> Length -> Length
>= :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c< :: Length -> Length -> Bool
compare :: Length -> Length -> Ordering
$ccompare :: Length -> Length -> Ordering
$cp1Ord :: Eq Length
Ord )

-- | Various articulatory features with a diacritic represenation in the IPA.
-- These can be combined with 'Segment's using the 'WithSegmentalFeature'
-- constructor of that type to produce a 'Segment' annotated with a given
-- articulatory feature, e.g.:
--
-- >>> toIPA $ WithSegmentalFeature (Length Long) (Vowel Close Front Unrounded)
-- Just (IPA "i\720") -- iː
data SegmentalFeature
    = Voicing Phonation
    | Length Length
    | SecondaryArticulation Segment
    | SuperScriptNumeric Int
    | Aspirated
    | MoreRounded
    | LessRounded
    | Advanced
    | Retracted
    | Centralized
    | MidCentralized
    | Compressed
    | Syllabic
    | NonSyllabic
    | Rhotacized
    | BreathyVoice
    | CreakyVoice
    | LinguoLabialized
    | Labialized
    | Palatalized
    | Velarized
    | Pharyngealized
    | Raised
    | Lowered
    | AdvancedTongueRoot
    | RetractedTongueRoot
    | Dentalized
    | Apical
    | Laminal
    | Nasalized
    | NasalRelease
    | LateralRelease
    | NoAudibleRelease
    deriving ( Int -> SegmentalFeature -> ShowS
[SegmentalFeature] -> ShowS
SegmentalFeature -> String
(Int -> SegmentalFeature -> ShowS)
-> (SegmentalFeature -> String)
-> ([SegmentalFeature] -> ShowS)
-> Show SegmentalFeature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentalFeature] -> ShowS
$cshowList :: [SegmentalFeature] -> ShowS
show :: SegmentalFeature -> String
$cshow :: SegmentalFeature -> String
showsPrec :: Int -> SegmentalFeature -> ShowS
$cshowsPrec :: Int -> SegmentalFeature -> ShowS
Show, SegmentalFeature -> SegmentalFeature -> Bool
(SegmentalFeature -> SegmentalFeature -> Bool)
-> (SegmentalFeature -> SegmentalFeature -> Bool)
-> Eq SegmentalFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentalFeature -> SegmentalFeature -> Bool
$c/= :: SegmentalFeature -> SegmentalFeature -> Bool
== :: SegmentalFeature -> SegmentalFeature -> Bool
$c== :: SegmentalFeature -> SegmentalFeature -> Bool
Eq, (forall x. SegmentalFeature -> Rep SegmentalFeature x)
-> (forall x. Rep SegmentalFeature x -> SegmentalFeature)
-> Generic SegmentalFeature
forall x. Rep SegmentalFeature x -> SegmentalFeature
forall x. SegmentalFeature -> Rep SegmentalFeature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentalFeature x -> SegmentalFeature
$cfrom :: forall x. SegmentalFeature -> Rep SegmentalFeature x
Generic )

data Stress = Primary | Secondary
    deriving ( Int -> Stress -> ShowS
[Stress] -> ShowS
Stress -> String
(Int -> Stress -> ShowS)
-> (Stress -> String) -> ([Stress] -> ShowS) -> Show Stress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stress] -> ShowS
$cshowList :: [Stress] -> ShowS
show :: Stress -> String
$cshow :: Stress -> String
showsPrec :: Int -> Stress -> ShowS
$cshowsPrec :: Int -> Stress -> ShowS
Show, Stress -> Stress -> Bool
(Stress -> Stress -> Bool)
-> (Stress -> Stress -> Bool) -> Eq Stress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stress -> Stress -> Bool
$c/= :: Stress -> Stress -> Bool
== :: Stress -> Stress -> Bool
$c== :: Stress -> Stress -> Bool
Eq, (forall x. Stress -> Rep Stress x)
-> (forall x. Rep Stress x -> Stress) -> Generic Stress
forall x. Rep Stress x -> Stress
forall x. Stress -> Rep Stress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stress x -> Stress
$cfrom :: forall x. Stress -> Rep Stress x
Generic, Eq Stress
Eq Stress =>
(Stress -> Stress -> Ordering)
-> (Stress -> Stress -> Bool)
-> (Stress -> Stress -> Bool)
-> (Stress -> Stress -> Bool)
-> (Stress -> Stress -> Bool)
-> (Stress -> Stress -> Stress)
-> (Stress -> Stress -> Stress)
-> Ord Stress
Stress -> Stress -> Bool
Stress -> Stress -> Ordering
Stress -> Stress -> Stress
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Stress -> Stress -> Stress
$cmin :: Stress -> Stress -> Stress
max :: Stress -> Stress -> Stress
$cmax :: Stress -> Stress -> Stress
>= :: Stress -> Stress -> Bool
$c>= :: Stress -> Stress -> Bool
> :: Stress -> Stress -> Bool
$c> :: Stress -> Stress -> Bool
<= :: Stress -> Stress -> Bool
$c<= :: Stress -> Stress -> Bool
< :: Stress -> Stress -> Bool
$c< :: Stress -> Stress -> Bool
compare :: Stress -> Stress -> Ordering
$ccompare :: Stress -> Stress -> Ordering
$cp1Ord :: Eq Stress
Ord )

data SuprasegmentalFeature
    = LevelLexicalTone LevelTone
      -- ^ Level lexical tones in Chao letters
    | LevelLexicalToneDiacritic LevelTone
      -- ^ Level lexical tones, diacritic. The tone is a combining character
    | LexicalToneContour ToneContour
      -- ^ Lexical tone contours in Chao letters
    | LexicalToneContourDiacritic ToneContour
      -- ^ Lexical tone contours, as diacritics. Each contour is a combining
      -- character
    | Stress Stress -- ^ Syllable stress
    | Break -- ^ Explicit syllable break
    | Linking -- ^ Absence of a break
    deriving ( Int -> SuprasegmentalFeature -> ShowS
[SuprasegmentalFeature] -> ShowS
SuprasegmentalFeature -> String
(Int -> SuprasegmentalFeature -> ShowS)
-> (SuprasegmentalFeature -> String)
-> ([SuprasegmentalFeature] -> ShowS)
-> Show SuprasegmentalFeature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SuprasegmentalFeature] -> ShowS
$cshowList :: [SuprasegmentalFeature] -> ShowS
show :: SuprasegmentalFeature -> String
$cshow :: SuprasegmentalFeature -> String
showsPrec :: Int -> SuprasegmentalFeature -> ShowS
$cshowsPrec :: Int -> SuprasegmentalFeature -> ShowS
Show, SuprasegmentalFeature -> SuprasegmentalFeature -> Bool
(SuprasegmentalFeature -> SuprasegmentalFeature -> Bool)
-> (SuprasegmentalFeature -> SuprasegmentalFeature -> Bool)
-> Eq SuprasegmentalFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SuprasegmentalFeature -> SuprasegmentalFeature -> Bool
$c/= :: SuprasegmentalFeature -> SuprasegmentalFeature -> Bool
== :: SuprasegmentalFeature -> SuprasegmentalFeature -> Bool
$c== :: SuprasegmentalFeature -> SuprasegmentalFeature -> Bool
Eq, (forall x. SuprasegmentalFeature -> Rep SuprasegmentalFeature x)
-> (forall x. Rep SuprasegmentalFeature x -> SuprasegmentalFeature)
-> Generic SuprasegmentalFeature
forall x. Rep SuprasegmentalFeature x -> SuprasegmentalFeature
forall x. SuprasegmentalFeature -> Rep SuprasegmentalFeature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SuprasegmentalFeature x -> SuprasegmentalFeature
$cfrom :: forall x. SuprasegmentalFeature -> Rep SuprasegmentalFeature x
Generic )

data IPAException = InvalidIPA Text | InvalidXSampa Text
    deriving ( Int -> IPAException -> ShowS
[IPAException] -> ShowS
IPAException -> String
(Int -> IPAException -> ShowS)
-> (IPAException -> String)
-> ([IPAException] -> ShowS)
-> Show IPAException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPAException] -> ShowS
$cshowList :: [IPAException] -> ShowS
show :: IPAException -> String
$cshow :: IPAException -> String
showsPrec :: Int -> IPAException -> ShowS
$cshowsPrec :: Int -> IPAException -> ShowS
Show, IPAException -> IPAException -> Bool
(IPAException -> IPAException -> Bool)
-> (IPAException -> IPAException -> Bool) -> Eq IPAException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPAException -> IPAException -> Bool
$c/= :: IPAException -> IPAException -> Bool
== :: IPAException -> IPAException -> Bool
$c== :: IPAException -> IPAException -> Bool
Eq, (forall x. IPAException -> Rep IPAException x)
-> (forall x. Rep IPAException x -> IPAException)
-> Generic IPAException
forall x. Rep IPAException x -> IPAException
forall x. IPAException -> Rep IPAException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IPAException x -> IPAException
$cfrom :: forall x. IPAException -> Rep IPAException x
Generic )

instance Exception IPAException