{-# LANGUAGE PatternSynonyms #-}

-- |
module Main where

import           Data.Foldable      ( traverse_ )
import           Data.Maybe         ( isNothing )

import           Language.IPA       ( ReprIPA(toIPA', toIPA) )
import           Language.IPA.Types
                 ( Backness(..)
                 , Height(..)
                 , IPA(IPA)
                 , Length(..)
                 , Manner(..)
                 , Phonation(..)
                 , Place(..)
                 , Roundedness(..)
                 , Segment(..)
                 , SegmentalFeature(..)
                 , Sibilance(..)
                 , Stress(Primary)
                 , SuprasegmentalFeature(..)
                 , Syllable(..)
                 , ToneContour(..)
                 , pattern ImplosiveConsonant
                 , pattern PulmonicConsonant
                 )

import           Test.Hspec
                 ( describe
                 , hspec
                 , it
                 , shouldBe
                 , shouldSatisfy
                 )

{- HLINT ignore "Redundant do" -}
main :: IO ()
main = hspec $ do
    describe "Segments" $ do
        it "Rejects nonsense segments" $ do
            let phones = toIPA
                    <$> [ PulmonicConsonant Voiceless
                                            Uvular
                                            (Fricative Sibilant)
                        , PulmonicConsonant Voiced Velar Flap
                        , PulmonicConsonant Voiced Pharyngeal Plosive
                        , PulmonicConsonant Voiceless Glottal Trill
                        , Vowel NearClose Central Unrounded
                        , Vowel NearOpen Back Rounded
                        ]
            traverse_ (`shouldSatisfy` isNothing) phones

    describe "Segmental features" $ do
        it "Correctly makes 'Short' a noop" $ do
            let vcfu   = Vowel Close Front Unrounded
                i      = toIPA' vcfu
                iShort = toIPA' $ WithSegmentalFeature (Length Short) vcfu

            i `shouldBe` iShort

        it "Chains articulatory features" $ do
            let vowel       = Vowel Close Back Unrounded
                IPA chained = toIPA'
                    $ WithSegmentalFeature (Length OverLong)
                                           (WithSegmentalFeature Compressed
                                                                 vowel)
            chained `shouldBe` "ɯᵝːː"

    describe "Suprasegmentals" $ do
        it "Preserves individual segments and order" $ do
            let segments     = [ ImplosiveConsonant Voiced Bilabial
                               , Vowel CloseMid Back Unrounded
                               ]
                IPA syllable = toIPA' $ Syllable segments
            syllable `shouldBe` "ɓɤ"

    describe "Suprasegmental features" $ do
        it "Chains articulatory features" $ do
            let segments    = [ PulmonicConsonant Voiced Alveolar Plosive
                              , Vowel CloseMid Back Rounded
                              ]
                syllable    = Syllable segments
                tone        = LexicalToneContour Rising
                IPA chained = toIPA'
                    $ WithSuprasegmentalFeature --
                    (Stress Primary)
                    (WithSuprasegmentalFeature tone syllable)
            chained `shouldBe` "do˩˥ˈ"