{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Data.Conduit.Attoparsec
(
sinkParser
, sinkParserEither
, conduitParser
, conduitParserEither
, ParseError (..)
, Position (..)
, PositionRange (..)
, 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)
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
}
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
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
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)
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)
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)
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 () #-}
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 #-}