{-# LANGUAGE LambdaCase #-}
moduleParser
( Parser()
, moduleX
, Parser.any
, satisfy
, string
, digit
, number
, spaces
, reserved
, lexeme
, (<?>)
, runParser
, between ) whereimportControl.ApplicativeasXimportControl.MonadasXimportData.CharnewtypeParser a
=Parser { parse::String->EitherString (a, String) }
runParser::Parser a ->String->EitherString a
runParser (Parser p) s = fst <$> p s
(<?>) ::Parser a ->String->Parser a
p <?> err = p <|> fail err
infixl2<?>instanceFunctorParserwhere
fn `fmap` (Parser p) =Parser go where
go st =case p st ofLeft e ->Left e
Right (res, str') ->Right (fn res, str')
instanceApplicativeParserwhere
pure x =Parser$\str ->Right (x, str)
(Parser p) <*> (Parser p') =Parser go where
go st =case p st ofLeft e ->Left e
Right (fn, st') ->case p' st' ofLeft e' ->Left e'
Right (v, st'') ->Right (fn v, st'')
instanceAlternativeParserwhere
empty = fail "nothing"
(Parser p) <|> (Parser p') =Parser go where
go st =case p st ofLeft_-> p' st
Right x ->Right x
instanceMonadParserwhere
return = pure
(Parser p) >>= f =Parser go where
go s =case p s ofLeft e ->Left e
Right (x, s') -> parse (f x) s'
fail m =Parser go where
go =Left. go'
go' [] ="expected "++ m ++", got to the end of stream"
go' (x:xs) ="expected "++ m ++", got '"++ x:"'"any::ParserChar
any =Parser go where
go [] =Left"any: end of file"
go (x:xs) =Right (x,xs)
satisfy:: (Char->Bool) ->ParserChar
satisfy f =do x <-Parser.any
if f x
then return x
else fail "a solution to the function"char::Char->ParserChar
char c = satisfy (c ==) <?>"literal "++ [c]
oneOf::String->ParserChar
oneOf s = satisfy (`elem` s) <?>"one of '"++ s ++"'"string::String->ParserString
string [] = return []
string (x:xs) =do char x
string xs
return $ x:xs
natural::ParserInteger
natural = read <$> some (satisfy isDigit)
lexeme::Parser a ->Parser a
lexeme = (<* spaces)
reserved::String->ParserString
reserved = lexeme . string
spaces::ParserString
spaces = many $ oneOf " \n\r"digit::ParserChar
digit = satisfy isDigit
number::ParserInt
number =do
s <- string "-"<|> empty
cs <- some digit
return $ read (s ++ cs)
between::Parser b ->Parser c ->Parser a ->Parser a
between o c x = o *> x <* c
contents::Parser a ->Parser a
contents x = spaces *> x <* spaces
sep::Parser b ->Parser a ->Parser [a]
sep s c = sep1 s c <|> return []
sep1::Parser b ->Parser a ->Parser [a]
sep1 s c =do x <- c
xs <- many $ s >> c
return $ x:xs
option:: a ->Parser a ->Parser a
option x p = p <|> return x
optionMaybe::Parser a ->Parser (Maybe a)
optionMaybe p = option Nothing$Just<$> p
optional::Parser a ->Parser ()
optional p = void p <|> return ()
eof::Parser ()
eof =Parser go where
go (x:_) =Left$"expected eof, got '"++ x:"'"
go [] =Right ((), [])