add syllabification, remove root parsing
This commit is contained in:
6
default.nix
Normal file
6
default.nix
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
{ pkgs ? import <nixpkgs> {} }:
|
||||||
|
with pkgs.haskellPackages;
|
||||||
|
developPackage {
|
||||||
|
root = ./.;
|
||||||
|
modifier = drv: pkgs.haskell.lib.addBuildTools drv [ cabal-install ghcid ];
|
||||||
|
}
|
||||||
@@ -21,7 +21,6 @@ description: Please see the README on GitHub at <https://github.com/kmei
|
|||||||
|
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- megaparsec >= 8.0 && < 9
|
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
|
|||||||
@@ -34,7 +34,6 @@ library
|
|||||||
src
|
src
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
, megaparsec >=8.0 && <9
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable pie-exe
|
executable pie-exe
|
||||||
@@ -46,7 +45,6 @@ executable pie-exe
|
|||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
, megaparsec >=8.0 && <9
|
|
||||||
, pie
|
, pie
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
@@ -60,6 +58,5 @@ test-suite pie-test
|
|||||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.7 && <5
|
base >=4.7 && <5
|
||||||
, megaparsec >=8.0 && <9
|
|
||||||
, pie
|
, pie
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
96
src/Lib.hs
96
src/Lib.hs
@@ -1,11 +1,13 @@
|
|||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
module Lib
|
module Lib
|
||||||
( someFunc
|
( someFunc
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
import Control.Monad ( forM_ )
|
||||||
|
{-
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import qualified Text.Megaparsec as Parsec
|
import qualified Text.Megaparsec as Parsec
|
||||||
import qualified Text.Megaparsec.Stream as Parsec
|
import qualified Text.Megaparsec.Stream as Parsec
|
||||||
@@ -38,7 +40,7 @@ parseRoot = () <$ do
|
|||||||
where
|
where
|
||||||
satisfyFeature :: (FeatureSet -> Bool) -> Parsec.Parsec Void [Phoneme] Phoneme
|
satisfyFeature :: (FeatureSet -> Bool) -> Parsec.Parsec Void [Phoneme] Phoneme
|
||||||
satisfyFeature p = Parsec.satisfy (p . features)
|
satisfyFeature p = Parsec.satisfy (p . features)
|
||||||
|
-}
|
||||||
|
|
||||||
|
|
||||||
data Manner = Tenuis | Media | MediaAspirata
|
data Manner = Tenuis | Media | MediaAspirata
|
||||||
@@ -50,9 +52,44 @@ data Place = Labial | Dental | Palatal | Velar | Labiovelar
|
|||||||
data Phoneme
|
data Phoneme
|
||||||
= E | O | A | E_ | O_ | A_
|
= E | O | A | E_ | O_ | A_
|
||||||
| I | U | N | M | R | L
|
| I | U | N | M | R | L
|
||||||
| P | B | Bh | T | D | Dh | Kj | Gj | Gjh | K | G | Gh | Kw | Gw | Gwh | S | H1 | H2 | H3
|
| P | B | Bh | T | D | Dh | Kj | Gj | Gjh | K | G | Gh | Kw | Gw | Gwh | S | H1 | H2 | H3 | H
|
||||||
deriving (Eq, Ord)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
|
instance Show Phoneme where
|
||||||
|
show = \case
|
||||||
|
E -> "e"
|
||||||
|
O -> "o"
|
||||||
|
A -> "a"
|
||||||
|
E_ -> "ē"
|
||||||
|
O_ -> "ō"
|
||||||
|
A_ -> "ā"
|
||||||
|
I -> "i"
|
||||||
|
U -> "u"
|
||||||
|
N -> "n"
|
||||||
|
M -> "m"
|
||||||
|
R -> "r"
|
||||||
|
L -> "l"
|
||||||
|
P -> "p"
|
||||||
|
B -> "b"
|
||||||
|
Bh -> "bh"
|
||||||
|
T -> "t"
|
||||||
|
D -> "d"
|
||||||
|
Dh -> "dh"
|
||||||
|
Kj -> "ḱ"
|
||||||
|
Gj -> "ǵ"
|
||||||
|
Gjh -> "ǵh"
|
||||||
|
K -> "k"
|
||||||
|
G -> "g"
|
||||||
|
Gh -> "gh"
|
||||||
|
Kw -> "kʷ"
|
||||||
|
Gw -> "gʷ"
|
||||||
|
Gwh -> "gʷh"
|
||||||
|
S -> "s"
|
||||||
|
H1 -> "h₁"
|
||||||
|
H2 -> "h₂"
|
||||||
|
H3 -> "h₃"
|
||||||
|
H -> "H"
|
||||||
|
|
||||||
data FeatureSet
|
data FeatureSet
|
||||||
= Vowel
|
= Vowel
|
||||||
| Resonant
|
| Resonant
|
||||||
@@ -69,7 +106,7 @@ features :: Phoneme -> FeatureSet
|
|||||||
features phoneme
|
features phoneme
|
||||||
| phoneme == S = Sibilant
|
| phoneme == S = Sibilant
|
||||||
| phoneme `elem` [E, O, A, E_, O_, A_] = Vowel
|
| phoneme `elem` [E, O, A, E_, O_, A_] = Vowel
|
||||||
| phoneme `elem` [H1, H2, H3] = Laryngeal
|
| phoneme `elem` [H1, H2, H3, H] = Laryngeal
|
||||||
| phoneme `elem` [I, U, N, M, R, L] = Resonant
|
| phoneme `elem` [I, U, N, M, R, L] = Resonant
|
||||||
| otherwise = Plosive
|
| otherwise = Plosive
|
||||||
{ manner = if
|
{ manner = if
|
||||||
@@ -85,6 +122,55 @@ features phoneme
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
syllabify :: [Phoneme] -> [Bool]
|
||||||
|
syllabify = foldr isSonant []
|
||||||
|
where
|
||||||
|
hasToBeSyllabic p = features p == Vowel
|
||||||
|
canBeSyllabic p = features p `elem` [Vowel, Resonant, Laryngeal]
|
||||||
|
isSonant current xs = case xs of
|
||||||
|
[] -> [hasToBeSyllabic current] -- last phoneme in word
|
||||||
|
previousIsSonant : _ -> if previousIsSonant
|
||||||
|
then hasToBeSyllabic current : xs -- only vowels are sonant, the rest can be consonantal
|
||||||
|
else canBeSyllabic current : xs -- make syllabic if previous is not syllabic
|
||||||
|
|
||||||
|
showSyllabic :: Phoneme -> Bool -> String
|
||||||
|
showSyllabic phoneme syllabic = case (phoneme, syllabic) of
|
||||||
|
(I , False) -> "y"
|
||||||
|
(U , False) -> "w"
|
||||||
|
(N , True ) -> "ṇ"
|
||||||
|
(M , True ) -> "ṃ"
|
||||||
|
(R , True ) -> "ṛ"
|
||||||
|
(L , True ) -> "ḷ"
|
||||||
|
(H1, True ) -> "ə₁"
|
||||||
|
(H2, True ) -> "ə₂"
|
||||||
|
(H3, True ) -> "ə₃"
|
||||||
|
(H , True ) -> "ə"
|
||||||
|
_ -> show phoneme
|
||||||
|
|
||||||
|
printSyllabified ps =
|
||||||
|
putStr (concatMap show ps) >> putChar ' ' >> print (syllabify ps)
|
||||||
|
|
||||||
someFunc :: IO ()
|
someFunc :: IO ()
|
||||||
someFunc = Parsec.parseTest parseRoot [P, R, E, Kj]
|
someFunc = do
|
||||||
|
let pieLines =
|
||||||
|
[ [Kj, M, T, O, M]
|
||||||
|
, [N, E, H2, U, S]
|
||||||
|
, [I, U, N, E, G, T, I]
|
||||||
|
, [I, U, N, G, E, N, T, I]
|
||||||
|
, [H2, N, R, Bh, I]
|
||||||
|
, [H2, E, R, H3, T, R, O, M]
|
||||||
|
, [H2, I, U, H, O, N]
|
||||||
|
, [H2, S, N, T, I, E, H2]
|
||||||
|
, [Gh, E_, I, M, N, O]
|
||||||
|
, [Kj, U, N, Bh, I]
|
||||||
|
, [D, I, U, O, S]
|
||||||
|
, [N, M, R, T, O, S]
|
||||||
|
, [U, L, Kw, O, S]
|
||||||
|
, [Kj, U, N, O, S]
|
||||||
|
, [D, N, T, N, S]
|
||||||
|
, [N, D, R, Kj, T, O, S]
|
||||||
|
, [U, N, T, O, S]
|
||||||
|
, [D, U, I, D, Kj, M, T]
|
||||||
|
]
|
||||||
|
forM_ pieLines
|
||||||
|
$ \line -> putStrLn $ concat $ zipWith showSyllabic line (syllabify line)
|
||||||
|
|||||||
Reference in New Issue
Block a user