module Haste.Parsing (
Parse, runParser, char, charP, string, oneOf, possibly, atLeast,
whitespace, word, Haste.Parsing.words, int, double, positiveDouble,
suchThat, quotedString, skip, rest, lookahead, anyChar
) where
import Control.Applicative
import Control.Monad
import Data.Char
newtype Parse a = Parse {unP :: (String -> Maybe (String, a))}
runParser :: Parse a -> String -> Maybe a
runParser (Parse p) s =
case p s of
Just ("", x) -> Just x
_ -> Nothing
instance Monad Parse where
return x = Parse $ \s -> Just (s, x)
Parse m >>= f = Parse $ \s -> do
(s', x) <- m s
unP (f x) s'
instance Alternative Parse where
empty = mzero
(<|>) = mplus
instance MonadPlus Parse where
mplus (Parse p1) (Parse p2) = Parse $ \s ->
case p1 s of
x@(Just _) -> x
_ -> p2 s
mzero = Parse $ const Nothing
instance Functor Parse where
fmap f (Parse g) = Parse $ fmap (fmap f) . g
instance Applicative Parse where
pure = return
(<*>) = ap
anyChar :: Parse Char
anyChar = Parse $ \s ->
case s of
(c:cs) -> Just (cs, c)
_ -> Nothing
char :: Char -> Parse Char
char c = charP (== c)
charP :: (Char -> Bool) -> Parse Char
charP p = Parse $ \s ->
case s of
(c:next) | p c -> Just (next, c)
_ -> Nothing
string :: String -> Parse String
string str = Parse $ \s ->
let len = length str
(s', next) = splitAt len s
in if s' == str
then Just (next, str)
else Nothing
oneOf :: [Parse a] -> Parse a
oneOf = msum
possibly :: Parse a -> Parse (Maybe a)
possibly p = oneOf [Just <$> p, return Nothing]
atLeast :: Int -> Parse a -> Parse [a]
atLeast 0 p = do
x <- possibly p
case x of
Just x' -> do
xs <- atLeast 0 p
return (x':xs)
_ ->
return []
atLeast n p = do
x <- p
xs <- atLeast (n1) p
return (x:xs)
whitespace :: Parse String
whitespace = atLeast 0 $ charP isSpace
word :: Parse String
word = atLeast 1 $ charP (not . isSpace)
words :: Parse [String]
words = atLeast 0 $ word <* whitespace
int :: Parse Int
int = oneOf [read <$> atLeast 1 (charP isDigit),
char '-' >> (0) . read <$> atLeast 1 (charP isDigit)]
double :: Parse Double
double = oneOf [positiveDouble,
char '-' >> (0) <$> positiveDouble]
positiveDouble :: Parse Double
positiveDouble = do
first <- atLeast 1 $ charP isDigit
msecond <- possibly $ char '.' *> atLeast 1 (charP isDigit)
case msecond of
Just second -> return $ read $ first ++ "." ++ second
_ -> return $ read first
suchThat :: Parse a -> (a -> Bool) -> Parse a
suchThat p f = do {x <- p ; if f x then return x else mzero}
quotedString :: Char -> Parse String
quotedString q = char q *> strContents q <* char q
strContents :: Char -> Parse String
strContents c = do
s <- atLeast 0 $ charP (\x -> x /= c && x /= '\\')
c' <- lookahead anyChar
if c == c'
then do
return s
else do
skip 1
c'' <- anyChar
s' <- strContents c
return $ s ++ [c''] ++ s'
rest :: Parse String
rest = Parse $ \s -> Just ("", s)
lookahead :: Parse a -> Parse a
lookahead p = do
s' <- Parse $ \s -> Just (s, s)
x <- p
Parse $ \_ -> Just (s', x)
skip :: Int -> Parse ()
skip n = Parse $ \s -> Just (drop n s, ())