module Language.Lojban.Lujvo (rafsis,fixClusters) 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

fixClusters :: String -> String
fixClusters xs = go xs [] where
    go (x:y:xs) acc | validCluster (x:y:[]) = go (y:xs) (acc++[x])
                    | otherwise             = go (y:xs) (acc++[x]++"y")
    go [x] acc = go [] (acc++[x])
    go [] acc = acc

validCluster :: [Char] -> Bool
validCluster = either (const False) (const True) . parse cluster ""

cluster = do diphthong / (do consonant / vowel; consonant / vowel)

rafsis :: String -> [String]
rafsis s = 
    case parse lujvo "" s of
      Right rs -> map show 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)