-- | @pipes@ utilities for incrementally running @attoparsec@-based parsers.
--
-- This module assumes familiarity with @pipes-parse@, you can learn about it in
-- "Pipes.Parse.Tutorial".

{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RankNTypes         #-}

module Pipes.Attoparsec (
    -- * Parsing
      parse
    , parsed

    -- ** Including input length
    --
    -- $lengths
    , parseL
    , parsedL

    -- * Utils
    , isEndOfParserInput

    -- * Types
    , ParserInput
    , ParsingError(..)
    ) where

import           Control.Exception                (Exception)
import           Control.Monad.Trans.Error        (Error)
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.Attoparsec.ByteString
import qualified Data.Attoparsec.Text
import           Data.Attoparsec.Types            (IResult (..))
import qualified Data.Attoparsec.Types            as Attoparsec
import           Data.ByteString                  (ByteString)
import qualified Data.ByteString
import           Data.Data                        (Data, Typeable)
import           Data.Monoid                      (Monoid (mempty))
import           Data.Text                        (Text)
import qualified Data.Text
import           Pipes
import qualified Pipes.Parse                      as Pipes (Parser)

--------------------------------------------------------------------------------

-- | Convert an @attoparsec@ 'Attoparsec.Parser' to a @pipes-parse@
-- 'Pipes.Parser'.
--
-- This 'Pipes.Parser' is compatible with the tools from "Pipes.Parse".
--
-- It returns 'Nothing' if the underlying 'Producer' is exhausted, otherwise
-- it attempts to run the given attoparsec 'Attoparsec.Parser' on the underlying
-- 'Producer', possibly failing with 'ParsingError'.
parse
  :: (Monad m, ParserInput a)
  => Attoparsec.Parser a b                            -- ^ Attoparsec parser
  -> Pipes.Parser a m (Maybe (Either ParsingError b)) -- ^ Pipes parser
parse :: Parser a b -> Parser a m (Maybe (Either ParsingError b))
parse parser :: Parser a b
parser = (Producer a m x
 -> m (Maybe (Either ParsingError b), Producer a m x))
-> StateT (Producer a m x) m (Maybe (Either ParsingError b))
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((Producer a m x
  -> m (Maybe (Either ParsingError b), Producer a m x))
 -> StateT (Producer a m x) m (Maybe (Either ParsingError b)))
-> (Producer a m x
    -> m (Maybe (Either ParsingError b), Producer a m x))
-> StateT (Producer a m x) m (Maybe (Either ParsingError b))
forall a b. (a -> b) -> a -> b
$ \p0 :: Producer a m x
p0 -> do
    Either x (a, Producer a m x)
x <- Producer a m x -> m (Either x (a, Producer a m x))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m x
p0
    case Either x (a, Producer a m x)
x of
      Left r :: x
r       -> (Maybe (Either ParsingError b), Producer a m x)
-> m (Maybe (Either ParsingError b), Producer a m x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either ParsingError b)
forall a. Maybe a
Nothing, x -> Producer a m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
r)
      Right (a :: a
a,p1 :: Producer a m x
p1) -> (Producer a m x -> Producer a m x)
-> IResult a b
-> Producer a m x
-> m (Maybe (Either ParsingError b), Producer a m x)
forall (m :: * -> *) a a b.
(Monad m, Eq a, Monoid a) =>
(Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> m (Maybe (Either ParsingError b), Proxy X () () a m a)
step (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m x -> Producer a m x
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser a b -> a -> IResult a b
forall a b. ParserInput a => Parser a b -> a -> IResult a b
_parse Parser a b
parser a
a) Producer a m x
p1
  where
    step :: (Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> m (Maybe (Either ParsingError b), Proxy X () () a m a)
step diffP :: Proxy X () () a m a -> Proxy X () () a m a
diffP res :: IResult a b
res p0 :: Proxy X () () a m a
p0 = case IResult a b
res of
      Fail _ c :: [String]
c m :: String
m -> (Maybe (Either ParsingError b), Proxy X () () a m a)
-> m (Maybe (Either ParsingError b), Proxy X () () a m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParsingError b -> Maybe (Either ParsingError b)
forall a. a -> Maybe a
Just (ParsingError -> Either ParsingError b
forall a b. a -> Either a b
Left ([String] -> String -> ParsingError
ParsingError [String]
c String
m)), Proxy X () () a m a -> Proxy X () () a m a
diffP Proxy X () () a m a
p0)
      Done a :: a
a b :: b
b   -> (Maybe (Either ParsingError b), Proxy X () () a m a)
-> m (Maybe (Either ParsingError b), Proxy X () () a m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParsingError b -> Maybe (Either ParsingError b)
forall a. a -> Maybe a
Just (b -> Either ParsingError b
forall a b. b -> Either a b
Right b
b), a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Proxy X () () a m a -> Proxy X () () a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy X () () a m a
p0)
      Partial k :: a -> IResult a b
k  -> do
        Either a (a, Proxy X () () a m a)
x <- Proxy X () () a m a -> m (Either a (a, Proxy X () () a m a))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Proxy X () () a m a
p0
        case Either a (a, Proxy X () () a m a)
x of
          Left e :: a
e -> (Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> m (Maybe (Either ParsingError b), Proxy X () () a m a)
step Proxy X () () a m a -> Proxy X () () a m a
diffP (a -> IResult a b
k a
forall a. Monoid a => a
mempty) (a -> Proxy X () () a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e)
          Right (a :: a
a,p1 :: Proxy X () () a m a
p1) -> (Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> m (Maybe (Either ParsingError b), Proxy X () () a m a)
step (Proxy X () () a m a -> Proxy X () () a m a
diffP (Proxy X () () a m a -> Proxy X () () a m a)
-> (Proxy X () () a m a -> Proxy X () () a m a)
-> Proxy X () () a m a
-> Proxy X () () a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Proxy X () () a m a -> Proxy X () () a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)) (a -> IResult a b
k a
a) Proxy X () () a m a
p1
{-# INLINABLE parse #-}


-- | Convert a producer of 'ParserInput' to a producer of parsed values.
--
-- This producer returns 'Right' when end-of-input is reached sucessfully,
-- otherwise it returns a 'ParsingError' and the leftovers including
-- the malformed input that couldn't be parsed. You can use 'Pipes.Lift.errorP'
-- to promote the 'Either' return value to an 'Control.Monad.Trans.Error.ErrorT'
-- monad transformer.
parsed
  :: (Monad m, ParserInput a)
  => Attoparsec.Parser a b  -- ^ Attoparsec parser
  -> Producer a m r         -- ^ Raw input
  -> Producer b m (Either (ParsingError, Producer a m r) r)
parsed :: Parser a b
-> Producer a m r
-> Producer b m (Either (ParsingError, Producer a m r) r)
parsed parser :: Parser a b
parser = Producer a m r
-> Producer b m (Either (ParsingError, Producer a m r) r)
forall (m :: * -> *) a x' x.
Monad m =>
Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
go
  where
    go :: Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
go p0 :: Producer a m a
p0 = do
      Either a (a, Producer a m a)
x <- m (Either a (a, Producer a m a))
-> Proxy x' x () b m (Either a (a, Producer a m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Producer a m a -> m (Either a (a, Producer a m a))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m a
p0)
      case Either a (a, Producer a m a)
x of
        Left r :: a
r       -> Either (ParsingError, Producer a m a) a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either (ParsingError, Producer a m a) a
forall a b. b -> Either a b
Right a
r)
        Right (a :: a
a,p1 :: Producer a m a
p1) -> (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
step (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m a -> Producer a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser a b -> a -> IResult a b
forall a b. ParserInput a => Parser a b -> a -> IResult a b
_parse Parser a b
parser a
a) Producer a m a
p1
    step :: (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
step diffP :: Producer a m a -> Producer a m a
diffP res :: IResult a b
res p0 :: Producer a m a
p0 = case IResult a b
res of
      Fail _ c :: [String]
c m :: String
m -> Either (ParsingError, Producer a m a) a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ParsingError, Producer a m a)
-> Either (ParsingError, Producer a m a) a
forall a b. a -> Either a b
Left ([String] -> String -> ParsingError
ParsingError [String]
c String
m, Producer a m a -> Producer a m a
diffP Producer a m a
p0))
      Done a :: a
a b :: b
b   -> b -> Producer' b m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield b
b Proxy x' x () b m ()
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
go (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m a -> Producer a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m a
p0)
      Partial k :: a -> IResult a b
k  -> do
        Either a (a, Producer a m a)
x <- m (Either a (a, Producer a m a))
-> Proxy x' x () b m (Either a (a, Producer a m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Producer a m a -> m (Either a (a, Producer a m a))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m a
p0)
        case Either a (a, Producer a m a)
x of
          Left e :: a
e -> (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
step Producer a m a -> Producer a m a
diffP (a -> IResult a b
k a
forall a. Monoid a => a
mempty) (a -> Producer a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e)
          Right (a :: a
a,p1 :: Producer a m a
p1) -> (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Proxy x' x () b m (Either (ParsingError, Producer a m a) a)
step (Producer a m a -> Producer a m a
diffP (Producer a m a -> Producer a m a)
-> (Producer a m a -> Producer a m a)
-> Producer a m a
-> Producer a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m a -> Producer a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)) (a -> IResult a b
k a
a) Producer a m a
p1
{-# INLINABLE parsed #-}

--------------------------------------------------------------------------------
-- $lengths
-- Like the functions above, but these also provide information about
-- the length of input consumed in order to fully parse each value.
--------------------------------------------------------------------------------

-- | Like 'parse', but also returns the length of input consumed to parse the
-- value.
parseL
    :: (Monad m, ParserInput a)
    => Attoparsec.Parser a b                           -- ^ Attoparsec parser
    -> Pipes.Parser a m (Maybe (Either ParsingError (Int, b))) -- ^ Pipes parser
parseL :: Parser a b -> Parser a m (Maybe (Either ParsingError (Int, b)))
parseL parser :: Parser a b
parser = (Producer a m x
 -> m (Maybe (Either ParsingError (Int, b)), Producer a m x))
-> StateT (Producer a m x) m (Maybe (Either ParsingError (Int, b)))
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((Producer a m x
  -> m (Maybe (Either ParsingError (Int, b)), Producer a m x))
 -> StateT
      (Producer a m x) m (Maybe (Either ParsingError (Int, b))))
-> (Producer a m x
    -> m (Maybe (Either ParsingError (Int, b)), Producer a m x))
-> StateT (Producer a m x) m (Maybe (Either ParsingError (Int, b)))
forall a b. (a -> b) -> a -> b
$ \p0 :: Producer a m x
p0 -> do
    Either x (a, Producer a m x)
x <- Producer a m x -> m (Either x (a, Producer a m x))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m x
p0
    case Either x (a, Producer a m x)
x of
      Left r :: x
r       -> (Maybe (Either ParsingError (Int, b)), Producer a m x)
-> m (Maybe (Either ParsingError (Int, b)), Producer a m x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either ParsingError (Int, b))
forall a. Maybe a
Nothing, x -> Producer a m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
r)
      Right (a :: a
a,p1 :: Producer a m x
p1) -> (Producer a m x -> Producer a m x)
-> IResult a b
-> Producer a m x
-> Int
-> m (Maybe (Either ParsingError (Int, b)), Producer a m x)
forall (m :: * -> *) a a b.
(Monad m, ParserInput a) =>
(Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> Int
-> m (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
step (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m x -> Producer a m x
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser a b -> a -> IResult a b
forall a b. ParserInput a => Parser a b -> a -> IResult a b
_parse Parser a b
parser a
a) Producer a m x
p1 (a -> Int
forall a. ParserInput a => a -> Int
_length a
a)
  where
    step :: (Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> Int
-> m (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
step diffP :: Proxy X () () a m a -> Proxy X () () a m a
diffP res :: IResult a b
res p0 :: Proxy X () () a m a
p0 !Int
len = case IResult a b
res of
      Fail _ c :: [String]
c m :: String
m -> (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
-> m (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParsingError (Int, b)
-> Maybe (Either ParsingError (Int, b))
forall a. a -> Maybe a
Just (ParsingError -> Either ParsingError (Int, b)
forall a b. a -> Either a b
Left ([String] -> String -> ParsingError
ParsingError [String]
c String
m)), Proxy X () () a m a -> Proxy X () () a m a
diffP Proxy X () () a m a
p0)
      Done a :: a
a b :: b
b   -> (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
-> m (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParsingError (Int, b)
-> Maybe (Either ParsingError (Int, b))
forall a. a -> Maybe a
Just ((Int, b) -> Either ParsingError (Int, b)
forall a b. b -> Either a b
Right (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. ParserInput a => a -> Int
_length a
a, b
b)), a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Proxy X () () a m a -> Proxy X () () a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy X () () a m a
p0)
      Partial k :: a -> IResult a b
k  -> do
        Either a (a, Proxy X () () a m a)
x <- Proxy X () () a m a -> m (Either a (a, Proxy X () () a m a))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Proxy X () () a m a
p0
        case Either a (a, Proxy X () () a m a)
x of
          Left e :: a
e -> (Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> Int
-> m (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
step Proxy X () () a m a -> Proxy X () () a m a
diffP (a -> IResult a b
k a
forall a. Monoid a => a
mempty) (a -> Proxy X () () a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e) Int
len
          Right (a :: a
a,p1 :: Proxy X () () a m a
p1) -> (Proxy X () () a m a -> Proxy X () () a m a)
-> IResult a b
-> Proxy X () () a m a
-> Int
-> m (Maybe (Either ParsingError (Int, b)), Proxy X () () a m a)
step (Proxy X () () a m a -> Proxy X () () a m a
diffP (Proxy X () () a m a -> Proxy X () () a m a)
-> (Proxy X () () a m a -> Proxy X () () a m a)
-> Proxy X () () a m a
-> Proxy X () () a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Proxy X () () a m a -> Proxy X () () a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)) (a -> IResult a b
k a
a) Proxy X () () a m a
p1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. ParserInput a => a -> Int
_length a
a)
{-# INLINABLE parseL #-}


-- | Like 'parsed', except this tags each parsed value with the length of input
-- consumed to parse the value.
parsedL
    :: (Monad m, ParserInput a)
    => Attoparsec.Parser a b    -- ^ Attoparsec parser
    -> Producer a m r           -- ^ Raw input
    -> Producer (Int, b) m (Either (ParsingError, Producer a m r) r)
parsedL :: Parser a b
-> Producer a m r
-> Producer (Int, b) m (Either (ParsingError, Producer a m r) r)
parsedL parser :: Parser a b
parser = Producer a m r
-> Producer (Int, b) m (Either (ParsingError, Producer a m r) r)
forall (m :: * -> *) a x' x.
Monad m =>
Producer a m a
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
go
  where
    go :: Producer a m a
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
go p0 :: Producer a m a
p0 = do
      Either a (a, Producer a m a)
x <- m (Either a (a, Producer a m a))
-> Proxy x' x () (Int, b) m (Either a (a, Producer a m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Producer a m a -> m (Either a (a, Producer a m a))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m a
p0)
      case Either a (a, Producer a m a)
x of
        Left r :: a
r       -> Either (ParsingError, Producer a m a) a
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either (ParsingError, Producer a m a) a
forall a b. b -> Either a b
Right a
r)
        Right (a :: a
a,p1 :: Producer a m a
p1) -> (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Int
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
step (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m a -> Producer a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Parser a b -> a -> IResult a b
forall a b. ParserInput a => Parser a b -> a -> IResult a b
_parse Parser a b
parser a
a) Producer a m a
p1 (a -> Int
forall a. ParserInput a => a -> Int
_length a
a)
    step :: (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Int
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
step diffP :: Producer a m a -> Producer a m a
diffP res :: IResult a b
res p0 :: Producer a m a
p0 !Int
len = case IResult a b
res of
      Fail _ c :: [String]
c m :: String
m -> Either (ParsingError, Producer a m a) a
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ParsingError, Producer a m a)
-> Either (ParsingError, Producer a m a) a
forall a b. a -> Either a b
Left ([String] -> String -> ParsingError
ParsingError [String]
c String
m, Producer a m a -> Producer a m a
diffP Producer a m a
p0))
      Done a :: a
a b :: b
b   -> (Int, b) -> Producer' (Int, b) m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. ParserInput a => a -> Int
_length a
a, b
b) Proxy x' x () (Int, b) m ()
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m a
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
go (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m a -> Producer a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m a
p0)
      Partial k :: a -> IResult a b
k  -> do
        Either a (a, Producer a m a)
x <- m (Either a (a, Producer a m a))
-> Proxy x' x () (Int, b) m (Either a (a, Producer a m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Producer a m a -> m (Either a (a, Producer a m a))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m a
p0)
        case Either a (a, Producer a m a)
x of
          Left e :: a
e -> (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Int
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
step Producer a m a -> Producer a m a
diffP (a -> IResult a b
k a
forall a. Monoid a => a
mempty) (a -> Producer a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e) Int
len
          Right (a :: a
a,p1 :: Producer a m a
p1) -> (Producer a m a -> Producer a m a)
-> IResult a b
-> Producer a m a
-> Int
-> Proxy
     x' x () (Int, b) m (Either (ParsingError, Producer a m a) a)
step (Producer a m a -> Producer a m a
diffP (Producer a m a -> Producer a m a)
-> (Producer a m a -> Producer a m a)
-> Producer a m a
-> Producer a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m a -> Producer a m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)) (a -> IResult a b
k a
a) Producer a m a
p1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. ParserInput a => a -> Int
_length a
a)
{-# INLINABLE parsedL #-}

--------------------------------------------------------------------------------

-- | Like 'Pipes.Parse.isEndOfInput', except that it also consumes and discards
-- leading empty chunks.
isEndOfParserInput :: (Monad m, ParserInput a) => Pipes.Parser a m Bool
isEndOfParserInput :: Parser a m Bool
isEndOfParserInput = (Producer a m x -> m (Bool, Producer a m x))
-> StateT (Producer a m x) m Bool
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((Producer a m x -> m (Bool, Producer a m x))
 -> StateT (Producer a m x) m Bool)
-> (Producer a m x -> m (Bool, Producer a m x))
-> StateT (Producer a m x) m Bool
forall a b. (a -> b) -> a -> b
$ \p0 :: Producer a m x
p0 -> do
    Either x (a, Producer a m x)
x <- Producer a m x -> m (Either x (a, Producer a m x))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty Producer a m x
p0
    case Either x (a, Producer a m x)
x of
       Left r :: x
r        -> (Bool, Producer a m x) -> m (Bool, Producer a m x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True,  x -> Producer a m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
r)
       Right (a :: a
a, p1 :: Producer a m x
p1) -> (Bool, Producer a m x) -> m (Bool, Producer a m x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy X () () a m () -> Producer a m x -> Producer a m x
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer a m x
p1)
{-# INLINABLE isEndOfParserInput #-}

--------------------------------------------------------------------------------

-- | A class for valid @attoparsec@ input types
class (Eq a, Monoid a) => ParserInput a where
    _parse  :: Attoparsec.Parser a b -> a -> IResult a b
    _length :: a -> Int

-- | Strict 'ByteString'.
instance ParserInput ByteString where
    _parse :: Parser ByteString b -> ByteString -> IResult ByteString b
_parse  = Parser ByteString b -> ByteString -> IResult ByteString b
forall b. Parser ByteString b -> ByteString -> IResult ByteString b
Data.Attoparsec.ByteString.parse
    {-# INLINE _parse #-}
    _length :: ByteString -> Int
_length = ByteString -> Int
Data.ByteString.length
    {-# INLINE _length #-}

-- | Strict 'Text'.
instance ParserInput Text where
    _parse :: Parser Text b -> Text -> IResult Text b
_parse  = Parser Text b -> Text -> IResult Text b
forall b. Parser Text b -> Text -> IResult Text b
Data.Attoparsec.Text.parse
    {-# INLINE _parse #-}
    _length :: Text -> Int
_length = Text -> Int
Data.Text.length
    {-# INLINE _length #-}

--------------------------------------------------------------------------------

-- | A parsing error report, as provided by Attoparsec's 'Fail'.
data ParsingError = ParsingError
    { ParsingError -> [String]
peContexts :: [String]  -- ^ Contexts where the parsing error occurred.
    , ParsingError -> String
peMessage  ::  String   -- ^ Parsing error description message.
    } deriving (Int -> ParsingError -> ShowS
[ParsingError] -> ShowS
ParsingError -> String
(Int -> ParsingError -> ShowS)
-> (ParsingError -> String)
-> ([ParsingError] -> ShowS)
-> Show ParsingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsingError] -> ShowS
$cshowList :: [ParsingError] -> ShowS
show :: ParsingError -> String
$cshow :: ParsingError -> String
showsPrec :: Int -> ParsingError -> ShowS
$cshowsPrec :: Int -> ParsingError -> ShowS
Show, ReadPrec [ParsingError]
ReadPrec ParsingError
Int -> ReadS ParsingError
ReadS [ParsingError]
(Int -> ReadS ParsingError)
-> ReadS [ParsingError]
-> ReadPrec ParsingError
-> ReadPrec [ParsingError]
-> Read ParsingError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParsingError]
$creadListPrec :: ReadPrec [ParsingError]
readPrec :: ReadPrec ParsingError
$creadPrec :: ReadPrec ParsingError
readList :: ReadS [ParsingError]
$creadList :: ReadS [ParsingError]
readsPrec :: Int -> ReadS ParsingError
$creadsPrec :: Int -> ReadS ParsingError
Read, ParsingError -> ParsingError -> Bool
(ParsingError -> ParsingError -> Bool)
-> (ParsingError -> ParsingError -> Bool) -> Eq ParsingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsingError -> ParsingError -> Bool
$c/= :: ParsingError -> ParsingError -> Bool
== :: ParsingError -> ParsingError -> Bool
$c== :: ParsingError -> ParsingError -> Bool
Eq, Typeable ParsingError
Constr
DataType
Typeable ParsingError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ParsingError -> c ParsingError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParsingError)
-> (ParsingError -> Constr)
-> (ParsingError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParsingError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParsingError))
-> ((forall b. Data b => b -> b) -> ParsingError -> ParsingError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParsingError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParsingError -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParsingError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParsingError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ParsingError -> m ParsingError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsingError -> m ParsingError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParsingError -> m ParsingError)
-> Data ParsingError
ParsingError -> Constr
ParsingError -> DataType
(forall b. Data b => b -> b) -> ParsingError -> ParsingError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsingError -> c ParsingError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsingError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ParsingError -> u
forall u. (forall d. Data d => d -> u) -> ParsingError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsingError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsingError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsingError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsingError -> c ParsingError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsingError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParsingError)
$cParsingError :: Constr
$tParsingError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
gmapMp :: (forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
gmapM :: (forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParsingError -> m ParsingError
gmapQi :: Int -> (forall d. Data d => d -> u) -> ParsingError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParsingError -> u
gmapQ :: (forall d. Data d => d -> u) -> ParsingError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParsingError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsingError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParsingError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsingError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParsingError -> r
gmapT :: (forall b. Data b => b -> b) -> ParsingError -> ParsingError
$cgmapT :: (forall b. Data b => b -> b) -> ParsingError -> ParsingError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParsingError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParsingError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ParsingError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParsingError)
dataTypeOf :: ParsingError -> DataType
$cdataTypeOf :: ParsingError -> DataType
toConstr :: ParsingError -> Constr
$ctoConstr :: ParsingError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsingError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParsingError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsingError -> c ParsingError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParsingError -> c ParsingError
$cp1Data :: Typeable ParsingError
Data, Typeable)

instance Exception ParsingError
instance Error     ParsingError

-- | This instance allows using 'Pipes.Lift.errorP' with 'parsed' and 'parsedL'
instance Error (ParsingError, Producer a m r)

--------------------------------------------------------------------------------
-- Internal stuff

-- | Like 'Pipes.next', except it skips leading 'mempty' chunks.
nextSkipEmpty
  :: (Monad m, Eq a, Monoid a)
  => Producer a m r
  -> m (Either r (a, Producer a m r))
nextSkipEmpty :: Producer a m r -> m (Either r (a, Producer a m r))
nextSkipEmpty = Producer a m r -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a r.
(Monad m, Eq a, Monoid a) =>
Producer a m r -> m (Either r (a, Producer a m r))
go where
    go :: Producer a m r -> m (Either r (a, Producer a m r))
go p0 :: Producer a m r
p0 = do
      Either r (a, Producer a m r)
x <- Producer a m r -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r
p0
      case Either r (a, Producer a m r)
x of
         Left  _        -> Either r (a, Producer a m r) -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a. Monad m => a -> m a
return Either r (a, Producer a m r)
x
         Right (a :: a
a,p1 :: Producer a m r
p1)
          | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty -> Producer a m r -> m (Either r (a, Producer a m r))
go Producer a m r
p1
          | Bool
otherwise   -> Either r (a, Producer a m r) -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a. Monad m => a -> m a
return Either r (a, Producer a m r)
x
{-# INLINABLE nextSkipEmpty #-}