pipes-attoparsec 0.4.0.1 → 0.5.0
raw patch · 5 files changed
+120/−76 lines, 5 files
Files
- PEOPLE +1/−0
- changelog +0/−30
- changelog.md +40/−0
- pipes-attoparsec.cabal +3/−3
- src/Pipes/Attoparsec.hs +76/−43
PEOPLE view
@@ -7,3 +7,4 @@ Gabriel Gonzalez Patrick Wheeler Danny Navarro+Michael Thompson
− changelog
@@ -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.
+ changelog.md view
@@ -0,0 +1,40 @@+# 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.
pipes-attoparsec.cabal view
@@ -1,5 +1,5 @@ name: pipes-attoparsec-version: 0.4.0.1+version: 0.5.0 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2012-2014, Paolo Capriotti 2012@@ -12,11 +12,11 @@ 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
src/Pipes/Attoparsec.hs view
@@ -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@@ -41,7 +42,6 @@ import qualified Data.Text import Pipes import qualified Pipes.Parse as Pipes (Parser)-import qualified Pipes.Prelude as P -------------------------------------------------------------------------------- @@ -49,15 +49,28 @@ -- '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 #-} @@ -73,7 +86,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 +114,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 +139,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 +161,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 #-} --------------------------------------------------------------------------------@@ -174,17 +206,18 @@ -------------------------------------------------------------------------------- -- 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 #-}