54 lines
1.2 KiB
Haskell
54 lines
1.2 KiB
Haskell
|
{-# LANGUAGE NamedFieldPuns #-}
|
||
|
module Lang.En.Morpheme (
|
||
|
Morpheme(..)
|
||
|
, Output(..)
|
||
|
, morphemes
|
||
|
, parse
|
||
|
) where
|
||
|
|
||
|
import Data.String (fromString)
|
||
|
import Lang.En.Grapheme (Grapheme(..))
|
||
|
import qualified Lang.En.Grapheme as Grapheme (Output(..))
|
||
|
import Stream (Stream)
|
||
|
import Transducer (Transducer(..), fromList, run)
|
||
|
|
||
|
data Regular =
|
||
|
LY
|
||
|
| ED
|
||
|
| UN
|
||
|
| CAT
|
||
|
| DOG
|
||
|
| EaT
|
||
|
| SLEeP
|
||
|
| A
|
||
|
| ThE
|
||
|
| GOoD
|
||
|
| KINd
|
||
|
| ANd
|
||
|
| Space
|
||
|
deriving (Bounded, Enum, Eq, Ord, Show)
|
||
|
|
||
|
data Morpheme = Morpheme Regular | Punctuation String deriving (Eq, Ord, Show)
|
||
|
|
||
|
auto :: Morpheme -> ([Grapheme], Either [Grapheme] Morpheme)
|
||
|
auto morpheme = (fromString $ show morpheme, Right morpheme)
|
||
|
|
||
|
morphemes :: Transducer Grapheme.Output Grapheme Morpheme
|
||
|
morphemes = (fromList $ auto <$> [minBound .. maxBound]) {
|
||
|
projector = Grapheme.grapheme
|
||
|
, rules = []
|
||
|
}
|
||
|
|
||
|
data Output = Output {
|
||
|
rawText :: String
|
||
|
, morpheme :: Morpheme
|
||
|
} deriving (Eq, Show)
|
||
|
|
||
|
parse :: Stream Grapheme.Output -> Stream Output
|
||
|
parse = fmap fusionGraphemes . run morphemes
|
||
|
where
|
||
|
fusionGraphemes (graphemes, morpheme) = Output {
|
||
|
rawText = concat $ Grapheme.rawText <$> graphemes
|
||
|
, morpheme
|
||
|
}
|