diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2012-2014, Renzo Carbonara +Copyright (c) 2012-, Renzo Carbonara Copyright (c) 2012, Paolo Capriotti All rights reserved. diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -7,3 +7,4 @@ Gabriel Gonzalez Patrick Wheeler Danny Navarro +Michael Thompson diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,30 +0,0 @@ -# Version 0.4.0.1 - -* Relax lower and upper dependencies on `text`. - - -# Version 0.4.0 - -* API revamped in order to support pipes-parse-3.0.*. - - -# Version 0.3.1 - -* Support attoparsec-0.11. - - -# Version 0.3.0 - -* Upgrade to pipes-4.0.0 and pipes-parse-2.0.0, removing proxy - transformers and changing the API substantially. - - -# Version 0.2.0.0 - -* Droped the previous API in favour of a new and incompatible API - that supports interleaved parsing by relying on pipes-parse. - - -# Version 0.1.0.1 - -* First version mentioned in NEWS file. diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,75 @@ +# Version 0.6.0 + +* Remove support for `Control.Monad.Trans.Error`. + + +# Version 0.5.1.5 + +* Remove upper bound limits on dependencies other than `base`. + + +# Version 0.5.1.4 + +* Bump upper bound dependency on `pipes`. + + +# Version 0.5.1.3 + +* Bump upper bound dependency on `transformers`. + + +# Version 0.5.1.2 + +* Bump upper bound dependency on `attoparsec`. + + +# Version 0.5.1.1 + +* Bump upper bound dependency on `text`. + + +# Version 0.5.1 + +* Bump upper bound dependency on `attoparsec`. + + +# Version 0.5.0 + +* Correctly propagate state in `parsedL`. + +* `parse` and `parseL` return `Nothing` if used on an exhausted + `Producer`. + +* Performance improvements. + + +# Version 0.4.0.1 + +* Relax lower and upper dependencies on `text`. + + +# Version 0.4.0 + +* API revamped in order to support pipes-parse-3.0.*. + + +# Version 0.3.1 + +* Support attoparsec-0.11. + + +# Version 0.3.0 + +* Upgrade to pipes-4.0.0 and pipes-parse-2.0.0, removing proxy + transformers and changing the API substantially. + + +# Version 0.2.0.0 + +* Droped the previous API in favour of a new and incompatible API + that supports interleaved parsing by relying on pipes-parse. + + +# Version 0.1.0.1 + +* First version mentioned in NEWS file. diff --git a/pipes-attoparsec.cabal b/pipes-attoparsec.cabal --- a/pipes-attoparsec.cabal +++ b/pipes-attoparsec.cabal @@ -1,8 +1,9 @@ +cabal-version: 2.4 name: pipes-attoparsec -version: 0.4.0.1 -license: BSD3 +version: 0.6.0 +license: BSD-3-Clause license-file: LICENSE -copyright: Copyright (c) Renzo Carbonara 2012-2014, Paolo Capriotti 2012 +copyright: Copyright (c) Renzo Carbonara 2012-, Paolo Capriotti 2012 author: Renzo Carbonara maintainer: renzocarbonaraλgmail.com stability: Experimental @@ -10,13 +11,12 @@ bug-reports: https://github.com/k0001/pipes-attoparsec/issues category: Pipes, Parser build-type: Simple -cabal-version: >=1.8 synopsis: Attoparsec and Pipes integration. -extra-source-files: README.md PEOPLE changelog +extra-source-files: README.md PEOPLE changelog.md description: Utilities to run Attoparsec parsers on Pipes input streams. . - See the @changelog@ file in the source distribution to learn about any + See the @changelog.md@ file in the source distribution to learn about any important changes between version. source-repository head @@ -24,19 +24,21 @@ location: git://github.com/k0001/pipes-attoparsec.git library + default-language: Haskell2010 hs-source-dirs: src exposed-modules: Pipes.Attoparsec build-depends: base (>=4.5 && <5.0) - , attoparsec (>=0.10 && <0.12) - , bytestring (>=0.9.2.1 && <0.11) - , pipes (>=4.1 && <4.2) - , pipes-parse (>=3.0.1 && <3.1) - , text (>=0.11.2.0 && <1.2) - , transformers (>=0.2 && <0.4) + , attoparsec (>=0.10) + , bytestring (>=0.9.2.1) + , pipes (>=4.1) + , pipes-parse (>=3.0.1) + , text (>=0.11.2.0) + , transformers (>=0.2) ghc-options: -Wall -O2 test-suite tests + default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs diff --git a/src/Pipes/Attoparsec.hs b/src/Pipes/Attoparsec.hs --- a/src/Pipes/Attoparsec.hs +++ b/src/Pipes/Attoparsec.hs @@ -3,6 +3,7 @@ -- This module assumes familiarity with @pipes-parse@, you can learn about it in -- "Pipes.Parse.Tutorial". +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} @@ -12,7 +13,7 @@ parse , parsed - -- ** Including input lenght + -- ** Including input length -- -- $lengths , parseL @@ -27,7 +28,6 @@ ) where import Control.Exception (Exception) -import Control.Monad.Trans.Error (Error) import qualified Control.Monad.Trans.State.Strict as S import qualified Data.Attoparsec.ByteString import qualified Data.Attoparsec.Text @@ -36,12 +36,10 @@ import Data.ByteString (ByteString) import qualified Data.ByteString import Data.Data (Data, Typeable) -import Data.Monoid (Monoid (mempty)) import Data.Text (Text) import qualified Data.Text import Pipes import qualified Pipes.Parse as Pipes (Parser) -import qualified Pipes.Prelude as P -------------------------------------------------------------------------------- @@ -49,21 +47,34 @@ -- 'Pipes.Parser'. -- -- This 'Pipes.Parser' is compatible with the tools from "Pipes.Parse". +-- +-- It returns 'Nothing' if the underlying 'Producer' is exhausted, otherwise +-- it attempts to run the given attoparsec 'Attoparsec.Parser' on the underlying +-- 'Producer', possibly failing with 'ParsingError'. parse :: (Monad m, ParserInput a) - => Attoparsec.Parser a b -- ^ Attoparsec parser - -> Pipes.Parser a m (Either ParsingError b) -- ^ Pipes parser -parse parser = do - x <- parseL parser - return (case x of - Left e -> Left e - Right (_, a) -> Right a) + => Attoparsec.Parser a b -- ^ Attoparsec parser + -> Pipes.Parser a m (Maybe (Either ParsingError b)) -- ^ Pipes parser +parse parser = S.StateT $ \p0 -> do + x <- nextSkipEmpty p0 + case x of + Left r -> return (Nothing, return r) + Right (a,p1) -> step (yield a >>) (_parse parser a) p1 + where + step diffP res p0 = case res of + Fail _ c m -> return (Just (Left (ParsingError c m)), diffP p0) + Done a b -> return (Just (Right b), yield a >> p0) + Partial k -> do + x <- nextSkipEmpty p0 + case x of + Left e -> step diffP (k mempty) (return e) + Right (a,p1) -> step (diffP . (yield a >>)) (k a) p1 {-# INLINABLE parse #-} -- | Convert a producer of 'ParserInput' to a producer of parsed values. -- --- This producer returns 'Right' when end-of-input is reached sucessfully, +-- This producer returns 'Right' when end-of-input is reached successfully, -- otherwise it returns a 'ParsingError' and the leftovers including -- the malformed input that couldn't be parsed. You can use 'Pipes.Lift.errorP' -- to promote the 'Either' return value to an 'Control.Monad.Trans.Error.ErrorT' @@ -73,7 +84,21 @@ => Attoparsec.Parser a b -- ^ Attoparsec parser -> Producer a m r -- ^ Raw input -> Producer b m (Either (ParsingError, Producer a m r) r) -parsed parser p = for (parsedL parser p) (\(_, a) -> yield a) +parsed parser = go + where + go p0 = do + x <- lift (nextSkipEmpty p0) + case x of + Left r -> return (Right r) + Right (a,p1) -> step (yield a >>) (_parse parser a) p1 + step diffP res p0 = case res of + Fail _ c m -> return (Left (ParsingError c m, diffP p0)) + Done a b -> yield b >> go (yield a >> p0) + Partial k -> do + x <- lift (nextSkipEmpty p0) + case x of + Left e -> step diffP (k mempty) (return e) + Right (a,p1) -> step (diffP . (yield a >>)) (k a) p1 {-# INLINABLE parsed #-} -------------------------------------------------------------------------------- @@ -87,21 +112,21 @@ parseL :: (Monad m, ParserInput a) => Attoparsec.Parser a b -- ^ Attoparsec parser - -> Pipes.Parser a m (Either ParsingError (Int, b)) -- ^ Pipes parser + -> Pipes.Parser a m (Maybe (Either ParsingError (Int, b))) -- ^ Pipes parser parseL parser = S.StateT $ \p0 -> do - x <- next (p0 >-> P.filter (/= mempty)) + x <- nextSkipEmpty p0 case x of - Left e -> go id (_parse parser mempty) (return e) 0 - Right (t, p1) -> go (yield t >>) (_parse parser t) p1 $! _length t + Left r -> return (Nothing, return r) + Right (a,p1) -> step (yield a >>) (_parse parser a) p1 (_length a) where - go diffP iResult p0 len = case iResult of - Fail _ c m -> return (Left (ParsingError c m) , diffP p0) - Done t r -> return (Right (len - _length t, r), yield t >> p0) + step diffP res p0 !len = case res of + Fail _ c m -> return (Just (Left (ParsingError c m)), diffP p0) + Done a b -> return (Just (Right (len - _length a, b)), yield a >> p0) Partial k -> do - x <- next p0 + x <- nextSkipEmpty p0 case x of - Left e -> go diffP (k mempty) (return e) len - Right (t, p1) -> go (diffP . (yield t >>)) (k t) p1 $! len + _length t + Left e -> step diffP (k mempty) (return e) len + Right (a,p1) -> step (diffP . (yield a >>)) (k a) p1 (len + _length a) {-# INLINABLE parseL #-} @@ -112,16 +137,21 @@ => Attoparsec.Parser a b -- ^ Attoparsec parser -> Producer a m r -- ^ Raw input -> Producer (Int, b) m (Either (ParsingError, Producer a m r) r) -parsedL parser = go where +parsedL parser = go + where go p0 = do - mr <- lift $ S.evalStateT atEndOfParserInput p0 - case mr of - Just r -> return (Right r) - Nothing -> do - (x, p1) <- lift $ S.runStateT (parseL parser) p0 - case x of - Left e -> return (Left (e, p1)) - Right a -> yield a >> go p1 + x <- lift (nextSkipEmpty p0) + case x of + Left r -> return (Right r) + Right (a,p1) -> step (yield a >>) (_parse parser a) p1 (_length a) + step diffP res p0 !len = case res of + Fail _ c m -> return (Left (ParsingError c m, diffP p0)) + Done a b -> yield (len - _length a, b) >> go (yield a >> p0) + Partial k -> do + x <- lift (nextSkipEmpty p0) + case x of + Left e -> step diffP (k mempty) (return e) len + Right (a,p1) -> step (diffP . (yield a >>)) (k a) p1 (len + _length a) {-# INLINABLE parsedL #-} -------------------------------------------------------------------------------- @@ -129,11 +159,11 @@ -- | Like 'Pipes.Parse.isEndOfInput', except that it also consumes and discards -- leading empty chunks. isEndOfParserInput :: (Monad m, ParserInput a) => Pipes.Parser a m Bool -isEndOfParserInput = do - mr <- atEndOfParserInput - return (case mr of - Nothing -> False - Just _ -> True) +isEndOfParserInput = S.StateT $ \p0 -> do + x <- nextSkipEmpty p0 + case x of + Left r -> return (True, return r) + Right (a, p1) -> return (False, yield a >> p1) {-# INLINABLE isEndOfParserInput #-} -------------------------------------------------------------------------------- @@ -166,25 +196,22 @@ } deriving (Show, Read, Eq, Data, Typeable) instance Exception ParsingError -instance Error ParsingError --- | This instance allows using 'Pipes.Lift.errorP' with 'parsed' and 'parsedL' -instance Error (ParsingError, Producer a m r) - -------------------------------------------------------------------------------- -- Internal stuff --- | Returns @'Just' r@ if the producer has reached end of input, otherwise --- 'Nothing'. -atEndOfParserInput - :: (Monad m, ParserInput a) => S.StateT (Producer a m r) m (Maybe r) -atEndOfParserInput = go =<< S.get where +-- | Like 'Pipes.next', except it skips leading 'mempty' chunks. +nextSkipEmpty + :: (Monad m, Eq a, Monoid a) + => Producer a m r + -> m (Either r (a, Producer a m r)) +nextSkipEmpty = go where go p0 = do - x <- lift (next p0) + x <- next p0 case x of - Left r -> S.put (return r) >> return (Just r) + Left _ -> return x Right (a,p1) | a == mempty -> go p1 - | otherwise -> S.put (yield a >> p1) >> return Nothing -{-# INLINABLE atEndOfParserInput #-} + | otherwise -> return x +{-# INLINABLE nextSkipEmpty #-}