Types.hs

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

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

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

import           GHC.Generics        ( Generic )

-- | Textual representation of a speech segment or grouping of segments, with
-- zero or more articulatory features; encoded in IPA transcription. Note this
-- has a 'Semigroup' instance, so various 'IPA's can conveniently be concatenated
-- with @<>@
newtype IPA = IPA { unIPA :: Text }
    deriving ( Show, Eq, Generic, Semigroup )

-- | Normalizes text value to NFC before wrapping it in 'IPA'. This is to ensure
-- the comparability of 'IPA' values
mkIPA :: Text -> IPA
mkIPA = IPA . normalize NFC

newtype XSampa = XSampa Text
    deriving ( Show, Eq, Generic )

-- | A single segment, or combination of a segment and articulatory feature
data Segment
    = Consonant Consonant -- ^ Pulmonic and non-pulmonic consonants
    | Vowel Height Backness Roundedness
    | Zero -- ^ A null/zero phone
    | WithSegmentalFeature SegmentalFeature Segment -- ^ Various other articulatory features
    deriving ( Show, Eq, Generic )

-- | Multiple segments, or combination of multiple segments with
-- suprasegmental feature
data Syllable t
    = Syllable (t Segment) -- ^ A grouping of segments
    | WithSuprasegmentalFeature SuprasegmentalFeature (Syllable t)
      -- ^ Articulatory features that affect/encompass the entire syllable
    deriving ( Generic )

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

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

-- | Pulmonic and non-pulmonic consonants
data Consonant
    = Pulmonic Phonation Place Manner
    | Ejective Place Manner
    | Implosive Phonation Place
    | Click Place
    | DoublyArticulated Phonation Place Place Manner
    deriving ( Show, Eq, Generic )

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

pattern EjectiveConsonant :: Place -> Manner -> Segment
pattern EjectiveConsonant pl m = Consonant (Ejective pl m)

pattern ClickConsonant :: Place -> Segment
pattern ClickConsonant pl = Consonant (Click pl)

pattern ImplosiveConsonant :: Phonation -> Place -> Segment
pattern ImplosiveConsonant ph pl = Consonant (Implosive ph pl)

-- | Consonantal manner of articulation
data Manner
    = Nasal
    | Plosive
    | Fricative Sibilance
    | Affricate Sibilance
    | Approximant
    | Flap
    | Trill
    | LateralAffricate
    | LateralFricative
    | LateralApproximant
    | LateralFlap
    deriving ( Show, Eq, Generic )

-- | Consonantal place of articulation
data Place
    = Bilabial
    | LabioDental
    | LinguoLabial
    | Dental
    | Alveolar
    | PostAlveolar
    | Retroflex
    | Palatal
    | Velar
    | Uvular
    | Pharyngeal
    | Glottal
    deriving ( Show, Eq, Generic, Ord )

-- | Phonation (voicing)
data Phonation = Voiced | Voiceless
    deriving ( Show, Eq, Generic )

-- | Sibilance for fricative consonants
data Sibilance = Sibilant | NonSibilant
    deriving ( Show, Eq, Generic )

-- | Vowel height
data Height = Close | NearClose | CloseMid | Mid | OpenMid | NearOpen | Open
    deriving ( Show, Eq, Generic )

-- | Vowel backness
data Backness = Front | NearFront | Central | NearBack | Back
    deriving ( Show, Eq, Generic, Ord )

-- | Vowel roundedness
data Roundedness = Rounded | Unrounded
    deriving ( Show, Eq, Generic )

-- | Lexical tone with Chao-style tone letters
data LevelTone
    = ExtraHighTone
    | HighTone
    | MidTone
    | LowTone
    | ExtraLowTone
    | DownStep
    | UpStep
    deriving ( Show, Eq, Generic, Ord )

-- | Lexical tone represented as a contour
data ToneContour
    = Rising
    | Falling
    | HighRising
    | LowRising
    | HighFalling
    | LowFalling
    | RisingFalling
    | FallingRising
    | GlobalRise
    | GlobalFall
    deriving ( Show, Eq, Generic, Ord )

-- | Vowel length; also serves as a notation for consonant gemination in the IPA
data Length
    = OverLong
    | HalfLong
    | Long
    | Short
      -- ^ The default/unmarked length; using this constructor doesn't affect the
      -- default IPA representation of the segment
    | ExtraShort
    deriving ( Show, Eq, Generic, Ord )

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

data Stress = Primary | Secondary
    deriving ( Show, Eq, Generic, Ord )

data SuprasegmentalFeature
    = LevelLexicalTone LevelTone -- ^ Level lexical tone
    | LevelLexicalToneDiacritic LevelTone
      -- ^ Level lexical tone, diactritic notation
    | LexicalToneContour ToneContour-- ^ Lexical tone as a contour
    | LexicalToneContourDiacritic ToneContour
      -- ^ Lexical tone as a contour, diacritic notation
    | Stress Stress
    | Break
    | Linking
    deriving ( Show, Eq, Generic )