diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +## 1.2.0 + +* Added the `posOffset` field to the + `Data.Conduit.Attoparsec.Position` data type + [#331](https://github.com/snoyberg/conduit/issues/331). + ## 1.1.17 * Speed up `sinkHandle` by not flushing after every output operation. diff --git a/Data/Conduit/Attoparsec.hs b/Data/Conduit/Attoparsec.hs --- a/Data/Conduit/Attoparsec.hs +++ b/Data/Conduit/Attoparsec.hs @@ -53,11 +53,13 @@ data Position = Position { posLine :: {-# UNPACK #-} !Int , posCol :: {-# UNPACK #-} !Int + , posOffset :: {-# UNPACK #-} !Int + -- ^ @since 1.2.0 } deriving (Eq, Ord) instance Show Position where - show (Position l c) = show l ++ ':' : show c + show (Position l c off) = show l ++ ':' : show c ++ " (" ++ show off ++ ")" data PositionRange = PositionRange { posRangeStart :: {-# UNPACK #-} !Position @@ -88,10 +90,11 @@ empty = B.empty isNull = B.null notEmpty = filter (not . B.null) - getLinesCols = B.foldl' f (Position 0 0) + getLinesCols = B.foldl' f (Position 0 0 0) where - f (Position l c) ch | ch == 10 = Position (l + 1) 0 - | otherwise = Position l (c + 1) + f (Position l c o) ch + | ch == 10 = Position (l + 1) 0 (o + 1) + | otherwise = Position l (c + 1) (o + 1) stripFromEnd b1 b2 = B.take (B.length b1 - B.length b2) b1 instance AttoparsecInput T.Text where @@ -100,10 +103,11 @@ empty = T.empty isNull = T.null notEmpty = filter (not . T.null) - getLinesCols = T.foldl' f (Position 0 0) + getLinesCols = T.foldl' f (Position 0 0 0) where - f (Position l c) ch | ch == '\n' = Position (l + 1) 0 - | otherwise = Position l (c + 1) + f (Position l c o) ch + | ch == '\n' = Position (l + 1) 0 (o + 1) + | otherwise = Position l (c + 1) (o + 1) stripFromEnd (TI.Text arr1 off1 len1) (TI.Text _ _ len2) = TI.text arr1 off1 (len1 - len2) @@ -114,14 +118,14 @@ -- -- Since 0.5.0 sinkParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> Consumer a m b -sinkParser = fmap snd . sinkParserPosErr (Position 1 1) +sinkParser = fmap snd . sinkParserPosErr (Position 1 1 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 -> Consumer a m (Either ParseError b) -sinkParserEither = (fmap.fmap) snd . sinkParserPos (Position 1 1) +sinkParserEither = (fmap.fmap) snd . sinkParserPos (Position 1 1 0) -- | Consume a stream of parsed tokens, returning both the token and @@ -131,7 +135,7 @@ -- Since 0.5.0 conduitParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> Conduit a m (PositionRange, b) conduitParser parser = - conduit $ Position 1 1 + conduit $ Position 1 1 0 where conduit !pos = await >>= maybe (return ()) go where @@ -158,7 +162,7 @@ => A.Parser a b -> Conduit a m (Either ParseError (PositionRange, b)) conduitParserEither parser = - conduit $ Position 1 1 + conduit $ Position 1 1 0 where conduit !pos = await >>= maybe (return ()) go where @@ -232,10 +236,11 @@ pos' = addLinesCols prev pos addLinesCols :: AttoparsecInput a => a -> Position -> Position - addLinesCols x (Position lines cols) = - lines' `seq` cols' `seq` Position lines' cols' + addLinesCols x (Position lines cols off) = + lines' `seq` cols' `seq` off' `seq` Position lines' cols' off' where - Position dlines dcols = getLinesCols x + Position dlines dcols doff = getLinesCols x lines' = lines + dlines cols' = (if dlines > 0 then 1 else cols) + dcols + off' = off + doff {-# INLINE sinkParserPos #-} diff --git a/conduit-extra.cabal b/conduit-extra.cabal --- a/conduit-extra.cabal +++ b/conduit-extra.cabal @@ -1,5 +1,5 @@ Name: conduit-extra -Version: 1.1.17 +Version: 1.2.0 Synopsis: Batteries included conduit: adapters for common libraries. Description: The conduit package itself maintains relative small dependencies. The purpose of this package is to collect commonly used utility functions wrapping other library dependencies, without depending on heavier-weight dependencies. The basic idea is that this package should only depend on haskell-platform packages and conduit. diff --git a/test/Data/Conduit/AttoparsecSpec.hs b/test/Data/Conduit/AttoparsecSpec.hs --- a/test/Data/Conduit/AttoparsecSpec.hs +++ b/test/Data/Conduit/AttoparsecSpec.hs @@ -22,6 +22,7 @@ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"] badLine = 4 badCol = 6 + badOff = 15 parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -30,15 +31,16 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff it "works for bytestring" $ do let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"] badLine = 4 badCol = 6 + badOff = 15 parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -47,15 +49,16 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff it "works in last chunk" $ do let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"] badLine = 6 badCol = 5 + badOff = 22 parser = Data.Attoparsec.Text.char 'c' <|> (Data.Attoparsec.Text.anyChar >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -64,15 +67,16 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff it "works in last chunk" $ do let input = ["aaa\na", "aaa\n\n", "aaa", "aa\n\naaaab"] badLine = 6 badCol = 6 + badOff = 22 parser = Data.Attoparsec.Text.string "bc" <|> (Data.Attoparsec.Text.anyChar >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -81,15 +85,16 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff it "works after new line in text" $ do let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"] badLine = 5 badCol = 1 + badOff = 15 parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -98,15 +103,16 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff it "works after new line in bytestring" $ do let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"] badLine = 5 badCol = 1 + badOff = 15 parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -115,15 +121,16 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff it "works for first line" $ do let input = ["aab\na", "aaa\n\n", "aaa", "aab\n\naaaa"] badLine = 1 badCol = 3 + badOff = 2 parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser) sink = sinkParser parser sink' = sinkParserEither parser @@ -132,11 +139,11 @@ Left e -> case fromException e of Just pe -> do - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff ea' <- CL.sourceList input $$ sink' case ea' of Left pe -> - errorPosition pe `shouldBe` Position badLine badCol + errorPosition pe `shouldBe` Position badLine badCol badOff describe "conduitParser" $ do it "parses a repeated stream" $ do @@ -147,7 +154,7 @@ let chk a = case a of Left{} -> False Right (_, xs) -> xs == "aaa" - chkp l = (PositionRange (Position l 1) (Position (l+1) 1)) + chkp l = PositionRange (Position l 1 ((l - 1) * 4)) (Position (l+1) 1 (l * 4)) forM_ ea $ \ a -> a `shouldSatisfy` chk :: Expectation forM_ (zip ea [1..]) $ \ (Right (pos, _), l) -> pos `shouldBe` chkp l length ea `shouldBe` 4 @@ -156,14 +163,14 @@ results <- yield "hihihi\nhihi" $$ conduitParser (Data.Attoparsec.Text.string "\n" <|> Data.Attoparsec.Text.string "hi") =$ CL.consume - let f (a, b, c, d, e) = (PositionRange (Position a b) (Position c d), e) + let f (a, b, c, d, e, f, g) = (PositionRange (Position a b c) (Position d e f), g) results `shouldBe` map f - [ (1, 1, 1, 3, "hi") - , (1, 3, 1, 5, "hi") - , (1, 5, 1, 7, "hi") + [ (1, 1, 0, 1, 3, 2, "hi") + , (1, 3, 2, 1, 5, 4, "hi") + , (1, 5, 4, 1, 7, 6, "hi") - , (1, 7, 2, 1, "\n") + , (1, 7, 6, 2, 1, 7, "\n") - , (2, 1, 2, 3, "hi") - , (2, 3, 2, 5, "hi") + , (2, 1, 7, 2, 3, 9, "hi") + , (2, 3, 9, 2, 5, 11, "hi") ]