module Text.ParserCombinators.HuttonMeijer
(Parser(..), item, first, papply, (+++), sat, many, many1,
sepby, sepby1, chainl,
chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,
letter, alphanum, string, ident, nat, int, spaces, comment, junk,
skip, token, natural, integer, symbol, identifier) where
import Data.Char
import Control.Applicative ( Applicative(pure,(<*>)), Alternative(empty,(<|>)) )
import Control.Monad
import qualified Control.Monad.Fail as Fail
infixr 5 +++
type Token = Char
newtype Parser a = P ([Token] -> [(a,[Token])])
instance Functor Parser where
fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (P String -> [(a, String)]
p) = forall a. (String -> [(a, String)]) -> Parser a
P (\String
inp -> [(a -> b
f a
v, String
out) | (a
v,String
out) <- String -> [(a, String)]
p String
inp])
instance Applicative Parser where
pure :: forall a. a -> Parser a
pure a
v = forall a. (String -> [(a, String)]) -> Parser a
P (\String
inp -> [(a
v,String
inp)])
<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Parser where
return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
(P String -> [(a, String)]
p) >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
f = forall a. (String -> [(a, String)]) -> Parser a
P (\String
inp -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall a. Parser a -> String -> [(a, String)]
papply (a -> Parser b
f a
v) String
out | (a
v,String
out) <- String -> [(a, String)]
p String
inp])
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail Parser where
fail :: forall a. String -> Parser a
fail String
_ = forall a. (String -> [(a, String)]) -> Parser a
P (\String
_ -> [])
instance Alternative Parser where
empty :: forall a. Parser a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus Parser where
mzero :: forall a. Parser a
mzero = forall a. (String -> [(a, String)]) -> Parser a
P (\String
_ -> [])
(P String -> [(a, String)]
p) mplus :: forall a. Parser a -> Parser a -> Parser a
`mplus` (P String -> [(a, String)]
q) = forall a. (String -> [(a, String)]) -> Parser a
P (\String
inp -> (String -> [(a, String)]
p String
inp forall a. [a] -> [a] -> [a]
++ String -> [(a, String)]
q String
inp))
item :: Parser Token
item :: Parser Char
item = forall a. (String -> [(a, String)]) -> Parser a
P (\String
inp -> case String
inp of
[] -> []
(Char
x:String
xs) -> [(Char
x,String
xs)])
first :: Parser a -> Parser a
first :: forall a. Parser a -> Parser a
first (P String -> [(a, String)]
p) = forall a. (String -> [(a, String)]) -> Parser a
P (\String
inp -> case String -> [(a, String)]
p String
inp of
[] -> []
((a, String)
x:[(a, String)]
_) -> [(a, String)
x])
papply :: Parser a -> [Token] -> [(a,[Token])]
papply :: forall a. Parser a -> String -> [(a, String)]
papply (P String -> [(a, String)]
p) String
inp = String -> [(a, String)]
p String
inp
(+++) :: Parser a -> Parser a -> Parser a
Parser a
p +++ :: forall a. Parser a -> Parser a -> Parser a
+++ Parser a
q = forall a. Parser a -> Parser a
first (Parser a
p forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Parser a
q)
sat :: (Token -> Bool) -> Parser Token
sat :: (Char -> Bool) -> Parser Char
sat Char -> Bool
p = do {Char
x <- Parser Char
item; if Char -> Bool
p Char
x then forall (m :: * -> *) a. Monad m => a -> m a
return Char
x else forall (m :: * -> *) a. MonadPlus m => m a
mzero}
many :: Parser a -> Parser [a]
many :: forall a. Parser a -> Parser [a]
many Parser a
p = forall a. Parser a -> Parser [a]
many1 Parser a
p forall a. Parser a -> Parser a -> Parser a
+++ forall (m :: * -> *) a. Monad m => a -> m a
return []
many1 :: Parser a -> Parser [a]
many1 :: forall a. Parser a -> Parser [a]
many1 Parser a
p = do {a
x <- Parser a
p; [a]
xs <- forall a. Parser a -> Parser [a]
many Parser a
p; forall (m :: * -> *) a. Monad m => a -> m a
return (a
xforall a. a -> [a] -> [a]
:[a]
xs)}
sepby :: Parser a -> Parser b -> Parser [a]
Parser a
p sepby :: forall a b. Parser a -> Parser b -> Parser [a]
`sepby` Parser b
sep = (Parser a
p forall a b. Parser a -> Parser b -> Parser [a]
`sepby1` Parser b
sep) forall a. Parser a -> Parser a -> Parser a
+++ forall (m :: * -> *) a. Monad m => a -> m a
return []
sepby1 :: Parser a -> Parser b -> Parser [a]
Parser a
p sepby1 :: forall a b. Parser a -> Parser b -> Parser [a]
`sepby1` Parser b
sep = do {a
x <- Parser a
p; [a]
xs <- forall a. Parser a -> Parser [a]
many (do {Parser b
sep; Parser a
p}); forall (m :: * -> *) a. Monad m => a -> m a
return (a
xforall a. a -> [a] -> [a]
:[a]
xs)}
chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl Parser a
p Parser (a -> a -> a)
op a
v = (Parser a
p forall a. Parser a -> Parser (a -> a -> a) -> Parser a
`chainl1` Parser (a -> a -> a)
op) forall a. Parser a -> Parser a -> Parser a
+++ forall (m :: * -> *) a. Monad m => a -> m a
return a
v
chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
Parser a
p chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
`chainl1` Parser (a -> a -> a)
op = do {a
x <- Parser a
p; a -> Parser a
rest a
x}
where
rest :: a -> Parser a
rest a
x = do {a -> a -> a
f <- Parser (a -> a -> a)
op; a
y <- Parser a
p; a -> Parser a
rest (a -> a -> a
f a
x a
y)}
forall a. Parser a -> Parser a -> Parser a
+++ forall (m :: * -> *) a. Monad m => a -> m a
return a
x
chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainr Parser a
p Parser (a -> a -> a)
op a
v = (Parser a
p forall a. Parser a -> Parser (a -> a -> a) -> Parser a
`chainr1` Parser (a -> a -> a)
op) forall a. Parser a -> Parser a -> Parser a
+++ forall (m :: * -> *) a. Monad m => a -> m a
return a
v
chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
Parser a
p chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
`chainr1` Parser (a -> a -> a)
op = do {a
x <- Parser a
p; a -> Parser a
rest a
x}
where
rest :: a -> Parser a
rest a
x = do {a -> a -> a
f <- Parser (a -> a -> a)
op; a
y <- Parser a
p forall a. Parser a -> Parser (a -> a -> a) -> Parser a
`chainr1` Parser (a -> a -> a)
op; forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> a
f a
x a
y)}
forall a. Parser a -> Parser a -> Parser a
+++ forall (m :: * -> *) a. Monad m => a -> m a
return a
x
ops :: [(Parser a, b)] -> Parser b
ops :: forall a b. [(Parser a, b)] -> Parser b
ops [(Parser a, b)]
xs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. Parser a -> Parser a -> Parser a
(+++) [do {Parser a
p; forall (m :: * -> *) a. Monad m => a -> m a
return b
op} | (Parser a
p,b
op) <- [(Parser a, b)]
xs]
bracket :: Parser a -> Parser b -> Parser c -> Parser b
bracket :: forall a b c. Parser a -> Parser b -> Parser c -> Parser b
bracket Parser a
open Parser b
p Parser c
close = do {Parser a
open; b
x <- Parser b
p; Parser c
close; forall (m :: * -> *) a. Monad m => a -> m a
return b
x}
char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
x = (Char -> Bool) -> Parser Char
sat (\Char
y -> Char
x forall a. Eq a => a -> a -> Bool
== Char
y)
digit :: Parser Char
digit :: Parser Char
digit = (Char -> Bool) -> Parser Char
sat Char -> Bool
isDigit
lower :: Parser Char
lower :: Parser Char
lower = (Char -> Bool) -> Parser Char
sat Char -> Bool
isLower
upper :: Parser Char
upper :: Parser Char
upper = (Char -> Bool) -> Parser Char
sat Char -> Bool
isUpper
letter :: Parser Char
letter :: Parser Char
letter = (Char -> Bool) -> Parser Char
sat Char -> Bool
isAlpha
alphanum :: Parser Char
alphanum :: Parser Char
alphanum = (Char -> Bool) -> Parser Char
sat Char -> Bool
isAlphaNum forall a. Parser a -> Parser a -> Parser a
+++ Char -> Parser Char
char Char
'_'
string :: String -> Parser String
string :: String -> Parser String
string String
"" = forall (m :: * -> *) a. Monad m => a -> m a
return String
""
string (Char
x:String
xs) = do {Char -> Parser Char
char Char
x; String -> Parser String
string String
xs; forall (m :: * -> *) a. Monad m => a -> m a
return (Char
xforall a. a -> [a] -> [a]
:String
xs)}
ident :: Parser String
ident :: Parser String
ident = do {Char
x <- Parser Char
lower; String
xs <- forall a. Parser a -> Parser [a]
many Parser Char
alphanum; forall (m :: * -> *) a. Monad m => a -> m a
return (Char
xforall a. a -> [a] -> [a]
:String
xs)}
nat :: Parser Int
nat :: Parser Int
nat = do {Char
x <- Parser Char
digit; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => a -> Int
fromEnum Char
x forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'0')} forall a. Parser a -> Parser (a -> a -> a) -> Parser a
`chainl1` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => a -> a -> a
op
where
a
m op :: a -> a -> a
`op` a
n = a
10forall a. Num a => a -> a -> a
*a
m forall a. Num a => a -> a -> a
+ a
n
int :: Parser Int
int :: Parser Int
int = do {Char -> Parser Char
char Char
'-'; Int
n <- Parser Int
nat; forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
n)} forall a. Parser a -> Parser a -> Parser a
+++ Parser Int
nat
spaces :: Parser ()
spaces :: Parser ()
spaces = do {forall a. Parser a -> Parser [a]
many1 ((Char -> Bool) -> Parser Char
sat Char -> Bool
isSpace); forall (m :: * -> *) a. Monad m => a -> m a
return ()}
comment :: Parser ()
= do
forall a b c. Parser a -> Parser b -> Parser c -> Parser b
bracket (String -> Parser String
string String
"/*") (forall a. Parser a -> Parser [a]
many Parser Char
item) (String -> Parser String
string String
"*/")
forall (m :: * -> *) a. Monad m => a -> m a
return ()
junk :: Parser ()
junk :: Parser ()
junk = do {forall a. Parser a -> Parser [a]
many (Parser ()
spaces forall a. Parser a -> Parser a -> Parser a
+++ Parser ()
comment); forall (m :: * -> *) a. Monad m => a -> m a
return ()}
skip :: Parser a -> Parser a
skip :: forall a. Parser a -> Parser a
skip Parser a
p = do {Parser ()
junk; Parser a
p}
token :: Parser a -> Parser a
token :: forall a. Parser a -> Parser a
token Parser a
p = do {a
v <- Parser a
p; Parser ()
junk; forall (m :: * -> *) a. Monad m => a -> m a
return a
v}
natural :: Parser Int
natural :: Parser Int
natural = forall a. Parser a -> Parser a
token Parser Int
nat
integer :: Parser Int
integer :: Parser Int
integer = forall a. Parser a -> Parser a
token Parser Int
int
symbol :: String -> Parser String
symbol :: String -> Parser String
symbol String
xs = forall a. Parser a -> Parser a
token (String -> Parser String
string String
xs)
identifier :: [String] -> Parser String
identifier :: [String] -> Parser String
identifier [String]
ks = forall a. Parser a -> Parser a
token (do {String
x <- Parser String
ident;
if Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
x [String]
ks) then forall (m :: * -> *) a. Monad m => a -> m a
return String
x
else forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. MonadPlus m => m a
mzero})