{-# LANGUAGE FlexibleContexts, RankNTypes #-}
{-# LANGUAGE CPP #-}
module Text.Parsec.Class
( CharParser, HasParser(parser), ErrorContext
, parseM, parse
,
module Text.Parsec
)
where
import Prelude hiding ( fail )
#if !MIN_VERSION_parsec(3,1,17)
import Text.Parsec.Class.Orphans ( )
#endif
import Control.Exception ( throw )
import Control.Monad.Fail
import Data.Functor.Identity
import Numeric.Natural ( Natural )
import Text.Parsec hiding ( parse )
type CharParser st input m a = Stream st m Char => ParsecT st input m a
class HasParser a where
parser :: CharParser st input m a
type ErrorContext = String
parseM :: (MonadFail m, Stream input m Char, HasParser a) => ErrorContext -> input -> m a
parseM :: forall (m :: * -> *) input a.
(MonadFail m, Stream input m Char, HasParser a) =>
ErrorContext -> input -> m a
parseM ErrorContext
ctx input
x = ParsecT input () m a
-> () -> ErrorContext -> input -> m (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a
-> u -> ErrorContext -> s -> m (Either ParseError a)
runParserT (ParsecT input () m a
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m a
parser ParsecT input () m a
-> ParsecT input () m () -> ParsecT input () m a
forall a b.
ParsecT input () m a
-> ParsecT input () m b -> ParsecT input () m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT input () m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) () ErrorContext
ctx input
x m (Either ParseError a) -> (Either ParseError a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParseError -> m a) -> (a -> m a) -> Either ParseError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ErrorContext -> m a
forall a. ErrorContext -> m a
forall (m :: * -> *) a. MonadFail m => ErrorContext -> m a
fail (ErrorContext -> m a)
-> (ParseError -> ErrorContext) -> ParseError -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> ErrorContext
forall a. Show a => a -> ErrorContext
show) a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
parse :: (Stream input Identity Char, HasParser a) => ErrorContext -> input -> a
parse :: forall input a.
(Stream input Identity Char, HasParser a) =>
ErrorContext -> input -> a
parse ErrorContext
ctx = (ParseError -> a) -> (a -> a) -> Either ParseError a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> a
forall a e. Exception e => e -> a
throw a -> a
forall a. a -> a
id (Either ParseError a -> a)
-> (input -> Either ParseError a) -> input -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec input () a
-> () -> ErrorContext -> input -> Either ParseError a
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> ErrorContext -> s -> Either ParseError a
runParser (Parsec input () a
forall a st input (m :: * -> *).
HasParser a =>
CharParser st input m a
forall st input (m :: * -> *). CharParser st input m a
parser Parsec input () a
-> ParsecT input () Identity () -> Parsec input () a
forall a b.
ParsecT input () Identity a
-> ParsecT input () Identity b -> ParsecT input () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT input () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) () ErrorContext
ctx
instance HasParser Natural where
parser :: forall st input (m :: * -> *). CharParser st input m Natural
parser = ErrorContext -> Natural
forall a. Read a => ErrorContext -> a
read (ErrorContext -> Natural)
-> ParsecT st input m ErrorContext -> ParsecT st input m Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT st input m Char -> ParsecT st input m ErrorContext
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT st input m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit