ipa-0.3.1: test/Main.hs
{-# LANGUAGE QuasiQuotes #-}
{-# 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 >> qq >> delim
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 syll = toIPA' $ Syllable segments
syll `shouldBe` "ɓɤ"
describe "Suprasegmental features" $ do
it "Chains articulatory features" $ do
let segments = [ PulmonicConsonant Voiced Alveolar Plosive
, PureVowel CloseMid Back Rounded
]
syll = Syllable segments
tone = LexicalToneContour Rising
IPA chained = toIPA'
$ WithSuprasegmentalFeature --
(Stress Primary)
(WithSuprasegmentalFeature tone syll)
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 syll = toXSampa' $ Syllable segments
syll `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
]
syll = Syllable segments
tone = LexicalToneContour Rising
XSampa chained = toXSampa'
$ WithSuprasegmentalFeature --
(Stress Primary)
(WithSuprasegmentalFeature tone syll)
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 syll = "ɣa"
parsed = parseIPA syll
gamma =
PulmonicConsonant Voiced Velar (Fricative NonSibilant)
a = PureVowel Open Front Unrounded
parsed `shouldBe` Right (Syllable [ gamma, a ])
it "Parses suprasegmental features" $ do
let syll = "o˨"
parsed = parseIPA syll
o = PureVowel CloseMid Back Rounded
tone = LevelLexicalTone LowTone
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature tone (Syllable [ o ]))
it "Parses multiple suprasegmental features" $ do
let syll = "ˈő"
parsed = parseIPA syll
tone = LevelLexicalToneDiacritic ExtraHighTone
o = PureVowel CloseMid Back Rounded
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature --
tone
(WithSuprasegmentalFeature (Stress Primary) (Syllable [ o ])))
it "Rejects invalid syllables" $ do
let syll = "aL"
parsed = parseIPA @(Syllable []) syll
parsed `shouldSatisfy` isLeft
it "Rejects multiple adjacent syllables" $ do
let syll = "aw.a"
parsed = parseIPA @(Syllable []) syll
parsed `shouldSatisfy` isLeft
it "Parses multiple syllables" $ do
let sylls = "bɤ bɤ"
parsed = parseSyllables sylls
syll = [ PulmonicConsonant Voiced Bilabial Plosive
, PureVowel CloseMid Back Unrounded
]
parsed `shouldBe` Right [ Syllable syll, Syllable syll ]
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 syll = "Ga"
parsed = parseXSampa syll
gamma =
PulmonicConsonant Voiced Velar (Fricative NonSibilant)
a = PureVowel Open Front Unrounded
parsed `shouldBe` Right (Syllable [ gamma, a ])
it "Parses suprasegmental features" $ do
let syll = "o_L"
parsed = parseXSampa syll
o = PureVowel CloseMid Back Rounded
tone = LevelLexicalTone LowTone
parsed
`shouldBe` Right --
(WithSuprasegmentalFeature tone (Syllable [ o ]))
it "Parses multiple suprasegmental features" $ do
let syll = "'o_T"
parsed = parseXSampa syll
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 syll = "aw.a"
parsed = parseXSampa @(Syllable []) syll
parsed `shouldSatisfy` isLeft
it "Parses multiple syllables" $ do
let sylls = "b7 b7"
parsed = parseSyllablesXSampa sylls
syll = [ PulmonicConsonant Voiced Bilabial Plosive
, PureVowel CloseMid Back Unrounded
]
parsed `shouldBe` Right [ Syllable syll, Syllable syll ]
qq :: IO ()
qq = hspec $ do
describe "Quasi-quoter" $ do
it "Works for individual segments" $ do
let segQQ = [segment|β|]
beta =
PulmonicConsonant Voiced Bilabial (Fricative NonSibilant)
segQQ `shouldBe` beta
it "Works for syllables" $ do
let syllQQ = [syllable|e˧˥|]
syll = Syllable [ Vowel (Pure CloseMid Front Unrounded) ]
contour =
WithSuprasegmentalFeature (LexicalToneContour HighRising)
syllQQ `shouldBe` contour syll
it "Works with X-SAMPA" $ do
let syllsQQ = [syllablesXS|?\ |]
fric = Consonant (Pulmonic Voiced
Pharyngeal
(Fricative NonSibilant))
syllsQQ `shouldBe` [ Syllable [ fric ] ]
delim :: IO ()
delim = hspec $ do
it "Transcribes segments" $ do
let v = PureVowel Close Back Unrounded
asIPA = toIPA' v
asXSampa = toXSampa' v
phoneticIPA = transcribe Phonetic asIPA
phonemicIPA = transcribe Phonemic asIPA
phoneticXSampa = transcribeXSampa Phonetic asXSampa
phonemicXSampa = transcribeXSampa Phonemic asXSampa
phoneticIPA `shouldBe` "[ɯ]"
phonemicIPA `shouldBe` "/ɯ/"
phoneticXSampa `shouldBe` "[M]"
phonemicXSampa `shouldBe` "/M/"