pipes-attoparsec 0.3.1 → 0.4.0
raw patch · 9 files changed
+256/−276 lines, 9 filesdep +tastydep +tasty-hunitdep −QuickCheckdep −test-frameworkdep −test-framework-hunitdep ~HUnitdep ~basedep ~bytestring
Dependencies added: tasty, tasty-hunit
Dependencies removed: QuickCheck, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: HUnit, base, bytestring, pipes, pipes-parse, text, transformers
Files
- LICENSE +1/−1
- NEWS +0/−20
- PEOPLE +1/−0
- changelog +25/−0
- pipes-attoparsec.cabal +14/−19
- src/Pipes/Attoparsec.hs +170/−78
- src/Pipes/Attoparsec/Internal.hs +0/−114
- tests/Main.hs +7/−14
- tests/Test/Attoparsec.hs +38/−30
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012-2013, Renzo Carbonara+Copyright (c) 2012-2014, Renzo Carbonara Copyright (c) 2012, Paolo Capriotti All rights reserved.
− NEWS
@@ -1,20 +0,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.
PEOPLE view
@@ -6,3 +6,4 @@ Renzo Carbonara Gabriel Gonzalez Patrick Wheeler+Danny Navarro
+ changelog view
@@ -0,0 +1,25 @@+# 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.
pipes-attoparsec.cabal view
@@ -1,23 +1,22 @@ name: pipes-attoparsec-version: 0.3.1+version: 0.4.0 license: BSD3 license-file: LICENSE-copyright: Copyright (c) Renzo Carbonara 2012-2013, Paolo Capriotti 2012+copyright: Copyright (c) Renzo Carbonara 2012-2014, Paolo Capriotti 2012 author: Renzo Carbonara maintainer: renzocarbonaraλgmail.com stability: Experimental-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 build-type: Simple cabal-version: >=1.8 synopsis: Attoparsec and Pipes integration.-extra-source-files: README.md PEOPLE NEWS+extra-source-files: README.md PEOPLE changelog description: Utilities to run Attoparsec parsers on Pipes input streams. .- See the @NEWS@ file in the source distribution to learn about any+ See the @changelog@ file in the source distribution to learn about any important changes between version. source-repository head@@ -27,15 +26,14 @@ library hs-source-dirs: src exposed-modules: Pipes.Attoparsec- , Pipes.Attoparsec.Internal build-depends:- base (==4.*)- , attoparsec (>=0.10 && <0.12)- , bytestring (>=0.9.2.1)- , pipes (>=4.0 && <4.1)- , pipes-parse (>=2.0 && <2.1)- , text (>=0.11.2.3)- , transformers (>=0.2 && <=0.4)+ 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.3 && <1.1)+ , transformers (>=0.2 && <0.4) ghc-options: -Wall -O2 test-suite tests@@ -54,9 +52,6 @@ , pipes-parse , text , transformers- , QuickCheck (== 2.*)- , HUnit (== 1.*)- , test-framework (>= 0.6)- , test-framework-quickcheck2 (>= 0.2)- , test-framework-hunit (>= 0.2)-+ , HUnit >= 1.2+ , tasty >= 0.7+ , tasty-hunit >= 0.4
src/Pipes/Attoparsec.hs view
@@ -1,98 +1,190 @@-{-# 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.+-- | @pipes@ utilities for incrementally running @attoparsec@-based parsers. ----- This module builds on top of the @attoparsec@, @pipes@ and @pipes-parse@--- libraries and assumes you understand how to use those.+-- This module assumes familiarity with @pipes-parse@, you can learn about it in+-- "Pipes.Parse.Tutorial". -module Pipes.Attoparsec- ( -- * Parsing- parse- , parseMany- , isEndOfParserInput- -- * Types- , I.ParserInput- , I.ParsingError(..)- ) where+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-} ---------------------------------------------------------------------------------+module Pipes.Attoparsec (+ -- * Parsing+ parse+ , parsed + -- ** Including input lenght+ --+ -- $lengths+ , parseL+ , parsedL++ -- * Utils+ , isEndOfParserInput++ -- * Types+ , ParserInput+ , ParsingError(..)+ ) 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+import Data.Attoparsec.Types (IResult (..))+import qualified Data.Attoparsec.Types as Attoparsec+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 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))+import qualified Pipes.Parse as Pipes (Parser)+import qualified Pipes.Prelude as P -------------------------------------------------------------------------------- --- | 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.+-- | Convert an @attoparsec@ 'Attoparsec.Parser' to a @pipes-parse@+-- 'Pipes.Parser'. ----- Use this function only if 'isEndOfParserInput' returns 'False', otherwise--- you'll get unexpected parsing errors.+-- This 'Pipes.Parser' is compatible with the tools from "Pipes.Parse". 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+ :: (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) {-# 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.++-- | Convert a producer of 'ParserInput' to a producer of parsed values. ----- 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+-- This producer returns 'Right' when end-of-input is reached sucessfully,+-- 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'+-- monad transformer.+parsed+ :: (Monad m, ParserInput a)+ => 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)+{-# INLINABLE parsed #-}++--------------------------------------------------------------------------------+-- $lengths+-- Like the functions above, but these also provide information about+-- the length of input consumed in order to fully parse each value.+--------------------------------------------------------------------------------++-- | Like 'parse', but also returns the length of input consumed to parse the+-- value.+parseL+ :: (Monad m, ParserInput a)+ => Attoparsec.Parser a b -- ^ Attoparsec parser+ -> Pipes.Parser a m (Either ParsingError (Int, b)) -- ^ Pipes parser+parseL parser = S.StateT $ \p0 -> do+ x <- next (p0 >-> P.filter (/= mempty))+ 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 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+ 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)+ Partial k -> do+ x <- next 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+{-# INLINABLE parseL #-} ++-- | Like 'parsed', except this tags each parsed value with the length of input+-- consumed to parse the value.+parsedL+ :: (Monad m, ParserInput a)+ => 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+ 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+{-# INLINABLE parsedL #-}+ -------------------------------------------------------------------------------- --- | 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+-- | 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- ma <- Pp.draw- case ma of- Left _ -> return True- Right a- | a == mempty -> isEndOfParserInput- | otherwise -> Pp.unDraw a >> return False+ mr <- atEndOfParserInput+ return (case mr of+ Nothing -> False+ Just _ -> True) {-# INLINABLE isEndOfParserInput #-}++--------------------------------------------------------------------------------++-- | A class for valid @attoparsec@ input types+class (Eq a, Monoid a) => ParserInput a where+ _parse :: Attoparsec.Parser a b -> a -> IResult a b+ _length :: a -> Int++-- | Strict 'ByteString'.+instance ParserInput ByteString where+ _parse = Data.Attoparsec.ByteString.parse+ {-# INLINE _parse #-}+ _length = Data.ByteString.length+ {-# INLINE _length #-}++-- | Strict 'Text'.+instance ParserInput Text where+ _parse = Data.Attoparsec.Text.parse+ {-# INLINE _parse #-}+ _length = Data.Text.length+ {-# INLINE _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++-- | 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+ go p0 = do+ x <- lift (next p0)+ case x of+ Left r -> S.put (return r) >> return (Just r)+ Right (a,p1)+ | a == mempty -> go p1+ | otherwise -> S.put (yield a >> p1) >> return Nothing+{-# INLINABLE atEndOfParserInput #-}
− src/Pipes/Attoparsec/Internal.hs
@@ -1,114 +0,0 @@-{-# 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- , parseWithRaw- ) 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 #-}
tests/Main.hs view
@@ -1,19 +1,12 @@ module Main (main) where -import Test.Framework (defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit- import qualified Test.Attoparsec--main = defaultMain tests+import qualified Test.Tasty as Tasty -tests =- [ testGroup "Sample." sampleTests- , testGroup "Attoparsec." Test.Attoparsec.tests- ]+main :: IO ()+main = Tasty.defaultMain tests -sampleTests = [ testProperty "QuickCheck" $ \x -> const True (x :: Int) == True- , testCase "HUnit" $ True @?= True- ]+tests :: Tasty.TestTree+tests = Tasty.testGroup "root"+ [ Tasty.testGroup "Attoparsec." Test.Attoparsec.tests+ ]
tests/Test/Attoparsec.hs view
@@ -1,20 +1,18 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoMonomorphismRestriction #-} module Test.Attoparsec (tests) where -import Control.Monad-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)+import Control.Monad (replicateM_)+import Control.Monad.Trans.Writer.Strict (runWriterT, tell)+import qualified Data.Attoparsec.Text as AT+import Data.Functor.Identity (runIdentity)+import Data.Text (Text)+import Pipes (each, for, lift, runEffect)+import Pipes.Attoparsec (parsed)+import Pipes.Prelude (toListM)+import Test.HUnit (Assertion, assert)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase) -- | Parses a 'Char' repeated four times. four :: AT.Parser Char@@ -23,20 +21,22 @@ replicateM_ 3 $ AT.char c return c -type ParseTest = (Bool, String, [T.Text], [Char], [T.Text])-+type ParseTest = (Bool, String, [Text], [Char], [Text]) assertFoursTest :: ParseTest -> Assertion-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- okRes = res == output- return $ okMlo && okErr && okRes+assertFoursTest (ok, _title, input, output, mlo) =+ assert $ res == output+ && isRight e == ok+ && mlo' == mlo+ where+ (e, res) = runIdentity . runWriterT . runEffect+ $ for (parsed four $ each input)+ (\c -> lift $ tell [c])+ mlo' = case e of+ Right _ -> []+ Left (_,pmlo') -> fst . runIdentity+ . runWriterT+ $ toListM pmlo' foursTests :: [ParseTest] foursTests =@@ -46,9 +46,9 @@ , (True ,"1 chunk: One twice" ,["aaaaaaaa"] ,['a','a'] ,[]) , (True ,"1 chunk: Two" ,["aaaabbbb"] ,['a','b'] ,[]) , (True ,"1 chunk: Two between null" ,["aaaa","","bbbb"] ,['a','b'] ,[])- , (False ,"1 chunk: Partial" ,["aaaab"] ,['a'] ,[])- , (False ,"1 chunk: Wrong" ,["aaxbb"] ,[] ,["xbb"])- , (False ,"1 chunk: One then wrong" ,["aaaavz"] ,['a'] ,["z"])+ , (False ,"1 chunk: Partial" ,["aaaab"] ,['a'] ,["b"])+ , (False ,"1 chunk: Wrong" ,["aaxbb"] ,[] ,["aaxbb"])+ , (False ,"1 chunk: One then wrong" ,["aaaavz"] ,['a'] ,["vz"]) , (True ,"2 chunk: Empty" ,["",""] ,[] ,[]) , (True ,"2 chunk: Empty then one" ,["","aaaa"] ,['a'] ,[]) , (True ,"2 chunk: One" ,["a","aaa"] ,['a'] ,[])@@ -56,12 +56,20 @@ , (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","efgh"])- , (False ,"2 chunk: One then wrong" ,["aaaab","bxz"] ,['a'] ,["xz"])+ , (False ,"2 chunk: Wrong" ,["abcd","efgh"] ,[] ,["abcd","efgh"])+ , (False ,"2 chunk: Wrong'" ,["a","axbb"] ,[] ,["a","axbb"])+ , (False ,"2 chunk: One then wrong" ,["aaaab","bxz"] ,['a'] ,["b","bxz"]) , (True ,"3 chunk: One" ,["a","a","aa"] ,['a'] ,[])+ , (False ,"3 chunk: Wrong" ,["a","a","axbb"] ,[] ,["a","a","axbb"]) ] +testCaseFoursTest :: (Bool, [Char], [Text], [Char], [Text]) -> TestTree testCaseFoursTest ft@(_,name,_,_,_) = testCase ("Fours." ++ name) $ assertFoursTest ft +tests :: [TestTree] tests = map testCaseFoursTest foursTests++isRight :: Either a b -> Bool+isRight (Right _) = True+isRight _ = False