conduit-tokenize-attoparsec (empty) → 0.1.0.0
raw patch · 12 files changed
+857/−0 lines, 12 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, conduit, conduit-tokenize-attoparsec, hspec, resourcet, text
Files
- LICENSE +30/−0
- README.md +23/−0
- Setup.hs +2/−0
- app/Main.hs +19/−0
- conduit-tokenize-attoparsec.cabal +60/−0
- src/Data/Conduit/Tokenize/Attoparsec.hs +29/−0
- src/Data/Conduit/Tokenize/Attoparsec/Internal.hs +196/−0
- src/Data/Conduit/Tokenize/Attoparsec/LineColumn.hs +84/−0
- src/Data/Conduit/Tokenize/Attoparsec/Offset.hs +78/−0
- test/Data/Conduit/Tokenize/Attoparsec/LineColumnSpec.hs +171/−0
- test/Data/Conduit/Tokenize/Attoparsec/OffsetSpec.hs +164/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,23 @@+# conduit-tokenize-attoparsec+Conduits for tokenizing streams.++`conduit-tokenize-attoparsec` is an extension to the `conduit` library based on+`Data.Conduit.Attoparsec` that allows the tokenization of a stream whilst also+tracking arbitrary state. The library includes in-built support for tracking+such as line-column and stream offset, but can be extended with type-classes to+support alternative state tracking.++For an example, see [`app/Main.hs`](../master/app/Main.hs)++## Building+Prerequisites: `haskell-stack` is installed.++Run the following in the shell:++ git clone git@github.com:haskell-works/conduit-tokenize-attoparsec.git+ cd conduit-tokenize-attoparsec+ stack setup+ stack build+ stack test+ stack ghci --ghc-options -XOverloadedStrings \+ --main-is conduit-tokenize-attoparsec:exe:conduit-tokenize-attoparsec-example
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Applicative+import Control.Monad.Trans.Resource+import Data.Attoparsec.Text+import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.Conduit.Tokenize.Attoparsec+import Data.Conduit.Tokenize.Attoparsec.Offset++main :: IO ()+main = do+ results <- runResourceT $ yield "hihihi\nhihi"+ $$ conduitParser (Offset 0) (Data.Attoparsec.Text.string "\n" <|> Data.Attoparsec.Text.string "hi")+ =$ CL.consume++ print results
+ conduit-tokenize-attoparsec.cabal view
@@ -0,0 +1,60 @@+name: conduit-tokenize-attoparsec+version: 0.1.0.0+synopsis: Conduits for tokenizing streams.+description: Please see README.md+homepage: http://github.com/haskell-works/conduit-tokenize-attoparsec#readme+license: BSD3+license-file: LICENSE+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016 John Ky+category: Data, Conduit+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.10++executable conduit-tokenize-attoparsec-example+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , attoparsec >= 0.10+ , conduit >= 1.1 && < 1.3+ , conduit-tokenize-attoparsec+ , resourcet >= 1.1+ default-language: Haskell2010++library+ hs-source-dirs: src+ exposed-modules: Data.Conduit.Tokenize.Attoparsec.Internal+ Data.Conduit.Tokenize.Attoparsec.LineColumn+ Data.Conduit.Tokenize.Attoparsec.Offset+ Data.Conduit.Tokenize.Attoparsec+ build-depends: base >= 4.7 && < 5+ , attoparsec >= 0.10+ , bytestring+ , conduit >= 1.1 && < 1.3+ , text+ , resourcet >= 1.1++ default-language: Haskell2010+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall++test-suite conduit-tokenize-attoparsec-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Data.Conduit.Tokenize.Attoparsec.LineColumnSpec+ , Data.Conduit.Tokenize.Attoparsec.OffsetSpec+ build-depends: base+ , attoparsec >= 0.10+ , conduit >= 1.1 && < 1.3+ , conduit-tokenize-attoparsec+ , hspec >= 1.3+ , resourcet >= 1.1+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/haskell-works/conduit-tokenize-attoparsec
+ src/Data/Conduit/Tokenize/Attoparsec.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin+-- License: MIT+--+-- Conduits for tokenizing streams.+--+-- This code was taken from attoparsec-enumerator and adapted for conduits.+module Data.Conduit.Tokenize.Attoparsec+ ( -- * Sink+ sinkParser+ , sinkParserEither+ -- * Conduit+ , conduitParser+ , conduitParserEither++ -- * Types+ , ParseError (..)+ , ParseDelta (..)+ -- * Classes+ , AttoparsecInput(..)+ , AttoparsecState(..)+ ) where++import Data.Conduit.Tokenize.Attoparsec.Internal
+ src/Data/Conduit/Tokenize/Attoparsec/Internal.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Copyright: 2016 John Ky, 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.Tokenize.Attoparsec.Internal+ ( -- * Sink+ sinkParser+ , sinkParserEither+ -- * Conduit+ , conduitParser+ , conduitParserEither++ -- * Types+ , ParseError (..)+ , ParseDelta (..)+ -- * Classes+ , AttoparsecInput(..)+ , AttoparsecState(..)+ ) where++import Control.Exception (Exception)+import Control.Monad (unless)+import Control.Monad.Trans.Resource (MonadThrow, monadThrow)+import qualified Data.Attoparsec.ByteString+import qualified Data.Attoparsec.Text+import qualified Data.Attoparsec.Types as A+import qualified Data.ByteString as B+import Data.Conduit+import qualified Data.Text as T+import qualified Data.Text.Internal as TI+import Data.Typeable (Typeable)+import Prelude hiding (lines)++-- | The context and message from a 'A.Fail' value.+data ParseError s = ParseError+ { errorContexts :: [String]+ , errorMessage :: String+ , errorPosition :: s+ } | DivergentParser+ deriving (Show, Typeable)++-- | The before and after state of a single parse in a conduit stream.+data ParseDelta s = ParseDelta+ { before :: !s+ , after :: !s+ }+ deriving (Eq, Ord)++-- | 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+ notEmpty :: [a] -> [a]++ -- | 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++-- | A class of types and states which may be consumed by an Attoparsec parser.+class AttoparsecState a s where+ getState :: a -> s+ modState :: AttoparsecInput a => a -> s -> s++instance AttoparsecInput B.ByteString where+ parseA = Data.Attoparsec.ByteString.parse+ feedA = Data.Attoparsec.ByteString.feed+ empty = B.empty+ isNull = B.null+ notEmpty = filter (not . B.null)+ stripFromEnd b1 b2 = B.take (B.length b1 - B.length b2) b1++instance AttoparsecInput T.Text where+ parseA = Data.Attoparsec.Text.parse+ feedA = Data.Attoparsec.Text.feed+ empty = T.empty+ isNull = T.null+ notEmpty = filter (not . T.null)+ stripFromEnd (TI.Text arr1 off1 len1) (TI.Text _ _ len2) =+ TI.text arr1 off1 (len1 - 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 'monadThrow'.+--+-- Since 0.5.0+sinkParser :: (AttoparsecInput a, AttoparsecState a s, MonadThrow m, Exception (ParseError s)) => s -> A.Parser a b -> Consumer a m b+sinkParser s = fmap snd . sinkParserPosErr s++-- | Same as 'sinkParser', but we return an 'Either' type instead+-- of raising an exception.+--+-- Since 1.1.5+sinkParserEither :: (AttoparsecInput a, AttoparsecState a s, Monad m) => s -> A.Parser a b -> Consumer a m (Either (ParseError s) b)+sinkParserEither s = (fmap.fmap) snd . sinkParserPos s++-- | 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, AttoparsecState a s, MonadThrow m, Exception (ParseError s)) => s -> A.Parser a b -> Conduit a m (ParseDelta s, b)+conduitParser s parser = conduit s+ where+ conduit !pos = await >>= maybe (return ()) go+ where+ go x = do+ leftover x+ (!pos', !res) <- sinkParserPosErr pos parser+ yield (ParseDelta pos pos', res)+ conduit pos'+{-# INLINABLE conduitParser #-}++-- | Same as 'conduitParser', but we return an 'Either' type instead+-- of raising an exception.+conduitParserEither+ :: (Monad m, AttoparsecInput a, AttoparsecState a s)+ => s+ -> A.Parser a b+ -> Conduit a m (Either (ParseError s) (ParseDelta s, b))+conduitParserEither s parser = conduit s+ where+ conduit !pos = await >>= maybe (return ()) go+ where+ go x = do+ leftover x+ eres <- sinkParserPos pos parser+ case eres of+ Left e -> yield $ Left e+ Right (!pos', !res) -> do+ yield $! Right (ParseDelta pos pos', res)+ conduit pos'+{-# INLINABLE conduitParserEither #-}++sinkParserPosErr+ :: (AttoparsecInput a, AttoparsecState a s, MonadThrow m, Exception (ParseError s))+ => s+ -> A.Parser a b+ -> Consumer a m (s, b)+sinkParserPosErr s p = sinkParserPos s p >>= f+ where+ f (Left e) = monadThrow e+ f (Right a) = return a+{-# INLINABLE sinkParserPosErr #-}++sinkParserPos+ :: (AttoparsecInput a, AttoparsecState a s, Monad m)+ => s+ -> A.Parser a b+ -> Consumer a m (Either (ParseError s) (s, b))+sinkParserPos s p = sink empty s (parseA p)+ where+ -- sink :: a -> s -> (a -> A.IResult a b) -> Consumer a m (Either (ParseError s) (s, b))+ sink prev pos parser = await >>= maybe close push+ where+ push c+ | isNull c = sink prev pos parser+ | otherwise = go False c $ parser c++ close = go True prev (feedA (parser empty) empty)++ go end c (A.Done lo x) = do+ let pos'+ | end = pos+ | otherwise = modState prev pos+ y = stripFromEnd c lo+ pos'' = modState y pos'+ unless (isNull lo) $ leftover lo+ pos'' `seq` return $! Right (pos'', x)+ go end c (A.Fail rest contexts msg) =+ let x = stripFromEnd c rest+ pos'+ | end = pos+ | otherwise = modState prev pos+ pos'' = modState x pos'+ in pos'' `seq` return $! Left (ParseError contexts msg pos'')+ go end c (A.Partial parser')+ | end = return $! Left DivergentParser+ | otherwise =+ pos' `seq` sink c pos' parser'+ where+ pos' = modState prev pos++{-# INLINABLE sinkParserPos #-}
+ src/Data/Conduit/Tokenize/Attoparsec/LineColumn.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin+-- License: MIT+--+-- Conduits for tokenizing streams.+--+-- This code was taken from attoparsec-enumerator and adapted for conduits.+module Data.Conduit.Tokenize.Attoparsec.LineColumn+ ( Position (..)+ ) where++import Control.Exception (Exception)+import Control.Monad.Trans.Resource (MonadThrow)+import qualified Data.Attoparsec.Types as A+import qualified Data.ByteString as B+import Data.Conduit+import Data.Conduit.Tokenize.Attoparsec.Internal+import qualified Data.Text as T+import Prelude hiding (lines)++data Position = Position+ { posLine :: {-# UNPACK #-} !Int+ , posCol :: {-# UNPACK #-} !Int+ }+ deriving (Eq, Ord)++instance Show Position where+ show (Position l c) = show l ++ ':' : show c++instance Exception (ParseError Position)++instance Show (ParseDelta Position) where+ show (ParseDelta s e) = show s ++ '-' : show e++instance AttoparsecState B.ByteString Position where+ getState = B.foldl' f (Position 0 0)+ where+ f (Position l c) ch | ch == 10 = Position (l + 1) 0+ | otherwise = Position l (c + 1)+ modState x (Position lines cols) =+ lines' `seq` cols' `seq` Position lines' cols'+ where+ Position dlines dcols = getState x+ lines' = lines + dlines+ cols' = (if dlines > 0 then 1 else cols) + dcols++instance AttoparsecState T.Text Position where+ getState = T.foldl' f (Position 0 0)+ where+ f (Position l c) ch | ch == '\n' = Position (l + 1) 0+ | otherwise = Position l (c + 1)+ modState x (Position lines cols) =+ lines' `seq` cols' `seq` Position lines' cols'+ where+ Position dlines dcols = getState x+ lines' = lines + dlines+ cols' = (if dlines > 0 then 1 else cols) + dcols++{-# SPECIALIZE conduitParser+ :: MonadThrow m+ => Position+ -> A.Parser T.Text b+ -> Conduit T.Text m (ParseDelta Position, b) #-}++{-# SPECIALIZE conduitParser+ :: MonadThrow m+ => Position+ -> A.Parser B.ByteString b+ -> Conduit B.ByteString m (ParseDelta Position, b) #-}++{-# SPECIALIZE conduitParserEither+ :: Monad m+ => Position+ -> A.Parser T.Text b+ -> Conduit T.Text m (Either (ParseError Position) (ParseDelta Position, b)) #-}++{-# SPECIALIZE conduitParserEither+ :: Monad m+ => Position+ -> A.Parser B.ByteString b+ -> Conduit B.ByteString m (Either (ParseError Position) (ParseDelta Position, b)) #-}
+ src/Data/Conduit/Tokenize/Attoparsec/Offset.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Copyright: 2016 John Ky, 2011 Michael Snoyman, 2010 John Millikin+-- License: MIT+--+-- Conduits for tokenizing streams.+--+-- This code was taken from attoparsec-enumerator and adapted for conduits.+module Data.Conduit.Tokenize.Attoparsec.Offset+ ( Offset (..)+ ) where++import Control.Exception (Exception)+import Control.Monad.Trans.Resource (MonadThrow)+import qualified Data.Attoparsec.Types as A+import qualified Data.ByteString as B+import Data.Conduit+import Data.Conduit.Tokenize.Attoparsec.Internal+import qualified Data.Text as T+import Prelude hiding (lines)++data Offset = Offset+ { pos :: {-# UNPACK #-} !Int+ }+ deriving (Eq, Ord)++instance Show Offset where+ show (Offset c) = show c++instance Exception (ParseError Offset)++instance Show (ParseDelta Offset) where+ show (ParseDelta s e) = show s ++ '-' : show e++instance AttoparsecState B.ByteString Offset where+ getState = B.foldl' f (Offset 0)+ where+ f (Offset c) _ = Offset (c + 1)+ modState x (Offset cols) = cols' `seq` Offset cols'+ where+ Offset dcols = getState x+ cols' = cols + dcols++instance AttoparsecState T.Text Offset where+ getState = T.foldl' f (Offset 0)+ where+ f (Offset c) _ = Offset (c + 1)+ modState x (Offset cols) =+ cols' `seq` Offset cols'+ where+ Offset dcols = getState x+ cols' = cols + dcols++{-# SPECIALIZE conduitParser+ :: MonadThrow m+ => Offset+ -> A.Parser T.Text b+ -> Conduit T.Text m (ParseDelta Offset, b) #-}++{-# SPECIALIZE conduitParser+ :: MonadThrow m+ => Offset+ -> A.Parser B.ByteString b+ -> Conduit B.ByteString m (ParseDelta Offset, b) #-}++{-# SPECIALIZE conduitParserEither+ :: Monad m+ => Offset+ -> A.Parser T.Text b+ -> Conduit T.Text m (Either (ParseError Offset) (ParseDelta Offset, b)) #-}++{-# SPECIALIZE conduitParserEither+ :: Monad m+ => Offset+ -> A.Parser B.ByteString b+ -> Conduit B.ByteString m (Either (ParseError Offset) (ParseDelta Offset, b)) #-}
+ test/Data/Conduit/Tokenize/Attoparsec/LineColumnSpec.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Data.Conduit.Tokenize.Attoparsec.LineColumnSpec (spec) where++import Control.Applicative ((<|>))+import Control.Exception (fromException)+import Control.Monad+import Control.Monad.Trans.Resource (runExceptionT)+import qualified Data.Attoparsec.ByteString.Char8+import qualified Data.Attoparsec.Text+import Data.Conduit+import Data.Conduit.Tokenize.Attoparsec+import Data.Conduit.Tokenize.Attoparsec.LineColumn+import qualified Data.Conduit.List as CL+import Test.Hspec++spec :: Spec+spec = describe "Data.Conduit.Tokenize.Attoparsec.LineColumnSpec" $ do+ describe "error position" $ do+ it "works for text" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badLine = 4+ badCol = 6+ parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol+ it "works for bytestring" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badLine = 4+ badCol = 6+ parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol+ it "works in last chunk" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badLine = 6+ badCol = 5+ parser = Data.Attoparsec.Text.char 'c' <|> (Data.Attoparsec.Text.anyChar >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol+ it "works in last chunk" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aa\n\naaaab"]+ badLine = 6+ badCol = 6+ parser = Data.Attoparsec.Text.string "bc" <|> (Data.Attoparsec.Text.anyChar >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol+ it "works after new line in text" $ do+ let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]+ badLine = 5+ badCol = 1+ parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol+ it "works after new line in bytestring" $ do+ let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]+ badLine = 5+ badCol = 1+ parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol+ it "works for first line" $ do+ let input = ["aab\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badLine = 1+ badCol = 3+ parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+ sink = sinkParser (Position 1 1) parser+ sink' = sinkParserEither (Position 1 1) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Position badLine badCol+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Position badLine badCol++ describe "conduitParser" $ do+ it "parses a repeated stream" $ do+ let input = ["aaa\n", "aaa\naaa\n", "aaa\n"]+ parser = Data.Attoparsec.Text.string "aaa" <* Data.Attoparsec.Text.endOfLine+ sink = conduitParserEither (Position 1 1) parser =$= CL.consume+ (Right ea) <- runExceptionT $ CL.sourceList input $$ sink+ let chk a = case a of+ Left{} -> False+ Right (_, xs) -> xs == "aaa"+ chkp l = (ParseDelta (Position l 1) (Position (l+1) 1))+ forM_ ea $ \ a -> a `shouldSatisfy` chk :: Expectation+ forM_ (zip ea [1..]) $ \ (Right (pos, _), l) -> pos `shouldBe` chkp l+ length ea `shouldBe` 4++ it "positions on first line" $ do+ results <- yield "hihihi\nhihi"+ $$ conduitParser (Position 1 1) (Data.Attoparsec.Text.string "\n" <|> Data.Attoparsec.Text.string "hi")+ =$ CL.consume+ let f (a, b, c, d, e) = (ParseDelta (Position a b) (Position c d), e)+ results `shouldBe` map f+ [ (1, 1, 1, 3, "hi")+ , (1, 3, 1, 5, "hi")+ , (1, 5, 1, 7, "hi")++ , (1, 7, 2, 1, "\n")++ , (2, 1, 2, 3, "hi")+ , (2, 3, 2, 5, "hi")+ ]
+ test/Data/Conduit/Tokenize/Attoparsec/OffsetSpec.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Data.Conduit.Tokenize.Attoparsec.OffsetSpec (spec) where++import Control.Applicative ((<|>))+import Control.Exception (fromException)+import Control.Monad+import Control.Monad.Trans.Resource (runExceptionT)+import qualified Data.Attoparsec.ByteString.Char8+import qualified Data.Attoparsec.Text+import Data.Conduit+import Data.Conduit.Tokenize.Attoparsec+import Data.Conduit.Tokenize.Attoparsec.Offset+import qualified Data.Conduit.List as CL+import Test.Hspec++spec :: Spec+spec = describe "Data.Conduit.Tokenize.Attoparsec.OffsetSpec" $ do+ describe "error position" $ do+ it "works for text" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badOffset = 15+ parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset+ it "works for bytestring" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badOffset = 15+ parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset+ it "works in last chunk" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badOffset = 22+ parser = Data.Attoparsec.Text.char 'c' <|> (Data.Attoparsec.Text.anyChar >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset+ it "works in last chunk" $ do+ let input = ["aaa\na", "aaa\n\n", "aaa", "aa\n\naaaab"]+ badOffset = 22+ parser = Data.Attoparsec.Text.string "bc" <|> (Data.Attoparsec.Text.anyChar >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset+ it "works after new line in text" $ do+ let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]+ badOffset = 15+ parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset+ it "works after new line in bytestring" $ do+ let input = ["aaa\n", "aaa\n\n", "aaa", "aa\nb\naaaa"]+ badOffset = 15+ parser = Data.Attoparsec.ByteString.Char8.endOfInput <|> (Data.Attoparsec.ByteString.Char8.notChar 'b' >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset+ it "works for first line" $ do+ let input = ["aab\na", "aaa\n\n", "aaa", "aab\n\naaaa"]+ badOffset = 2+ parser = Data.Attoparsec.Text.endOfInput <|> (Data.Attoparsec.Text.notChar 'b' >> parser)+ sink = sinkParser (Offset 0) parser+ sink' = sinkParserEither (Offset 0) parser+ ea <- runExceptionT $ CL.sourceList input $$ sink+ case ea of+ Left e ->+ case fromException e of+ Just pe -> do+ errorPosition pe `shouldBe` Offset badOffset+ ea' <- CL.sourceList input $$ sink'+ case ea' of+ Left pe ->+ errorPosition pe `shouldBe` Offset badOffset++ describe "conduitParser" $ do+ it "parses a repeated stream" $ do+ let input = ["aaa\n", "aaa\naaa\n", "aaa\n"]+ parser = Data.Attoparsec.Text.string "aaa" <* Data.Attoparsec.Text.endOfLine+ sink = conduitParserEither (Offset 0) parser =$= CL.consume+ (Right ea) <- runExceptionT $ CL.sourceList input $$ sink+ let chk a = case a of+ Left{} -> False+ Right (_, xs) -> xs == "aaa"+ chkp l = (ParseDelta (Offset l) (Offset (l + 4)))+ forM_ ea $ \ a -> a `shouldSatisfy` chk :: Expectation+ forM_ (zip ea [0,4..]) $ \ (Right (pos2, _), l) -> pos2 `shouldBe` chkp l+ length ea `shouldBe` 4++ it "positions on first line" $ do+ results <- yield "hihihi\nhihi"+ $$ conduitParser (Offset 0) (Data.Attoparsec.Text.string "\n" <|> Data.Attoparsec.Text.string "hi")+ =$ CL.consume+ let f (b, d, e) = (ParseDelta (Offset b) (Offset d), e)+ results `shouldBe` map f+ [ (0, 2, "hi")+ , (2, 4, "hi")+ , (4, 6, "hi")++ , (6, 7, "\n")++ , (7, 9, "hi")+ , (9, 11, "hi")+ ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}