module Text.ParserCombinators.PArrow.Prim (runParser) where
import Text.ParserCombinators.PArrow.CharSet
import Text.ParserCombinators.PArrow.MD
type UserState= ()
type Location = ()
data PS char ustate = PS [char] ustate Location
data Res c u r = POk (PS c u) r | PErr [String]
type PSF c u r = PS c u -> Res c u r
optM :: MD i o -> PSF Char UserState o
optM = matcher
matcher :: MD i o -> PSF Char UserState o
matcher (MNot x) i = case optM x i of
POk _ _ -> PErr ["not"]
PErr _ -> POk i undefined
matcher (MChoice l) i = let mm [] = PErr ["no choice matches"]
mm (c:cs) = case optM c i of
POk s t -> POk s t
_ -> mm cs
in mm l
matcher (MEqual c) (PS (x:xs) u l) = if x == c then POk (PS xs u l) c else PErr ["expected "++[c]]
matcher (MSeq a b) i = case optM a i of
POk s t -> case b of
(MPure _ f) -> POk s (f t)
_ -> optM b s
PErr e -> PErr e
matcher (MStar x) i = let p = optM x
sm st acc = case p st of
POk st' r -> sm st' (r:acc)
PErr _ -> POk st (reverse acc)
in sm i []
matcher (MEmpty) i = POk i (error "result for empty")
matcher (MPure _ _) i = POk i (error "result for pure")
matcher (MCSet cs) (PS (x:xs) u l) = if x `elem` csetValue cs then POk (PS xs u l) x else PErr ["Expected "++show cs]
matcher (MParWire _ _) _ = error "matcher on ParWire"
matcher (MJoin a b) i = case optM a i of
POk s t -> case optM b s of
POk s' t' -> POk s' (t,t')
PErr e' -> PErr e'
PErr e -> PErr e
matcher _ (PS [] _ _) = PErr ["eof"]
matcher _ _ = PErr ["unknown"]
runParser :: MD i o -> String -> Either [String] o
runParser md input = case optM md (PS input () ()) of
POk _ r -> Right r
PErr e -> Left e