ipa-0.3: test/Main.hs
{-# LANGUAGE TypeApplications #-}
-- |
module Main where
import Data.Either ( isLeft )
import Data.Foldable ( for_, traverse_ )
import Data.Maybe ( isNothing )
import Language.IPA
import Test.Hspec ( describe
, hspec
, it
, shouldBe
, shouldSatisfy
)
{- HLINT ignore "Redundant do" -}
main :: IO ()
main = ipa >> xsampa >> parser >> parserXSampa
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
, PureVowel NearClose Central Unrounded
, PureVowel NearOpen Back Rounded
]
traverse_ (`shouldSatisfy` isNothing) phones
describe "Segmental features" $ do
it "Correctly makes 'Short' a noop" $ do
let vcfu = PureVowel Close Front Unrounded
i = toIPA' vcfu
iShort = toIPA' $ WithSegmentalFeature (Length Short) vcfu
i `shouldBe` iShort
it "Chains articulatory features" $ do
let vowel = PureVowel 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
, PureVowel 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
, PureVowel 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
, PureVowel 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 = PureVowel Close Front Unrounded
i = toXSampa' vcfu
iShort = toXSampa' $ WithSegmentalFeature (Length Short) vcfu
i `shouldBe` iShort
it "Chains articulatory features" $ do
let vowel = PureVowel 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
, PureVowel NearClose Central Unrounded
, PureVowel NearOpen Back Rounded
]
traverse_ (`shouldSatisfy` isNothing) phones
describe "Suprasegmental features" $ do
it "Chains articulatory features" $ do
let segments = [ PulmonicConsonant Voiced Alveolar Plosive
, PureVowel CloseMid Back Rounded
]
syllable = Syllable segments
tone = LexicalToneContour Rising
XSampa chained = toXSampa'
$ WithSuprasegmentalFeature --
(Stress Primary)
(WithSuprasegmentalFeature tone syllable)
chained `shouldBe` "do_R\""
parser :: IO ()
parser = hspec $ do
describe "Segment parser" $ do
it "Parses individual segments" $ do
let char = "β"
parsed = parseIPA char
parsed
`shouldBe` Right --
(PulmonicConsonant Voiced Bilabial (Fricative NonSibilant))
it "Rejects multiple adjacent segments" $ do
let char = "ββ"
parsed = parseIPA @Segment char
parsed `shouldSatisfy` isLeft
it "Parses segmental features" $ do
let char = "oʲ"
parsed = parseIPA @Segment char
j = PulmonicConsonant Voiced Palatal Approximant
o = PureVowel CloseMid Back Rounded
parsed
`shouldBe` Right --
(WithSegmentalFeature (SecondaryArticulation j) o)
it "Parses multiple segmental features" $ do
let char = "ãͪ"
parsed = parseIPA char
a = PureVowel Open Front Unrounded
parsed
`shouldBe` Right --
(WithSegmentalFeature Nasalized
(WithSegmentalFeature Aspirated a))
it "Parses specific phones first" $ do
let chars = [ "k", "k͡x", "k͡xʼ" ]
parsed = parseIPA <$> chars
phones = [ PulmonicConsonant Voiceless Velar Plosive
, PulmonicConsonant Voiceless
Velar
(Affricate NonSibilant)
, EjectiveConsonant Velar (Affricate NonSibilant)
]
for_ (zip parsed phones) $ \(p, ph) -> p `shouldBe` Right ph
it "Rejects invalid segments" $ do
let chars = [ "L", "Z", "C", "0" ]
parsed = parseIPA @Segment <$> chars
traverse_ (`shouldSatisfy` isLeft) parsed
describe "Syllable parser" $ do
it "Parses syllables" $ do
let syllable = "ɣa"
parsed = parseIPA syllable
gamma =
PulmonicConsonant Voiced Velar (Fricative NonSibilant)
a = PureVowel Open Front Unrounded
parsed `shouldBe` Right (Syllable [ gamma, a ])
it "Parses suprasegmental features" $ do
let syllable = "o˨"
parsed = parseIPA syllable
o = PureVowel CloseMid Back Rounded
tone = LevelLexicalTone LowTone
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature tone (Syllable [ o ]))
it "Parses multiple suprasegmental features" $ do
let syllable = "ˈő"
parsed = parseIPA syllable
tone = LevelLexicalToneDiacritic ExtraHighTone
o = PureVowel CloseMid Back Rounded
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature --
tone
(WithSuprasegmentalFeature (Stress Primary) (Syllable [ o ])))
it "Rejects invalid syllables" $ do
let syllable = "aL"
parsed = parseIPA @(Syllable []) syllable
parsed `shouldSatisfy` isLeft
it "Rejects multiple adjacent syllables" $ do
let syllable = "aw.a"
parsed = parseIPA @(Syllable []) syllable
parsed `shouldSatisfy` isLeft
it "Parses multiple syllables" $ do
let syllables = "bɤ bɤ"
parsed = parseSyllables syllables
syllable = [ PulmonicConsonant Voiced Bilabial Plosive
, PureVowel CloseMid Back Unrounded
]
parsed `shouldBe` Right [ Syllable syllable, Syllable syllable ]
parserXSampa :: IO ()
parserXSampa = hspec $ do
describe "Segment parser" $ do
it "Parses individual segments" $ do
let char = "B"
parsed = parseXSampa char
parsed
`shouldBe` Right --
(PulmonicConsonant Voiced Bilabial (Fricative NonSibilant))
it "Rejects multiple adjacent segments" $ do
let char = "BB"
parsed = parseIPA @Segment char
parsed `shouldSatisfy` isLeft
it "Parses segmental features" $ do
let char = "o_G"
parsed = parseXSampa @Segment char
o = PureVowel CloseMid Back Rounded
parsed `shouldBe` Right (WithSegmentalFeature Velarized o)
it "Parses multiple segmental features" $ do
let char = "a~_h"
parsed = parseXSampa char
a = PureVowel Open Front Unrounded
parsed
`shouldBe` Right --
(WithSegmentalFeature Nasalized
(WithSegmentalFeature Aspirated a))
it "Parses specific phones first" $ do
let chars = [ "k", "k_x", "k_x_>" ]
parsed = parseXSampa <$> chars
phones = [ PulmonicConsonant Voiceless Velar Plosive
, PulmonicConsonant Voiceless
Velar
(Affricate NonSibilant)
, EjectiveConsonant Velar (Affricate NonSibilant)
]
for_ (zip parsed phones) $ \(p, ph) -> p `shouldBe` Right ph
describe "Syllable parser" $ do
it "Parses syllables" $ do
let syllable = "Ga"
parsed = parseXSampa syllable
gamma =
PulmonicConsonant Voiced Velar (Fricative NonSibilant)
a = PureVowel Open Front Unrounded
parsed `shouldBe` Right (Syllable [ gamma, a ])
it "Parses suprasegmental features" $ do
let syllable = "o_L"
parsed = parseXSampa syllable
o = PureVowel CloseMid Back Rounded
tone = LevelLexicalTone LowTone
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature tone (Syllable [ o ]))
it "Parses multiple suprasegmental features" $ do
let syllable = "'o_T"
parsed = parseXSampa syllable
tone = LevelLexicalTone ExtraHighTone
o = PureVowel CloseMid Back Rounded
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature --
tone
(WithSuprasegmentalFeature (Stress Primary) (Syllable [ o ])))
it "Rejects multiple adjacent syllables" $ do
let syllable = "aw.a"
parsed = parseXSampa @(Syllable []) syllable
parsed `shouldSatisfy` isLeft
it "Parses multiple syllables" $ do
let syllables = "b7 b7"
parsed = parseSyllablesXSampa syllables
syllable = [ PulmonicConsonant Voiced Bilabial Plosive
, PureVowel CloseMid Back Unrounded
]
parsed `shouldBe` Right [ Syllable syllable, Syllable syllable ]