diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,7 +1,14 @@ +# 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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # pipes-attoparsec +[![Build Status](https://secure.travis-ci.org/k0001/pipes-attoparsec.png)](http://travis-ci.org/k0001/pipes-attoparsec) + Utilities to run **Attoparsec** parser on **Pipes** input streams. Check the source or rendered Haddocks for documentation. diff --git a/pipes-attoparsec.cabal b/pipes-attoparsec.cabal --- a/pipes-attoparsec.cabal +++ b/pipes-attoparsec.cabal @@ -1,12 +1,12 @@ name: pipes-attoparsec -version: 0.2.0.0 +version: 0.3.0 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2012-2013, Paolo Capriotti 2012 author: Renzo Carbonara maintainer: renzocarbonaraλgmail.com stability: Experimental -tested-with: GHC ==7.4.1 +tested-with: GHC ==7.6.3 homepage: https://github.com/k0001/pipes-attoparsec bug-reports: https://github.com/k0001/pipes-attoparsec/issues category: Pipes, Parser @@ -15,7 +15,7 @@ synopsis: Attoparsec and Pipes integration. extra-source-files: README.md PEOPLE NEWS description: - Utilities to run @attoparsec@ parsers on @pipes@ input streams. + Utilities to run Attoparsec parsers on Pipes input streams. . See the @NEWS@ file in the source distribution to learn about any important changes between version. @@ -26,15 +26,15 @@ library hs-source-dirs: src - exposed-modules: Control.Proxy.Attoparsec - Control.Proxy.Attoparsec.Internal + exposed-modules: Pipes.Attoparsec + other-modules: Pipes.Attoparsec.Internal build-depends: base (==4.*) - , pipes (>=3.3 && <3.4) - , pipes-parse (>=1.0 && <1.1) , attoparsec (>=0.10 && <0.11) , bytestring (>=0.9.2.1) - , text + , pipes (>=4.0 && <4.1) + , pipes-parse (>=2.0 && <2.1) + , text (>=0.11.2.3) , transformers (>=0.2 && <=0.4) ghc-options: -Wall -O2 @@ -47,12 +47,13 @@ build-depends: base + , attoparsec , mmorph , pipes - , attoparsec - , text , pipes-attoparsec , pipes-parse + , text + , transformers , QuickCheck (== 2.*) , HUnit (== 1.*) , test-framework (>= 0.6) diff --git a/src/Control/Proxy/Attoparsec.hs b/src/Control/Proxy/Attoparsec.hs deleted file mode 100644 --- a/src/Control/Proxy/Attoparsec.hs +++ /dev/null @@ -1,117 +0,0 @@ --- | This module allows you to run Attoparsec parsers on input flowing --- downstream through Pipes streams, possibly interleaving other stream --- effects. --- --- This module builds on top of the @pipes-parse@ package and assumes --- you have read "Control.Proxy.Parse.Tutorial". - -module Control.Proxy.Attoparsec - ( -- * Parsing - -- $parsing - parse - , parseD - , isEndOfParserInput - -- * Types - , I.ParserInput(I.null) - , I.ParsingError(..) - ) where - --------------------------------------------------------------------------------- - -import Control.Monad (unless) -import qualified Control.Proxy as P -import qualified Control.Proxy.Parse as Pa -import qualified Control.Proxy.Attoparsec.Internal as I -import qualified Control.Proxy.Trans.Either as P -import qualified Control.Proxy.Trans.State as P -import Data.Attoparsec.Types (Parser) -import Data.Foldable (mapM_) -import Data.Function (fix) -import Prelude hiding (mapM_) - --------------------------------------------------------------------------------- --- $parsing --- --- There are two basic parsing facilities exported by this module, and choosing --- between them is easy: If you need to interleave Attoparsec parsing with other --- stream effects you must use 'parse', otherwise you may use the simpler --- 'parseD'. --- --- These proxies use the 'P.EitherP' proxy transformer to report parsing errors, --- you might use any of the facilities exported by "Control.Proxy.Trans.Either" --- to recover from them. - - --- | Parses one element flowing downstream. --- --- * In case of parsing errors, a 'I.ParsingError' exception is thrown in --- the 'Pe.EitherP' proxy transformer. --- --- * Requests more input from upstream using 'Pa.draw' when needed. --- --- * /Do not/ use this proxy if 'isEndOfParserInput' returns 'True', --- otherwise you may get unexpected parsing errors. --- --- Here is an example parsing loop that allows interleaving stream effects --- together with 'parse': --- --- > loop = do --- > eof <- liftP isEndOfParserInput --- > unless eof $ do --- > -- 1. Possibly perform some stream effects here. --- > -- 2. Parse one element from the stream. --- > exampleElement <- parse myExampleParser --- > -- 3. Do something with exampleElement and possibly perform --- > -- some more stream effects. --- > -- 4. Start all over again. --- > loop -parse - :: (I.ParserInput a, Monad m, P.Proxy p) - => Parser a r -- ^Attoparsec parser to run on the input stream. - -> P.EitherP I.ParsingError (P.StateP [a] p) () (Maybe a) y' y m r - -- ^Proxy compatible with the facilities provided by "Control.Proxy.Parse". -parse parser = do - (er, mlo) <- P.liftP (I.parseWithMay Pa.draw parser) - P.liftP (mapM_ Pa.unDraw mlo) - either P.throw return er -{-# INLINABLE parse #-} - - --- | Parses consecutive elements flowing downstream until end of input. --- --- * In case of parsing errors, a 'I.ParsingError' exception is thrown in the --- 'Pe.EitherP' proxy transformer. --- --- * Requests more input from upstream using 'Pa.draw' when needed. --- --- * Empty input chunks flowing downstream will be discarded. -parseD - :: (I.ParserInput a, Monad m, P.Proxy p) - => Parser a b -- ^Attoparsec parser to run on the input stream. - -> () -> P.Pipe (P.EitherP I.ParsingError (P.StateP [a] p)) (Maybe a) b m () - -- ^Proxy compatible with the facilities provided by "Control.Proxy.Parse". -parseD parser = \() -> loop - where - loop = do - eof <- P.liftP isEndOfParserInput - unless eof $ do - () <- P.respond =<< parse parser - loop -{-# INLINABLE parseD #-} - --------------------------------------------------------------------------------- - --- | Like 'Pa.isEndOfInput', except it also consumes and discards leading --- empty 'I.ParserInput' chunks. -isEndOfParserInput - :: (I.ParserInput a, Monad m, P.Proxy p) - => P.StateP [a] p () (Maybe a) y' y m Bool -isEndOfParserInput = fix $ \loop -> do - ma <- Pa.draw - case ma of - Just a - | I.null a -> loop - | otherwise -> Pa.unDraw a >> return False - Nothing -> return True -{-# INLINABLE isEndOfParserInput #-} - diff --git a/src/Control/Proxy/Attoparsec/Internal.hs b/src/Control/Proxy/Attoparsec/Internal.hs deleted file mode 100644 --- a/src/Control/Proxy/Attoparsec/Internal.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# OPTIONS_HADDOCK hide prune #-} - --- | This module provides low-level integration with Attoparsec and is likely --- to be modified in backwards-incompatible ways in the future. --- --- Use the stable API exported by the "Control.Proxy.Attoparsec" module instead. - -module Control.Proxy.Attoparsec.Internal - ( -- * Types - ParsingError(..) - , ParserInput(..) - -- * Parsing - , parseWith - , parseWithMay - -- * Utils - , mayInput - ) where - --------------------------------------------------------------------------------- - -import Control.Exception (Exception) -import Data.Attoparsec.Types (Parser, IResult(..)) -import qualified Data.Attoparsec.ByteString as AB -import qualified Data.Attoparsec.Text as AT -import qualified Data.ByteString.Char8 as B -import Data.Data (Data, Typeable) -import Data.Monoid (Monoid(mempty)) -import qualified Data.Text as T -import Prelude hiding (null) - --------------------------------------------------------------------------------- - --- | A parsing error report, as provided by Attoparsec's 'Fail'. -data ParsingError = ParsingError - { peContexts :: [String] -- ^ Contexts where the parsing error occurred. - , peMessage :: String -- ^ Parsing error description message. - } deriving (Show, Eq, Data, Typeable) - -instance Exception ParsingError where - --------------------------------------------------------------------------------- - --- | A class for valid Attoparsec input types: strict 'T.Text' and --- strict 'B.ByteString'. -class (Monoid a) => ParserInput a where - -- | Run a 'Parser' with input @a@. - parse :: Parser a b -> a -> IResult a b - -- | Tests whether @a@ is empty. - null :: a -> Bool - -instance ParserInput B.ByteString where - parse = AB.parse - null = B.null - -instance ParserInput T.Text where - parse = AT.parse - null = T.null - --------------------------------------------------------------------------------- - --- | Run a parser drawing input from the given monadic action as needed. -parseWith - :: (Monad m, ParserInput a) - => m a - -- ^An action that will be executed to provide the parser with more input - -- as needed. If the action returns 'mempty', then it's assumed no more - -- input is available. - -> Parser a r - -- ^Parser to run on the given input - -> m (Either ParsingError r, Maybe a) - -- ^Either a parser error or a parsed result, together with any leftover. -parseWith refill p = step . parse p =<< refill where - step (Partial k) = step . k =<< refill - step (Done t r) = return (Right r, mayInput t) - step (Fail t c m) = return (Left (ParsingError c m), mayInput t) -{-# INLINABLE parseWith #-} - - --- | Run a parser drawing input from the given monadic action as needed. -parseWithMay - :: (Monad m, ParserInput a) - => m (Maybe a) - -- ^An action that will be executed to provide the parser with more input - -- as needed. If the action returns 'Nothing', then it's assumed no more - -- input is available. @'Just' 'mempty'@ input is discarded. - -> Parser a r - -- ^Parser to run on the given input - -> m (Either ParsingError r, Maybe a) - -- ^Either a parser error or a parsed result, together with any leftover. -parseWithMay refill p = parseWith loop p - where - loop = do - ma <- refill - case ma of - Just a - | null a -> loop -- retry on null input - | otherwise -> return a - Nothing -> return mempty -{-# INLINABLE parseWithMay #-} - - --- | Wrap @a@ in 'Just' if not-null. Otherwise, 'Nothing'. -mayInput :: ParserInput a => a -> Maybe a -mayInput = \x -> if null x then Nothing else Just x -{-# INLINABLE mayInput #-} - - diff --git a/src/Pipes/Attoparsec.hs b/src/Pipes/Attoparsec.hs new file mode 100644 --- /dev/null +++ b/src/Pipes/Attoparsec.hs @@ -0,0 +1,98 @@ +{-# Language RankNTypes #-} + +-- | The utilities in this module allow you to run Attoparsec parsers on input +-- flowing downstream through pipes, possibly interleaving other stream effects +-- while doing so. +-- +-- This module builds on top of the @attoparsec@, @pipes@ and @pipes-parse@ +-- libraries and assumes you understand how to use those. + +module Pipes.Attoparsec + ( -- * Parsing + parse + , parseMany + , isEndOfParserInput + -- * Types + , I.ParserInput + , I.ParsingError(..) + ) where + +-------------------------------------------------------------------------------- + +import Pipes +import qualified Pipes.Parse as Pp +import qualified Pipes.Lift as P +import qualified Pipes.Attoparsec.Internal as I +import qualified Control.Monad.Trans.State.Strict as S +import Data.Attoparsec.Types (Parser) +import Data.Monoid (Monoid(mempty)) + +-------------------------------------------------------------------------------- + +-- | Run an Attoparsec 'Parser' on input from the underlying 'Producer', +-- returning either a 'I.ParsingError' on failure, or a pair with the parsed +-- entity together with the length of input consumed in order to produce it. +-- +-- Use this function only if 'isEndOfParserInput' returns 'False', otherwise +-- you'll get unexpected parsing errors. +parse + :: (Monad m, I.ParserInput a) + => Parser a b -- ^Attoparsec parser. + -> S.StateT (Producer a m r) m (Either I.ParsingError (Int, b)) +parse attoparser = do + (eb, mlo) <- I.parseWithDraw attoparser + case mlo of + Just lo -> Pp.unDraw lo + Nothing -> return () + return eb +{-# INLINABLE parse #-} + +-- | Continuously run an Attoparsec 'Parser' on input from the given 'Producer', +-- sending downstream pairs of each successfully parsed entity together with the +-- length of input consumed in order to produce it. +-- +-- This 'Producer' runs until it either runs out of input or a parsing +-- failure occurs, in which case it returns 'Left' with a 'I.ParsingError' and a +-- 'Producer' with any leftovers. You can use 'P.errorP' to turn the 'Either' +-- return value into an 'Control.Monad.Trans.Error.ErrorT' monad transformer. +parseMany + :: (Monad m, I.ParserInput a) + => Parser a b -- ^Attoparsec parser. + -> Producer a m r -- ^Producer from which to draw input. + -> Producer' (Int, b) m (Either (I.ParsingError, Producer a m r) r) +parseMany attoparser src = do + (me, src') <- P.runStateP src go + return $ case me of + Left e -> Left (e, src') + Right r -> Right r + where + go = do + eof <- lift isEndOfParserInput + if eof + then do + ra <- lift Pp.draw + case ra of + Left r -> return (Right r) + Right _ -> error "Pipes.Attoparsec.parseMany: impossible!!" + else do + eb <- lift (parse attoparser) + case eb of + Left e -> return (Left e) + Right b -> yield b >> go + +-------------------------------------------------------------------------------- + +-- | Like 'P.isEndOfInput', except it also consumes and discards leading +-- empty 'I.ParserInput' chunks. +isEndOfParserInput + :: (I.ParserInput a, Monad m) + => S.StateT (Producer a m r) m Bool +isEndOfParserInput = do + ma <- Pp.draw + case ma of + Left _ -> return True + Right a + | a == mempty -> isEndOfParserInput + | otherwise -> Pp.unDraw a >> return False +{-# INLINABLE isEndOfParserInput #-} + diff --git a/src/Pipes/Attoparsec/Internal.hs b/src/Pipes/Attoparsec/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Pipes/Attoparsec/Internal.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | This module provides low-level integration with Attoparsec and is likely +-- to be modified in backwards-incompatible ways in the future. +-- +-- Use the stable API exported by the "Pipes.Attoparsec" module instead. + +module Pipes.Attoparsec.Internal + ( -- * Types + ParsingError(..) + , ParserInput + -- * Parsing + , parseWithDraw + ) where + +-------------------------------------------------------------------------------- + +import Control.Exception (Exception) +import Control.Monad.Trans.Error (Error) +import Data.Attoparsec.Types (Parser, IResult(..)) +import qualified Data.Attoparsec.ByteString as AB +import qualified Data.Attoparsec.Text as AT +import qualified Data.ByteString.Char8 as B +import Data.Data (Data, Typeable) +import Data.Monoid (Monoid(mempty)) +import qualified Data.Text as T +import Pipes (Producer) +import qualified Pipes.Parse as Pp +import Prelude hiding (null, length) + +-------------------------------------------------------------------------------- + +-- | A parsing error report, as provided by Attoparsec's 'Fail'. +data ParsingError = ParsingError + { peContexts :: [String] -- ^ Contexts where the parsing error occurred. + , peMessage :: String -- ^ Parsing error description message. + } deriving (Show, Read, Eq, Data, Typeable) + +instance Exception ParsingError +instance Error ParsingError + +-------------------------------------------------------------------------------- + +instance (Monad m, ParserInput a) => Error (ParsingError, Producer a m r) + +-------------------------------------------------------------------------------- + +-- | A class for valid Attoparsec input types: strict 'T.Text' and +-- strict 'B.ByteString'. +class (Eq a, Monoid a) => ParserInput a where + -- | Run a 'Parser' with input @a@. + parse :: Parser a b -> a -> IResult a b + -- | Length of @a@. + length :: a -> Int + +instance ParserInput B.ByteString where + parse = AB.parse + length = B.length + +instance ParserInput T.Text where + parse = AT.parse + length = T.length + +-------------------------------------------------------------------------------- + +-- | Run a parser drawing input from the given monadic action as needed. +parseWithRaw + :: (Monad m, ParserInput a) + => m a + -- ^An action that will be executed to provide the parser with more input + -- as needed. If the action returns 'mempty', then it's assumed no more + -- input is available. + -> Parser a r + -- ^Parser to run on the given input + -> m (Either ParsingError (Int, r), Maybe a) + -- ^Either a parser error or a pair of a result and the parsed input length, + -- as well as an any leftovers. +parseWithRaw refill p = refill >>= \a -> step (length a) (parse p a) + where + step !len res = case res of + Partial k -> refill >>= \a -> step (len + length a) (k a) + Done t r -> return (Right (len - length t, r), mayInput t) + Fail t c m -> return (Left (ParsingError c m) , mayInput t) +{-# INLINABLE parseWithRaw #-} + +-- | Run a parser drawing input from the underlying 'Producer'. +parseWithDraw + :: (Monad m, ParserInput a) + => Parser a b + -- ^Parser to run on the given input + -> Pp.StateT (Producer a m r) m (Either ParsingError (Int, b), Maybe a) + -- ^Either a parser error or a pair of a result and the parsed input length, + -- as well as an any leftovers. +parseWithDraw = parseWithRaw refill + where + refill = do + ra <- Pp.draw + case ra of + Left _ -> return mempty + Right a + | a == mempty -> refill + | otherwise -> return a +{-# INLINABLE parseWithDraw #-} + +-------------------------------------------------------------------------------- + +-- | Wrap @a@ in 'Just' if not-null. Otherwise, 'Nothing'. +mayInput :: ParserInput a => a -> Maybe a +mayInput x | x == mempty = Nothing + | otherwise = Just x +{-# INLINE mayInput #-} diff --git a/tests/Test/Attoparsec.hs b/tests/Test/Attoparsec.hs --- a/tests/Test/Attoparsec.hs +++ b/tests/Test/Attoparsec.hs @@ -4,18 +4,17 @@ module Test.Attoparsec (tests) where import Control.Monad -import Control.Proxy ((>->)) -import qualified Control.Proxy as P -import qualified Control.Proxy.Trans.State as P -import qualified Control.Proxy.Trans.Either as P -import qualified Control.Proxy.Trans.Writer as P -import qualified Control.Proxy.Parse as Pa -import Control.Proxy.Attoparsec (parseD) -import qualified Data.Attoparsec.Text as AT -import qualified Data.Text as T -import Data.Maybe -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (Assertion, assert) +import Pipes +import qualified Pipes.Lift as P +import qualified Pipes.Prelude as P +import Control.Monad.Trans.Error (runErrorT) +import Control.Monad.Trans.Writer.Strict (runWriterT, tell) +import Pipes.Attoparsec (parseMany) +import qualified Data.Attoparsec.Text as AT +import Data.Functor.Identity (runIdentity) +import qualified Data.Text as T +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assert) -- | Parses a 'Char' repeated four times. four :: AT.Parser Char @@ -28,13 +27,14 @@ assertFoursTest :: ParseTest -> Assertion -assertFoursTest (ok, _title, input, output, mlo) = assert . fromJust $ do - let srcS = (Pa.wrap.) $ P.fromListS input - run = P.runProxy . P.runWriterK . P.runStateK Pa.mempty . P.runEitherK - ((epe,mlo'), res) <- run $ srcS >-> parseD four - >-> P.liftP . P.liftP . P.toListD +assertFoursTest (ok, _title, input, output, mlo) = assert . runIdentity $ do + (e,res) <- runWriterT . runErrorT . P.toListM $ + for (P.errorP $ parseMany four $ each input) + (\a -> lift . lift $ tell [snd a]) + let (okErr,mlo') = case e of + Left (_, pmlo') -> (not ok, P.toList . fmap fst $ P.runWriterP pmlo') + Right _ -> (ok, []) let okMlo = mlo' == mlo - okErr = either (const $ not ok) (const $ ok) epe okRes = res == output return $ okMlo && okErr && okRes @@ -56,7 +56,7 @@ , (True ,"2 chunk: One''" ,["aaa","a"] ,['a'] ,[]) , (True ,"2 chunk: One'''" ,["aaaa",""] ,['a'] ,[]) , (True ,"2 chunk: Two" ,["aaaa","bbbb"] ,['a','b'] ,[]) - , (False ,"2 chunk: Wrong" ,["abcd","efgh"] ,[] ,["bcd"]) + , (False ,"2 chunk: Wrong" ,["abcd","efgh"] ,[] ,["bcd","efgh"]) , (False ,"2 chunk: One then wrong" ,["aaaab","bxz"] ,['a'] ,["xz"]) , (True ,"3 chunk: One" ,["a","a","aa"] ,['a'] ,[]) ]