{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module Mini.Transformers.ParserT (
ParserT,
ParseError,
runParserT,
sat,
item,
symbol,
string,
oneOf,
noneOf,
sepBy,
sepBy1,
endBy,
endBy1,
between,
option,
) where
import Control.Applicative (
Alternative (
empty,
many,
(<|>)
),
)
import Control.Monad (
ap,
liftM,
(>=>),
)
import Data.Bool (
bool,
)
import Data.Functor (
(<&>),
)
import Mini.Transformers.Class (
MonadTrans (
lift
),
)
newtype ParserT s m a = ParserT
{ forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
runParserT :: [s] -> m (Either [ParseError s] (a, [s]))
}
instance (Monad m) => Functor (ParserT s m) where
fmap :: forall a b. (a -> b) -> ParserT s m a -> ParserT s m b
fmap = (a -> b) -> ParserT s m a -> ParserT s m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m) => Applicative (ParserT s m) where
pure :: forall a. a -> ParserT s m a
pure a
a = ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s])))
-> ([s] -> Either [ParseError s] (a, [s]))
-> [s]
-> m (Either [ParseError s] (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> Either [ParseError s] (a, [s])
forall a b. b -> Either a b
Right ((a, [s]) -> Either [ParseError s] (a, [s]))
-> ([s] -> (a, [s])) -> [s] -> Either [ParseError s] (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a,)
<*> :: forall a b. ParserT s m (a -> b) -> ParserT s m a -> ParserT s m b
(<*>) = ParserT s m (a -> b) -> ParserT s m a -> ParserT s m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Monad m, Eq s) => Alternative (ParserT s m) where
empty :: forall a. ParserT s m a
empty = ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a)
-> (Either [ParseError s] (a, [s])
-> [s] -> m (Either [ParseError s] (a, [s])))
-> Either [ParseError s] (a, [s])
-> ParserT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either [ParseError s] (a, [s]))
-> [s] -> m (Either [ParseError s] (a, [s]))
forall a b. a -> b -> a
const (m (Either [ParseError s] (a, [s]))
-> [s] -> m (Either [ParseError s] (a, [s])))
-> (Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s])))
-> Either [ParseError s] (a, [s])
-> [s]
-> m (Either [ParseError s] (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (a, [s]) -> ParserT s m a)
-> Either [ParseError s] (a, [s]) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ [ParseError s] -> Either [ParseError s] (a, [s])
forall a b. a -> Either a b
Left [ParseError s
forall s. ParseError s
EmptyError]
ParserT s m a
m <|> :: forall a. ParserT s m a -> ParserT s m a -> ParserT s m a
<|> ParserT s m a
n = ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ \[s]
ss ->
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
runParserT ParserT s m a
m [s]
ss
m (Either [ParseError s] (a, [s]))
-> (Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s])))
-> m (Either [ParseError s] (a, [s]))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([ParseError s] -> m (Either [ParseError s] (a, [s])))
-> ((a, [s]) -> m (Either [ParseError s] (a, [s])))
-> Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
( \[ParseError s]
e1 ->
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
runParserT ParserT s m a
n [s]
ss
m (Either [ParseError s] (a, [s]))
-> (Either [ParseError s] (a, [s])
-> Either [ParseError s] (a, [s]))
-> m (Either [ParseError s] (a, [s]))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([ParseError s] -> Either [ParseError s] (a, [s]))
-> ((a, [s]) -> Either [ParseError s] (a, [s]))
-> Either [ParseError s] (a, [s])
-> Either [ParseError s] (a, [s])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
([ParseError s] -> Either [ParseError s] (a, [s])
forall a b. a -> Either a b
Left ([ParseError s] -> Either [ParseError s] (a, [s]))
-> ([ParseError s] -> [ParseError s])
-> [ParseError s]
-> Either [ParseError s] (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseError s] -> [ParseError s] -> [ParseError s]
forall a. Monoid a => a -> a -> a
mappend [ParseError s]
e1)
(a, [s]) -> Either [ParseError s] (a, [s])
forall a b. b -> Either a b
Right
)
(Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (a, [s])))
-> ((a, [s]) -> Either [ParseError s] (a, [s]))
-> (a, [s])
-> m (Either [ParseError s] (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> Either [ParseError s] (a, [s])
forall a b. b -> Either a b
Right)
instance (Monad m) => Monad (ParserT s m) where
ParserT s m a
m >>= :: forall a b. ParserT s m a -> (a -> ParserT s m b) -> ParserT s m b
>>= a -> ParserT s m b
k =
([s] -> m (Either [ParseError s] (b, [s]))) -> ParserT s m b
forall s (m :: * -> *) a.
([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either [ParseError s] (b, [s]))) -> ParserT s m b)
-> ([s] -> m (Either [ParseError s] (b, [s]))) -> ParserT s m b
forall a b. (a -> b) -> a -> b
$
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
runParserT ParserT s m a
m
([s] -> m (Either [ParseError s] (a, [s])))
-> (Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (b, [s])))
-> [s]
-> m (Either [ParseError s] (b, [s]))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ([ParseError s] -> m (Either [ParseError s] (b, [s])))
-> ((a, [s]) -> m (Either [ParseError s] (b, [s])))
-> Either [ParseError s] (a, [s])
-> m (Either [ParseError s] (b, [s]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(Either [ParseError s] (b, [s])
-> m (Either [ParseError s] (b, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (b, [s])
-> m (Either [ParseError s] (b, [s])))
-> ([ParseError s] -> Either [ParseError s] (b, [s]))
-> [ParseError s]
-> m (Either [ParseError s] (b, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParseError s] -> Either [ParseError s] (b, [s])
forall a b. a -> Either a b
Left)
(\(a
a, [s]
ss') -> ParserT s m b -> [s] -> m (Either [ParseError s] (b, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either [ParseError s] (a, [s]))
runParserT (a -> ParserT s m b
k a
a) [s]
ss')
instance MonadTrans (ParserT s) where
lift :: forall (m :: * -> *) a. Monad m => m a -> ParserT s m a
lift m a
m = ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ \[s]
ss -> m a
m m a
-> (a -> Either [ParseError s] (a, [s]))
-> m (Either [ParseError s] (a, [s]))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a, [s]) -> Either [ParseError s] (a, [s])
forall a b. b -> Either a b
Right ((a, [s]) -> Either [ParseError s] (a, [s]))
-> (a -> (a, [s])) -> a -> Either [ParseError s] (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[s]
ss)
data ParseError s
= EndOfInput
| Unexpected s
| EmptyError
instance (Show s) => Show (ParseError s) where
show :: ParseError s -> String
show = \case
ParseError s
EndOfInput -> String
"unexpected EOF"
Unexpected s
s -> String
"unexpected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> s -> String
forall a. Show a => a -> String
show s
s
ParseError s
EmptyError -> String
"empty"
sat :: (Applicative m) => (s -> Bool) -> ParserT s m s
sat :: forall (m :: * -> *) s.
Applicative m =>
(s -> Bool) -> ParserT s m s
sat s -> Bool
p =
([s] -> m (Either [ParseError s] (s, [s]))) -> ParserT s m s
forall s (m :: * -> *) a.
([s] -> m (Either [ParseError s] (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either [ParseError s] (s, [s]))) -> ParserT s m s)
-> ([s] -> m (Either [ParseError s] (s, [s]))) -> ParserT s m s
forall a b. (a -> b) -> a -> b
$ \case
[] -> Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s])))
-> Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s]))
forall a b. (a -> b) -> a -> b
$ [ParseError s] -> Either [ParseError s] (s, [s])
forall a b. a -> Either a b
Left [ParseError s
forall s. ParseError s
EndOfInput]
(s
s : [s]
ss) ->
m (Either [ParseError s] (s, [s]))
-> m (Either [ParseError s] (s, [s]))
-> Bool
-> m (Either [ParseError s] (s, [s]))
forall a. a -> a -> Bool -> a
bool
(Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s])))
-> Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s]))
forall a b. (a -> b) -> a -> b
$ [ParseError s] -> Either [ParseError s] (s, [s])
forall a b. a -> Either a b
Left [s -> ParseError s
forall s. s -> ParseError s
Unexpected s
s])
(Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s])))
-> Either [ParseError s] (s, [s])
-> m (Either [ParseError s] (s, [s]))
forall a b. (a -> b) -> a -> b
$ (s, [s]) -> Either [ParseError s] (s, [s])
forall a b. b -> Either a b
Right (s
s, [s]
ss))
(Bool -> m (Either [ParseError s] (s, [s])))
-> Bool -> m (Either [ParseError s] (s, [s]))
forall a b. (a -> b) -> a -> b
$ s -> Bool
p s
s
item :: (Applicative m) => ParserT s m s
item :: forall (m :: * -> *) s. Applicative m => ParserT s m s
item = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
Applicative m =>
(s -> Bool) -> ParserT s m s
sat ((s -> Bool) -> ParserT s m s) -> (s -> Bool) -> ParserT s m s
forall a b. (a -> b) -> a -> b
$ Bool -> s -> Bool
forall a b. a -> b -> a
const Bool
True
symbol :: (Applicative m, Eq s) => s -> ParserT s m s
symbol :: forall (m :: * -> *) s. (Applicative m, Eq s) => s -> ParserT s m s
symbol = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
Applicative m =>
(s -> Bool) -> ParserT s m s
sat ((s -> Bool) -> ParserT s m s)
-> (s -> s -> Bool) -> s -> ParserT s m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s -> Bool
forall a. Eq a => a -> a -> Bool
(==)
string :: (Monad m, Traversable t, Eq s) => t s -> ParserT s m (t s)
string :: forall (m :: * -> *) (t :: * -> *) s.
(Monad m, Traversable t, Eq s) =>
t s -> ParserT s m (t s)
string = (s -> ParserT s m s) -> t s -> ParserT s m (t s)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse s -> ParserT s m s
forall (m :: * -> *) s. (Applicative m, Eq s) => s -> ParserT s m s
symbol
oneOf :: (Applicative m, Foldable t, Eq s) => t s -> ParserT s m s
oneOf :: forall (m :: * -> *) (t :: * -> *) s.
(Applicative m, Foldable t, Eq s) =>
t s -> ParserT s m s
oneOf = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
Applicative m =>
(s -> Bool) -> ParserT s m s
sat ((s -> Bool) -> ParserT s m s)
-> (t s -> s -> Bool) -> t s -> ParserT s m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> t s -> Bool) -> t s -> s -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> t s -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
noneOf :: (Applicative m, Foldable t, Eq s) => t s -> ParserT s m s
noneOf :: forall (m :: * -> *) (t :: * -> *) s.
(Applicative m, Foldable t, Eq s) =>
t s -> ParserT s m s
noneOf = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
Applicative m =>
(s -> Bool) -> ParserT s m s
sat ((s -> Bool) -> ParserT s m s)
-> (t s -> s -> Bool) -> t s -> ParserT s m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> t s -> Bool) -> t s -> s -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> t s -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem
sepBy :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]
sepBy :: forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
sepBy ParserT s m a
p = [a] -> ParserT s m [a] -> ParserT s m [a]
forall (m :: * -> *) s a.
(Monad m, Eq s) =>
a -> ParserT s m a -> ParserT s m a
option [] (ParserT s m [a] -> ParserT s m [a])
-> (ParserT s m b -> ParserT s m [a])
-> ParserT s m b
-> ParserT s m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s m a -> ParserT s m b -> ParserT s m [a]
forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
sepBy1 ParserT s m a
p
sepBy1 :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]
sepBy1 :: forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
sepBy1 ParserT s m a
p ParserT s m b
sep = (:) (a -> [a] -> [a]) -> ParserT s m a -> ParserT s m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT s m a
p ParserT s m ([a] -> [a]) -> ParserT s m [a] -> ParserT s m [a]
forall a b. ParserT s m (a -> b) -> ParserT s m a -> ParserT s m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT s m a -> ParserT s m [a]
forall a. ParserT s m a -> ParserT s m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParserT s m b
sep ParserT s m b -> ParserT s m a -> ParserT s m a
forall a b. ParserT s m a -> ParserT s m b -> ParserT s m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT s m a
p)
endBy :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]
endBy :: forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
endBy ParserT s m a
p = [a] -> ParserT s m [a] -> ParserT s m [a]
forall (m :: * -> *) s a.
(Monad m, Eq s) =>
a -> ParserT s m a -> ParserT s m a
option [] (ParserT s m [a] -> ParserT s m [a])
-> (ParserT s m b -> ParserT s m [a])
-> ParserT s m b
-> ParserT s m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT s m a -> ParserT s m b -> ParserT s m [a]
forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
endBy1 ParserT s m a
p
endBy1 :: (Monad m, Eq s) => ParserT s m a -> ParserT s m b -> ParserT s m [a]
endBy1 :: forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
endBy1 ParserT s m a
p ParserT s m b
sep = ParserT s m a -> ParserT s m b -> ParserT s m [a]
forall (m :: * -> *) s a b.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m b -> ParserT s m [a]
sepBy1 ParserT s m a
p ParserT s m b
sep ParserT s m [a] -> ParserT s m b -> ParserT s m [a]
forall a b. ParserT s m a -> ParserT s m b -> ParserT s m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT s m b
sep
between
:: (Monad m)
=> ParserT s m open
-> ParserT s m close
-> ParserT s m a
-> ParserT s m a
between :: forall (m :: * -> *) s open close a.
Monad m =>
ParserT s m open
-> ParserT s m close -> ParserT s m a -> ParserT s m a
between ParserT s m open
open ParserT s m close
close ParserT s m a
p = ParserT s m open
open ParserT s m open -> ParserT s m a -> ParserT s m a
forall a b. ParserT s m a -> ParserT s m b -> ParserT s m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT s m a
p ParserT s m a -> ParserT s m close -> ParserT s m a
forall a b. ParserT s m a -> ParserT s m b -> ParserT s m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT s m close
close
option :: (Monad m, Eq s) => a -> ParserT s m a -> ParserT s m a
option :: forall (m :: * -> *) s a.
(Monad m, Eq s) =>
a -> ParserT s m a -> ParserT s m a
option a
a ParserT s m a
p = ParserT s m a
p ParserT s m a -> ParserT s m a -> ParserT s m a
forall a. ParserT s m a -> ParserT s m a -> ParserT s m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ParserT s m a
forall a. a -> ParserT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a