module Pinch.Internal.Pinchable.Parser
( Parser
, runParser
, parserCatch
) where
import Control.Applicative
import Control.Monad
type Failure r = String -> r
type Success a r = a -> r
newtype Parser a = Parser
{ unParser :: forall r.
Failure r
-> Success a r
-> r
}
instance Functor Parser where
fmap f (Parser g) = Parser $ \kFail kSucc -> g kFail (kSucc . f)
instance Applicative Parser where
pure a = Parser $ \_ kSucc -> kSucc a
Parser f' <*> Parser a' =
Parser $ \kFail kSuccB ->
f' kFail $ \f ->
a' kFail $ \a ->
kSuccB (f a)
instance Alternative Parser where
empty = Parser $ \kFail _ -> kFail "Alternative.empty"
Parser l' <|> Parser r' =
Parser $ \kFail kSucc ->
l' (\_ -> r' kFail kSucc) kSucc
instance Monad Parser where
fail msg = Parser $ \kFail _ -> kFail msg
return = pure
(>>) = (*>)
Parser a' >>= k =
Parser $ \kFail kSuccB ->
a' kFail $ \a ->
unParser (k a) kFail kSuccB
instance MonadPlus Parser where
mzero = empty
mplus = (<|>)
runParser :: Parser a -> Either String a
runParser p = unParser p Left Right
parserCatch
:: Parser a -> (String -> Parser b) -> (a -> Parser b) -> Parser b
parserCatch = unParser