attoparsec-conduit 0.5.0.3 → 1.1.0
raw patch · 4 files changed
Files
- Data/Conduit/Attoparsec.hs +0/−178
- LICENSE +17/−27
- attoparsec-conduit.cabal +4/−26
- test/main.hs +0/−65
− Data/Conduit/Attoparsec.hs
@@ -1,178 +0,0 @@-{-# 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- -- * Types- , ParseError (..)- , Position (..)- , PositionRange (..)- -- * Classes- , AttoparsecInput- ) where--import Prelude hiding (lines)-import Control.Exception (Exception)-import Data.Typeable (Typeable)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.Text as T-import Control.Monad.Trans.Class (lift)-import Control.Monad (unless)--import qualified Data.Attoparsec.ByteString-import qualified Data.Attoparsec.Text-import qualified Data.Attoparsec.Types as A-import Data.Conduit hiding (Pipe, Sink, Conduit, Source)---- | 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 :: Int- , posCol :: Int- }- deriving (Eq, Ord)-instance Show Position where- show (Position l c) = show l ++ ':' : show c--data PositionRange = PositionRange- { posRangeStart :: Position- , posRangeEnd :: 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 -> (Int, Int)- take' :: Int -> a -> a- length' :: a -> Int--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 =- (lines, cols)- where- lines = B.count 10 b- cols =- case B8.lines b of- [] -> 0- ls -> B.length $ last ls- take' = B.take- length' = B.length--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 =- (lines, cols)- where- lines = T.count (T.pack "\n") t- cols =- case T.lines t of- [] -> 0- ls -> T.length $ last ls- take' = T.take- length' = T.length---- | 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 -> GLSink a m b-sinkParser = fmap snd . sinkParserPos (Position 1 1)---- | Consume a stream of parsed tokens, returning both the token and the--- position it appears at.------ Since 0.5.0-conduitParser :: (AttoparsecInput a, MonadThrow m) => A.Parser a b -> GLInfConduit a m (PositionRange, b)-conduitParser parser =- conduit $ Position 1 0- where- conduit pos =- awaitE >>= either return go- where- go x = do- leftover x- (pos', res) <- sinkParserPos pos parser- yield (PositionRange pos pos', res)- conduit pos'--sinkParserPos :: (AttoparsecInput a, MonadThrow m) => Position -> A.Parser a b -> GLSink a m (Position, b)-sinkParserPos pos0 =- sink empty pos0 . parseA- where- sink prev pos parser = do- 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 = take' (length' c - length' lo) c- pos'' = addLinesCols y pos'- unless (isNull lo) $ leftover lo- pos'' `seq` return (pos'', x)- go end c (A.Fail rest contexts msg) =- let x = take' (length' c - length' rest) c- pos'- | end = pos- | otherwise = addLinesCols prev pos- pos'' = addLinesCols x pos'- in pos'' `seq` lift (monadThrow $ ParseError contexts msg pos'')- go end c (A.Partial parser')- | end = lift $ monadThrow 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- (dlines, dcols) = getLinesCols x- lines' = lines + dlines- cols' = (if dlines > 0 then 1 else cols) + dcols
LICENSE view
@@ -1,30 +1,20 @@-Copyright (c)2011, Michael Snoyman--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.+Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ - * 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.+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: - * Neither the name of Michael Snoyman nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.+The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -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.+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.cabal view
@@ -1,8 +1,8 @@ Name: attoparsec-conduit-Version: 0.5.0.3-Synopsis: Consume attoparsec parsers via conduit.+Version: 1.1.0+Synopsis: Consume attoparsec parsers via conduit. (deprecated) Description: Consume attoparsec parsers via conduit.-License: BSD3+License: MIT License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com@@ -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 >= 0.5 && < 0.6- 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,65 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-import Test.Hspec-import Control.Exception (fromException)--import Data.Conduit-import Data.Conduit.Attoparsec-import qualified Data.Conduit.List as CL-import qualified Data.Attoparsec.Text-import qualified Data.Attoparsec.ByteString.Char8-import Control.Applicative ((<|>))-import Control.Monad.Trans.Resource--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