chore: import pie
This commit is contained in:
Kierán Meinhardt
101
pie/src/Lib.hs
Normal file
101
pie/src/Lib.hs
Normal file
@@ -0,0 +1,101 @@
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Lib
|
||||
( someFunc
|
||||
)
|
||||
where
|
||||
|
||||
import Phonology
|
||||
import Util ( replaceSublist )
|
||||
|
||||
import Control.Monad ( forM_ )
|
||||
import Data.List ( zip3 )
|
||||
|
||||
{-
|
||||
import Data.Void
|
||||
import qualified Text.Megaparsec as Parsec
|
||||
import qualified Text.Megaparsec.Stream as Parsec
|
||||
|
||||
instance Parsec.Stream [Phoneme] where
|
||||
type Token [Phoneme] = Phoneme
|
||||
type Tokens [Phoneme] = [Phoneme]
|
||||
tokensToChunk _ = id
|
||||
chunkToTokens _ = id
|
||||
chunkLength _ = length
|
||||
take1_ [] = Nothing
|
||||
take1_ (x : xs) = Just (x, xs)
|
||||
takeN_ n xs = if length xs >= n then Just (splitAt n xs) else Nothing
|
||||
takeWhile_ = span
|
||||
showTokens _ = show
|
||||
reachOffset offset posState =
|
||||
Parsec.reachOffset' splitAt foldl' id id ('\n', '\t') o pst
|
||||
|
||||
|
||||
|
||||
parseRoot :: Parsec.Parsec Void [Phoneme] ()
|
||||
parseRoot = () <$ do
|
||||
Parsec.optional $ satisfyFeature (`elem` [Sibilant, Laryngeal])
|
||||
Parsec.optional $ satisfyFeature isPlosive
|
||||
satisfyFeature $ \p -> isPlosive p || p == Resonant
|
||||
Parsec.single E
|
||||
satisfyFeature $ \p -> isPlosive p || p == Resonant
|
||||
Parsec.optional $ satisfyFeature isPlosive
|
||||
Parsec.optional $ satisfyFeature (`elem` [Sibilant, Laryngeal])
|
||||
where
|
||||
satisfyFeature :: (FeatureSet -> Bool) -> Parsec.Parsec Void [Phoneme] Phoneme
|
||||
satisfyFeature p = Parsec.satisfy (p . features)
|
||||
-}
|
||||
|
||||
|
||||
|
||||
syllabify :: [Phoneme] -> [Bool]
|
||||
syllabify = replaceSublist [True, True] [True, False] -- replace VV by VC
|
||||
. foldr isSonant []
|
||||
where
|
||||
hasToBeSyllabic p = features p == Vowel
|
||||
canBeSyllabic p = features p `elem` [Vowel, Resonant]
|
||||
isSonant current xs = case xs of
|
||||
[] -> [canBeSyllabic current] -- make last phoneme in word syllabic
|
||||
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
|
||||
|
||||
|
||||
syllableCores :: [Phoneme] -> [Bool]
|
||||
syllableCores = localMax . (++ [0]) . ([0] ++) . map (sonority . features)
|
||||
where
|
||||
localMax xs = map project $ zip3 xs (tail xs) (drop 2 xs)
|
||||
where project (x, y, z) = x <= y && y >= z
|
||||
|
||||
-- chunkSyllables :: [Bool] -> [[Bool]]
|
||||
-- chunkSyllables = _
|
||||
|
||||
someFunc :: IO ()
|
||||
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]
|
||||
, [Kj, L, U, Dh, I]
|
||||
, [H1, N, E, U, N]
|
||||
, [H2, U, E, H1, N, T, O, S]
|
||||
]
|
||||
forM_ pieLines $ \line -> do
|
||||
putStr $ concatMap show line
|
||||
putChar ' '
|
||||
putStrLn $ concat $ zipWith showSyllabic line (syllabify line)
|
||||
105
pie/src/Phonology.hs
Normal file
105
pie/src/Phonology.hs
Normal file
@@ -0,0 +1,105 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
module Phonology where
|
||||
|
||||
|
||||
data Manner = MediaAspirata | Media | Tenuis
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data Place = Labial | Dental | Palatal | Velar | Labiovelar
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data Phoneme
|
||||
= E | O | A | E_ | O_ | A_
|
||||
| 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 | H
|
||||
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
|
||||
= Vowel
|
||||
| Resonant
|
||||
| Laryngeal
|
||||
| Sibilant
|
||||
| Plosive { manner :: Manner, place :: Place }
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
sonority :: FeatureSet -> Int
|
||||
sonority = \case
|
||||
Vowel -> 4
|
||||
Resonant -> 3
|
||||
Laryngeal -> 3
|
||||
Sibilant -> 2
|
||||
Plosive _ _ -> 1
|
||||
|
||||
isPlosive :: FeatureSet -> Bool
|
||||
isPlosive (Plosive _ _) = True
|
||||
isPlosive _ = False
|
||||
|
||||
features :: Phoneme -> FeatureSet
|
||||
features phoneme
|
||||
| phoneme == S = Sibilant
|
||||
| phoneme `elem` [E, O, A, E_, O_, A_] = Vowel
|
||||
| phoneme `elem` [H1, H2, H3, H] = Laryngeal
|
||||
| phoneme `elem` [I, U, N, M, R, L] = Resonant
|
||||
| otherwise = Plosive
|
||||
{ manner = if
|
||||
| phoneme `elem` [P, T, K, Kj, Kw] -> Tenuis
|
||||
| phoneme `elem` [B, D, G, Gj, Gw] -> Media
|
||||
| phoneme `elem` [Bh, Dh, Gh, Gjh, Gwh] -> MediaAspirata
|
||||
, place = if
|
||||
| phoneme `elem` [P, B, Bh] -> Labial
|
||||
| phoneme `elem` [T, D, Dh] -> Dental
|
||||
| phoneme `elem` [Kj, Gj, Gjh] -> Palatal
|
||||
| phoneme `elem` [K, G, Gh] -> Velar
|
||||
| phoneme `elem` [Kw, Gw, Gwh] -> Labiovelar
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
10
pie/src/Util.hs
Normal file
10
pie/src/Util.hs
Normal file
@@ -0,0 +1,10 @@
|
||||
module Util where
|
||||
|
||||
import Data.List ( isPrefixOf )
|
||||
|
||||
replaceSublist :: Eq a => [a] -> [a] -> [a] -> [a]
|
||||
replaceSublist _ _ [] = []
|
||||
replaceSublist list replacement xss@(x : xs) = if list `isPrefixOf` xss
|
||||
then replacement ++ replaceSublist list replacement (drop (length list) xss)
|
||||
else x : replaceSublist list replacement xs
|
||||
|
||||
Reference in New Issue
Block a user