module Lojban.Lujvo (rafsis,Rafsi(..)) where import Prelude hiding ((^),(*),(/),(+)) import Text.ParserCombinators.Parsec hiding (notFollowedBy) import Control.Monad import Control.Applicative ((<$>)) data Rafsi = ShortRafsi [Char] | Rafsi4Let [Char] | Rafsi5Let [Char] instance Show Rafsi where show (ShortRafsi e) = e show (Rafsi4Let e) = e show (Rafsi5Let e) = e rafsis :: String -> [Rafsi] rafsis s = case parse lujvo "" s of Right rs -> rs Left _ -> [] lujvo = ((rafsi5 <!anyChar / rafsi3 / rafsi4)+) <!anyChar rafsi3 = ShortRafsi <$> ((cvc / ccv / cvv) <!y <!(anyChar >> y)) rafsi4 = Rafsi4Let <$> (ct & (vt & ct / ct & vt) & ct <&anyChar <&!(y?)) rafsi5 = do (Rafsi4Let ls) <- rafsi4; v <- vowel; return $ Rafsi5Let (ls++v) cvc = ct & vt & ct <&anyChar <&!(y?) ccv = ct & ct & vt <&!(((r / n) <& consonant)?) cvv = ct & (diphthong / vt & h & vt) <&!(((r / n) <& consonant)?) ct = consonant vt = vowel syllabic = l / m / n / r consonant = voiced / unvoiced / syllabic diphthong = (a & i / a & u / e & i / o & i) <!nucleus <!glide vowel = (a / e / i / o / u) <!nucleus a = oneOf' "aA" e = oneOf' "eE" i = oneOf' "iI" o = oneOf' "oO" u = oneOf' "uU" y = oneOf' "yY" affricate = t & c / t & s / d & j / d & z glide = (i / u) <&nucleus <!glide nucleus = vowel / diphthong / y <!nucleus voiced = b / d / g / j / v / z unvoiced = c / f / k / p / s / t / x l = oneOf' "lL" <!l m = oneOf' "mM" <!m <!z n = oneOf' "nN" <!n <!affricate r = oneOf' "rR" <!r b = oneOf' "bB" <!b <!unvoiced d = oneOf' "dD" <!d <!unvoiced g = oneOf' "gG" <!g <!unvoiced v = oneOf' "vV" <!v <!unvoiced j = oneOf' "jJ" <!j <!z <!unvoiced z = oneOf' "zZ" <!z <!j <!unvoiced s = oneOf' "sS" <!s <!c <!voiced c = oneOf' "cC" <!c <!s <!x <!voiced x = oneOf' "xX" <!x <!c <!k <!voiced k = oneOf' "kK" <!k <!x <!voiced f = oneOf' "fF" <!f <!voiced p = oneOf' "pP" <!p <!voiced t = oneOf' "tT" <!t <!voiced h = oneOf' "'h" <!h <&nucleus p <&! p1 = do r <- p; p1; return r infixl 2 <&! oneOf' p = oneOf p >>= return . (:[]) (+) p = many1 (try p) (*) p = many (try p) (<!) a a1 = do r <- a; ((try a1 >>= unexpected . show) <|> return r) infixl 2 <! (/) a a1 = (try a <|> a1) infixl 1 / (&) a a1 = (do r <- a; r1 <- a1; return $ mplus r r1) infixl 4 & (<&) a a1 = do r <- a; lookAhead a1; return r infixl 2 <& (?) p = (try p <|> return mzero)