attoparsec-conduit 1.0.1.2 → 1.1.0
raw patch · 3 files changed
+3/−365 lines, 3 filesdep −attoparsecdep −attoparsec-conduitdep −bytestringdep ~basedep ~conduit
Dependencies removed: attoparsec, attoparsec-conduit, bytestring, hspec, resourcet, text, transformers
Dependency ranges changed: base, conduit
Files
- Data/Conduit/Attoparsec.hs +0/−233
- attoparsec-conduit.cabal +3/−25
- test/main.hs +0/−107
− Data/Conduit/Attoparsec.hs
@@ -1,233 +0,0 @@-{-# 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- -- * 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---- | The context and message from a 'A.Fail' value.-data ParseError = ParseError- { errorContexts :: [String]- , errorMessage :: String- , errorPosition :: Position- } | DivergentParser- deriving (Show, Typeable)--instance Exception ParseError--data Position = Position- { posLine :: {-# UNPACK #-} !Int- , posCol :: {-# UNPACK #-} !Int- }- deriving (Eq, Ord)--instance Show Position where- show (Position l c) = show l ++ ':' : show c--data PositionRange = PositionRange- { posRangeStart :: {-# UNPACK #-} !Position- , posRangeEnd :: {-# UNPACK #-} !Position- }- deriving (Eq, Ord)--instance Show PositionRange where- show (PositionRange s e) = show s ++ '-' : show 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- notEmpty :: [a] -> [a]- 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 = Data.Attoparsec.ByteString.parse- feedA = Data.Attoparsec.ByteString.feed- empty = B.empty- isNull = B.null- notEmpty = filter (not . B.null)- getLinesCols = B.foldl' f (Position 0 0)- where- f (Position l c) ch | ch == 10 = Position (l + 1) 0- | otherwise = Position l (c + 1)- 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)- getLinesCols = T.foldl' f (Position 0 0)- where- f (Position l c) ch | ch == '\n' = Position (l + 1) 0- | otherwise = Position l (c + 1)- stripFromEnd (TI.Text arr1 off1 len1) (TI.Text _ _ len2) =- TI.textP 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, MonadThrow m) => A.Parser a b -> Consumer a m b-sinkParser = fmap snd . sinkParserPosErr (Position 1 1)------ | 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 -> Conduit a m (PositionRange, b)-conduitParser parser =- conduit $ Position 1 0- where- conduit !pos = await >>= maybe (return ()) go- where- go x = do- leftover x- (!pos', !res) <- sinkParserPosErr pos parser- yield (PositionRange pos pos', res)- conduit pos'-{-# SPECIALIZE conduitParser- :: MonadThrow m- => A.Parser T.Text b- -> Conduit T.Text m (PositionRange, b) #-}-{-# SPECIALIZE conduitParser- :: MonadThrow m- => A.Parser B.ByteString b- -> Conduit B.ByteString m (PositionRange, b) #-}------ | Same as 'conduitParser', but we return an 'Either' type instead--- of raising an exception.-conduitParserEither- :: (Monad m, AttoparsecInput a)- => A.Parser a b- -> Conduit a m (Either ParseError (PositionRange, b))-conduitParserEither parser =- conduit $ Position 1 0- 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 (PositionRange pos pos', res)- conduit pos'-{-# SPECIALIZE conduitParserEither- :: Monad m- => A.Parser T.Text b- -> Conduit T.Text m (Either ParseError (PositionRange, b)) #-}-{-# SPECIALIZE conduitParserEither- :: Monad m- => A.Parser B.ByteString b- -> Conduit B.ByteString m (Either ParseError (PositionRange, b)) #-}-----sinkParserPosErr- :: (AttoparsecInput a, MonadThrow m)- => Position- -> A.Parser a b- -> Consumer a m (Position, b)-sinkParserPosErr pos0 p = sinkParserPos pos0 p >>= f- where- f (Left e) = monadThrow e- f (Right a) = return a-{-# INLINE sinkParserPosErr #-}---sinkParserPos- :: (AttoparsecInput a, Monad m)- => Position- -> A.Parser a b- -> Consumer a m (Either ParseError (Position, b))-sinkParserPos pos0 p = sink empty pos0 (parseA p)- where- 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 = addLinesCols prev pos- y = stripFromEnd c lo- pos'' = addLinesCols 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 = addLinesCols prev pos- pos'' = addLinesCols 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' = addLinesCols prev pos-- addLinesCols :: AttoparsecInput a => a -> Position -> Position- addLinesCols x (Position lines cols) =- lines' `seq` cols' `seq` Position lines' cols'- where- Position dlines dcols = getLinesCols x- lines' = lines + dlines- cols' = (if dlines > 0 then 1 else cols) + dcols-{-# INLINE sinkParserPos #-}
attoparsec-conduit.cabal view
@@ -1,6 +1,6 @@ Name: attoparsec-conduit-Version: 1.0.1.2-Synopsis: Consume attoparsec parsers via conduit.+Version: 1.1.0+Synopsis: Consume attoparsec parsers via conduit. (deprecated) Description: Consume attoparsec parsers via conduit. License: MIT License-file: LICENSE@@ -10,32 +10,10 @@ Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit-extra-source-files: test/main.hs Library- Exposed-modules: Data.Conduit.Attoparsec Build-depends: base >= 4 && < 5- , transformers >= 0.2.2 && < 0.4- , bytestring >= 0.9- , attoparsec >= 0.10- , text >= 0.11- , conduit >= 1.0 && < 1.1- ghc-options: -Wall--test-suite test- hs-source-dirs: test- main-is: main.hs- type: exitcode-stdio-1.0- cpp-options: -DTEST- build-depends: conduit- , base- , hspec >= 1.3- , text- , resourcet- , attoparsec- , attoparsec-conduit- , conduit- ghc-options: -Wall+ , conduit >= 1.1 source-repository head type: git
− test/main.hs
@@ -1,107 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-import Control.Exception (fromException)-import Test.Hspec--import Control.Applicative ((<*), (<|>))-import Control.Monad-import Control.Monad.Trans.Resource-import qualified Data.Attoparsec.ByteString.Char8-import qualified Data.Attoparsec.Text-import Data.Conduit-import Data.Conduit.Attoparsec-import qualified Data.Conduit.List as CL--main :: IO ()-main = hspec $ 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 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- 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 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- 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 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- 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 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- 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 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- 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 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-- 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 parser =$= CL.consume- (Right ea) <- runExceptionT $ CL.sourceList input $$ sink- let chk a = case a of- Left{} -> False- Right (_, xs) -> xs == "aaa"- chkp 1 = (PositionRange (Position 1 0) (Position 2 1))- chkp l = (PositionRange (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--