102 lines
3.2 KiB
Haskell
102 lines
3.2 KiB
Haskell
{-# 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, Laryngeal]
|
|
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)
|