module Text.ParserCombinators.UU.Examples where
import Char
import Text.ParserCombinators.UU.Parsing
import Text.ParserCombinators.UU.BasicInstances
type P b = P_m (Str Char) b -> String -> (b, [Error Char Char Int])
test :: P b
test p inp = parse ( (,) <$> p <*> pEnd) (listToStr inp)
lift a = [a]
pa, pb, paz :: P_m (Str Char) [Char]
pa = lift <$> pSym 'a'
pb = lift <$> pSym 'b'
p <++> q = (++) <$> p <*> q
pa2 = pa <++> pa
pa3 = pa <++> pa2
pCount p = (\ a b -> b+1) <$> p <*> pCount p <<|> pReturn 0
pExact 0 p = pReturn []
pExact n p = (:) <$> p <*> pExact (n1) p
paz = pMany (pSym ('a', 'z'))
paz' = pSym (\t -> 'a' <= t && t <= 'z', "a .. z", 'k')
main :: IO ()
main = do print (test pa "a")
print (test pa "b")
print (test pa2 "bbab")
print (test pa "ba")
print (test pa "aa")
print (test (do l <- pCount pa
pExact l pb) "aaacabbb")
print (test (amb ( (++) <$> pa2 <*> pa3 <|> (++) <$> pa3 <*> pa2)) "aaabaa")
print (test paz "ab1z7")
print (test paz' "m")
print (test paz' "")
infixl 3 `opt`
p `opt` v = p <|> pReturn v
pMany p = (:) <$> p <*> pMany p <|> pReturn []
pMany1 p = (:) <$> p <*> pMany p
pChoice = foldr (<|>) pFail
pSeq (p : pp ) = (:) <$> p <*> pSeq pp
pSeq [ ] = pReturn [ ]
pListSep p s = pListSep1 p s `opt` []
pListSep1 p s = (:) <$> p <*> pSepTail p s
where pSepTail p s = pMany (s *> p)
pParens p = id <$ pSym '(' <*> p <* pSym ')'
pBracks p = id <$ pSym '[' <*> p <* pSym ']'
pCurlys p = id <$ pSym '{' <*> p <* pSym '}'
pDigit = pSym ('0', '9')
pDigitAsInt = digit2Int <$> pDigit
pNatural = foldl (\a b -> a * 10 + b ) 0 <$> pMany1 pDigitAsInt
digit2Int a = ord a ord '0'
pLower = pSym ('a','z')
pUpper = pSym ('A','Z')
pLetter = pUpper <|> pLower
pVarId = (:) <$> pLower <*> pMany pIdChar
pConId = (:) <$> pUpper <*> pMany pIdChar
pIdChar = pLower <|> pUpper <|> pDigit <|> pSymIn "='"
pSymIn s = pChoice $ map pSym s
pKey str = pSeq (map pSym str)
run :: forall t. P_m (Str Char) t -> String -> t
run p i = do let (a,b) = exec p i
if null b then a else error (show b)
exec :: P_m (Str Char) b -> String -> (b, [Error Char Char Int])
exec p inp = parse ( (,) <$> p <*> pEnd) (listToStr inp)
pTest_MS :: P_m (Str Char) Char
pTest_MS = id <$ pSym 'u' <*> pSym '2'
pOp (c, op) = op <$ pSym c
pChainl t op = applyall <$> t <*> pMany (flip <$> op <*> t)
applyall e [] = e
applyall e (f:fs) = applyall (f e) fs
expr = term `pChainl` (pOp ('+', (+)) <|> pOp ('-', ()))
term = factor `pChainl` pOp ('*' , (*))
factor = getal <|> pSym '(' *> expr <* pSym ')'
getal = pNatural
rune :: String -> IO ()
rune i = do let (a,b) = exec expr i
if null b then print ("Result: " ++ show a)
else do print b
print ("Result: " ++ show a)