diff --git a/Data/Conduit/Attoparsec.hs b/Data/Conduit/Attoparsec.hs deleted file mode 100644 --- a/Data/Conduit/Attoparsec.hs +++ /dev/null @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/attoparsec-conduit.cabal b/attoparsec-conduit.cabal --- a/attoparsec-conduit.cabal +++ b/attoparsec-conduit.cabal @@ -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 diff --git a/test/main.hs b/test/main.hs deleted file mode 100644 --- a/test/main.hs +++ /dev/null @@ -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