module ExtensionOrganizerTest.Parser
( module ExtensionOrganizerTest.Parser
, module Control.Applicative
, module Data.Char
) where
import Control.Applicative
import Data.Char
import Data.List (foldl')
import Data.Maybe
{-# ANN module "HLint: ignore Use mappend" #-}
newtype Parser a = P (String -> [(a, String)])
char :: Char -> Parser Char
char c = matches (== c)
matches :: (Char -> Bool) -> Parser Char
matches p = P $ \s ->
case s of
(x:xs) | p x -> [(x, xs)]
_ -> []
instance Functor Parser where
fmap f (P p) = P $ \s -> [ (f x, s') | (x, s') <- p s ]
instance Applicative Parser where
pure x = P $ \s -> [(x, s)]
(P pf) <*> (P q) = P $ \s -> [ (f x, s'') | (f, s') <- pf s, (x, s'') <- q s' ]
instance Alternative Parser where
empty = P $ const []
(P p) <|> (P q) = P $ \s -> p s ++ q s
instance Monad Parser where
return = pure
--(>>=) :: Parser a -> (a -> Parser b) -> Parser b
--qs :: Parser (Parser b) ~ P ( String -> [(Parser b, Strng)]
p >>= f = P (\s -> case f <$> p of
P qs -> concat [ qs' s' | (P qs', s') <- qs s ] )
times :: Int -> Parser a -> Parser [a]
times 0 _ = pure []
times n p = (:) <$> p <*> times (n-1) p
--parseNInts :: Parser [Int]
--parseNInts = (decimal <* whitespace) >>= (\n -> times n (decimal <* whitespace))
token :: String -> Parser String
token "" = pure ""
token (x:xs) = (:) <$> char x <*> token xs
digit :: Parser Int
digit = digitToInt <$> matches isDigit
decimal :: Parser Int
decimal = foldl' (\n x -> 10 * n + fromIntegral x) 0 <$> some digit
string :: Parser String
string = char '"' *> many (matches (/= '"')) <* char '"'
word :: Parser String
word = many $ matches isAlpha
whitespace :: Parser String
whitespace = many (matches isSpace)
endParsing :: Parser ()
endParsing = P $ const [((), "")]
parserResult :: Parser a -> String -> [(a, String)]
parserResult (P p) = p
runParser :: Parser a -> String -> Maybe a
runParser (P p) s =
case dropWhile (not . null . snd) $ p s of
((x,""):_) -> Just x
_ -> Nothing
execParser :: Parser a -> String -> a
execParser p s = fromMaybe (error $ "execParser: Couldn't parse: " ++ s)
(runParser p s)
-- Examples for the monad instance
{-
parseNInts :: Parser [Int]
parseNInts = do
{
n <- (decimal <* whitespace);
res <- times n (decimal <* whitespace);
return res;
}
parseNTests :: Parser [[Int]]
parseNTests = do
{
numOfTests <- decimal';
tests <- times numOfTests (do
{
n <- decimal';
ints <- times n decimal';
return ints;
});
return tests;
}
where decimal' = decimal <* whitespace
-}