pipes-attoparsec-0.5.1.5/0000755000000000000000000000000013057556727013352 5ustar0000000000000000pipes-attoparsec-0.5.1.5/Setup.hs0000644000000000000000000000005613057556727015007 0ustar0000000000000000import Distribution.Simple main = defaultMain pipes-attoparsec-0.5.1.5/LICENSE0000644000000000000000000000304113057556727014355 0ustar0000000000000000Copyright (c) 2012-2017, Renzo Carbonara Copyright (c) 2012, Paolo Capriotti 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. * 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. * Neither the name of Renzo Carbonara nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. 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. pipes-attoparsec-0.5.1.5/README.md0000644000000000000000000000076213057556727014636 0ustar0000000000000000# 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. This code is licensed under the terms of the so called **3-clause BSD license**. Read the file named ``LICENSE`` found in this same directory for details. See the ``PEOPLE`` file to learn about the people involved in this effort. pipes-attoparsec-0.5.1.5/pipes-attoparsec.cabal0000644000000000000000000000326013057556727017622 0ustar0000000000000000name: pipes-attoparsec version: 0.5.1.5 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2012-2017, Paolo Capriotti 2012 author: Renzo Carbonara maintainer: renzocarbonaraλgmail.com stability: Experimental 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 changelog.md description: Utilities to run Attoparsec parsers on Pipes input streams. . See the @changelog.md@ file in the source distribution to learn about any important changes between version. source-repository head type: git location: git://github.com/k0001/pipes-attoparsec.git library hs-source-dirs: src exposed-modules: Pipes.Attoparsec build-depends: base (>=4.5 && <5.0) , 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 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs other-modules: Test.Attoparsec ghc-options: -Wall -rtsopts -fno-warn-missing-signatures build-depends: base , attoparsec , mmorph , pipes , pipes-attoparsec , pipes-parse , text , transformers , HUnit >= 1.2 , tasty >= 0.7 , tasty-hunit >= 0.4 pipes-attoparsec-0.5.1.5/changelog.md0000644000000000000000000000213013057556727015617 0ustar0000000000000000# 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. pipes-attoparsec-0.5.1.5/PEOPLE0000644000000000000000000000047013057556727014262 0ustar0000000000000000The following people have participated in creating this library, either by directly contributing code, or by providing resources or thoughtful input in discussions about the library design, or somehow else. In order of appareance. Renzo Carbonara Gabriel Gonzalez Patrick Wheeler Danny Navarro Michael Thompson pipes-attoparsec-0.5.1.5/tests/0000755000000000000000000000000013057556727014514 5ustar0000000000000000pipes-attoparsec-0.5.1.5/tests/Main.hs0000644000000000000000000000041213057556727015731 0ustar0000000000000000module Main (main) where import qualified Test.Attoparsec import qualified Test.Tasty as Tasty main :: IO () main = Tasty.defaultMain tests tests :: Tasty.TestTree tests = Tasty.testGroup "root" [ Tasty.testGroup "Attoparsec." Test.Attoparsec.tests ] pipes-attoparsec-0.5.1.5/tests/Test/0000755000000000000000000000000013057556727015433 5ustar0000000000000000pipes-attoparsec-0.5.1.5/tests/Test/Attoparsec.hs0000644000000000000000000000667013057556727020105 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Test.Attoparsec (tests) where 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 four = do c <- AT.anyChar replicateM_ 3 $ AT.char c return c type ParseTest = (Bool, String, [Text], [Char], [Text]) assertFoursTest :: ParseTest -> Assertion 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 = [ (True ,"0 chunk" ,[] ,[] ,[]) , (True ,"1 chunk: Empty" ,[] ,[] ,[]) , (True ,"1 chunk: One" ,["aaaa"] ,['a'] ,[]) , (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'] ,["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'] ,[]) , (True ,"2 chunk: One'" ,["aa","aa"] ,['a'] ,[]) , (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"] ,[] ,["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 pipes-attoparsec-0.5.1.5/src/0000755000000000000000000000000013057556727014141 5ustar0000000000000000pipes-attoparsec-0.5.1.5/src/Pipes/0000755000000000000000000000000013057556727015221 5ustar0000000000000000pipes-attoparsec-0.5.1.5/src/Pipes/Attoparsec.hs0000644000000000000000000001771113057556727017671 0ustar0000000000000000-- | @pipes@ utilities for incrementally running @attoparsec@-based parsers. -- -- This module assumes familiarity with @pipes-parse@, you can learn about it in -- "Pipes.Parse.Tutorial". {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} module Pipes.Attoparsec ( -- * Parsing parse , parsed -- ** Including input length -- -- $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 Pipes (Parser) -------------------------------------------------------------------------------- -- | Convert an @attoparsec@ 'Attoparsec.Parser' to a @pipes-parse@ -- '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 (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, -- 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 = 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 #-} -------------------------------------------------------------------------------- -- $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 (Maybe (Either ParsingError (Int, b))) -- ^ Pipes parser parseL 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 (_length a) where 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 <- 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 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 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 #-} -------------------------------------------------------------------------------- -- | 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 = 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 #-} -------------------------------------------------------------------------------- -- | 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 -- | 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 <- next p0 case x of Left _ -> return x Right (a,p1) | a == mempty -> go p1 | otherwise -> return x {-# INLINABLE nextSkipEmpty #-}