{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
module Data.Conduit.Parser.Internal (module Data.Conduit.Parser.Internal) where

-- {{{ Imports
import qualified Conduit

import           Control.Applicative
import           Control.Exception.Safe    as Exception
import           Control.Monad
import           Control.Monad.Error.Class
import           Control.Monad.IO.Class    (MonadIO)
import           Control.Monad.Trans.Class (MonadTrans(..))
import           Control.Monad.Trans.Except (ExceptT, runExceptT)
import           Control.Monad.Trans.State

import           Data.Bifunctor
import           Data.Conduit              hiding (await, leftover)
import qualified Data.Conduit.List         as Conduit
import           Data.DList                (DList (..), append, cons)
import           Data.Maybe                (fromMaybe)
import           Data.Semigroup
import           Data.Text                 as Text (Text, pack, unpack)

import           Safe

import           Text.Parser.Combinators   as Parser
-- }}}

-- | Core type of the package. This is basically a 'Sink' with a parsing state.
newtype ConduitParser i m a = ConduitParser (ExceptT ConduitParserException (StateT ([Text], Buffer i) (ConduitT i Void m)) a)

deriving instance Functor (ConduitParser i m)
deriving instance Applicative (ConduitParser i m)
deriving instance Monad (ConduitParser i m)
deriving instance (MonadIO m) => MonadIO (ConduitParser i m)
deriving instance (MonadThrow m) => MonadThrow (ConduitParser i m)

instance MonadTrans (ConduitParser i) where
  lift :: m a -> ConduitParser i m a
lift = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   a
 -> ConduitParser i m a)
-> (m a
    -> ExceptT
         ConduitParserException
         (StateT ([Text], Buffer i) (ConduitT i Void m))
         a)
-> m a
-> ConduitParser i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([Text], Buffer i) (ConduitT i Void m) a
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) a
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      a)
-> (m a -> StateT ([Text], Buffer i) (ConduitT i Void m) a)
-> m a
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT i Void m a
-> StateT ([Text], Buffer i) (ConduitT i Void m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConduitT i Void m a
 -> StateT ([Text], Buffer i) (ConduitT i Void m) a)
-> (m a -> ConduitT i Void m a)
-> m a
-> StateT ([Text], Buffer i) (ConduitT i Void m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ConduitT i Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


-- | Backtracking is supported by pushing back consumed elements (using 'leftover') whenever an error is catched.
--
-- As a consequence, within the scope of a `catchError`,
-- all streamed items are kept in memory,
-- which means the consumer no longer uses constant memory.
instance MonadError ConduitParserException (ConduitParser i m) where
  throwError :: ConduitParserException -> ConduitParser i m a
throwError ConduitParserException
e = do
    [Text]
names <- ConduitParser i m [Text]
forall i (m :: * -> *). ConduitParser i m [Text]
getParserNames
    ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   a
 -> ConduitParser i m a)
-> (ConduitParserException
    -> ExceptT
         ConduitParserException
         (StateT ([Text], Buffer i) (ConduitT i Void m))
         a)
-> ConduitParserException
-> ConduitParser i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitParserException
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser i m a)
-> ConduitParserException -> ConduitParser i m a
forall a b. (a -> b) -> a -> b
$ (Text -> ConduitParserException -> ConduitParserException)
-> ConduitParserException -> [Text] -> ConduitParserException
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> ConduitParserException -> ConduitParserException
NamedParserException ConduitParserException
e ([Text] -> ConduitParserException)
-> [Text] -> ConduitParserException
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
names

  catchError :: ConduitParser i m a
-> (ConduitParserException -> ConduitParser i m a)
-> ConduitParser i m a
catchError (ConduitParser ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
f) ConduitParserException -> ConduitParser i m a
handler = do
    Buffer i
buffer <- (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall i (m :: * -> *).
(Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer Buffer i -> Buffer i
forall i. Buffer i -> Buffer i
resetBuffer
    (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall i (m :: * -> *).
(Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer ((Buffer i -> Buffer i) -> ConduitParser i m (Buffer i))
-> (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall a b. (a -> b) -> a -> b
$ Bool -> Buffer i -> Buffer i
forall i. Bool -> Buffer i -> Buffer i
setEnabled Bool
True

    Either ConduitParserException a
result <- ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  (Either ConduitParserException a)
-> ConduitParser i m (Either ConduitParserException a)
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   (Either ConduitParserException a)
 -> ConduitParser i m (Either ConduitParserException a))
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Either ConduitParserException a)
-> ConduitParser i m (Either ConduitParserException a)
forall a b. (a -> b) -> a -> b
$ (a -> Either ConduitParserException a
forall a b. b -> Either a b
Right (a -> Either ConduitParserException a)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Either ConduitParserException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
f) ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  (Either ConduitParserException a)
-> (ConduitParserException
    -> ExceptT
         ConduitParserException
         (StateT ([Text], Buffer i) (ConduitT i Void m))
         (Either ConduitParserException a))
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Either ConduitParserException a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (Either ConduitParserException a
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Either ConduitParserException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ConduitParserException a
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      (Either ConduitParserException a))
-> (ConduitParserException -> Either ConduitParserException a)
-> ConduitParserException
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Either ConduitParserException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitParserException -> Either ConduitParserException a
forall a b. a -> Either a b
Left)

    case Either ConduitParserException a
result of
      Left ConduitParserException
e  -> ConduitParser i m ()
forall i (m :: * -> *). ConduitParser i m ()
backtrack ConduitParser i m ()
-> ConduitParser i m (Buffer i) -> ConduitParser i m (Buffer i)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Buffer i -> ConduitParser i m (Buffer i)
forall i (m :: * -> *). Buffer i -> ConduitParser i m (Buffer i)
setBuffer Buffer i
buffer ConduitParser i m (Buffer i)
-> ConduitParser i m a -> ConduitParser i m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitParserException -> ConduitParser i m a
handler ConduitParserException
e
      Right a
a -> (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall i (m :: * -> *).
(Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer (Buffer i -> Buffer i -> Buffer i
forall i. Buffer i -> Buffer i -> Buffer i
prependBuffer Buffer i
buffer) ConduitParser i m (Buffer i)
-> ConduitParser i m a -> ConduitParser i m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> ConduitParser i m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Parsers can be combined with ('<|>'), 'some', 'many', 'optional', 'choice'.
--
-- The use of 'guard' is not recommended as it generates unhelpful error messages.
-- Please consider using 'throwError' or 'unexpected' instead.
instance Alternative (ConduitParser i m) where
  empty :: ConduitParser i m a
empty = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   a
 -> ConduitParser i m a)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
-> ConduitParser i m a
forall a b. (a -> b) -> a -> b
$ ConduitParserException
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      a)
-> ConduitParserException
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     a
forall a b. (a -> b) -> a -> b
$ Text -> ConduitParserException
Unexpected Text
"ConduitParser.empty"

  ConduitParser i m a
parserA <|> :: ConduitParser i m a -> ConduitParser i m a -> ConduitParser i m a
<|> ConduitParser i m a
parserB = ConduitParser i m a
-> (ConduitParserException -> ConduitParser i m a)
-> ConduitParser i m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ConduitParser i m a
parserA ((ConduitParserException -> ConduitParser i m a)
 -> ConduitParser i m a)
-> (ConduitParserException -> ConduitParser i m a)
-> ConduitParser i m a
forall a b. (a -> b) -> a -> b
$ \ConduitParserException
ea ->
    ConduitParser i m a
-> (ConduitParserException -> ConduitParser i m a)
-> ConduitParser i m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ConduitParser i m a
parserB ((ConduitParserException -> ConduitParser i m a)
 -> ConduitParser i m a)
-> (ConduitParserException -> ConduitParser i m a)
-> ConduitParser i m a
forall a b. (a -> b) -> a -> b
$ \ConduitParserException
eb ->
      ConduitParserException -> ConduitParser i m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser i m a)
-> ConduitParserException -> ConduitParser i m a
forall a b. (a -> b) -> a -> b
$ ConduitParserException
-> ConduitParserException -> ConduitParserException
BothFailed ConduitParserException
ea ConduitParserException
eb

-- | Parsing combinators can be used with 'ConduitParser's.
instance (Monad m) => Parsing (ConduitParser i m) where
  try :: ConduitParser i m a -> ConduitParser i m a
try ConduitParser i m a
parser = ConduitParser i m a
parser

  ConduitParser i m a
parser <?> :: ConduitParser i m a -> String -> ConduitParser i m a
<?> String
name = do
    Text -> ConduitParser i m ()
forall i (m :: * -> *). Text -> ConduitParser i m ()
pushParserName (Text -> ConduitParser i m ()) -> Text -> ConduitParser i m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
name
    a
a <- ConduitParser i m a
parser
    ConduitParser i m ()
forall i (m :: * -> *). ConduitParser i m ()
popParserName
    a -> ConduitParser i m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

  unexpected :: String -> ConduitParser i m a
unexpected = ConduitParserException -> ConduitParser i m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser i m a)
-> (String -> ConduitParserException)
-> String
-> ConduitParser i m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ConduitParserException
Unexpected (Text -> ConduitParserException)
-> (String -> Text) -> String -> ConduitParserException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

  eof :: ConduitParser i m ()
eof = do
    Maybe i
result <- ConduitParser i m (Maybe i)
forall (m :: * -> *) i. Monad m => ConduitParser i m (Maybe i)
peek
    ConduitParser i m ()
-> (i -> ConduitParser i m ()) -> Maybe i -> ConduitParser i m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitParser i m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (ConduitParser i m () -> i -> ConduitParser i m ()
forall a b. a -> b -> a
const (ConduitParser i m () -> i -> ConduitParser i m ())
-> ConduitParser i m () -> i -> ConduitParser i m ()
forall a b. (a -> b) -> a -> b
$ ConduitParserException -> ConduitParser i m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ConduitParserException
ExpectedEndOfInput) Maybe i
result

  notFollowedBy :: ConduitParser i m a -> ConduitParser i m ()
notFollowedBy ConduitParser i m a
parser = do
    Maybe a
result <- ConduitParser i m a -> ConduitParser i m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ConduitParser i m a
parser
    Text
name <- ConduitParser i m Text
forall i (m :: * -> *). ConduitParser i m Text
getParserName
    Maybe a -> (a -> ConduitParser i m Any) -> ConduitParser i m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
result ((a -> ConduitParser i m Any) -> ConduitParser i m ())
-> (a -> ConduitParser i m Any) -> ConduitParser i m ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> ConduitParserException -> ConduitParser i m Any
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConduitParserException -> ConduitParser i m Any)
-> ConduitParserException -> ConduitParser i m Any
forall a b. (a -> b) -> a -> b
$ Text -> ConduitParserException
UnexpectedFollowedBy Text
name

-- | Flipped version of ('<?>').
named :: (Monad m) => Text -> ConduitParser i m a -> ConduitParser i m a
named :: Text -> ConduitParser i m a -> ConduitParser i m a
named Text
name = (ConduitParser i m a -> String -> ConduitParser i m a)
-> String -> ConduitParser i m a -> ConduitParser i m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitParser i m a -> String -> ConduitParser i m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
(<?>) (Text -> String
unpack Text
name)


-- | Run a 'ConduitParser'.
-- Any parsing failure will be thrown as an exception.
runConduitParser :: (MonadThrow m) => ConduitParser i m a -> ConduitT i Void m a
runConduitParser :: ConduitParser i m a -> ConduitT i Void m a
runConduitParser (ConduitParser ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
p) = (ConduitParserException -> ConduitT i Void m a)
-> (a -> ConduitT i Void m a)
-> Either ConduitParserException a
-> ConduitT i Void m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ConduitParserException -> ConduitT i Void m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM a -> ConduitT i Void m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ConduitParserException a -> ConduitT i Void m a)
-> ((Either ConduitParserException a, ([Text], Buffer i))
    -> Either ConduitParserException a)
-> (Either ConduitParserException a, ([Text], Buffer i))
-> ConduitT i Void m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ConduitParserException a, ([Text], Buffer i))
-> Either ConduitParserException a
forall a b. (a, b) -> a
fst ((Either ConduitParserException a, ([Text], Buffer i))
 -> ConduitT i Void m a)
-> ConduitT
     i Void m (Either ConduitParserException a, ([Text], Buffer i))
-> ConduitT i Void m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT
  ([Text], Buffer i)
  (ConduitT i Void m)
  (Either ConduitParserException a)
-> ([Text], Buffer i)
-> ConduitT
     i Void m (Either ConduitParserException a, ([Text], Buffer i))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> StateT
     ([Text], Buffer i)
     (ConduitT i Void m)
     (Either ConduitParserException a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
p) ([Text]
forall a. Monoid a => a
mempty, Buffer i
forall a. Monoid a => a
mempty)

-- | Return the ordered list of names (assigned through ('<?>')) for the current parser stack. First element is the most nested parser.
getParserNames :: ConduitParser i m [Text]
getParserNames :: ConduitParser i m [Text]
getParserNames = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  [Text]
-> ConduitParser i m [Text]
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   [Text]
 -> ConduitParser i m [Text])
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     [Text]
-> ConduitParser i m [Text]
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) [Text]
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     [Text]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) [Text]
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      [Text])
-> StateT ([Text], Buffer i) (ConduitT i Void m) [Text]
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     [Text]
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> [Text])
-> StateT ([Text], Buffer i) (ConduitT i Void m) [Text]
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ([Text], Buffer i) -> [Text]
forall a b. (a, b) -> a
fst

-- | Return the name (assigned through ('<?>')) of the current parser (most nested), or 'mempty' if it has none.
getParserName :: ConduitParser i m Text
getParserName :: ConduitParser i m Text
getParserName = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  Text
-> ConduitParser i m Text
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   Text
 -> ConduitParser i m Text)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     Text
-> ConduitParser i m Text
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) Text
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) Text
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      Text)
-> StateT ([Text], Buffer i) (ConduitT i Void m) Text
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     Text
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> Text)
-> StateT ([Text], Buffer i) (ConduitT i Void m) Text
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef Text
"" ([Text] -> Text)
-> (([Text], Buffer i) -> [Text]) -> ([Text], Buffer i) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Buffer i) -> [Text]
forall a b. (a, b) -> a
fst)

pushParserName :: Text -> ConduitParser i m ()
pushParserName :: Text -> ConduitParser i m ()
pushParserName Text
name = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  ()
-> ConduitParser i m ()
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   ()
 -> ConduitParser i m ())
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
-> ConduitParser i m ()
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) ()
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      ())
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> ([Text], Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((([Text], Buffer i) -> ([Text], Buffer i))
 -> StateT ([Text], Buffer i) (ConduitT i Void m) ())
-> (([Text], Buffer i) -> ([Text], Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> ([Text], Buffer i) -> ([Text], Buffer i)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)

popParserName ::  ConduitParser i m ()
popParserName :: ConduitParser i m ()
popParserName = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  ()
-> ConduitParser i m ()
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   ()
 -> ConduitParser i m ())
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
-> ConduitParser i m ()
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) ()
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      ())
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> ([Text], Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((([Text], Buffer i) -> ([Text], Buffer i))
 -> StateT ([Text], Buffer i) (ConduitT i Void m) ())
-> (([Text], Buffer i) -> ([Text], Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> ([Text], Buffer i) -> ([Text], Buffer i)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Text] -> [Text]
forall a. [a] -> [a]
tailSafe

getBuffer :: ConduitParser i m (Buffer i)
getBuffer :: ConduitParser i m (Buffer i)
getBuffer = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  (Buffer i)
-> ConduitParser i m (Buffer i)
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   (Buffer i)
 -> ConduitParser i m (Buffer i))
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Buffer i)
-> ConduitParser i m (Buffer i)
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Buffer i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      (Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Buffer i)
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> Buffer i)
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ([Text], Buffer i) -> Buffer i
forall a b. (a, b) -> b
snd

setBuffer :: Buffer i -> ConduitParser i m (Buffer i)
setBuffer :: Buffer i -> ConduitParser i m (Buffer i)
setBuffer Buffer i
buffer = (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall i (m :: * -> *).
(Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer (Buffer i -> Buffer i -> Buffer i
forall a b. a -> b -> a
const Buffer i
buffer)

withBuffer :: (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer :: (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer Buffer i -> Buffer i
f = do
  Buffer i
buffer <- ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  (Buffer i)
-> ConduitParser i m (Buffer i)
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   (Buffer i)
 -> ConduitParser i m (Buffer i))
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Buffer i)
-> ConduitParser i m (Buffer i)
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Buffer i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      (Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Buffer i)
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> Buffer i)
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Buffer i)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets ([Text], Buffer i) -> Buffer i
forall a b. (a, b) -> b
snd
  ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  ()
-> ConduitParser i m ()
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   ()
 -> ConduitParser i m ())
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
-> ConduitParser i m ()
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) ()
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      ())
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall a b. (a -> b) -> a -> b
$ (([Text], Buffer i) -> ([Text], Buffer i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Buffer i -> Buffer i) -> ([Text], Buffer i) -> ([Text], Buffer i)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Buffer i -> Buffer i
f)
  Buffer i -> ConduitParser i m (Buffer i)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer i
buffer

backtrack :: ConduitParser i m ()
backtrack :: ConduitParser i m ()
backtrack = (i -> ConduitParser i m ()) -> Buffer i -> ConduitParser i m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ i -> ConduitParser i m ()
forall i (m :: * -> *). i -> ConduitParser i m ()
leftover (Buffer i -> ConduitParser i m ())
-> ConduitParser i m (Buffer i) -> ConduitParser i m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall i (m :: * -> *).
(Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer Buffer i -> Buffer i
forall i. Buffer i -> Buffer i
resetBuffer


newtype Buffer i = Buffer (Maybe (DList i))

deriving instance Semigroup (Buffer i)
deriving instance Monoid (Buffer i)
deriving instance (Show i) => Show (Buffer i)

instance Functor Buffer where
  fmap :: (a -> b) -> Buffer a -> Buffer b
fmap a -> b
_ (Buffer Maybe (DList a)
Nothing)  = Maybe (DList b) -> Buffer b
forall i. Maybe (DList i) -> Buffer i
Buffer Maybe (DList b)
forall a. Monoid a => a
mempty
  fmap a -> b
f (Buffer (Just DList a
a)) = Maybe (DList b) -> Buffer b
forall i. Maybe (DList i) -> Buffer i
Buffer (Maybe (DList b) -> Buffer b) -> Maybe (DList b) -> Buffer b
forall a b. (a -> b) -> a -> b
$ DList b -> Maybe (DList b)
forall a. a -> Maybe a
Just (DList b -> Maybe (DList b)) -> DList b -> Maybe (DList b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> DList a -> DList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f DList a
a

instance Foldable Buffer where
  foldMap :: (a -> m) -> Buffer a -> m
foldMap a -> m
_ (Buffer Maybe (DList a)
Nothing)  = m
forall a. Monoid a => a
mempty
  foldMap a -> m
f (Buffer (Just DList a
a)) = (a -> m) -> DList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f DList a
a


setEnabled :: Bool -> Buffer i -> Buffer i
setEnabled :: Bool -> Buffer i -> Buffer i
setEnabled Bool
True (Buffer Maybe (DList i)
a) = Maybe (DList i) -> Buffer i
forall i. Maybe (DList i) -> Buffer i
Buffer (Maybe (DList i)
a Maybe (DList i) -> Maybe (DList i) -> Maybe (DList i)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DList i -> Maybe (DList i)
forall a. a -> Maybe a
Just DList i
forall a. Monoid a => a
mempty)
setEnabled Bool
_ (Buffer Maybe (DList i)
_)    = Maybe (DList i) -> Buffer i
forall i. Maybe (DList i) -> Buffer i
Buffer Maybe (DList i)
forall a. Monoid a => a
mempty

prependItem :: i -> Buffer i -> Buffer i
prependItem :: i -> Buffer i -> Buffer i
prependItem i
new (Buffer Maybe (DList i)
a) = Maybe (DList i) -> Buffer i
forall i. Maybe (DList i) -> Buffer i
Buffer (Maybe (DList i) -> Buffer i) -> Maybe (DList i) -> Buffer i
forall a b. (a -> b) -> a -> b
$ (DList i -> DList i) -> Maybe (DList i) -> Maybe (DList i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i -> DList i -> DList i
forall a. a -> DList a -> DList a
cons i
new) Maybe (DList i)
a

-- Warning: this function is asymetric
prependBuffer :: Buffer i -> Buffer i -> Buffer i
prependBuffer :: Buffer i -> Buffer i -> Buffer i
prependBuffer (Buffer Maybe (DList i)
a) (Buffer Maybe (DList i)
b) = case Maybe (DList i)
a of
  Just DList i
a' -> Maybe (DList i) -> Buffer i
forall i. Maybe (DList i) -> Buffer i
Buffer (Maybe (DList i) -> Buffer i) -> Maybe (DList i) -> Buffer i
forall a b. (a -> b) -> a -> b
$ DList i -> Maybe (DList i)
forall a. a -> Maybe a
Just (DList i -> Maybe (DList i) -> DList i
forall a. a -> Maybe a -> a
fromMaybe DList i
forall a. Monoid a => a
mempty Maybe (DList i)
b DList i -> DList i -> DList i
forall a. DList a -> DList a -> DList a
`append` DList i
a')
  Maybe (DList i)
_       -> Maybe (DList i) -> Buffer i
forall i. Maybe (DList i) -> Buffer i
Buffer Maybe (DList i)
a

resetBuffer :: Buffer i -> Buffer i
resetBuffer :: Buffer i -> Buffer i
resetBuffer (Buffer Maybe (DList i)
a) = Maybe (DList i) -> Buffer i
forall i. Maybe (DList i) -> Buffer i
Buffer (Maybe (DList i) -> Buffer i) -> Maybe (DList i) -> Buffer i
forall a b. (a -> b) -> a -> b
$ (DList i -> DList i) -> Maybe (DList i) -> Maybe (DList i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DList i -> DList i -> DList i
forall a b. a -> b -> a
const DList i
forall a. Monoid a => a
mempty) Maybe (DList i)
a

-- | 'Conduit.await' wrapped as a 'ConduitParser'.
--
-- If no data is available, 'UnexpectedEndOfInput' is thrown.
await :: (Monad m) => ConduitParser i m i
await :: ConduitParser i m i
await = do
  Maybe i
event <- ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  (Maybe i)
-> ConduitParser i m (Maybe i)
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   (Maybe i)
 -> ConduitParser i m (Maybe i))
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Maybe i)
-> ConduitParser i m (Maybe i)
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Maybe i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      (Maybe i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Maybe i)
forall a b. (a -> b) -> a -> b
$ ConduitT i Void m (Maybe i)
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ConduitT i Void m (Maybe i)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
Conduit.await
  i
e     <- ConduitParser i m i
-> (i -> ConduitParser i m i) -> Maybe i -> ConduitParser i m i
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConduitParserException -> ConduitParser i m i
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ConduitParserException
UnexpectedEndOfInput) i -> ConduitParser i m i
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe i
event
  (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall i (m :: * -> *).
(Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
withBuffer ((Buffer i -> Buffer i) -> ConduitParser i m (Buffer i))
-> (Buffer i -> Buffer i) -> ConduitParser i m (Buffer i)
forall a b. (a -> b) -> a -> b
$ i -> Buffer i -> Buffer i
forall i. i -> Buffer i -> Buffer i
prependItem i
e
  i -> ConduitParser i m i
forall (m :: * -> *) a. Monad m => a -> m a
return i
e

-- | 'Conduit.leftover' wrapped as a 'ConduitParser'.
leftover :: i -> ConduitParser i m ()
leftover :: i -> ConduitParser i m ()
leftover = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  ()
-> ConduitParser i m ()
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   ()
 -> ConduitParser i m ())
-> (i
    -> ExceptT
         ConduitParserException
         (StateT ([Text], Buffer i) (ConduitT i Void m))
         ())
-> i
-> ConduitParser i m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([Text], Buffer i) (ConduitT i Void m) ()
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) ()
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      ())
-> (i -> StateT ([Text], Buffer i) (ConduitT i Void m) ())
-> i
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT i Void m ()
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConduitT i Void m ()
 -> StateT ([Text], Buffer i) (ConduitT i Void m) ())
-> (i -> ConduitT i Void m ())
-> i
-> StateT ([Text], Buffer i) (ConduitT i Void m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> ConduitT i Void m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
Conduit.leftover

-- | 'Conduit.peek' wrapped as a 'ConduitParser'.
peek :: (Monad m) => ConduitParser i m (Maybe i)
peek :: ConduitParser i m (Maybe i)
peek = ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  (Maybe i)
-> ConduitParser i m (Maybe i)
forall i (m :: * -> *) a.
ExceptT
  ConduitParserException
  (StateT ([Text], Buffer i) (ConduitT i Void m))
  a
-> ConduitParser i m a
ConduitParser (ExceptT
   ConduitParserException
   (StateT ([Text], Buffer i) (ConduitT i Void m))
   (Maybe i)
 -> ConduitParser i m (Maybe i))
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Maybe i)
-> ConduitParser i m (Maybe i)
forall a b. (a -> b) -> a -> b
$ StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Maybe i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
 -> ExceptT
      ConduitParserException
      (StateT ([Text], Buffer i) (ConduitT i Void m))
      (Maybe i))
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
-> ExceptT
     ConduitParserException
     (StateT ([Text], Buffer i) (ConduitT i Void m))
     (Maybe i)
forall a b. (a -> b) -> a -> b
$ ConduitT i Void m (Maybe i)
-> StateT ([Text], Buffer i) (ConduitT i Void m) (Maybe i)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ConduitT i Void m (Maybe i)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
Conduit.peek


data ConduitParserException = BothFailed ConduitParserException ConduitParserException
                            | ExpectedEndOfInput
                            | NamedParserException Text ConduitParserException
                            | UnexpectedEndOfInput
                            | UnexpectedFollowedBy Text
                            | Unexpected Text

deriving instance Eq ConduitParserException
deriving instance Show ConduitParserException

instance Exception ConduitParserException where
  displayException :: ConduitParserException -> String
displayException (BothFailed ConduitParserException
ea ConduitParserException
eb) = ConduitParserException -> String
forall e. Exception e => e -> String
displayException ConduitParserException
ea String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ConduitParserException -> String
forall e. Exception e => e -> String
displayException ConduitParserException
eb
  displayException ConduitParserException
ExpectedEndOfInput = String
"Unexpected input, expected end of input."
  displayException (NamedParserException Text
t ConduitParserException
e) = String
"While parsing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ConduitParserException -> String
forall e. Exception e => e -> String
displayException ConduitParserException
e
  displayException ConduitParserException
UnexpectedEndOfInput = String
"Unexpected end of input."
  displayException (UnexpectedFollowedBy Text
t) = String
"Should not be followed by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
t
  displayException (Unexpected Text
t) = Text -> String
unpack Text
t