diff --git a/CHANGELOG.org b/CHANGELOG.org new file mode 100644 --- /dev/null +++ b/CHANGELOG.org @@ -0,0 +1,2 @@ +* 0.1.0.0 ++ Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2021, Rory Tyler Hayford + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rory Tyler Hayford nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.org b/README.org new file mode 100644 --- /dev/null +++ b/README.org @@ -0,0 +1,60 @@ +* ipa +** About +~ipa~ is a Haskell library for dealing with International Phonetic Alphabet (IPA) transcriptions. It provides a set of datatypes for working with speech segments and suprasegmentals which can be represented using IPA transcription. +** Usage +IPA values can be created by constructing ~Segment~ or ~Syllable~ values and applying ~toIPA~. +For instance: +#+begin_src haskell +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE OverloadedStrings #-} + +import Language.IPA +import qualified Data.Text.IO as T + +main :: IO () +main = maybe message (T.putStrLn . unIPA) (toIPA b) + where + b = PulmonicConsonant Voiced Bilabial Plosive + message = T.putStrLn "Invalid or unrepresentable segment!" + +#+end_src +~Segment~ and ~Syllable~ values can be adorned with additional articulatory information as well, and can further be nested to created more complex structures, e.g.: +#+begin_src haskell +someComplexVowel :: Segment +someComplexVowel = WithSegmentalFeature + (SuperScriptNumeric 255) + (WithSegmentalFeature + (Length OverLong) + (WithSegmentalFeature + Compressed + (Vowel Close Back Unrounded))) +-- ɯᵝːː²⁵⁵ + +#+end_src +~IPA~ is an instance of ~Semigroup~, so values can be concatenated with ~<>~: +#+begin_src haskell +someSyllables :: Maybe IPA +someSyllables = (<>) <$> toIPA syllable1 <*> toIPA syllable2 + where + syllable1 = + WithSuprasegmentalFeature Linking + (Syllable [ WithSegmentalFeature -- + (Length Long) + (Vowel Close Back Rounded) + ]) + + syllable2 = Syllable [ PulmonicConsonant Voiced Palatal Approximant + , Vowel OpenMid Front Unrounded + , Vowel Mid Central Unrounded + ] +-- uː‿jɛə + +#+end_src +~toIPA~ is a method of the ~ReprIPA~ typeclass; I decided a typeclass was best in order to allow users to create their own instances if the library-supplied ones were insufficient. You could create an instance, for example, for a hypothetical ~Mora~ datatype, etc... +** License +This library is distributed under the BSD 3-Clause revised license. +** TODO TODO +- [ ] Export constant values for common segments +- [ ] Convenience functions for wrapping IPA values in different trasncription delimiters (phonemic, phonetic, etc...) +- [ ] Support for XSampa transcription and IPA-XSampa conversion +- [ ] Parsing and validation of user-supplied IPA literals diff --git a/ipa.cabal b/ipa.cabal new file mode 100644 --- /dev/null +++ b/ipa.cabal @@ -0,0 +1,56 @@ +cabal-version: 2.4 +name: ipa +version: 0.1.0.0 +synopsis: Internal Phonetic Alphabet (IPA) +description: + Types and tools for working with the International Phonetic Alphabet (IPA) + +license: BSD-3-Clause +license-file: LICENSE +author: Rory Tyler Hayford +maintainer: rory.hayford@protonmail.com +copyright: (c) Rory Tyler Hayford, 2021 +homepage: https://gitlab.com/ngua/ipa-hs/-/blob/master/README.org +category: language +extra-source-files: + README.org + CHANGELOG.org + +source-repository head + type: git + location: https://gitlab.com/ngua/ipa-hs + +common common-options + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints + +common common-extensions + default-extensions: OverloadedStrings + +library + import: common-options, common-extensions + build-depends: + , base ^>=4.13.0.0 + , text ^>=1.2.4 + , unicode-transforms ^>=0.3.7 + + exposed-modules: + Language.IPA + Language.IPA.Types + + hs-source-dirs: src + default-language: Haskell2010 + +test-suite ipa-testsuite + import: common-options, common-extensions + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + , base + , hspec + , ipa + , text + + main-is: Main.hs + default-language: Haskell2010 diff --git a/src/Language/IPA.hs b/src/Language/IPA.hs new file mode 100644 --- /dev/null +++ b/src/Language/IPA.hs @@ -0,0 +1,588 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : Language.IPA +-- Copyright : (c) 2021 Rory Tyler Hayford +-- +-- License : BSD-3-Clause +-- Maintainer : rory.hayford@protonmail.com +-- Stability : experimental +-- Portability : GHC +-- +-- Working with IPA transcriptions +module Language.IPA + ( module M + -- * Converting to IPA representations + , ReprIPA(..) + ) where + +import Data.Char ( digitToInt ) +import Data.Text ( Text ) +import qualified Data.Text as T + +import Language.IPA.Types as M + +-- | Entities representable through IPA transcription +class ReprIPA a where + -- | Produces an 'IPA' transcription given a valid 'Segment'; a result + -- of @Nothing@ indicates either an unattested-yet-possible segment, or one + -- considered impossible + toIPA :: a -> Maybe IPA + + -- | Partial function for creating an 'IPA'. Useful if you are certain that + -- the sound in question is representable + toIPA' :: a -> IPA + toIPA' (toIPA -> Just x) = x + toIPA' _ = error "Illegal/unrepresentable value" + +instance Traversable t => ReprIPA (Syllable t) where + toIPA = \case + -- Syllable without any suprasegmental information + Syllable ss + | null ss -> Nothing + | otherwise -> foldr1 (<>) <$> traverse toIPA ss + WithSuprasegmentalFeature feature s -> + withSuprasegmentalFeature s feature + +instance ReprIPA Segment where + toIPA = \case + Zero -> mkJustIPA "∅" + Consonant c -> consonant c + v@Vowel {} -> vowel v + WithSegmentalFeature feature s -> withSegmentalFeature s feature + +mkJustIPA :: Text -> Maybe IPA +mkJustIPA = Just . mkIPA + +mkIPAOp :: ReprIPA a => (b -> Maybe IPA) -> a -> b -> Maybe IPA +mkIPAOp f x y = (<>) <$> toIPA x <*> f y + +withSuprasegmentalFeature + :: Traversable t => Syllable t -> SuprasegmentalFeature -> Maybe IPA +withSuprasegmentalFeature s = \case + -- Level tones, non-diacritic + LevelLexicalTone tone -> mkIPAOp ipaTone s tone + where + ipaTone = \case + ExtraHighTone -> mkJustIPA "˥" + HighTone -> mkJustIPA "˦" + MidTone -> mkJustIPA "˧" + LowTone -> mkJustIPA "˨" + ExtraLowTone -> mkJustIPA "˩" + -- Down-step and up-step are represented with + -- diacritics, not tone characters + _ -> Nothing + + -- Level tones, diacritic. The text value inside the 'IPA' is a + -- combining character + LevelLexicalToneDiacritic tone -> mkIPAOp ipaTone s tone + where + ipaTone = \case + ExtraHighTone -> mkJustIPA "\x030b" -- ◌̋ + HighTone -> mkJustIPA "\x0341" -- ◌́ + MidTone -> mkJustIPA "\x0304" -- ◌̄ + LowTone -> mkJustIPA "\x0340" -- ◌̀ + ExtraLowTone -> mkJustIPA "\x030f" -- ◌̏ + DownStep -> mkJustIPA "ꜜ" + UpStep -> mkJustIPA "ꜛ" + + -- Tone contours, non-diacritic + LexicalToneContour tone -> mkIPAOp ipaToneContour s tone + where + ipaToneContour = \case + Rising -> mkJustIPA "˩˥" + Falling -> mkJustIPA "˥˩" + HighRising -> mkJustIPA "˧˥" + LowRising -> mkJustIPA "˩˧" + HighFalling -> mkJustIPA "˥˧" + LowFalling -> mkJustIPA "˧˩" + RisingFalling -> mkJustIPA "˧˦˨" + FallingRising -> mkJustIPA "˧˨˦" + GlobalRise -> mkJustIPA "↗" + GlobalFall -> mkJustIPA "↙" + + -- Tone contours, diacritic + LexicalToneContourDiacritic tone -> mkIPAOp ipaToneContour s tone + where + ipaToneContour = \case + Rising -> mkJustIPA "\x0302" -- ◌̂ + Falling -> mkJustIPA "\x030c" -- ◌̌ + HighRising -> mkJustIPA "\x1dc9" -- ◌᷉ + LowRising -> mkJustIPA "\x1dc5" -- ◌᷅ + HighFalling -> mkJustIPA "\x1dc7" -- ◌᷇ + LowFalling -> mkJustIPA "\x1dc6" -- ◌᷆ + RisingFalling -> mkJustIPA "\x1dc8" -- ◌᷈ + FallingRising -> mkJustIPA "\x1dc9" -- ◌᷉ + -- 'GlobalRise' and 'GlobalFall' don't have + -- diacritic representations + _ -> Nothing + + -- Syllable stress + Stress stress -> mkIPAOp ipaStress s stress + where + ipaStress Primary = mkJustIPA "ˈ" + ipaStress Secondary = mkJustIPA "ˌ" + + -- Explicit syllable break + Break -> (<>) <$> toIPA s <*> mkJustIPA "." + + -- Syllable non-break + Linking -> (<>) <$> toIPA s <*> mkJustIPA "‿" + +withSegmentalFeature :: Segment -> SegmentalFeature -> Maybe IPA +withSegmentalFeature s = \case + Voicing v -> mkIPAOp ipaVoicing s v + where + ipaVoicing = \case + Voiceless -> mkJustIPA "\x030a" -- ◌̊ + Voiced -> mkJustIPA "\x030c" -- ◌̌ + Length l -> mkIPAOp ipaLength s l + where + ipaLength = \case + OverLong -> mkJustIPA "ːː" + HalfLong -> mkJustIPA "ˑ" + Long -> mkJustIPA "ː" + Short -> mkJustIPA mempty + ExtraShort -> mkJustIPA "\x0306" -- ◌ ̆ + SecondaryArticulation sa -> mkIPAOp secondaryArticulation s sa + SuperScriptNumeric ns -> (<>) <$> toIPA s <*> mkJustIPA digits + where + digits = T.concat $ T.pack <$> (code . digitToInt <$> show ns) + + code = \case + 0 -> "\x2070" + 1 -> "\x00b9" + 2 -> "\x00b2" + 3 -> "\x00b3" + 4 -> "\x2074" + 5 -> "\x2075" + 6 -> "\x2076" + 7 -> "\x2077" + 8 -> "\x2078" + 9 -> "\x2079" + _ -> mempty + + feature -> (<>) <$> toIPA s <*> case feature of + Aspirated -> mkJustIPA "\x02b0" -- ◌ʰ + MoreRounded -> mkJustIPA "\x0339" -- ◌̹ + LessRounded -> mkJustIPA "\x031c" -- ◌̜ + Advanced -> mkJustIPA "\x031f" -- ◌̟ + Retracted -> mkJustIPA "\x0320" -- ◌̠ + Centralized -> mkJustIPA "\x0308" -- ◌̈ + MidCentralized -> mkJustIPA "\x033d" -- ◌̽ + Compressed -> mkJustIPA "\x1d5d" -- ◌ᵝ + Syllabic -> mkJustIPA "\x0329" -- ◌̩ + NonSyllabic -> mkJustIPA "\x032f" -- ◌̯ + Rhotacized -> mkJustIPA "\x02de" -- ◌˞ + BreathyVoice -> mkJustIPA "\x0324" -- ◌̤ + CreakyVoice -> mkJustIPA "\x0330" -- ◌̰ + LinguoLabialized -> mkJustIPA "\x033c" -- ◌̼ + Labialized -> mkJustIPA "\x02b7" -- ◌ʷ + Palatalized -> mkJustIPA "\x02b2" -- ◌ʲ + Velarized -> mkJustIPA "\x02e0" -- ◌ˠ + Pharyngealized -> mkJustIPA "\x02e4" -- ◌ˤ + Raised -> mkJustIPA "\x031d" -- ◌̝ + Lowered -> mkJustIPA "\x031e" -- ◌̞ + AdvancedTongueRoot -> mkJustIPA "\x0318" -- ◌̘ + RetractedTongueRoot -> mkJustIPA "\x0319" -- ◌̙ + Dentalized -> mkJustIPA "\x032a" -- ◌̪ + Apical -> mkJustIPA "\x033a" -- ◌̺ + Laminal -> mkJustIPA "\x033b" -- ◌̻ + Nasalized -> mkJustIPA "\x0303" -- ◌̃ + NasalRelease -> mkJustIPA "\x207f" -- ◌ⁿ + LateralRelease -> mkJustIPA "\x02e1" -- ◌ˡ + NoAudibleRelease -> mkJustIPA "\x031a" -- ◌̚ + _ -> mkJustIPA "" -- + +consonant :: Consonant -> Maybe IPA +consonant = \case + -- Pulmonic consonants + -- Bilabials + Pulmonic Voiceless Bilabial Nasal -> mkJustIPA "m̥" + Pulmonic Voiced Bilabial Nasal -> mkJustIPA "m" + Pulmonic Voiced Bilabial Plosive -> mkJustIPA "b" + Pulmonic Voiceless Bilabial Plosive -> mkJustIPA "p" + Pulmonic Voiceless Bilabial (Affricate NonSibilant) -> mkJustIPA "p͡ɸ" + Pulmonic Voiced Bilabial (Affricate NonSibilant) -> mkJustIPA "b͡β" + Pulmonic Voiceless Bilabial (Fricative NonSibilant) -> mkJustIPA "ɸ" + Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkJustIPA "β" + Pulmonic Voiced Bilabial Flap -> mkJustIPA "ⱱ̟" + Pulmonic Voiceless Bilabial Trill -> mkJustIPA "ʙ̥" + Pulmonic Voiced Bilabial Trill -> mkJustIPA "ʙ" + + -- Labio-dentals + Pulmonic Voiced LabioDental Nasal -> mkJustIPA "ɱ" + Pulmonic Voiceless LabioDental Plosive -> mkJustIPA "p̪" + Pulmonic Voiced LabioDental Plosive -> mkJustIPA "b̪" + Pulmonic Voiceless LabioDental (Affricate NonSibilant) -> + mkJustIPA "p̪͡f" + Pulmonic Voiced LabioDental (Affricate NonSibilant) -> mkJustIPA "b̪͡v" + Pulmonic Voiceless LabioDental (Fricative NonSibilant) -> mkJustIPA "f" + Pulmonic Voiced LabioDental (Fricative NonSibilant) -> mkJustIPA "v" + Pulmonic Voiced LabioDental Approximant -> mkJustIPA "ʋ" + Pulmonic Voiced LabioDental Flap -> mkJustIPA "ⱱ" + + -- Linguo-labials + Pulmonic Voiced LinguoLabial Nasal -> mkJustIPA "n̼" + Pulmonic Voiceless LinguoLabial Plosive -> mkJustIPA "t̼" + Pulmonic Voiced LinguoLabial Plosive -> mkJustIPA "d̼" + Pulmonic Voiceless LinguoLabial (Fricative NonSibilant) -> + mkJustIPA "θ̼ " + Pulmonic Voiced LinguoLabial (Fricative NonSibilant) -> mkJustIPA "ð̼" + Pulmonic Voiced LinguoLabial Flap -> mkJustIPA "ɾ̼" + + -- Dentals + Pulmonic Voiceless Dental (Affricate NonSibilant) -> mkJustIPA "t̼͡θ" + Pulmonic Voiced Dental (Affricate NonSibilant) -> mkJustIPA "d̼͡ð" + Pulmonic Voiceless Dental (Fricative NonSibilant) -> mkJustIPA "θ" + Pulmonic Voiced Dental (Fricative NonSibilant) -> mkJustIPA "ð" + + -- Alveolars + Pulmonic Voiceless Alveolar Nasal -> mkJustIPA "n̥" + Pulmonic Voiced Alveolar Nasal -> mkJustIPA "n" + Pulmonic Voiceless Alveolar Plosive -> mkJustIPA "t" + Pulmonic Voiced Alveolar Plosive -> mkJustIPA "d" + Pulmonic Voiceless Alveolar (Affricate Sibilant) -> mkJustIPA "t͡s" + Pulmonic Voiced Alveolar (Affricate Sibilant) -> mkJustIPA "d͡z" + Pulmonic Voiceless Alveolar (Affricate NonSibilant) -> + mkJustIPA "t͡ɹ̝̊" + Pulmonic Voiced Alveolar (Affricate NonSibilant) -> mkJustIPA "d͡ɹ̝" + Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkJustIPA "s" + Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkJustIPA "z" + Pulmonic Voiced Alveolar Approximant -> mkJustIPA "ɹ" + Pulmonic Voiceless Alveolar Flap -> mkJustIPA "ɾ̥" + Pulmonic Voiced Alveolar Flap -> mkJustIPA "ɾ" + Pulmonic Voiceless Alveolar Trill -> mkJustIPA "r" + Pulmonic Voiced Alveolar Trill -> mkJustIPA "r̥" + Pulmonic Voiceless Alveolar LateralAffricate -> mkJustIPA "tɬ" + Pulmonic Voiced Alveolar LateralAffricate -> mkJustIPA "dɮ" + Pulmonic Voiceless Alveolar LateralFricative -> mkJustIPA "ɬ" + Pulmonic Voiced Alveolar LateralFricative -> mkJustIPA "ɮ" + Pulmonic Voiced Alveolar LateralApproximant -> mkJustIPA "l" + Pulmonic Voiceless Alveolar LateralFlap -> mkJustIPA "ɺ̥" + Pulmonic Voiced Alveolar LateralFlap -> mkJustIPA "ɺ" + + -- Post-alveolars + Pulmonic Voiceless PostAlveolar (Affricate Sibilant) -> mkJustIPA "t͡ʃ" + Pulmonic Voiced PostAlveolar (Affricate Sibilant) -> mkJustIPA "d͡ʒ" + Pulmonic Voiceless PostAlveolar (Affricate NonSibilant) -> + mkJustIPA "tɹ̠̊˔" + Pulmonic Voiced PostAlveolar (Affricate NonSibilant) -> + mkJustIPA "d͡ɹ̠˔" + Pulmonic Voiceless PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʃ" + Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʒ" + Pulmonic Voiceless PostAlveolar (Fricative NonSibilant) -> + mkJustIPA "ɹ̠̊˔" + Pulmonic Voiced PostAlveolar (Fricative NonSibilant) -> mkJustIPA "ɹ̠˔" + + -- Retroflexes + Pulmonic Voiceless Retroflex Nasal -> mkJustIPA "ɳ̊" + Pulmonic Voiced Retroflex Nasal -> mkJustIPA "ɳ" + Pulmonic Voiceless Retroflex Plosive -> mkJustIPA "ʈ" + Pulmonic Voiced Retroflex Plosive -> mkJustIPA "ɖ" + Pulmonic Voiceless Retroflex (Affricate Sibilant) -> mkJustIPA "ʈ͡ʂ" + Pulmonic Voiced Retroflex (Affricate Sibilant) -> mkJustIPA "ɖ͡ʐ" + Pulmonic Voiceless Retroflex (Fricative Sibilant) -> mkJustIPA "ʂ" + Pulmonic Voiced Retroflex (Fricative Sibilant) -> mkJustIPA "ʐ" + Pulmonic Voiced Retroflex (Fricative NonSibilant) -> mkJustIPA "ɻ˔" + Pulmonic Voiced Retroflex Approximant -> mkJustIPA "ɻ" + Pulmonic Voiceless Retroflex Flap -> mkJustIPA "ɽ̊" + Pulmonic Voiced Retroflex Flap -> mkJustIPA "ɽ" + Pulmonic Voiceless Retroflex Trill -> mkJustIPA "ɽ̊r̥" + Pulmonic Voiced Retroflex Trill -> mkJustIPA "ɽr" + Pulmonic Voiceless Retroflex LateralAffricate -> mkJustIPA "ʈɭ̊˔" + Pulmonic Voiced Retroflex LateralAffricate -> mkJustIPA "ɖɭ˔" + Pulmonic Voiceless Retroflex LateralFricative -> mkJustIPA "ɭ̊˔" + Pulmonic Voiced Retroflex LateralFricative -> mkJustIPA "ɭ˔" + Pulmonic Voiced Retroflex LateralApproximant -> mkJustIPA "ɭ" + Pulmonic Voiceless Retroflex LateralFlap -> mkJustIPA "ɭ̥̆" + Pulmonic Voiced Retroflex LateralFlap -> mkJustIPA "ɭ̆" + + -- Palatals + Pulmonic Voiceless Palatal Nasal -> mkJustIPA "ɲ̊" + Pulmonic Voiced Palatal Nasal -> mkJustIPA "ɲ" + Pulmonic Voiceless Palatal Plosive -> mkJustIPA "c" + Pulmonic Voiced Palatal Plosive -> mkJustIPA "ɟ" + Pulmonic Voiceless Palatal (Affricate Sibilant) -> mkJustIPA "t͡ɕ" + Pulmonic Voiced Palatal (Affricate Sibilant) -> mkJustIPA "d͡ʑ" + Pulmonic Voiceless Palatal (Affricate NonSibilant) -> mkJustIPA "c͡ç" + Pulmonic Voiced Palatal (Affricate NonSibilant) -> mkJustIPA "ɟ͡ʝ" + Pulmonic Voiceless Palatal (Fricative Sibilant) -> mkJustIPA "ɕ" + Pulmonic Voiced Palatal (Fricative Sibilant) -> mkJustIPA "ʑ" + Pulmonic Voiceless Palatal (Fricative NonSibilant) -> mkJustIPA "ç" + Pulmonic Voiced Palatal (Fricative NonSibilant) -> mkJustIPA "ʝ" + Pulmonic Voiced Palatal Approximant -> mkJustIPA "j" + Pulmonic Voiceless Palatal LateralAffricate -> mkJustIPA "cʎ̝̊" + Pulmonic Voiced Palatal LateralAffricate -> mkJustIPA "ɟʎ̝" + Pulmonic Voiceless Palatal LateralFricative -> mkJustIPA "ʎ̝̊" + Pulmonic Voiced Palatal LateralFricative -> mkJustIPA "ʎ̝" + Pulmonic Voiced Palatal LateralApproximant -> mkJustIPA "ʎ" + Pulmonic Voiced Palatal LateralFlap -> mkJustIPA "ʎ̆" + + -- Velars + Pulmonic Voiceless Velar Nasal -> mkJustIPA "ŋ̊" + Pulmonic Voiced Velar Nasal -> mkJustIPA "ŋ" + Pulmonic Voiceless Velar Plosive -> mkJustIPA "k" + Pulmonic Voiced Velar Plosive -> mkJustIPA "g" + Pulmonic Voiceless Velar (Affricate NonSibilant) -> mkJustIPA "k͡x" + Pulmonic Voiced Velar (Affricate NonSibilant) -> mkJustIPA "g͡ɣ" + Pulmonic Voiceless Velar (Fricative NonSibilant) -> mkJustIPA "x" + Pulmonic Voiced Velar (Fricative NonSibilant) -> mkJustIPA "ɣ" + Pulmonic Voiced Velar Approximant -> mkJustIPA "ɰ" + Pulmonic Voiceless Velar LateralAffricate -> mkJustIPA "kʟ̝̊" + Pulmonic Voiced Velar LateralAffricate -> mkJustIPA "ɡʟ̝" + Pulmonic Voiceless Velar LateralFricative -> mkJustIPA "ʟ̝̊" + Pulmonic Voiced Velar LateralFricative -> mkJustIPA "ʟ̝" + Pulmonic Voiced Velar LateralApproximant -> mkJustIPA "ʟ" + Pulmonic Voiced Velar LateralFlap -> mkJustIPA "ʟ̆" + + -- Uvulars + Pulmonic Voiced Uvular Nasal -> mkJustIPA "ɴ" + Pulmonic Voiceless Uvular Plosive -> mkJustIPA "q" + Pulmonic Voiced Uvular Plosive -> mkJustIPA "ɢ" + Pulmonic Voiceless Uvular (Affricate NonSibilant) -> mkJustIPA "q͡χ" + Pulmonic Voiced Uvular (Affricate NonSibilant) -> mkJustIPA "ɢ͡ʁ" + Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustIPA "χ" + Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustIPA "ʁ" + Pulmonic Voiced Uvular Flap -> mkJustIPA "ɢ̆" + Pulmonic Voiceless Uvular Trill -> mkJustIPA "ʀ" + Pulmonic Voiced Uvular Trill -> mkJustIPA "ʀ̥" + Pulmonic Voiced Uvular LateralApproximant -> mkJustIPA "ʟ̠" + + -- Pharyngeals + Pulmonic Voiceless Pharyngeal Plosive -> mkJustIPA "ʡ" + Pulmonic Voiced Pharyngeal (Affricate NonSibilant) -> mkJustIPA "ʡ͡ʢ" + Pulmonic Voiceless Pharyngeal (Fricative NonSibilant) -> mkJustIPA "ħ" + Pulmonic Voiced Pharyngeal (Fricative NonSibilant) -> mkJustIPA "ʕ" + Pulmonic Voiced Pharyngeal Flap -> mkJustIPA "̆ʡ̆" + Pulmonic Voiceless Pharyngeal Trill -> mkJustIPA "ʜ" + Pulmonic Voiced Pharyngeal Trill -> mkJustIPA "ʢ" + + -- Glottals + Pulmonic Voiceless Glottal Plosive -> mkJustIPA "ʔ" + Pulmonic Voiceless Glottal (Affricate NonSibilant) -> mkJustIPA "ʔ͡h" + Pulmonic Voiceless Glottal (Fricative NonSibilant) -> mkJustIPA "h" + Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkJustIPA "ɦ" + Pulmonic Voiced Glottal Approximant -> mkJustIPA "̆̆ʔ̞" + + -- Ejectives + -- Bilabials + Ejective Bilabial Plosive -> mkJustIPA "pʼ" + Ejective Bilabial (Fricative NonSibilant) -> mkJustIPA "ɸʼ" + + -- Labio-dentals + Ejective LabioDental (Affricate NonSibilant) -> mkJustIPA "p̪͡fʼ" + Ejective LabioDental (Fricative NonSibilant) -> mkJustIPA "fʼ" + + -- Dentals + Ejective Dental Plosive -> mkJustIPA "t̪ʼ" + Ejective Dental (Affricate NonSibilant) -> mkJustIPA "t̪͡θʼ" + Ejective Dental (Fricative NonSibilant) -> mkJustIPA "θʼ" + + -- Alveolars + Ejective Alveolar Plosive -> mkJustIPA "tʼ" + Ejective Alveolar (Affricate Sibilant) -> mkJustIPA "t͡sʼ" + Ejective Alveolar (Fricative Sibilant) -> mkJustIPA "sʼ" + Ejective Alveolar LateralAffricate -> mkJustIPA "t͡ɬʼ" + Ejective Alveolar LateralFricative -> mkJustIPA "ɬʼ" + + -- Post-alveolars + Ejective PostAlveolar (Affricate Sibilant) -> mkJustIPA "t͡ʃʼ" + Ejective PostAlveolar (Fricative Sibilant) -> mkJustIPA "ʃʼ" + + -- Retroflexes + Ejective Retroflex Plosive -> mkJustIPA "ʈʼ" + Ejective Retroflex (Affricate Sibilant) -> mkJustIPA "ʈ͡ʂʼ" + Ejective Retroflex (Fricative Sibilant) -> mkJustIPA "ʂʼ" + + -- Palatals + Ejective Palatal Plosive -> mkJustIPA "cʼ" + Ejective Palatal (Affricate Sibilant) -> mkJustIPA "t͡ɕʼ" + Ejective Palatal (Fricative Sibilant) -> mkJustIPA "ɕʼ" + Ejective Palatal LateralAffricate -> mkJustIPA "cʎ̝̊ʼ" + + -- Velars + Ejective Velar Plosive -> mkJustIPA "kʼ" + Ejective Velar (Affricate NonSibilant) -> mkJustIPA "k͡xʼ" + Ejective Velar (Fricative NonSibilant) -> mkJustIPA "xʼ" + Ejective Velar LateralAffricate -> mkJustIPA "kʟ̝̊ʼ" + + -- Uvulars + Ejective Uvular Plosive -> mkJustIPA "qʼ" + Ejective Uvular (Affricate NonSibilant) -> mkJustIPA "q͡χʼ" + Ejective Uvular (Fricative NonSibilant) -> mkJustIPA "χʼ" + + -- Pharyngeals + Ejective Pharyngeal Plosive -> mkJustIPA "ʡʼ " + + -- Implosives + Implosive Voiceless Bilabial -> mkJustIPA "ƥ" + Implosive Voiced Bilabial -> mkJustIPA "ɓ" + Implosive Voiceless Dental -> mkJustIPA "ƭ̪" + Implosive Voiced Dental -> mkJustIPA "ɗ̪" + Implosive Voiceless Alveolar -> mkJustIPA "ɗ" + Implosive Voiced Alveolar -> mkJustIPA "ƭ" + Implosive Voiceless Retroflex -> mkJustIPA "ᶑ" + Implosive Voiced Retroflex -> mkJustIPA "ƭ̢" + Implosive Voiceless Palatal -> mkJustIPA "ƈ" + Implosive Voiced Palatal -> mkJustIPA "ʄ" + Implosive Voiceless Velar -> mkJustIPA "ƙ" + Implosive Voiced Velar -> mkJustIPA "ɠ" + Implosive Voiceless Uvular -> mkJustIPA "ʠ" + Implosive Voiced Uvular -> mkJustIPA "ʛ" + + -- Clicks + Click Bilabial -> mkJustIPA "ʘ" + Click Dental -> mkJustIPA "ǀ" + Click Alveolar -> mkJustIPA "ǃ" + Click PostAlveolar -> mkJustIPA "ǁ" -- lateral click + Click Palatal -> mkJustIPA "ǂ" + + -- Double articulation + DoublyArticulated Voiced Bilabial Alveolar Nasal -> mkJustIPA "n͡m" + DoublyArticulated Voiceless Bilabial Alveolar Plosive -> mkJustIPA "t͡p" + DoublyArticulated Voiced Bilabial Alveolar Plosive -> mkJustIPA "d͡b" + DoublyArticulated Voiced Bilabial Velar Nasal -> mkJustIPA "ŋ͡m" + DoublyArticulated Voiceless Bilabial Velar Plosive -> mkJustIPA "k͡p" + DoublyArticulated Voiced Bilabial Velar Plosive -> mkJustIPA "g͡b" + DoublyArticulated Voiceless Uvular Pharyngeal Plosive -> mkJustIPA "q͡ʡ" + DoublyArticulated Voiceless Bilabial Palatal (Fricative NonSibilant) -> + mkJustIPA "ɥ̊" + DoublyArticulated Voiced Bilabial Palatal Approximant -> mkJustIPA "ɥ" + DoublyArticulated Voiceless Bilabial Velar (Fricative NonSibilant) -> + mkJustIPA "ʍ" + DoublyArticulated Voiced Bilabial Velar Approximant -> mkJustIPA "w" + DoublyArticulated Voiced Alveolar Velar LateralApproximant -> + mkJustIPA "ɫ" + -- The sj-sound in Swedish phonology; actual realization is contested + -- and appears to vary between dialects + DoublyArticulated Voiceless PostAlveolar Velar (Fricative Sibilant) -> + mkJustIPA "ɧ" + DoublyArticulated Voiceless LabioDental Velar (Fricative Sibilant) -> + mkJustIPA "ɧ" + + _ -> Nothing + +vowel :: Segment -> Maybe IPA +vowel = \case + Vowel Close Front Unrounded -> mkJustIPA "i" + Vowel Close Front Rounded -> mkJustIPA "y" + Vowel Close Central Unrounded -> mkJustIPA "ɨ" + Vowel Close Central Rounded -> mkJustIPA "ʉ" + Vowel Close Back Unrounded -> mkJustIPA "ɯ" + Vowel Close Back Rounded -> mkJustIPA "u" + Vowel NearClose Front Unrounded -> mkJustIPA "ɪ" + Vowel NearClose Front Rounded -> mkJustIPA "ʏ" + Vowel NearClose Back Rounded -> mkJustIPA "ʊ" + Vowel CloseMid Front Unrounded -> mkJustIPA "e" + Vowel CloseMid Front Rounded -> mkJustIPA "ø" + Vowel CloseMid Central Unrounded -> mkJustIPA "ɘ" + Vowel CloseMid Central Rounded -> mkJustIPA "ɵ" + Vowel CloseMid Back Unrounded -> mkJustIPA "ɤ" + Vowel CloseMid Back Rounded -> mkJustIPA "o" + Vowel Mid Front Unrounded -> mkJustIPA "e̞" + Vowel Mid Front Rounded -> mkJustIPA "ø̞" + Vowel Mid Central Unrounded -> mkJustIPA "ə" + Vowel Mid Central Rounded -> mkJustIPA "ə" + Vowel Mid Back Unrounded -> mkJustIPA "ɤ̞" + Vowel Mid Back Rounded -> mkJustIPA "o̞" + Vowel OpenMid Front Unrounded -> mkJustIPA "ɛ" + Vowel OpenMid Front Rounded -> mkJustIPA "œ" + Vowel OpenMid Central Unrounded -> mkJustIPA "ɜ" + Vowel OpenMid Central Rounded -> mkJustIPA "ɞ" + Vowel OpenMid Back Unrounded -> mkJustIPA "ʌ" + Vowel OpenMid Back Rounded -> mkJustIPA "ɔ" + Vowel NearOpen Front Unrounded -> mkJustIPA "æ" + Vowel NearOpen Central Unrounded -> mkJustIPA "ɐ" + Vowel Open Front Unrounded -> mkJustIPA "a" + Vowel Open Front Rounded -> mkJustIPA "ɶ" + Vowel Open Central Unrounded -> mkJustIPA "ä" + Vowel Open Back Unrounded -> mkJustIPA "ɑ" + Vowel Open Back Rounded -> mkJustIPA "ɒ" + _ -> Nothing + +secondaryArticulation :: Segment -> Maybe IPA +secondaryArticulation = \case + Consonant c -> case c of + Pulmonic Voiced Bilabial Nasal -> mkJustIPA "\x1d50" + Pulmonic Voiced LabioDental Nasal -> mkJustIPA "\x1dac" + Pulmonic Voiced Alveolar Nasal -> mkJustIPA "\x207f" + Pulmonic Voiced Retroflex Nasal -> mkJustIPA "\x1daf" + Pulmonic Voiced Palatal Nasal -> mkJustIPA "\x1dae" + Pulmonic Voiced Velar Nasal -> mkJustIPA "\x1d51" + Pulmonic Voiced Uvular Nasal -> mkJustIPA "\x1db0" + + Pulmonic Voiced Bilabial Plosive -> mkJustIPA "\x1d56" + Pulmonic Voiceless Bilabial Plosive -> mkJustIPA "\x1d47" + Pulmonic Voiceless Alveolar Plosive -> mkJustIPA "\x1d57" + Pulmonic Voiced Alveolar Plosive -> mkJustIPA "\x1d48" + Pulmonic Voiceless Palatal Plosive -> mkJustIPA "\x1d9c" + Pulmonic Voiced Palatal Plosive -> mkJustIPA "\x1da1" + Pulmonic Voiceless Velar Plosive -> mkJustIPA "\x1d4f" + Pulmonic Voiced Velar Plosive -> mkJustIPA "\x1da2" + Pulmonic Voiceless Glottal Plosive -> mkJustIPA "\x02c0" + + Pulmonic Voiced Bilabial (Fricative NonSibilant) -> mkJustIPA "\x1db2" + Pulmonic Voiceless Bilabial (Fricative NonSibilant) -> + mkJustIPA "\x1d5d" + Pulmonic Voiced LabioDental (Fricative NonSibilant) -> + mkJustIPA "\x1da0" + Pulmonic Voiceless LabioDental (Fricative NonSibilant) -> + mkJustIPA "\x1d5b" + Pulmonic Voiceless Dental (Fricative NonSibilant) -> mkJustIPA "\x1dbf" + Pulmonic Voiced Dental (Fricative NonSibilant) -> mkJustIPA "\x1d9e" + Pulmonic Voiceless Alveolar (Fricative Sibilant) -> mkJustIPA "\x02e2" + Pulmonic Voiced Alveolar (Fricative Sibilant) -> mkJustIPA "\x1dbb" + Pulmonic Voiceless PostAlveolar (Fricative Sibilant) -> + mkJustIPA "\x1db4" + Pulmonic Voiced PostAlveolar (Fricative Sibilant) -> mkJustIPA "\x1dbe" + Pulmonic Voiceless Palatal (Fricative Sibilant) -> mkJustIPA "\x1d9d" + Pulmonic Voiced Palatal (Fricative Sibilant) -> mkJustIPA "\x1dbd" + Pulmonic Voiceless Palatal (Fricative NonSibilant) -> + mkJustIPA "\x1d9c\x0327" + Pulmonic Voiced Palatal (Fricative NonSibilant) -> mkJustIPA "\x1da8" + Pulmonic Voiceless Velar (Fricative NonSibilant) -> mkJustIPA "\x02e3" + Pulmonic Voiced Velar (Fricative NonSibilant) -> mkJustIPA "\x02e0" + Pulmonic Voiceless Uvular (Fricative NonSibilant) -> mkJustIPA "\x1d61" + Pulmonic Voiced Uvular (Fricative NonSibilant) -> mkJustIPA "\x02b6" + Pulmonic Voiceless Glottal (Fricative NonSibilant) -> + mkJustIPA "\x02b0" + Pulmonic Voiced Glottal (Fricative NonSibilant) -> mkJustIPA "\x02b1" + + Pulmonic Voiced LabioDental Approximant -> mkJustIPA "\x1db9" + Pulmonic Voiced Alveolar Approximant -> mkJustIPA "\x02b4" + Pulmonic Voiced Retroflex Approximant -> mkJustIPA "\x02b5" + Pulmonic Voiced Palatal Approximant -> mkJustIPA "\x02b2" + Pulmonic Voiceless Velar Approximant -> mkJustIPA "\xab69" + Pulmonic Voiced Velar Approximant -> mkJustIPA "\x1dad" + + Pulmonic Voiced Alveolar Trill -> mkJustIPA "\x02b3" + + _ -> Nothing + + Vowel Close Front Unrounded -> mkJustIPA "\x2071" + Vowel Close Front Rounded -> mkJustIPA "\x02b8" + Vowel Close Central Unrounded -> mkJustIPA "\x1da4" + Vowel Close Central Rounded -> mkJustIPA "\x1db6" + Vowel Close Back Unrounded -> mkJustIPA "\x1d5a" + Vowel Close Back Rounded -> mkJustIPA "\x1d58" + Vowel NearClose Front Unrounded -> mkJustIPA "\x1da6" + Vowel NearClose Central Unrounded -> mkJustIPA "\x1da7" + Vowel NearClose Back Rounded -> mkJustIPA "\x1db7" + Vowel Mid Central Unrounded -> mkJustIPA "\x1d4a" + Vowel Mid Central Rounded -> mkJustIPA "\x1d4a" + Vowel OpenMid Front Unrounded -> mkJustIPA "\x1d4b" + Vowel OpenMid Front Rounded -> mkJustIPA "\xa7f9" + Vowel OpenMid Central Unrounded -> mkJustIPA "\x1d9f" + Vowel OpenMid Back Unrounded -> mkJustIPA "\x1dba" + Vowel OpenMid Back Rounded -> mkJustIPA "\x1d53" + Vowel NearOpen Front Unrounded -> mkJustIPA "\x1d46" + Vowel NearOpen Central Unrounded -> mkJustIPA "\x1d44" + Vowel NearOpen Back Unrounded -> mkJustIPA "\x1d45" + Vowel NearOpen Back Rounded -> mkJustIPA "\x1d9b" + Vowel Open Front Unrounded -> mkJustIPA "\x1d43" + Vowel Open Back Rounded -> mkJustIPA "\x1d44" + + _ -> Nothing + diff --git a/src/Language/IPA/Types.hs b/src/Language/IPA/Types.hs new file mode 100644 --- /dev/null +++ b/src/Language/IPA/Types.hs @@ -0,0 +1,263 @@ +{-# 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 ) + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,90 @@ +{-# 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˩˥ˈ"