attoparsec-conduit-1.0.1.2/0000755000000000000000000000000012172127371013652 5ustar0000000000000000attoparsec-conduit-1.0.1.2/LICENSE0000644000000000000000000000207512172127371014663 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. attoparsec-conduit-1.0.1.2/Setup.lhs0000644000000000000000000000016212172127371015461 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain attoparsec-conduit-1.0.1.2/attoparsec-conduit.cabal0000644000000000000000000000266312172127371020455 0ustar0000000000000000Name: attoparsec-conduit Version: 1.0.1.2 Synopsis: Consume attoparsec parsers via conduit. Description: Consume attoparsec parsers via conduit. License: MIT License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit, Parsing 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 source-repository head type: git location: git://github.com/snoyberg/conduit.git attoparsec-conduit-1.0.1.2/test/0000755000000000000000000000000012172127371014631 5ustar0000000000000000attoparsec-conduit-1.0.1.2/test/main.hs0000644000000000000000000001162012172127371016111 0ustar0000000000000000{-# 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 attoparsec-conduit-1.0.1.2/Data/0000755000000000000000000000000012172127371014523 5ustar0000000000000000attoparsec-conduit-1.0.1.2/Data/Conduit/0000755000000000000000000000000012172127371016130 5ustar0000000000000000attoparsec-conduit-1.0.1.2/Data/Conduit/Attoparsec.hs0000644000000000000000000001662612172127371020604 0ustar0000000000000000{-# 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 #-}