{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

-- | Extend a monad with the ability to parse symbol sequences
module Mini.Transformers.ParserT (
  -- * Types
  ParserT (
    ParserT
  ),
  ParseError (
    ParseError,
    unexpected
  ),

  -- * Runner
  runParserT,

  -- * Parsers
  sat,
  item,
  symbol,
  string,
  oneOf,
  noneOf,
  eof,

  -- * Combinators
  sepBy,
  sepBy1,
  endBy,
  endBy1,
  chainl1,
  chainr1,
  between,
  option,
  reject,
  accept,
) where

import Control.Applicative (
  Alternative (
    empty,
    many,
    (<|>)
  ),
 )
import Control.Monad (
  ap,
  liftM,
  (>=>),
 )
import Data.Bool (
  bool,
 )
import Mini.Transformers.Class (
  MonadTrans (
    lift
  ),
 )

{-
 - Types
 -}

-- | A transformer parsing symbols /s/, inner monad /m/, return /a/
newtype ParserT s m a = ParserT
  { forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
runParserT :: [s] -> m (Either ParseError (a, [s]))
  -- ^ Unwrap a 'ParserT' computation with a sequence of symbols to parse
  }

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 (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ Either ParseError (a, [s]) -> m (Either ParseError (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> ([s] -> Either ParseError (a, [s]))
-> [s]
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> Either ParseError (a, [s])
forall a b. b -> Either a b
Right ((a, [s]) -> Either ParseError (a, [s]))
-> ([s] -> (a, [s])) -> [s] -> Either ParseError (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

-- | Parse @p@ or, if @p@ fails, backtrack and parse @q@ via @p \<|\> q@
instance (Monad m, Eq s) => Alternative (ParserT s m) where
  empty :: forall a. ParserT s m a
empty = ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a)
-> (ParseError -> [s] -> m (Either ParseError (a, [s])))
-> ParseError
-> ParserT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either ParseError (a, [s]))
-> [s] -> m (Either ParseError (a, [s]))
forall a b. a -> b -> a
const (m (Either ParseError (a, [s]))
 -> [s] -> m (Either ParseError (a, [s])))
-> (ParseError -> m (Either ParseError (a, [s])))
-> ParseError
-> [s]
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseError (a, [s]) -> m (Either ParseError (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> (ParseError -> Either ParseError (a, [s]))
-> ParseError
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError (a, [s])
forall a b. a -> Either a b
Left (ParseError -> ParserT s m a) -> ParseError -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
forall a. [a]
forall (f :: * -> *) a. Alternative f => f a
empty
  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 (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ \[s]
ss ->
    ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
runParserT ParserT s m a
m [s]
ss
      m (Either ParseError (a, [s]))
-> (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> m (Either ParseError (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 -> m (Either ParseError (a, [s])))
-> ((a, [s]) -> m (Either ParseError (a, [s])))
-> Either ParseError (a, [s])
-> m (Either ParseError (a, [s]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        ( \ParseError
e1 ->
            (ParseError -> Either ParseError (a, [s]))
-> ((a, [s]) -> Either ParseError (a, [s]))
-> Either ParseError (a, [s])
-> Either ParseError (a, [s])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (Either ParseError (a, [s])
-> ParseError -> Either ParseError (a, [s])
forall a b. a -> b -> a
const (Either ParseError (a, [s])
 -> ParseError -> Either ParseError (a, [s]))
-> Either ParseError (a, [s])
-> ParseError
-> Either ParseError (a, [s])
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (a, [s])
forall a b. a -> Either a b
Left ParseError
e1)
              (a, [s]) -> Either ParseError (a, [s])
forall a b. b -> Either a b
Right
              (Either ParseError (a, [s]) -> Either ParseError (a, [s]))
-> m (Either ParseError (a, [s])) -> m (Either ParseError (a, [s]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
runParserT ParserT s m a
n [s]
ss
        )
        (Either ParseError (a, [s]) -> m (Either ParseError (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> ((a, [s]) -> Either ParseError (a, [s]))
-> (a, [s])
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> Either ParseError (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 (b, [s]))) -> ParserT s m b
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (b, [s]))) -> ParserT s m b)
-> ([s] -> m (Either ParseError (b, [s]))) -> ParserT s m b
forall a b. (a -> b) -> a -> b
$
      ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
runParserT ParserT s m a
m
        ([s] -> m (Either ParseError (a, [s])))
-> (Either ParseError (a, [s]) -> m (Either ParseError (b, [s])))
-> [s]
-> m (Either ParseError (b, [s]))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ParseError -> m (Either ParseError (b, [s])))
-> ((a, [s]) -> m (Either ParseError (b, [s])))
-> Either ParseError (a, [s])
-> m (Either ParseError (b, [s]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          (Either ParseError (b, [s]) -> m (Either ParseError (b, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (b, [s]) -> m (Either ParseError (b, [s])))
-> (ParseError -> Either ParseError (b, [s]))
-> ParseError
-> m (Either ParseError (b, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError (b, [s])
forall a b. a -> Either a b
Left)
          (\(a
a, [s]
ss') -> ParserT s m b -> [s] -> m (Either ParseError (b, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (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 (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ \[s]
ss -> (a, [s]) -> Either ParseError (a, [s])
forall a b. b -> Either a b
Right ((a, [s]) -> Either ParseError (a, [s]))
-> (a -> (a, [s])) -> a -> Either ParseError (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[s]
ss) (a -> Either ParseError (a, [s]))
-> m a -> m (Either ParseError (a, [s]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m

-- | Combine the results of @p@ and @q@ via @p <> q@
instance (Monad m, Semigroup a) => Semigroup (ParserT s m a) where
  ParserT s m a
m <> :: ParserT s m a -> ParserT s m a -> ParserT s m a
<> ParserT s m a
n = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (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
m 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
n

instance (Monad m, Monoid a) => Monoid (ParserT s m a) where
  mempty :: ParserT s m a
mempty = a -> ParserT s m a
forall a. a -> ParserT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

instance (Monad m) => MonadFail (ParserT s m) where
  fail :: forall a. String -> ParserT s m a
fail = ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a)
-> (String -> [s] -> m (Either ParseError (a, [s])))
-> String
-> ParserT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either ParseError (a, [s]))
-> [s] -> m (Either ParseError (a, [s]))
forall a b. a -> b -> a
const (m (Either ParseError (a, [s]))
 -> [s] -> m (Either ParseError (a, [s])))
-> (String -> m (Either ParseError (a, [s])))
-> String
-> [s]
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseError (a, [s]) -> m (Either ParseError (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> (String -> Either ParseError (a, [s]))
-> String
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError (a, [s])
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (a, [s]))
-> (String -> ParseError) -> String -> Either ParseError (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError

-- | A parse error
newtype ParseError = ParseError {ParseError -> String
unexpected :: String}
  deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

{-
 - Parsers
 -}

-- | Parse symbols satisfying a predicate
sat :: (Applicative m, Show s) => (s -> Bool) -> ParserT s m s
sat :: forall (m :: * -> *) s.
(Applicative m, Show s) =>
(s -> Bool) -> ParserT s m s
sat s -> Bool
p = ([s] -> m (Either ParseError (s, [s]))) -> ParserT s m s
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (s, [s]))) -> ParserT s m s)
-> ([s] -> m (Either ParseError (s, [s]))) -> ParserT s m s
forall a b. (a -> b) -> a -> b
$ \case
  [] -> Either ParseError (s, [s]) -> m (Either ParseError (s, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (s, [s]) -> m (Either ParseError (s, [s])))
-> (ParseError -> Either ParseError (s, [s]))
-> ParseError
-> m (Either ParseError (s, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError (s, [s])
forall a b. a -> Either a b
Left (ParseError -> m (Either ParseError (s, [s])))
-> ParseError -> m (Either ParseError (s, [s]))
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError []
  (s
s : [s]
ss) ->
    m (Either ParseError (s, [s]))
-> m (Either ParseError (s, [s]))
-> Bool
-> m (Either ParseError (s, [s]))
forall a. a -> a -> Bool -> a
bool
      (Either ParseError (s, [s]) -> m (Either ParseError (s, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (s, [s]) -> m (Either ParseError (s, [s])))
-> (String -> Either ParseError (s, [s]))
-> String
-> m (Either ParseError (s, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError (s, [s])
forall a b. a -> Either a b
Left (ParseError -> Either ParseError (s, [s]))
-> (String -> ParseError) -> String -> Either ParseError (s, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError (String -> m (Either ParseError (s, [s])))
-> String -> m (Either ParseError (s, [s]))
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Show a => a -> String
show s
s)
      (Either ParseError (s, [s]) -> m (Either ParseError (s, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (s, [s]) -> m (Either ParseError (s, [s])))
-> Either ParseError (s, [s]) -> m (Either ParseError (s, [s]))
forall a b. (a -> b) -> a -> b
$ (s, [s]) -> Either ParseError (s, [s])
forall a b. b -> Either a b
Right (s
s, [s]
ss))
      (Bool -> m (Either ParseError (s, [s])))
-> Bool -> m (Either ParseError (s, [s]))
forall a b. (a -> b) -> a -> b
$ s -> Bool
p s
s

-- | Parse any symbol
item :: (Applicative m, Show s) => ParserT s m s
item :: forall (m :: * -> *) s. (Applicative m, Show s) => ParserT s m s
item = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
(Applicative m, Show s) =>
(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

-- | Parse a symbol
symbol :: (Applicative m, Show s, Eq s) => s -> ParserT s m s
symbol :: forall (m :: * -> *) s.
(Applicative m, Show s, Eq s) =>
s -> ParserT s m s
symbol = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
(Applicative m, Show s) =>
(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
(==)

-- | Parse a sequence of symbols
string :: (Monad m, Traversable t, Show s, Eq s) => t s -> ParserT s m (t s)
string :: forall (m :: * -> *) (t :: * -> *) s.
(Monad m, Traversable t, Show s, 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, Show s, Eq s) =>
s -> ParserT s m s
symbol

-- | Parse symbols included in a collection
oneOf :: (Applicative m, Foldable t, Show s, Eq s) => t s -> ParserT s m s
oneOf :: forall (m :: * -> *) (t :: * -> *) s.
(Applicative m, Foldable t, Show s, Eq s) =>
t s -> ParserT s m s
oneOf = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
(Applicative m, Show s) =>
(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

-- | Parse symbols excluded from a collection
noneOf :: (Applicative m, Foldable t, Show s, Eq s) => t s -> ParserT s m s
noneOf :: forall (m :: * -> *) (t :: * -> *) s.
(Applicative m, Foldable t, Show s, Eq s) =>
t s -> ParserT s m s
noneOf = (s -> Bool) -> ParserT s m s
forall (m :: * -> *) s.
(Applicative m, Show s) =>
(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

-- | Parse successfully only at end of input
eof :: (Monad m, Show s) => ParserT s m ()
eof :: forall (m :: * -> *) s. (Monad m, Show s) => ParserT s m ()
eof = ParserT s m s -> ParserT s m ()
forall (m :: * -> *) a s.
(Monad m, Show a) =>
ParserT s m a -> ParserT s m ()
reject ParserT s m s
forall (m :: * -> *) s. (Applicative m, Show s) => ParserT s m s
item

{-
 - Combinators
 -}

-- | Parse zero or more @p@ separated by @q@ via @p \`sepBy\` q@
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

-- | Parse one or more @p@ separated by @q@ via @p \`sepBy1\` q@
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)

-- | Parse zero or more @p@ separated and ended by @q@ via @p \`endBy\` q@
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

-- | Parse one or more @p@ separated and ended by @q@ via @p \`endBy1\` q@
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

-- | Parse one or more @p@ left-chained with @op@ via @chainl1 p op@
chainl1
  :: (Monad m, Eq s)
  => ParserT s m a
  -> ParserT s m (a -> a -> a)
  -> ParserT s m a
chainl1 :: forall (m :: * -> *) s a.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m (a -> a -> a) -> ParserT s m a
chainl1 ParserT s m a
p ParserT s m (a -> a -> a)
op = 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 -> (a -> ParserT s m b) -> ParserT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParserT s m a
go
 where
  go :: a -> ParserT s m a
go a
a = 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 a
a (ParserT s m a -> ParserT s m a) -> ParserT s m a -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ ParserT s m (a -> a -> a)
op ParserT s m (a -> a -> a) -> ParserT s m a -> ParserT s m (a -> 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
<*> a -> ParserT s m a
forall a. a -> ParserT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a 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
p ParserT s m a -> (a -> ParserT s m a) -> ParserT s m a
forall a b. ParserT s m a -> (a -> ParserT s m b) -> ParserT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParserT s m a
go

-- | Parse one or more @p@ right-chained with @op@ via @chainr1 p op@
chainr1
  :: (Monad m, Eq s)
  => ParserT s m a
  -> ParserT s m (a -> a -> a)
  -> ParserT s m a
chainr1 :: forall (m :: * -> *) s a.
(Monad m, Eq s) =>
ParserT s m a -> ParserT s m (a -> a -> a) -> ParserT s m a
chainr1 ParserT s m a
p ParserT s m (a -> a -> a)
op = ParserT s m a
go
 where
  go :: ParserT s m a
go = 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 -> (a -> ParserT s m b) -> ParserT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParserT s m a
rest
  rest :: a -> ParserT s m a
rest a
a = 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 a
a (ParserT s m a -> ParserT s m a) -> ParserT s m a -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ ParserT s m (a -> a -> a)
op ParserT s m (a -> a -> a) -> ParserT s m a -> ParserT s m (a -> 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
<*> a -> ParserT s m a
forall a. a -> ParserT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a 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
go ParserT s m a -> (a -> ParserT s m a) -> ParserT s m a
forall a b. ParserT s m a -> (a -> ParserT s m b) -> ParserT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParserT s m a
rest

-- | Parse @p@ enclosed by @a@ and @b@ via @between a b p@
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

-- | Parse @p@ returning @a@ in case of failure via @option a p@
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

-- | Parse @p@, without consuming input, iff @p@ fails via @reject p@
reject :: (Monad m, Show a) => ParserT s m a -> ParserT s m ()
reject :: forall (m :: * -> *) a s.
(Monad m, Show a) =>
ParserT s m a -> ParserT s m ()
reject ParserT s m a
p = ([s] -> m (Either ParseError ((), [s]))) -> ParserT s m ()
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError ((), [s]))) -> ParserT s m ())
-> ([s] -> m (Either ParseError ((), [s]))) -> ParserT s m ()
forall a b. (a -> b) -> a -> b
$ \[s]
ss ->
  ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
runParserT ParserT s m a
p [s]
ss
    m (Either ParseError (a, [s]))
-> (Either ParseError (a, [s]) -> m (Either ParseError ((), [s])))
-> m (Either ParseError ((), [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 -> m (Either ParseError ((), [s])))
-> ((a, [s]) -> m (Either ParseError ((), [s])))
-> Either ParseError (a, [s])
-> m (Either ParseError ((), [s]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (m (Either ParseError ((), [s]))
-> ParseError -> m (Either ParseError ((), [s]))
forall a b. a -> b -> a
const (m (Either ParseError ((), [s]))
 -> ParseError -> m (Either ParseError ((), [s])))
-> (Either ParseError ((), [s]) -> m (Either ParseError ((), [s])))
-> Either ParseError ((), [s])
-> ParseError
-> m (Either ParseError ((), [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseError ((), [s]) -> m (Either ParseError ((), [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError ((), [s])
 -> ParseError -> m (Either ParseError ((), [s])))
-> Either ParseError ((), [s])
-> ParseError
-> m (Either ParseError ((), [s]))
forall a b. (a -> b) -> a -> b
$ ((), [s]) -> Either ParseError ((), [s])
forall a b. b -> Either a b
Right ((), [s]
ss))
      (Either ParseError ((), [s]) -> m (Either ParseError ((), [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError ((), [s]) -> m (Either ParseError ((), [s])))
-> ((a, [s]) -> Either ParseError ((), [s]))
-> (a, [s])
-> m (Either ParseError ((), [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError ((), [s])
forall a b. a -> Either a b
Left (ParseError -> Either ParseError ((), [s]))
-> ((a, [s]) -> ParseError)
-> (a, [s])
-> Either ParseError ((), [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError (String -> ParseError)
-> ((a, [s]) -> String) -> (a, [s]) -> ParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> String) -> ((a, [s]) -> a) -> (a, [s]) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> a
forall a b. (a, b) -> a
fst)

-- | Parse @p@, without consuming input, iff @p@ succeeds via @accept p@
accept :: (Monad m) => ParserT s m a -> ParserT s m a
accept :: forall (m :: * -> *) s a. Monad m => ParserT s m a -> ParserT s m a
accept ParserT s m a
p = ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall s (m :: * -> *) a.
([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
ParserT (([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a)
-> ([s] -> m (Either ParseError (a, [s]))) -> ParserT s m a
forall a b. (a -> b) -> a -> b
$ \[s]
ss ->
  ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
forall s (m :: * -> *) a.
ParserT s m a -> [s] -> m (Either ParseError (a, [s]))
runParserT ParserT s m a
p [s]
ss
    m (Either ParseError (a, [s]))
-> (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> m (Either ParseError (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 -> m (Either ParseError (a, [s])))
-> ((a, [s]) -> m (Either ParseError (a, [s])))
-> Either ParseError (a, [s])
-> m (Either ParseError (a, [s]))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (Either ParseError (a, [s]) -> m (Either ParseError (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> (ParseError -> Either ParseError (a, [s]))
-> ParseError
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Either ParseError (a, [s])
forall a b. a -> Either a b
Left)
      (Either ParseError (a, [s]) -> m (Either ParseError (a, [s]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (a, [s]) -> m (Either ParseError (a, [s])))
-> ((a, [s]) -> Either ParseError (a, [s]))
-> (a, [s])
-> m (Either ParseError (a, [s]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> Either ParseError (a, [s])
forall a b. b -> Either a b
Right ((a, [s]) -> Either ParseError (a, [s]))
-> ((a, [s]) -> (a, [s])) -> (a, [s]) -> Either ParseError (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[s]
ss) (a -> (a, [s])) -> ((a, [s]) -> a) -> (a, [s]) -> (a, [s])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> a
forall a b. (a, b) -> a
fst)