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

-- |
-- Copyright: 2011 Michael Snoyman, 2010 John Millikin
-- License: MIT
--
-- Consume attoparsec parsers via conduit.
--
-- This code was taken from attoparsec-enumerator and adapted for conduits.
module Data.Conduit.Attoparsec
    ( -- * Sink
      sinkParser
    , sinkParserEither
      -- * Conduit
    , conduitParser
    , conduitParserEither

      -- * Types
    , ParseError (..)
    , Position (..)
    , PositionRange (..)
      -- * Classes
    , AttoparsecInput
    ) where

import           Control.Exception          (Exception)
import           Control.Monad              (unless)
import qualified Data.ByteString            as B
import qualified Data.Text                  as T
import qualified Data.Text.Internal         as TI
import           Data.Typeable              (Typeable)
import           Prelude                    hiding (lines)

import qualified Data.Attoparsec.ByteString
import qualified Data.Attoparsec.Text
import qualified Data.Attoparsec.Types      as A
import           Data.Conduit
import Control.Monad.Trans.Resource (MonadThrow, throwM)

-- | The context and message from a 'A.Fail' value.
data ParseError = ParseError
    { ParseError -> [String]
errorContexts :: [String]
    , ParseError -> String
errorMessage  :: String
    , ParseError -> Position
errorPosition :: Position
    } | DivergentParser
    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
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, Typeable)

instance Exception ParseError

data Position = Position
    { Position -> Int
posLine :: {-# UNPACK #-} !Int
    , Position -> Int
posCol  :: {-# UNPACK #-} !Int
    , Position -> Int
posOffset :: {-# UNPACK #-} !Int
    -- ^ @since 1.2.0
    }
    deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position
-> (Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord)

instance Show Position where
    show :: Position -> String
show (Position Int
l Int
c Int
off) = Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
off String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

data PositionRange = PositionRange
    { PositionRange -> Position
posRangeStart :: {-# UNPACK #-} !Position
    , PositionRange -> Position
posRangeEnd   :: {-# UNPACK #-} !Position
    }
    deriving (PositionRange -> PositionRange -> Bool
(PositionRange -> PositionRange -> Bool)
-> (PositionRange -> PositionRange -> Bool) -> Eq PositionRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionRange -> PositionRange -> Bool
$c/= :: PositionRange -> PositionRange -> Bool
== :: PositionRange -> PositionRange -> Bool
$c== :: PositionRange -> PositionRange -> Bool
Eq, Eq PositionRange
Eq PositionRange
-> (PositionRange -> PositionRange -> Ordering)
-> (PositionRange -> PositionRange -> Bool)
-> (PositionRange -> PositionRange -> Bool)
-> (PositionRange -> PositionRange -> Bool)
-> (PositionRange -> PositionRange -> Bool)
-> (PositionRange -> PositionRange -> PositionRange)
-> (PositionRange -> PositionRange -> PositionRange)
-> Ord PositionRange
PositionRange -> PositionRange -> Bool
PositionRange -> PositionRange -> Ordering
PositionRange -> PositionRange -> PositionRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PositionRange -> PositionRange -> PositionRange
$cmin :: PositionRange -> PositionRange -> PositionRange
max :: PositionRange -> PositionRange -> PositionRange
$cmax :: PositionRange -> PositionRange -> PositionRange
>= :: PositionRange -> PositionRange -> Bool
$c>= :: PositionRange -> PositionRange -> Bool
> :: PositionRange -> PositionRange -> Bool
$c> :: PositionRange -> PositionRange -> Bool
<= :: PositionRange -> PositionRange -> Bool
$c<= :: PositionRange -> PositionRange -> Bool
< :: PositionRange -> PositionRange -> Bool
$c< :: PositionRange -> PositionRange -> Bool
compare :: PositionRange -> PositionRange -> Ordering
$ccompare :: PositionRange -> PositionRange -> Ordering
$cp1Ord :: Eq PositionRange
Ord)

instance Show PositionRange where
    show :: PositionRange -> String
show (PositionRange Position
s Position
e) = Position -> String
forall a. Show a => a -> String
show Position
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Position -> String
forall a. Show a => a -> String
show Position
e

-- | A class of types which may be consumed by an Attoparsec parser.
class AttoparsecInput a where
    parseA :: A.Parser a b -> a -> A.IResult a b
    feedA :: A.IResult a b -> a -> A.IResult a b
    empty :: a
    isNull :: a -> Bool
    getLinesCols :: a -> Position

    -- | Return the beginning of the first input with the length of
    -- the second input removed. Assumes the second string is shorter
    -- than the first.
    stripFromEnd :: a -> a -> a

instance AttoparsecInput B.ByteString where
    parseA :: Parser ByteString b -> ByteString -> IResult ByteString b
parseA = Parser ByteString b -> ByteString -> IResult ByteString b
forall b. Parser ByteString b -> ByteString -> IResult ByteString b
Data.Attoparsec.ByteString.parse
    feedA :: IResult ByteString b -> ByteString -> IResult ByteString b
feedA = IResult ByteString b -> ByteString -> IResult ByteString b
forall i r. Monoid i => IResult i r -> i -> IResult i r
Data.Attoparsec.ByteString.feed
    empty :: ByteString
empty = ByteString
B.empty
    isNull :: ByteString -> Bool
isNull = ByteString -> Bool
B.null
    getLinesCols :: ByteString -> Position
getLinesCols = (Position -> Word8 -> Position)
-> Position -> ByteString -> Position
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Position -> Word8 -> Position
forall a. (Eq a, Num a) => Position -> a -> Position
f (Int -> Int -> Int -> Position
Position Int
0 Int
0 Int
0)
      where
        f :: Position -> a -> Position
f (Position Int
l Int
c Int
o) a
ch
          | a
ch a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
10 = Int -> Int -> Int -> Position
Position (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = Int -> Int -> Int -> Position
Position Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    stripFromEnd :: ByteString -> ByteString -> ByteString
stripFromEnd ByteString
b1 ByteString
b2 = Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
b2) ByteString
b1

instance AttoparsecInput T.Text where
    parseA :: Parser Text b -> Text -> IResult Text b
parseA = Parser Text b -> Text -> IResult Text b
forall b. Parser Text b -> Text -> IResult Text b
Data.Attoparsec.Text.parse
    feedA :: IResult Text b -> Text -> IResult Text b
feedA = IResult Text b -> Text -> IResult Text b
forall i r. Monoid i => IResult i r -> i -> IResult i r
Data.Attoparsec.Text.feed
    empty :: Text
empty = Text
T.empty
    isNull :: Text -> Bool
isNull = Text -> Bool
T.null
    getLinesCols :: Text -> Position
getLinesCols = (Position -> Char -> Position) -> Position -> Text -> Position
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Position -> Char -> Position
f (Int -> Int -> Int -> Position
Position Int
0 Int
0 Int
0)
      where
        f :: Position -> Char -> Position
f (Position Int
l Int
c Int
o) Char
ch
          | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = Int -> Int -> Int -> Position
Position (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          | Bool
otherwise = Int -> Int -> Int -> Position
Position Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    stripFromEnd :: Text -> Text -> Text
stripFromEnd (TI.Text Array
arr1 Int
off1 Int
len1) (TI.Text Array
_ Int
_ Int
len2) =
        Array -> Int -> Int -> Text
TI.text Array
arr1 Int
off1 (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len2)

-- | Convert an Attoparsec 'A.Parser' into a 'Sink'. The parser will
-- be streamed bytes until it returns 'A.Done' or 'A.Fail'.
--
-- If parsing fails, a 'ParseError' will be thrown with 'throwM'.
--
-- Since 0.5.0
sinkParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> ConduitT a o m b
sinkParser :: Parser a b -> ConduitT a o m b
sinkParser = ((Position, b) -> b)
-> ConduitT a o m (Position, b) -> ConduitT a o m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position, b) -> b
forall a b. (a, b) -> b
snd (ConduitT a o m (Position, b) -> ConduitT a o m b)
-> (Parser a b -> ConduitT a o m (Position, b))
-> Parser a b
-> ConduitT a o m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Parser a b -> ConduitT a o m (Position, b)
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Position -> Parser a b -> ConduitT a o m (Position, b)
sinkParserPosErr (Int -> Int -> Int -> Position
Position Int
1 Int
1 Int
0)

-- | Same as 'sinkParser', but we return an 'Either' type instead
-- of raising an exception.
--
-- Since 1.1.5
sinkParserEither :: (AttoparsecInput a, Monad m) => A.Parser a b -> ConduitT a o m (Either ParseError b)
sinkParserEither :: Parser a b -> ConduitT a o m (Either ParseError b)
sinkParserEither = ((Either ParseError (Position, b) -> Either ParseError b)
-> ConduitT a o m (Either ParseError (Position, b))
-> ConduitT a o m (Either ParseError b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Either ParseError (Position, b) -> Either ParseError b)
 -> ConduitT a o m (Either ParseError (Position, b))
 -> ConduitT a o m (Either ParseError b))
-> (((Position, b) -> b)
    -> Either ParseError (Position, b) -> Either ParseError b)
-> ((Position, b) -> b)
-> ConduitT a o m (Either ParseError (Position, b))
-> ConduitT a o m (Either ParseError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Position, b) -> b)
-> Either ParseError (Position, b) -> Either ParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Position, b) -> b
forall a b. (a, b) -> b
snd (ConduitT a o m (Either ParseError (Position, b))
 -> ConduitT a o m (Either ParseError b))
-> (Parser a b -> ConduitT a o m (Either ParseError (Position, b)))
-> Parser a b
-> ConduitT a o m (Either ParseError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position
-> Parser a b -> ConduitT a o m (Either ParseError (Position, b))
forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Position
-> Parser a b -> ConduitT a o m (Either ParseError (Position, b))
sinkParserPos (Int -> Int -> Int -> Position
Position Int
1 Int
1 Int
0)


-- | Consume a stream of parsed tokens, returning both the token and
-- the position it appears at. This function will raise a 'ParseError'
-- on bad input.
--
-- Since 0.5.0
conduitParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> ConduitT a (PositionRange, b) m ()
conduitParser :: Parser a b -> ConduitT a (PositionRange, b) m ()
conduitParser Parser a b
parser =
    Position -> ConduitT a (PositionRange, b) m ()
forall (m :: * -> *).
MonadThrow m =>
Position -> ConduitT a (PositionRange, b) m ()
conduit (Position -> ConduitT a (PositionRange, b) m ())
-> Position -> ConduitT a (PositionRange, b) m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Position
Position Int
1 Int
1 Int
0
       where
         conduit :: Position -> ConduitT a (PositionRange, b) m ()
conduit !Position
pos = ConduitT a (PositionRange, b) m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT a (PositionRange, b) m (Maybe a)
-> (Maybe a -> ConduitT a (PositionRange, b) m ())
-> ConduitT a (PositionRange, b) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT a (PositionRange, b) m ()
-> (a -> ConduitT a (PositionRange, b) m ())
-> Maybe a
-> ConduitT a (PositionRange, b) m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT a (PositionRange, b) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> ConduitT a (PositionRange, b) m ()
go
             where
               go :: a -> ConduitT a (PositionRange, b) m ()
go a
x = do
                   a -> ConduitT a (PositionRange, b) m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover a
x
                   (!Position
pos', !b
res) <- Position
-> Parser a b -> ConduitT a (PositionRange, b) m (Position, b)
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Position -> Parser a b -> ConduitT a o m (Position, b)
sinkParserPosErr Position
pos Parser a b
parser
                   (PositionRange, b) -> ConduitT a (PositionRange, b) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Position -> Position -> PositionRange
PositionRange Position
pos Position
pos', b
res)
                   Position -> ConduitT a (PositionRange, b) m ()
conduit Position
pos'
{-# SPECIALIZE conduitParser
                   :: MonadThrow m
                   => A.Parser T.Text b
                   -> ConduitT T.Text (PositionRange, b) m () #-}
{-# SPECIALIZE conduitParser
                   :: MonadThrow m
                   => A.Parser B.ByteString b
                   -> ConduitT B.ByteString (PositionRange, b) m () #-}



-- | Same as 'conduitParser', but we return an 'Either' type instead
-- of raising an exception.
conduitParserEither
    :: (Monad m, AttoparsecInput a)
    => A.Parser a b
    -> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither :: Parser a b
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither Parser a b
parser =
    Position -> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall (m :: * -> *).
Monad m =>
Position -> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduit (Position
 -> ConduitT a (Either ParseError (PositionRange, b)) m ())
-> Position
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Position
Position Int
1 Int
1 Int
0
  where
    conduit :: Position -> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduit !Position
pos = ConduitT a (Either ParseError (PositionRange, b)) m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT a (Either ParseError (PositionRange, b)) m (Maybe a)
-> (Maybe a
    -> ConduitT a (Either ParseError (PositionRange, b)) m ())
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT a (Either ParseError (PositionRange, b)) m ()
-> (a -> ConduitT a (Either ParseError (PositionRange, b)) m ())
-> Maybe a
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> ConduitT a (Either ParseError (PositionRange, b)) m ()
go
      where
        go :: a -> ConduitT a (Either ParseError (PositionRange, b)) m ()
go a
x = do
          a -> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover a
x
          Either ParseError (Position, b)
eres <- Position
-> Parser a b
-> ConduitT
     a
     (Either ParseError (PositionRange, b))
     m
     (Either ParseError (Position, b))
forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Position
-> Parser a b -> ConduitT a o m (Either ParseError (Position, b))
sinkParserPos Position
pos Parser a b
parser
          case Either ParseError (Position, b)
eres of
            Left ParseError
e -> Either ParseError (PositionRange, b)
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either ParseError (PositionRange, b)
 -> ConduitT a (Either ParseError (PositionRange, b)) m ())
-> Either ParseError (PositionRange, b)
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (PositionRange, b)
forall a b. a -> Either a b
Left ParseError
e
            Right (!Position
pos', !b
res) -> do
              Either ParseError (PositionRange, b)
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either ParseError (PositionRange, b)
 -> ConduitT a (Either ParseError (PositionRange, b)) m ())
-> Either ParseError (PositionRange, b)
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
forall a b. (a -> b) -> a -> b
$! (PositionRange, b) -> Either ParseError (PositionRange, b)
forall a b. b -> Either a b
Right (Position -> Position -> PositionRange
PositionRange Position
pos Position
pos', b
res)
              Position -> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduit Position
pos'
{-# SPECIALIZE conduitParserEither
                   :: Monad m
                   => A.Parser T.Text b
                   -> ConduitT T.Text (Either ParseError (PositionRange, b)) m () #-}
{-# SPECIALIZE conduitParserEither
                   :: Monad m
                   => A.Parser B.ByteString b
                   -> ConduitT B.ByteString (Either ParseError (PositionRange, b)) m () #-}




sinkParserPosErr
    :: (AttoparsecInput a, MonadThrow m)
    => Position
    -> A.Parser a b
    -> ConduitT a o m (Position, b)
sinkParserPosErr :: Position -> Parser a b -> ConduitT a o m (Position, b)
sinkParserPosErr Position
pos0 Parser a b
p = Position
-> Parser a b -> ConduitT a o m (Either ParseError (Position, b))
forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Position
-> Parser a b -> ConduitT a o m (Either ParseError (Position, b))
sinkParserPos Position
pos0 Parser a b
p ConduitT a o m (Either ParseError (Position, b))
-> (Either ParseError (Position, b)
    -> ConduitT a o m (Position, b))
-> ConduitT a o m (Position, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ParseError (Position, b) -> ConduitT a o m (Position, b)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
Either e a -> m a
f
    where
      f :: Either e a -> m a
f (Left e
e) = e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e
      f (Right a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE sinkParserPosErr #-}


sinkParserPos
    :: (AttoparsecInput a, Monad m)
    => Position
    -> A.Parser a b
    -> ConduitT a o m (Either ParseError (Position, b))
sinkParserPos :: Position
-> Parser a b -> ConduitT a o m (Either ParseError (Position, b))
sinkParserPos Position
pos0 Parser a b
p = a
-> Position
-> (a -> IResult a b)
-> ConduitT a o m (Either ParseError (Position, b))
forall (m :: * -> *) t b o.
(Monad m, AttoparsecInput t) =>
t
-> Position
-> (t -> IResult t b)
-> ConduitT t o m (Either ParseError (Position, b))
sink a
forall a. AttoparsecInput a => a
empty Position
pos0 (Parser a b -> a -> IResult a b
forall a b. AttoparsecInput a => Parser a b -> a -> IResult a b
parseA Parser a b
p)
  where
    sink :: t
-> Position
-> (t -> IResult t b)
-> ConduitT t o m (Either ParseError (Position, b))
sink t
prev Position
pos t -> IResult t b
parser = ConduitT t o m (Maybe t)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT t o m (Maybe t)
-> (Maybe t -> ConduitT t o m (Either ParseError (Position, b)))
-> ConduitT t o m (Either ParseError (Position, b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT t o m (Either ParseError (Position, b))
-> (t -> ConduitT t o m (Either ParseError (Position, b)))
-> Maybe t
-> ConduitT t o m (Either ParseError (Position, b))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT t o m (Either ParseError (Position, b))
close t -> ConduitT t o m (Either ParseError (Position, b))
push
      where
        push :: t -> ConduitT t o m (Either ParseError (Position, b))
push t
c
            | t -> Bool
forall a. AttoparsecInput a => a -> Bool
isNull t
c  = t
-> Position
-> (t -> IResult t b)
-> ConduitT t o m (Either ParseError (Position, b))
sink t
prev Position
pos t -> IResult t b
parser
            | Bool
otherwise = Bool
-> t
-> IResult t b
-> ConduitT t o m (Either ParseError (Position, b))
go Bool
False t
c (IResult t b -> ConduitT t o m (Either ParseError (Position, b)))
-> IResult t b -> ConduitT t o m (Either ParseError (Position, b))
forall a b. (a -> b) -> a -> b
$ t -> IResult t b
parser t
c

        close :: ConduitT t o m (Either ParseError (Position, b))
close = Bool
-> t
-> IResult t b
-> ConduitT t o m (Either ParseError (Position, b))
go Bool
True t
prev (IResult t b -> t -> IResult t b
forall a b. AttoparsecInput a => IResult a b -> a -> IResult a b
feedA (t -> IResult t b
parser t
forall a. AttoparsecInput a => a
empty) t
forall a. AttoparsecInput a => a
empty)

        go :: Bool
-> t
-> IResult t b
-> ConduitT t o m (Either ParseError (Position, b))
go Bool
end t
c (A.Done t
lo b
x) = do
            let pos' :: Position
pos'
                    | Bool
end       = Position
pos
                    | Bool
otherwise = t -> Position -> Position
forall a. AttoparsecInput a => a -> Position -> Position
addLinesCols t
prev Position
pos
                y :: t
y = t -> t -> t
forall a. AttoparsecInput a => a -> a -> a
stripFromEnd t
c t
lo
                pos'' :: Position
pos'' = t -> Position -> Position
forall a. AttoparsecInput a => a -> Position -> Position
addLinesCols t
y Position
pos'
            Bool -> ConduitT t o m () -> ConduitT t o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (t -> Bool
forall a. AttoparsecInput a => a -> Bool
isNull t
lo) (ConduitT t o m () -> ConduitT t o m ())
-> ConduitT t o m () -> ConduitT t o m ()
forall a b. (a -> b) -> a -> b
$ t -> ConduitT t o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover t
lo
            Position
pos'' Position
-> ConduitT t o m (Either ParseError (Position, b))
-> ConduitT t o m (Either ParseError (Position, b))
`seq` Either ParseError (Position, b)
-> ConduitT t o m (Either ParseError (Position, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Position, b)
 -> ConduitT t o m (Either ParseError (Position, b)))
-> Either ParseError (Position, b)
-> ConduitT t o m (Either ParseError (Position, b))
forall a b. (a -> b) -> a -> b
$! (Position, b) -> Either ParseError (Position, b)
forall a b. b -> Either a b
Right (Position
pos'', b
x)
        go Bool
end t
c (A.Fail t
rest [String]
contexts String
msg) =
            let x :: t
x = t -> t -> t
forall a. AttoparsecInput a => a -> a -> a
stripFromEnd t
c t
rest
                pos' :: Position
pos'
                    | Bool
end       = Position
pos
                    | Bool
otherwise = t -> Position -> Position
forall a. AttoparsecInput a => a -> Position -> Position
addLinesCols t
prev Position
pos
                pos'' :: Position
pos'' = t -> Position -> Position
forall a. AttoparsecInput a => a -> Position -> Position
addLinesCols t
x Position
pos'
             in Position
pos'' Position
-> ConduitT t o m (Either ParseError (Position, b))
-> ConduitT t o m (Either ParseError (Position, b))
`seq` Either ParseError (Position, b)
-> ConduitT t o m (Either ParseError (Position, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Position, b)
 -> ConduitT t o m (Either ParseError (Position, b)))
-> Either ParseError (Position, b)
-> ConduitT t o m (Either ParseError (Position, b))
forall a b. (a -> b) -> a -> b
$! ParseError -> Either ParseError (Position, b)
forall a b. a -> Either a b
Left ([String] -> String -> Position -> ParseError
ParseError [String]
contexts String
msg Position
pos'')
        go Bool
end t
c (A.Partial t -> IResult t b
parser')
            | Bool
end       = Either ParseError (Position, b)
-> ConduitT t o m (Either ParseError (Position, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Position, b)
 -> ConduitT t o m (Either ParseError (Position, b)))
-> Either ParseError (Position, b)
-> ConduitT t o m (Either ParseError (Position, b))
forall a b. (a -> b) -> a -> b
$! ParseError -> Either ParseError (Position, b)
forall a b. a -> Either a b
Left ParseError
DivergentParser
            | Bool
otherwise =
                Position
pos' Position
-> ConduitT t o m (Either ParseError (Position, b))
-> ConduitT t o m (Either ParseError (Position, b))
`seq` t
-> Position
-> (t -> IResult t b)
-> ConduitT t o m (Either ParseError (Position, b))
sink t
c Position
pos' t -> IResult t b
parser'
              where
                pos' :: Position
pos' = t -> Position -> Position
forall a. AttoparsecInput a => a -> Position -> Position
addLinesCols t
prev Position
pos

    addLinesCols :: AttoparsecInput a => a -> Position -> Position
    addLinesCols :: a -> Position -> Position
addLinesCols a
x (Position Int
lines Int
cols Int
off) =
        Int
lines' Int -> Position -> Position
`seq` Int
cols' Int -> Position -> Position
`seq` Int
off' Int -> Position -> Position
`seq` Int -> Int -> Int -> Position
Position Int
lines' Int
cols' Int
off'
      where
        Position Int
dlines Int
dcols Int
doff = a -> Position
forall a. AttoparsecInput a => a -> Position
getLinesCols a
x
        lines' :: Int
lines' = Int
lines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dlines
        cols' :: Int
cols' = (if Int
dlines Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
1 else Int
cols) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dcols
        off' :: Int
off' = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
doff
{-# INLINE sinkParserPos #-}