module Control.Effects.Parser (
parse,
oneOf,
item,
itemIf,
lookahead,
noMatch,
noBacktrack,
parseFail,
parseEnd,
parseOpt,
parseMany,
parseMany1,
parseOpt',
parseMany',
parseMany1'
) where
import Control.Applicative
import Control.Effects
import Control.Monad
newtype Parser c m a = Parser ([c] -> m (Maybe a) -> m (Maybe a))
parse :: Monad m => [c] -> Handler (Parser c m a) (Maybe a) m a
parse input = Handler
{ ret = \a -> return . Parser $ \cs f -> return (Just a)
, fin = \(Parser r) -> r input (return Nothing)
}
putInput :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> [c] -> n ()
putInput p cs' = operation p $ \k -> return . Parser $ \cs f -> do
Parser r <- k ()
r cs' f
putFailAction :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> m (Maybe a) -> n ()
putFailAction p f' = operation p $ \k -> return . Parser $ \cs f -> do
Parser r <- k ()
r cs f'
oneOf :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> [n b] -> n b
oneOf p [] = parseFail p
oneOf p (a:as) = join $ operation p $ \k -> return . Parser $ \cs f -> do
Parser r <- k a
r cs $ do
Parser r' <- k (oneOf p as)
r' cs f
item :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n c
item p = operation p $ \k -> return . Parser $ \cs f ->
case cs of
[] -> f
(h:t) -> do { Parser r <- k h; r t f }
itemIf :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> (c -> Bool) -> n c
itemIf p f = do { x <- item p; if f x then return x else parseFail p }
lookahead :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n b
lookahead p a = join $ operation p $ \k -> return . Parser $ \cs f -> do
Parser r <- k (a <* putInput p cs)
r cs f
noMatch :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n ()
noMatch p a = join $ operation p $ \k -> return . Parser $ \cs f -> do
Parser r <- k (a >> putFailAction p f >> parseFail p)
r cs $ do
Parser r' <- k (return ())
r' cs f
noBacktrack :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n b
noBacktrack p a = join $ operation p $ \k -> return . Parser $ \cs f -> do
Parser r <- k (a <* putFailAction p f)
r cs f
parseFail :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b
parseFail p = operation p $ \k -> return . Parser $ \cs f -> f
parseEnd :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n ()
parseEnd p = noMatch p (item p)
parseOpt :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n (Maybe b)
parseOpt p f = oneOf p [Just <$> f, return Nothing]
parseMany :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n [b]
parseMany p f = oneOf p [parseMany1 p f, return []]
parseMany1 :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n [b]
parseMany1 p f = (:) <$> f <*> parseMany p f
parseOpt' :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n (Maybe b)
parseOpt' p f = oneOf p [return Nothing, Just <$> f]
parseMany' :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n [b]
parseMany' p f = oneOf p [return [], parseMany1' p f]
parseMany1' :: AutoLift (Parser c m a) m n => Effect (Parser c m a) m -> n b -> n [b]
parseMany1' p f = (:) <$> f <*> parseMany' p f