{-# LANGUAGE PatternSynonyms #-}

-- |
module Main where

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

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

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

{- HLINT ignore "Redundant do" -}
main :: IO ()
main = ipa >> xsampa

ipa :: IO ()
ipa = 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˩˥ˈ"

    describe "IPA normalization" $ do
        it "Normalizes IPA values to NFC" $ do
            let oRisingNFD     = "o\x0301" -- decomposed form
                IPA oRisingIPA = mkIPA oRisingNFD
            oRisingIPA `shouldBe` "\x00f3"

xsampa :: IO ()
xsampa = hspec $ do
    describe "Suprasegmentals" $ do
        it "Preserves individual segments and order" $ do
            let segments        = [ ImplosiveConsonant Voiced Bilabial
                                  , Vowel CloseMid Back Unrounded
                                  ]
                XSampa syllable = toXSampa' $ Syllable segments
            syllable `shouldBe` "b_<7"

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

            i `shouldBe` iShort

        it "Chains articulatory features" $ do
            let vowel          = Vowel Close Back Unrounded
                XSampa chained = toXSampa'
                    $ WithSegmentalFeature (Length OverLong)
                                           (WithSegmentalFeature Lowered vowel)
            chained `shouldBe` "M_o::"

    describe "Segments" $ do
        it "Rejects nonsense segments" $ do
            let phones = toXSampa
                    <$> [ 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 "Suprasegmental features" $ do
        it "Chains articulatory features" $ do
            let segments       = [ PulmonicConsonant Voiced Alveolar Plosive
                                 , Vowel CloseMid Back Rounded
                                 ]
                syllable       = Syllable segments
                tone           = LexicalToneContour Rising
                XSampa chained = toXSampa'
                    $ WithSuprasegmentalFeature --
                    (Stress Primary)
                    (WithSuprasegmentalFeature tone syllable)
            chained `shouldBe` "do_R\""