{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# 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(..)
    , mkXSampa
      -- * Segments
    , Segment(..)
      -- ** Consonants (pulmonic and non-pulmonic)
    , Consonant(..)
      -- *** Convenience patterns
      -- $pat
    , pattern PulmonicConsonant
    , pattern EjectiveConsonant
    , pattern ClickConsonant
    , pattern ImplosiveConsonant
    , pattern DoublyArticulatedConsonant
      -- *** Consonant features
    , Manner(..)
    , Place(..)
    , Phonation(..)
    , Sibilance(..)
      -- ** Vowels
    , Vowel(..)
      -- *** Convenience patterns
    , pattern PureVowel
    , pattern Diphthong
    , pattern Triphthong
      -- *** Vowel features
    , Height(..)
    , Backness(..)
    , Roundedness(..)
      -- * Suprasegmentals
    , MultiSegment
    , Syllable(..)
      -- ** Suprasegmental features
    , SuprasegmentalFeature(..)
    , ToneContour(..)
    , LevelTone(..)
    , Stress(..)
      -- ** Segmental articulatory features
    , Length(..)
    , SegmentalFeature(..)
      -- * Transcription delimiters
    , Delimiter(..)
      -- * Errors
    , IPAException(..)
    ) where

import           Control.Exception          ( Exception )

import           Data.Char                  ( isAscii )
import           Data.Data                  ( Data )
import           Data.Dynamic               ( Typeable )
import           Data.Text                  ( Text )
import qualified Data.Text                  as T
import           Data.Text.Normalize        ( NormalizationMode(NFC)
                                            , normalize
                                            )

import           GHC.Generics               ( Generic )

import           Language.Haskell.TH.Syntax ( Lift )

-- | 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' 'Segment'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 contain 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 )

-- | Wraps a 'Text' value in 'XSampa', provided the text only contains ASCII
-- characters
mkXSampa :: Text -> Maybe XSampa
mkXSampa :: Text -> Maybe XSampa
mkXSampa Text
t
    | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
t = XSampa -> Maybe XSampa
forall a. a -> Maybe a
Just (XSampa -> Maybe XSampa) -> XSampa -> Maybe XSampa
forall a b. (a -> b) -> a -> b
$ Text -> XSampa
XSampa Text
t
    | Bool
otherwise = Maybe XSampa
forall a. Maybe a
Nothing

-- | A single segment, or combination of a segment and articulatory feature
data Segment
    = Consonant Consonant -- ^ Pulmonic and non-pulmonic consonants
    | Vowel Vowel -- ^ Monoph-, diph-, and triphthongs
    | Zero -- ^ A null/zero phone
    | WithSegmentalFeature SegmentalFeature Segment -- ^ Various other articulatory features
    | Optional Segment
      -- ^ A segment that is conventionally surrounded by parentheses. This is not an
      -- official part of the IPA, but is nevertheless encountered fairly frequently
      -- in IPA notation in the wild
    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, Typeable Segment
DataType
Constr
Typeable Segment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Segment -> c Segment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Segment)
-> (Segment -> Constr)
-> (Segment -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Segment))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Segment))
-> ((forall b. Data b => b -> b) -> Segment -> Segment)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Segment -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Segment -> r)
-> (forall u. (forall d. Data d => d -> u) -> Segment -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Segment -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Segment -> m Segment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Segment -> m Segment)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Segment -> m Segment)
-> Data Segment
Segment -> DataType
Segment -> Constr
(forall b. Data b => b -> b) -> Segment -> Segment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment -> c Segment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Segment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Segment -> u
forall u. (forall d. Data d => d -> u) -> Segment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Segment -> m Segment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Segment -> m Segment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Segment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment -> c Segment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Segment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Segment)
$cOptional :: Constr
$cWithSegmentalFeature :: Constr
$cZero :: Constr
$cVowel :: Constr
$cConsonant :: Constr
$tSegment :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Segment -> m Segment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Segment -> m Segment
gmapMp :: (forall d. Data d => d -> m d) -> Segment -> m Segment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Segment -> m Segment
gmapM :: (forall d. Data d => d -> m d) -> Segment -> m Segment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Segment -> m Segment
gmapQi :: Int -> (forall d. Data d => d -> u) -> Segment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Segment -> u
gmapQ :: (forall d. Data d => d -> u) -> Segment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Segment -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Segment -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Segment -> r
gmapT :: (forall b. Data b => b -> b) -> Segment -> Segment
$cgmapT :: (forall b. Data b => b -> b) -> Segment -> Segment
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Segment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Segment)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Segment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Segment)
dataTypeOf :: Segment -> DataType
$cdataTypeOf :: Segment -> DataType
toConstr :: Segment -> Constr
$ctoConstr :: Segment -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Segment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Segment
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment -> c Segment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Segment -> c Segment
$cp1Data :: Typeable Segment
Data, Segment -> Q Exp
Segment -> Q (TExp Segment)
(Segment -> Q Exp) -> (Segment -> Q (TExp Segment)) -> Lift Segment
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Segment -> Q (TExp Segment)
$cliftTyped :: Segment -> Q (TExp Segment)
lift :: Segment -> Q Exp
$clift :: Segment -> Q Exp
Lift )

-- | 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)

deriving instance (Data (t Segment), Typeable t) => Data (Syllable t)

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

-- | Constraint synonym for syllable containers
type MultiSegment t = (Applicative t, Traversable t, Monoid (t Segment))

-- | Pulmonic and non-pulmonic consonants
data Consonant
    = Pulmonic Phonation Place Manner
    | Ejective Place Manner
    | Implosive Phonation Place
    | Click Place -- ^ 'PostAlveolar' place represents a lateral click
    | 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, Typeable Consonant
DataType
Constr
Typeable Consonant
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Consonant -> c Consonant)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Consonant)
-> (Consonant -> Constr)
-> (Consonant -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Consonant))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Consonant))
-> ((forall b. Data b => b -> b) -> Consonant -> Consonant)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Consonant -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Consonant -> r)
-> (forall u. (forall d. Data d => d -> u) -> Consonant -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Consonant -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Consonant -> m Consonant)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Consonant -> m Consonant)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Consonant -> m Consonant)
-> Data Consonant
Consonant -> DataType
Consonant -> Constr
(forall b. Data b => b -> b) -> Consonant -> Consonant
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Consonant -> c Consonant
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Consonant
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Consonant -> u
forall u. (forall d. Data d => d -> u) -> Consonant -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Consonant -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Consonant -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Consonant -> m Consonant
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Consonant -> m Consonant
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Consonant
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Consonant -> c Consonant
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Consonant)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Consonant)
$cDoublyArticulated :: Constr
$cClick :: Constr
$cImplosive :: Constr
$cEjective :: Constr
$cPulmonic :: Constr
$tConsonant :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Consonant -> m Consonant
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Consonant -> m Consonant
gmapMp :: (forall d. Data d => d -> m d) -> Consonant -> m Consonant
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Consonant -> m Consonant
gmapM :: (forall d. Data d => d -> m d) -> Consonant -> m Consonant
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Consonant -> m Consonant
gmapQi :: Int -> (forall d. Data d => d -> u) -> Consonant -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Consonant -> u
gmapQ :: (forall d. Data d => d -> u) -> Consonant -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Consonant -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Consonant -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Consonant -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Consonant -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Consonant -> r
gmapT :: (forall b. Data b => b -> b) -> Consonant -> Consonant
$cgmapT :: (forall b. Data b => b -> b) -> Consonant -> Consonant
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Consonant)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Consonant)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Consonant)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Consonant)
dataTypeOf :: Consonant -> DataType
$cdataTypeOf :: Consonant -> DataType
toConstr :: Consonant -> Constr
$ctoConstr :: Consonant -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Consonant
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Consonant
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Consonant -> c Consonant
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Consonant -> c Consonant
$cp1Data :: Typeable Consonant
Data, Consonant -> Q Exp
Consonant -> Q (TExp Consonant)
(Consonant -> Q Exp)
-> (Consonant -> Q (TExp Consonant)) -> Lift Consonant
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Consonant -> Q (TExp Consonant)
$cliftTyped :: Consonant -> Q (TExp Consonant)
lift :: Consonant -> Q Exp
$clift :: Consonant -> Q Exp
Lift )

-- $pat
-- These are convenience patterns for creating different types of 'Consonant'
-- 'Segment's, as the nesting of data constructors might otherwise be somewhat
-- tiresome
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)

pattern DoublyArticulatedConsonant
    :: Phonation -> Place -> Place -> Manner -> Segment
pattern $bDoublyArticulatedConsonant :: Phonation -> Place -> Place -> Manner -> Segment
$mDoublyArticulatedConsonant :: forall r.
Segment
-> (Phonation -> Place -> Place -> Manner -> r)
-> (Void# -> r)
-> r
DoublyArticulatedConsonant ph pl1 pl2 m =
    Consonant (DoublyArticulated ph pl1 pl2 m)

-- | 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, Typeable Manner
DataType
Constr
Typeable Manner
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Manner -> c Manner)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Manner)
-> (Manner -> Constr)
-> (Manner -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Manner))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Manner))
-> ((forall b. Data b => b -> b) -> Manner -> Manner)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Manner -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Manner -> r)
-> (forall u. (forall d. Data d => d -> u) -> Manner -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Manner -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Manner -> m Manner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Manner -> m Manner)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Manner -> m Manner)
-> Data Manner
Manner -> DataType
Manner -> Constr
(forall b. Data b => b -> b) -> Manner -> Manner
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Manner -> c Manner
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Manner
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Manner -> u
forall u. (forall d. Data d => d -> u) -> Manner -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Manner -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Manner -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Manner -> m Manner
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Manner -> m Manner
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Manner
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Manner -> c Manner
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Manner)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Manner)
$cLateralFlap :: Constr
$cLateralApproximant :: Constr
$cLateralFricative :: Constr
$cLateralAffricate :: Constr
$cTrill :: Constr
$cFlap :: Constr
$cApproximant :: Constr
$cAffricate :: Constr
$cFricative :: Constr
$cPlosive :: Constr
$cNasal :: Constr
$tManner :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Manner -> m Manner
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Manner -> m Manner
gmapMp :: (forall d. Data d => d -> m d) -> Manner -> m Manner
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Manner -> m Manner
gmapM :: (forall d. Data d => d -> m d) -> Manner -> m Manner
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Manner -> m Manner
gmapQi :: Int -> (forall d. Data d => d -> u) -> Manner -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Manner -> u
gmapQ :: (forall d. Data d => d -> u) -> Manner -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Manner -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Manner -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Manner -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Manner -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Manner -> r
gmapT :: (forall b. Data b => b -> b) -> Manner -> Manner
$cgmapT :: (forall b. Data b => b -> b) -> Manner -> Manner
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Manner)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Manner)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Manner)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Manner)
dataTypeOf :: Manner -> DataType
$cdataTypeOf :: Manner -> DataType
toConstr :: Manner -> Constr
$ctoConstr :: Manner -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Manner
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Manner
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Manner -> c Manner
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Manner -> c Manner
$cp1Data :: Typeable Manner
Data, Manner -> Q Exp
Manner -> Q (TExp Manner)
(Manner -> Q Exp) -> (Manner -> Q (TExp Manner)) -> Lift Manner
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Manner -> Q (TExp Manner)
$cliftTyped :: Manner -> Q (TExp Manner)
lift :: Manner -> Q Exp
$clift :: Manner -> Q Exp
Lift )

-- | 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, Typeable Place
DataType
Constr
Typeable Place
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Place -> c Place)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Place)
-> (Place -> Constr)
-> (Place -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Place))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place))
-> ((forall b. Data b => b -> b) -> Place -> Place)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r)
-> (forall u. (forall d. Data d => d -> u) -> Place -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Place -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Place -> m Place)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Place -> m Place)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Place -> m Place)
-> Data Place
Place -> DataType
Place -> Constr
(forall b. Data b => b -> b) -> Place -> Place
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Place -> u
forall u. (forall d. Data d => d -> u) -> Place -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Place -> m Place
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Place)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place)
$cGlottal :: Constr
$cPharyngeal :: Constr
$cUvular :: Constr
$cVelar :: Constr
$cPalatal :: Constr
$cRetroflex :: Constr
$cPostAlveolar :: Constr
$cAlveolar :: Constr
$cDental :: Constr
$cLinguoLabial :: Constr
$cLabioDental :: Constr
$cBilabial :: Constr
$tPlace :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Place -> m Place
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
gmapMp :: (forall d. Data d => d -> m d) -> Place -> m Place
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Place -> m Place
gmapM :: (forall d. Data d => d -> m d) -> Place -> m Place
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Place -> m Place
gmapQi :: Int -> (forall d. Data d => d -> u) -> Place -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Place -> u
gmapQ :: (forall d. Data d => d -> u) -> Place -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Place -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Place -> r
gmapT :: (forall b. Data b => b -> b) -> Place -> Place
$cgmapT :: (forall b. Data b => b -> b) -> Place -> Place
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Place)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Place)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Place)
dataTypeOf :: Place -> DataType
$cdataTypeOf :: Place -> DataType
toConstr :: Place -> Constr
$ctoConstr :: Place -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Place
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Place -> c Place
$cp1Data :: Typeable Place
Data, Place -> Q Exp
Place -> Q (TExp Place)
(Place -> Q Exp) -> (Place -> Q (TExp Place)) -> Lift Place
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Place -> Q (TExp Place)
$cliftTyped :: Place -> Q (TExp Place)
lift :: Place -> Q Exp
$clift :: Place -> Q Exp
Lift )

-- | 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, Typeable Phonation
DataType
Constr
Typeable Phonation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Phonation -> c Phonation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Phonation)
-> (Phonation -> Constr)
-> (Phonation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Phonation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Phonation))
-> ((forall b. Data b => b -> b) -> Phonation -> Phonation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Phonation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Phonation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Phonation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Phonation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Phonation -> m Phonation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Phonation -> m Phonation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Phonation -> m Phonation)
-> Data Phonation
Phonation -> DataType
Phonation -> Constr
(forall b. Data b => b -> b) -> Phonation -> Phonation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Phonation -> c Phonation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Phonation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Phonation -> u
forall u. (forall d. Data d => d -> u) -> Phonation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Phonation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Phonation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Phonation -> m Phonation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Phonation -> m Phonation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Phonation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Phonation -> c Phonation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Phonation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Phonation)
$cVoiceless :: Constr
$cVoiced :: Constr
$tPhonation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Phonation -> m Phonation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Phonation -> m Phonation
gmapMp :: (forall d. Data d => d -> m d) -> Phonation -> m Phonation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Phonation -> m Phonation
gmapM :: (forall d. Data d => d -> m d) -> Phonation -> m Phonation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Phonation -> m Phonation
gmapQi :: Int -> (forall d. Data d => d -> u) -> Phonation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Phonation -> u
gmapQ :: (forall d. Data d => d -> u) -> Phonation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Phonation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Phonation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Phonation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Phonation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Phonation -> r
gmapT :: (forall b. Data b => b -> b) -> Phonation -> Phonation
$cgmapT :: (forall b. Data b => b -> b) -> Phonation -> Phonation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Phonation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Phonation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Phonation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Phonation)
dataTypeOf :: Phonation -> DataType
$cdataTypeOf :: Phonation -> DataType
toConstr :: Phonation -> Constr
$ctoConstr :: Phonation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Phonation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Phonation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Phonation -> c Phonation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Phonation -> c Phonation
$cp1Data :: Typeable Phonation
Data, Phonation -> Q Exp
Phonation -> Q (TExp Phonation)
(Phonation -> Q Exp)
-> (Phonation -> Q (TExp Phonation)) -> Lift Phonation
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Phonation -> Q (TExp Phonation)
$cliftTyped :: Phonation -> Q (TExp Phonation)
lift :: Phonation -> Q Exp
$clift :: Phonation -> Q Exp
Lift )

-- | 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, Typeable Sibilance
DataType
Constr
Typeable Sibilance
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Sibilance -> c Sibilance)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Sibilance)
-> (Sibilance -> Constr)
-> (Sibilance -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Sibilance))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sibilance))
-> ((forall b. Data b => b -> b) -> Sibilance -> Sibilance)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Sibilance -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Sibilance -> r)
-> (forall u. (forall d. Data d => d -> u) -> Sibilance -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Sibilance -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Sibilance -> m Sibilance)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Sibilance -> m Sibilance)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Sibilance -> m Sibilance)
-> Data Sibilance
Sibilance -> DataType
Sibilance -> Constr
(forall b. Data b => b -> b) -> Sibilance -> Sibilance
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sibilance -> c Sibilance
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sibilance
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Sibilance -> u
forall u. (forall d. Data d => d -> u) -> Sibilance -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sibilance -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sibilance -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sibilance
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sibilance -> c Sibilance
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Sibilance)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sibilance)
$cNonSibilant :: Constr
$cSibilant :: Constr
$tSibilance :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
gmapMp :: (forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
gmapM :: (forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sibilance -> m Sibilance
gmapQi :: Int -> (forall d. Data d => d -> u) -> Sibilance -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Sibilance -> u
gmapQ :: (forall d. Data d => d -> u) -> Sibilance -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Sibilance -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sibilance -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sibilance -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sibilance -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sibilance -> r
gmapT :: (forall b. Data b => b -> b) -> Sibilance -> Sibilance
$cgmapT :: (forall b. Data b => b -> b) -> Sibilance -> Sibilance
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sibilance)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Sibilance)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Sibilance)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Sibilance)
dataTypeOf :: Sibilance -> DataType
$cdataTypeOf :: Sibilance -> DataType
toConstr :: Sibilance -> Constr
$ctoConstr :: Sibilance -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sibilance
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Sibilance
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sibilance -> c Sibilance
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sibilance -> c Sibilance
$cp1Data :: Typeable Sibilance
Data, Sibilance -> Q Exp
Sibilance -> Q (TExp Sibilance)
(Sibilance -> Q Exp)
-> (Sibilance -> Q (TExp Sibilance)) -> Lift Sibilance
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Sibilance -> Q (TExp Sibilance)
$cliftTyped :: Sibilance -> Q (TExp Sibilance)
lift :: Sibilance -> Q Exp
$clift :: Sibilance -> Q Exp
Lift )

-- | Vowel type. Note that this type does not prevent the construction of
-- nonsensical vowel values such as @Diphthong (Diphthong ...) (Diphthong ...)@
data Vowel
    = Pure Height Backness Roundedness
    | Diphthongized Vowel Vowel
    | Triphthongized Vowel Vowel Vowel
    deriving ( Int -> Vowel -> ShowS
[Vowel] -> ShowS
Vowel -> String
(Int -> Vowel -> ShowS)
-> (Vowel -> String) -> ([Vowel] -> ShowS) -> Show Vowel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vowel] -> ShowS
$cshowList :: [Vowel] -> ShowS
show :: Vowel -> String
$cshow :: Vowel -> String
showsPrec :: Int -> Vowel -> ShowS
$cshowsPrec :: Int -> Vowel -> ShowS
Show, Vowel -> Vowel -> Bool
(Vowel -> Vowel -> Bool) -> (Vowel -> Vowel -> Bool) -> Eq Vowel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vowel -> Vowel -> Bool
$c/= :: Vowel -> Vowel -> Bool
== :: Vowel -> Vowel -> Bool
$c== :: Vowel -> Vowel -> Bool
Eq, (forall x. Vowel -> Rep Vowel x)
-> (forall x. Rep Vowel x -> Vowel) -> Generic Vowel
forall x. Rep Vowel x -> Vowel
forall x. Vowel -> Rep Vowel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vowel x -> Vowel
$cfrom :: forall x. Vowel -> Rep Vowel x
Generic, Typeable Vowel
DataType
Constr
Typeable Vowel
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Vowel -> c Vowel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Vowel)
-> (Vowel -> Constr)
-> (Vowel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Vowel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vowel))
-> ((forall b. Data b => b -> b) -> Vowel -> Vowel)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r)
-> (forall u. (forall d. Data d => d -> u) -> Vowel -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Vowel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Vowel -> m Vowel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Vowel -> m Vowel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Vowel -> m Vowel)
-> Data Vowel
Vowel -> DataType
Vowel -> Constr
(forall b. Data b => b -> b) -> Vowel -> Vowel
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vowel -> c Vowel
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vowel
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Vowel -> u
forall u. (forall d. Data d => d -> u) -> Vowel -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vowel -> m Vowel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vowel -> m Vowel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vowel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vowel -> c Vowel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Vowel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vowel)
$cTriphthongized :: Constr
$cDiphthongized :: Constr
$cPure :: Constr
$tVowel :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Vowel -> m Vowel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vowel -> m Vowel
gmapMp :: (forall d. Data d => d -> m d) -> Vowel -> m Vowel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Vowel -> m Vowel
gmapM :: (forall d. Data d => d -> m d) -> Vowel -> m Vowel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Vowel -> m Vowel
gmapQi :: Int -> (forall d. Data d => d -> u) -> Vowel -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Vowel -> u
gmapQ :: (forall d. Data d => d -> u) -> Vowel -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Vowel -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vowel -> r
gmapT :: (forall b. Data b => b -> b) -> Vowel -> Vowel
$cgmapT :: (forall b. Data b => b -> b) -> Vowel -> Vowel
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vowel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Vowel)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Vowel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Vowel)
dataTypeOf :: Vowel -> DataType
$cdataTypeOf :: Vowel -> DataType
toConstr :: Vowel -> Constr
$ctoConstr :: Vowel -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vowel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Vowel
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vowel -> c Vowel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Vowel -> c Vowel
$cp1Data :: Typeable Vowel
Data, Vowel -> Q Exp
Vowel -> Q (TExp Vowel)
(Vowel -> Q Exp) -> (Vowel -> Q (TExp Vowel)) -> Lift Vowel
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Vowel -> Q (TExp Vowel)
$cliftTyped :: Vowel -> Q (TExp Vowel)
lift :: Vowel -> Q Exp
$clift :: Vowel -> Q Exp
Lift )

pattern PureVowel :: Height -> Backness -> Roundedness -> Segment
pattern $bPureVowel :: Height -> Backness -> Roundedness -> Segment
$mPureVowel :: forall r.
Segment
-> (Height -> Backness -> Roundedness -> r) -> (Void# -> r) -> r
PureVowel h b r = Vowel (Pure h b r)

pattern Diphthong :: Vowel -> Vowel -> Segment
pattern $bDiphthong :: Vowel -> Vowel -> Segment
$mDiphthong :: forall r. Segment -> (Vowel -> Vowel -> r) -> (Void# -> r) -> r
Diphthong v1 v2 = Vowel (Diphthongized v1 v2)

pattern Triphthong :: Vowel -> Vowel -> Vowel -> Segment
pattern $bTriphthong :: Vowel -> Vowel -> Vowel -> Segment
$mTriphthong :: forall r.
Segment -> (Vowel -> Vowel -> Vowel -> r) -> (Void# -> r) -> r
Triphthong v1 v2 v3 = Vowel (Triphthongized v1 v2 v3)

-- | 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, Typeable Height
DataType
Constr
Typeable Height
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Height -> c Height)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Height)
-> (Height -> Constr)
-> (Height -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Height))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Height))
-> ((forall b. Data b => b -> b) -> Height -> Height)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Height -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Height -> r)
-> (forall u. (forall d. Data d => d -> u) -> Height -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Height -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Height -> m Height)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Height -> m Height)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Height -> m Height)
-> Data Height
Height -> DataType
Height -> Constr
(forall b. Data b => b -> b) -> Height -> Height
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Height -> c Height
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Height
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Height -> u
forall u. (forall d. Data d => d -> u) -> Height -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Height -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Height -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Height -> m Height
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Height -> m Height
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Height
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Height -> c Height
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Height)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Height)
$cOpen :: Constr
$cNearOpen :: Constr
$cOpenMid :: Constr
$cMid :: Constr
$cCloseMid :: Constr
$cNearClose :: Constr
$cClose :: Constr
$tHeight :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Height -> m Height
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Height -> m Height
gmapMp :: (forall d. Data d => d -> m d) -> Height -> m Height
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Height -> m Height
gmapM :: (forall d. Data d => d -> m d) -> Height -> m Height
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Height -> m Height
gmapQi :: Int -> (forall d. Data d => d -> u) -> Height -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Height -> u
gmapQ :: (forall d. Data d => d -> u) -> Height -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Height -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Height -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Height -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Height -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Height -> r
gmapT :: (forall b. Data b => b -> b) -> Height -> Height
$cgmapT :: (forall b. Data b => b -> b) -> Height -> Height
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Height)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Height)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Height)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Height)
dataTypeOf :: Height -> DataType
$cdataTypeOf :: Height -> DataType
toConstr :: Height -> Constr
$ctoConstr :: Height -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Height
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Height
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Height -> c Height
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Height -> c Height
$cp1Data :: Typeable Height
Data, Height -> Q Exp
Height -> Q (TExp Height)
(Height -> Q Exp) -> (Height -> Q (TExp Height)) -> Lift Height
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Height -> Q (TExp Height)
$cliftTyped :: Height -> Q (TExp Height)
lift :: Height -> Q Exp
$clift :: Height -> Q Exp
Lift )

-- | 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, Typeable Backness
DataType
Constr
Typeable Backness
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Backness -> c Backness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Backness)
-> (Backness -> Constr)
-> (Backness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Backness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Backness))
-> ((forall b. Data b => b -> b) -> Backness -> Backness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Backness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Backness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Backness -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Backness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Backness -> m Backness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Backness -> m Backness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Backness -> m Backness)
-> Data Backness
Backness -> DataType
Backness -> Constr
(forall b. Data b => b -> b) -> Backness -> Backness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Backness -> c Backness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Backness
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Backness -> u
forall u. (forall d. Data d => d -> u) -> Backness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Backness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Backness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Backness -> m Backness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Backness -> m Backness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Backness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Backness -> c Backness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Backness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Backness)
$cBack :: Constr
$cNearBack :: Constr
$cCentral :: Constr
$cNearFront :: Constr
$cFront :: Constr
$tBackness :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Backness -> m Backness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Backness -> m Backness
gmapMp :: (forall d. Data d => d -> m d) -> Backness -> m Backness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Backness -> m Backness
gmapM :: (forall d. Data d => d -> m d) -> Backness -> m Backness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Backness -> m Backness
gmapQi :: Int -> (forall d. Data d => d -> u) -> Backness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Backness -> u
gmapQ :: (forall d. Data d => d -> u) -> Backness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Backness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Backness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Backness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Backness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Backness -> r
gmapT :: (forall b. Data b => b -> b) -> Backness -> Backness
$cgmapT :: (forall b. Data b => b -> b) -> Backness -> Backness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Backness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Backness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Backness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Backness)
dataTypeOf :: Backness -> DataType
$cdataTypeOf :: Backness -> DataType
toConstr :: Backness -> Constr
$ctoConstr :: Backness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Backness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Backness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Backness -> c Backness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Backness -> c Backness
$cp1Data :: Typeable Backness
Data, Backness -> Q Exp
Backness -> Q (TExp Backness)
(Backness -> Q Exp)
-> (Backness -> Q (TExp Backness)) -> Lift Backness
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Backness -> Q (TExp Backness)
$cliftTyped :: Backness -> Q (TExp Backness)
lift :: Backness -> Q Exp
$clift :: Backness -> Q Exp
Lift )

-- | 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, Typeable Roundedness
DataType
Constr
Typeable Roundedness
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Roundedness -> c Roundedness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Roundedness)
-> (Roundedness -> Constr)
-> (Roundedness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Roundedness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Roundedness))
-> ((forall b. Data b => b -> b) -> Roundedness -> Roundedness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Roundedness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Roundedness -> r)
-> (forall u. (forall d. Data d => d -> u) -> Roundedness -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Roundedness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Roundedness -> m Roundedness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Roundedness -> m Roundedness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Roundedness -> m Roundedness)
-> Data Roundedness
Roundedness -> DataType
Roundedness -> Constr
(forall b. Data b => b -> b) -> Roundedness -> Roundedness
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Roundedness -> c Roundedness
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Roundedness
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Roundedness -> u
forall u. (forall d. Data d => d -> u) -> Roundedness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Roundedness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Roundedness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Roundedness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Roundedness -> c Roundedness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Roundedness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Roundedness)
$cUnrounded :: Constr
$cRounded :: Constr
$tRoundedness :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
gmapMp :: (forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
gmapM :: (forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Roundedness -> m Roundedness
gmapQi :: Int -> (forall d. Data d => d -> u) -> Roundedness -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Roundedness -> u
gmapQ :: (forall d. Data d => d -> u) -> Roundedness -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Roundedness -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Roundedness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Roundedness -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Roundedness -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Roundedness -> r
gmapT :: (forall b. Data b => b -> b) -> Roundedness -> Roundedness
$cgmapT :: (forall b. Data b => b -> b) -> Roundedness -> Roundedness
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Roundedness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Roundedness)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Roundedness)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Roundedness)
dataTypeOf :: Roundedness -> DataType
$cdataTypeOf :: Roundedness -> DataType
toConstr :: Roundedness -> Constr
$ctoConstr :: Roundedness -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Roundedness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Roundedness
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Roundedness -> c Roundedness
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Roundedness -> c Roundedness
$cp1Data :: Typeable Roundedness
Data, Roundedness -> Q Exp
Roundedness -> Q (TExp Roundedness)
(Roundedness -> Q Exp)
-> (Roundedness -> Q (TExp Roundedness)) -> Lift Roundedness
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Roundedness -> Q (TExp Roundedness)
$cliftTyped :: Roundedness -> Q (TExp Roundedness)
lift :: Roundedness -> Q Exp
$clift :: Roundedness -> Q Exp
Lift )

-- | 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, Typeable LevelTone
DataType
Constr
Typeable LevelTone
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LevelTone -> c LevelTone)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LevelTone)
-> (LevelTone -> Constr)
-> (LevelTone -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LevelTone))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LevelTone))
-> ((forall b. Data b => b -> b) -> LevelTone -> LevelTone)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LevelTone -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LevelTone -> r)
-> (forall u. (forall d. Data d => d -> u) -> LevelTone -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LevelTone -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LevelTone -> m LevelTone)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LevelTone -> m LevelTone)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LevelTone -> m LevelTone)
-> Data LevelTone
LevelTone -> DataType
LevelTone -> Constr
(forall b. Data b => b -> b) -> LevelTone -> LevelTone
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LevelTone -> c LevelTone
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LevelTone
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LevelTone -> u
forall u. (forall d. Data d => d -> u) -> LevelTone -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LevelTone -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LevelTone -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LevelTone
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LevelTone -> c LevelTone
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LevelTone)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LevelTone)
$cUpStep :: Constr
$cDownStep :: Constr
$cExtraLowTone :: Constr
$cLowTone :: Constr
$cMidTone :: Constr
$cHighTone :: Constr
$cExtraHighTone :: Constr
$tLevelTone :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
gmapMp :: (forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
gmapM :: (forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LevelTone -> m LevelTone
gmapQi :: Int -> (forall d. Data d => d -> u) -> LevelTone -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LevelTone -> u
gmapQ :: (forall d. Data d => d -> u) -> LevelTone -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LevelTone -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LevelTone -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LevelTone -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LevelTone -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LevelTone -> r
gmapT :: (forall b. Data b => b -> b) -> LevelTone -> LevelTone
$cgmapT :: (forall b. Data b => b -> b) -> LevelTone -> LevelTone
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LevelTone)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LevelTone)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LevelTone)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LevelTone)
dataTypeOf :: LevelTone -> DataType
$cdataTypeOf :: LevelTone -> DataType
toConstr :: LevelTone -> Constr
$ctoConstr :: LevelTone -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LevelTone
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LevelTone
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LevelTone -> c LevelTone
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LevelTone -> c LevelTone
$cp1Data :: Typeable LevelTone
Data, LevelTone -> Q Exp
LevelTone -> Q (TExp LevelTone)
(LevelTone -> Q Exp)
-> (LevelTone -> Q (TExp LevelTone)) -> Lift LevelTone
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: LevelTone -> Q (TExp LevelTone)
$cliftTyped :: LevelTone -> Q (TExp LevelTone)
lift :: LevelTone -> Q Exp
$clift :: LevelTone -> Q Exp
Lift )

-- | 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, Typeable ToneContour
DataType
Constr
Typeable ToneContour
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ToneContour -> c ToneContour)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ToneContour)
-> (ToneContour -> Constr)
-> (ToneContour -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ToneContour))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ToneContour))
-> ((forall b. Data b => b -> b) -> ToneContour -> ToneContour)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ToneContour -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ToneContour -> r)
-> (forall u. (forall d. Data d => d -> u) -> ToneContour -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ToneContour -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ToneContour -> m ToneContour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ToneContour -> m ToneContour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ToneContour -> m ToneContour)
-> Data ToneContour
ToneContour -> DataType
ToneContour -> Constr
(forall b. Data b => b -> b) -> ToneContour -> ToneContour
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ToneContour -> c ToneContour
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ToneContour
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ToneContour -> u
forall u. (forall d. Data d => d -> u) -> ToneContour -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ToneContour -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ToneContour -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ToneContour
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ToneContour -> c ToneContour
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ToneContour)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ToneContour)
$cGlobalFall :: Constr
$cGlobalRise :: Constr
$cFallingRising :: Constr
$cRisingFalling :: Constr
$cLowFalling :: Constr
$cHighFalling :: Constr
$cLowRising :: Constr
$cHighRising :: Constr
$cFalling :: Constr
$cRising :: Constr
$tToneContour :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
gmapMp :: (forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
gmapM :: (forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ToneContour -> m ToneContour
gmapQi :: Int -> (forall d. Data d => d -> u) -> ToneContour -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ToneContour -> u
gmapQ :: (forall d. Data d => d -> u) -> ToneContour -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ToneContour -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ToneContour -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ToneContour -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ToneContour -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ToneContour -> r
gmapT :: (forall b. Data b => b -> b) -> ToneContour -> ToneContour
$cgmapT :: (forall b. Data b => b -> b) -> ToneContour -> ToneContour
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ToneContour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ToneContour)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ToneContour)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ToneContour)
dataTypeOf :: ToneContour -> DataType
$cdataTypeOf :: ToneContour -> DataType
toConstr :: ToneContour -> Constr
$ctoConstr :: ToneContour -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ToneContour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ToneContour
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ToneContour -> c ToneContour
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ToneContour -> c ToneContour
$cp1Data :: Typeable ToneContour
Data, ToneContour -> Q Exp
ToneContour -> Q (TExp ToneContour)
(ToneContour -> Q Exp)
-> (ToneContour -> Q (TExp ToneContour)) -> Lift ToneContour
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ToneContour -> Q (TExp ToneContour)
$cliftTyped :: ToneContour -> Q (TExp ToneContour)
lift :: ToneContour -> Q Exp
$clift :: ToneContour -> Q Exp
Lift )

-- | 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, Typeable Length
DataType
Constr
Typeable Length
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Length -> c Length)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Length)
-> (Length -> Constr)
-> (Length -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Length))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Length))
-> ((forall b. Data b => b -> b) -> Length -> Length)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Length -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Length -> r)
-> (forall u. (forall d. Data d => d -> u) -> Length -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Length -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Length -> m Length)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Length -> m Length)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Length -> m Length)
-> Data Length
Length -> DataType
Length -> Constr
(forall b. Data b => b -> b) -> Length -> Length
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Length -> c Length
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Length
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Length -> u
forall u. (forall d. Data d => d -> u) -> Length -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Length -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Length -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Length -> m Length
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Length -> m Length
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Length
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Length -> c Length
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Length)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Length)
$cExtraShort :: Constr
$cShort :: Constr
$cLong :: Constr
$cHalfLong :: Constr
$cOverLong :: Constr
$tLength :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Length -> m Length
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Length -> m Length
gmapMp :: (forall d. Data d => d -> m d) -> Length -> m Length
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Length -> m Length
gmapM :: (forall d. Data d => d -> m d) -> Length -> m Length
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Length -> m Length
gmapQi :: Int -> (forall d. Data d => d -> u) -> Length -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Length -> u
gmapQ :: (forall d. Data d => d -> u) -> Length -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Length -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Length -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Length -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Length -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Length -> r
gmapT :: (forall b. Data b => b -> b) -> Length -> Length
$cgmapT :: (forall b. Data b => b -> b) -> Length -> Length
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Length)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Length)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Length)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Length)
dataTypeOf :: Length -> DataType
$cdataTypeOf :: Length -> DataType
toConstr :: Length -> Constr
$ctoConstr :: Length -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Length
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Length
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Length -> c Length
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Length -> c Length
$cp1Data :: Typeable Length
Data, Length -> Q Exp
Length -> Q (TExp Length)
(Length -> Q Exp) -> (Length -> Q (TExp Length)) -> Lift Length
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Length -> Q (TExp Length)
$cliftTyped :: Length -> Q (TExp Length)
lift :: Length -> Q Exp
$clift :: Length -> Q Exp
Lift )

-- | 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
    | 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, Typeable SegmentalFeature
DataType
Constr
Typeable SegmentalFeature
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SegmentalFeature -> c SegmentalFeature)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SegmentalFeature)
-> (SegmentalFeature -> Constr)
-> (SegmentalFeature -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SegmentalFeature))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SegmentalFeature))
-> ((forall b. Data b => b -> b)
    -> SegmentalFeature -> SegmentalFeature)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SegmentalFeature -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SegmentalFeature -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SegmentalFeature -> m SegmentalFeature)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SegmentalFeature -> m SegmentalFeature)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SegmentalFeature -> m SegmentalFeature)
-> Data SegmentalFeature
SegmentalFeature -> DataType
SegmentalFeature -> Constr
(forall b. Data b => b -> b)
-> SegmentalFeature -> SegmentalFeature
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentalFeature -> c SegmentalFeature
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SegmentalFeature
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SegmentalFeature -> u
forall u. (forall d. Data d => d -> u) -> SegmentalFeature -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SegmentalFeature
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentalFeature -> c SegmentalFeature
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SegmentalFeature)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SegmentalFeature)
$cNoAudibleRelease :: Constr
$cLateralRelease :: Constr
$cNasalRelease :: Constr
$cNasalized :: Constr
$cLaminal :: Constr
$cApical :: Constr
$cDentalized :: Constr
$cRetractedTongueRoot :: Constr
$cAdvancedTongueRoot :: Constr
$cLowered :: Constr
$cRaised :: Constr
$cPharyngealized :: Constr
$cVelarized :: Constr
$cPalatalized :: Constr
$cLabialized :: Constr
$cLinguoLabialized :: Constr
$cCreakyVoice :: Constr
$cBreathyVoice :: Constr
$cRhotacized :: Constr
$cNonSyllabic :: Constr
$cSyllabic :: Constr
$cCompressed :: Constr
$cMidCentralized :: Constr
$cCentralized :: Constr
$cRetracted :: Constr
$cAdvanced :: Constr
$cLessRounded :: Constr
$cMoreRounded :: Constr
$cAspirated :: Constr
$cSecondaryArticulation :: Constr
$cLength :: Constr
$cVoicing :: Constr
$tSegmentalFeature :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
gmapMp :: (forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
gmapM :: (forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SegmentalFeature -> m SegmentalFeature
gmapQi :: Int -> (forall d. Data d => d -> u) -> SegmentalFeature -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SegmentalFeature -> u
gmapQ :: (forall d. Data d => d -> u) -> SegmentalFeature -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SegmentalFeature -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SegmentalFeature -> r
gmapT :: (forall b. Data b => b -> b)
-> SegmentalFeature -> SegmentalFeature
$cgmapT :: (forall b. Data b => b -> b)
-> SegmentalFeature -> SegmentalFeature
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SegmentalFeature)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SegmentalFeature)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SegmentalFeature)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SegmentalFeature)
dataTypeOf :: SegmentalFeature -> DataType
$cdataTypeOf :: SegmentalFeature -> DataType
toConstr :: SegmentalFeature -> Constr
$ctoConstr :: SegmentalFeature -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SegmentalFeature
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SegmentalFeature
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentalFeature -> c SegmentalFeature
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SegmentalFeature -> c SegmentalFeature
$cp1Data :: Typeable SegmentalFeature
Data, SegmentalFeature -> Q Exp
SegmentalFeature -> Q (TExp SegmentalFeature)
(SegmentalFeature -> Q Exp)
-> (SegmentalFeature -> Q (TExp SegmentalFeature))
-> Lift SegmentalFeature
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SegmentalFeature -> Q (TExp SegmentalFeature)
$cliftTyped :: SegmentalFeature -> Q (TExp SegmentalFeature)
lift :: SegmentalFeature -> Q Exp
$clift :: SegmentalFeature -> Q Exp
Lift )

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, Typeable Stress
DataType
Constr
Typeable Stress
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Stress -> c Stress)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Stress)
-> (Stress -> Constr)
-> (Stress -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Stress))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stress))
-> ((forall b. Data b => b -> b) -> Stress -> Stress)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Stress -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Stress -> r)
-> (forall u. (forall d. Data d => d -> u) -> Stress -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Stress -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Stress -> m Stress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Stress -> m Stress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Stress -> m Stress)
-> Data Stress
Stress -> DataType
Stress -> Constr
(forall b. Data b => b -> b) -> Stress -> Stress
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stress -> c Stress
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stress
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Stress -> u
forall u. (forall d. Data d => d -> u) -> Stress -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stress -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stress -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stress -> m Stress
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stress -> m Stress
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stress
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stress -> c Stress
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stress)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stress)
$cSecondary :: Constr
$cPrimary :: Constr
$tStress :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Stress -> m Stress
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stress -> m Stress
gmapMp :: (forall d. Data d => d -> m d) -> Stress -> m Stress
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Stress -> m Stress
gmapM :: (forall d. Data d => d -> m d) -> Stress -> m Stress
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Stress -> m Stress
gmapQi :: Int -> (forall d. Data d => d -> u) -> Stress -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Stress -> u
gmapQ :: (forall d. Data d => d -> u) -> Stress -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Stress -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stress -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Stress -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stress -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Stress -> r
gmapT :: (forall b. Data b => b -> b) -> Stress -> Stress
$cgmapT :: (forall b. Data b => b -> b) -> Stress -> Stress
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Stress)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Stress)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Stress)
dataTypeOf :: Stress -> DataType
$cdataTypeOf :: Stress -> DataType
toConstr :: Stress -> Constr
$ctoConstr :: Stress -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Stress
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stress -> c Stress
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Stress -> c Stress
$cp1Data :: Typeable Stress
Data, Stress -> Q Exp
Stress -> Q (TExp Stress)
(Stress -> Q Exp) -> (Stress -> Q (TExp Stress)) -> Lift Stress
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Stress -> Q (TExp Stress)
$cliftTyped :: Stress -> Q (TExp Stress)
lift :: Stress -> Q Exp
$clift :: Stress -> Q Exp
Lift )

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
    | ToneNumber Int
    | 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, Typeable SuprasegmentalFeature
DataType
Constr
Typeable SuprasegmentalFeature
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SuprasegmentalFeature
    -> c SuprasegmentalFeature)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SuprasegmentalFeature)
-> (SuprasegmentalFeature -> Constr)
-> (SuprasegmentalFeature -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SuprasegmentalFeature))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SuprasegmentalFeature))
-> ((forall b. Data b => b -> b)
    -> SuprasegmentalFeature -> SuprasegmentalFeature)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SuprasegmentalFeature
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> SuprasegmentalFeature
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SuprasegmentalFeature -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SuprasegmentalFeature -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SuprasegmentalFeature -> m SuprasegmentalFeature)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SuprasegmentalFeature -> m SuprasegmentalFeature)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SuprasegmentalFeature -> m SuprasegmentalFeature)
-> Data SuprasegmentalFeature
SuprasegmentalFeature -> DataType
SuprasegmentalFeature -> Constr
(forall b. Data b => b -> b)
-> SuprasegmentalFeature -> SuprasegmentalFeature
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SuprasegmentalFeature
-> c SuprasegmentalFeature
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SuprasegmentalFeature
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SuprasegmentalFeature -> u
forall u.
(forall d. Data d => d -> u) -> SuprasegmentalFeature -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SuprasegmentalFeature -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SuprasegmentalFeature -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SuprasegmentalFeature
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SuprasegmentalFeature
-> c SuprasegmentalFeature
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SuprasegmentalFeature)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SuprasegmentalFeature)
$cLinking :: Constr
$cBreak :: Constr
$cStress :: Constr
$cToneNumber :: Constr
$cLexicalToneContourDiacritic :: Constr
$cLexicalToneContour :: Constr
$cLevelLexicalToneDiacritic :: Constr
$cLevelLexicalTone :: Constr
$tSuprasegmentalFeature :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
gmapMp :: (forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
gmapM :: (forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SuprasegmentalFeature -> m SuprasegmentalFeature
gmapQi :: Int -> (forall d. Data d => d -> u) -> SuprasegmentalFeature -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SuprasegmentalFeature -> u
gmapQ :: (forall d. Data d => d -> u) -> SuprasegmentalFeature -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SuprasegmentalFeature -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SuprasegmentalFeature -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SuprasegmentalFeature -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SuprasegmentalFeature -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SuprasegmentalFeature -> r
gmapT :: (forall b. Data b => b -> b)
-> SuprasegmentalFeature -> SuprasegmentalFeature
$cgmapT :: (forall b. Data b => b -> b)
-> SuprasegmentalFeature -> SuprasegmentalFeature
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SuprasegmentalFeature)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SuprasegmentalFeature)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SuprasegmentalFeature)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SuprasegmentalFeature)
dataTypeOf :: SuprasegmentalFeature -> DataType
$cdataTypeOf :: SuprasegmentalFeature -> DataType
toConstr :: SuprasegmentalFeature -> Constr
$ctoConstr :: SuprasegmentalFeature -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SuprasegmentalFeature
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SuprasegmentalFeature
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SuprasegmentalFeature
-> c SuprasegmentalFeature
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SuprasegmentalFeature
-> c SuprasegmentalFeature
$cp1Data :: Typeable SuprasegmentalFeature
Data, SuprasegmentalFeature -> Q Exp
SuprasegmentalFeature -> Q (TExp SuprasegmentalFeature)
(SuprasegmentalFeature -> Q Exp)
-> (SuprasegmentalFeature -> Q (TExp SuprasegmentalFeature))
-> Lift SuprasegmentalFeature
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SuprasegmentalFeature -> Q (TExp SuprasegmentalFeature)
$cliftTyped :: SuprasegmentalFeature -> Q (TExp SuprasegmentalFeature)
lift :: SuprasegmentalFeature -> Q Exp
$clift :: SuprasegmentalFeature -> Q Exp
Lift )

-- | Transcription delimiters/brackets
data Delimiter
    = Phonetic -- ^ Actual pronunciation, transcribed with square brackets, [ .. ]
    | Phonemic -- ^ Abstract phonemic representation, transcribed with slashes, \/ .. \/
    deriving ( Int -> Delimiter -> ShowS
[Delimiter] -> ShowS
Delimiter -> String
(Int -> Delimiter -> ShowS)
-> (Delimiter -> String)
-> ([Delimiter] -> ShowS)
-> Show Delimiter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delimiter] -> ShowS
$cshowList :: [Delimiter] -> ShowS
show :: Delimiter -> String
$cshow :: Delimiter -> String
showsPrec :: Int -> Delimiter -> ShowS
$cshowsPrec :: Int -> Delimiter -> ShowS
Show, Delimiter -> Delimiter -> Bool
(Delimiter -> Delimiter -> Bool)
-> (Delimiter -> Delimiter -> Bool) -> Eq Delimiter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delimiter -> Delimiter -> Bool
$c/= :: Delimiter -> Delimiter -> Bool
== :: Delimiter -> Delimiter -> Bool
$c== :: Delimiter -> Delimiter -> Bool
Eq, (forall x. Delimiter -> Rep Delimiter x)
-> (forall x. Rep Delimiter x -> Delimiter) -> Generic Delimiter
forall x. Rep Delimiter x -> Delimiter
forall x. Delimiter -> Rep Delimiter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Delimiter x -> Delimiter
$cfrom :: forall x. Delimiter -> Rep Delimiter 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