diff --git a/Control/Pipe/Attoparsec.hs b/Control/Pipe/Attoparsec.hs deleted file mode 100644 --- a/Control/Pipe/Attoparsec.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -module Control.Pipe.Attoparsec ( - ParseError(..), - pipeParser, - ) where - -import qualified Control.Exception as E -import Control.Pipe -import Control.Pipe.Combinators -import Control.Pipe.Exception -import Data.Attoparsec.Types -import Data.Maybe -import Data.Monoid -import Data.Typeable - --- | A parse error as returned by Attoparsec. -data ParseError - = ParseError { - errorContexts :: [String], -- ^ Contexts where the error occurred. - errorMessage :: String -- ^ Error message. - } - | DivergentParser -- ^ Returned if a parser does not terminate - -- when its input is exhausted. - deriving (Show, Typeable) - -instance E.Exception ParseError - --- | Convert a parser continuation into a Pipe. --- --- To get a parser continuation from a 'Parser', use the @parse@ function of the --- appropriate Attoparsec module. -pipeParser :: (Monoid a, Monad m) => (a -> IResult a r) -> Pipe a x m (a, Either ParseError r) -pipeParser p = go p - where - go p = do - chunk <- tryAwait - case p (maybe mempty id chunk) of - Fail leftover contexts msg -> - return (leftover, Left $ ParseError contexts msg) - Partial p' -> - if isNothing chunk - then return (mempty, Left DivergentParser) - else go p' - Done leftover result -> - return (leftover, Right result) diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ -Copyright (c)2012, Paolo Capriotti +Copyright (c) 2012-2012, Paolo Capriotti +Copyright (c) 2012-, Renzo Carbonara All rights reserved. @@ -13,7 +14,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Paolo Capriotti nor the names of other + * 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# pipes-attoparsec + +Utilities to convert an Attoparsec Parser into a Pipe. + +Version 0.1.\* is not backwards compatible with previous versions. diff --git a/pipes-attoparsec.cabal b/pipes-attoparsec.cabal --- a/pipes-attoparsec.cabal +++ b/pipes-attoparsec.cabal @@ -1,24 +1,67 @@ -Name: pipes-attoparsec -Version: 0.0.2 -License: BSD3 -License-file: LICENSE -Author: Paolo Capriotti -Maintainer: p.capriotti@gmail.com -Stability: Experimental -Homepage: https://github.com/pcapriotti/pipes-extra -Category: Text -Build-type: Simple -Synopsis: Utilities to convert a parser into a pipe. -Description: Utilities to convert a parser into a pipe. -Cabal-version: >=1.8 +name: pipes-attoparsec +version: 0.1.0.1 +license: BSD3 +license-file: LICENSE +copyright: Copyright (c) Paolo Capriotti 2012-2012, + Renzo Carbonara 2012- +author: Paolo Capriotti, Renzo Carbonara +maintainer: renzocarbonaraλgmail.com +stability: Experimental +tested-with: GHC ==7.4.1, GHC ==7.6.1 +homepage: https://github.com/k0001/pipes-attoparsec +bug-reports: https://github.com/k0001/pipes-attoparsec +category: Pipes, Parser +build-type: Simple +cabal-version: >=1.8 +synopsis: Utilities to convert an Attoparsec parser into a pipe Pipe. +description: + Utilities to convert an Attoparsec 'Data.Attoparsec.Types.Parser' into + a 'Control.Proxy.Synonym.Pipe'. + . + See "Control.Proxy.Attoparsec.Tutorial" for an extensive introduction with + examples. + . + Version 0.1.* is not backwards compatible with previous versions. +extra-source-files: + README.md -Source-Repository head - Type: git - Location: https://github.com/pcapriotti/pipes-extra +source-repository head + type: git + location: git://github.com/k0001/pipes-attoparsec.git -Library - Exposed-modules: Control.Pipe.Attoparsec - Build-depends: +library + hs-source-dirs: src + exposed-modules: Control.Proxy.Attoparsec + Control.Proxy.Attoparsec.Control + Control.Proxy.Attoparsec.Tutorial + Control.Proxy.Attoparsec.Types + build-depends: + base (==4.*), + pipes (>=3.0), + attoparsec (>=0.10), + bytestring, + text + + ghc-options: + -Wall -fno-warn-missing-signatures + +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Main.hs + other-modules: Test.Attoparsec + Test.Tutorial + ghc-options: + -Wall -rtsopts -fno-warn-missing-signatures + + build-depends: base (== 4.*), - pipes-core (== 0.1.*), - attoparsec (== 0.10.*) + pipes (>= 3.0), + attoparsec (>= 0.10), + text, + pipes-attoparsec, + QuickCheck (== 2.*), + HUnit (== 1.*), + test-framework (>= 0.6), + test-framework-quickcheck2 (>= 0.2), + test-framework-hunit (>= 0.2) diff --git a/src/Control/Proxy/Attoparsec.hs b/src/Control/Proxy/Attoparsec.hs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Attoparsec.hs @@ -0,0 +1,94 @@ +-- | This module provides utilities to turn your Attoparsec @'Parser' a +-- b@ into a 'Pipe' that parses @a@ values into @b@ values as they flow +-- downstream. +-- +-- See "Control.Proxy.Attoparsec.Tutorial" for an extensive introduction +-- with examples. + +module Control.Proxy.Attoparsec + ( -- * Parsing Pipe + -- $pieces + parserInputD + , parserD + -- * Modules + , module Control.Proxy.Attoparsec.Types + , module Control.Proxy.Attoparsec.Control + ) where + +import Control.Proxy +import Control.Proxy.Attoparsec.Control +import Control.Proxy.Attoparsec.Types +import Data.Attoparsec.Types (IResult (..), Parser) +import Prelude hiding (length, null) + + +-- $pieces +-- +-- A 'Pipe' that parses @a@ input flowing downstream into @b@ values is +-- made of at least two smaller cooperating 'Proxy's: +-- +-- 1. 'parserInputD': Prepares @a@ input received from upstream to be +-- consumed by a downstream parsing 'Proxy'. +-- +-- 2. 'parserD': Repeatedly runs a given @'Parser' a b@ on input 'a' +-- from upstream, and sends 'b' values downstream. +-- +-- Given a @'Parser' a b@ named @myParser@, the simplest way to use +-- these 'Proxy's together is: +-- +-- > myParsingPipe :: (Proxy p, Monad m, AttoparsecInput a) => Pipe a b m r +-- > myParsingPipe = parserInputD >-> parserD myParser +-- +-- In between these two 'Proxy's, you can place other 'Proxy's to handle +-- extraordinary situations like parsing failures or limiting input +-- length. "Control.Proxy.Attoparsec.Control" exports some useful +-- 'Proxy's that fit this place. If you skip using any of those, the +-- default behavior is that of +-- 'Control.Proxy.Attoparsec.Control.skipMalformedChunks': to simply +-- ignore all parsing errors and malformed input, and start parsing new +-- input as soon as it's available. + + + +-- | 'Proxy' turning 'a' values flowing downstream into +-- @'ParserSupply' a@ values to be consumed by a downstream parsing +-- 'Proxy'. +-- +-- This 'Proxy' responds with @'Resume' a@ to any 'ParserStatus' value +-- received from downstream. +parserInputD :: (Monad m, Proxy p) + => ParserStatus a -> p () a (ParserStatus a) (ParserSupply a) m r +parserInputD _ = runIdentityP . forever $ request () >>= respond . (,) Resume + + +-- | 'Proxy' using the given @'Parser' a b@ to repeatedly parse pieces +-- of @'ParserSupply' a@ values flowing downstream into @b@ values. +-- +-- When more input is needed, a @'ParserStatus' a@ value reporting the +-- current parsing status is sent upstream, and in exchange a +-- @'ParserSupply' a@ value is expected, containing more input to be +-- parsed and directives on how to use it (see 'ParserSupply' +-- documentation). +parserD :: (Proxy p, Monad m, AttoparsecInput a) + => Parser a b + -> () -> p (ParserStatus a) (ParserSupply a) () b m r +parserD parser () = runIdentityP . forever $ ask k0 0 (Parsing 0) + where + k0 = parse parser + + requestNonEmpty status = go where + go = do + ps@(_, chunk) <- request status + if null chunk then go else return ps + + ask k len status = do + (su, chunk) <- requestNonEmpty status + case su of + Start -> use (k0 chunk) 0 + Resume -> use (k chunk) (len + length chunk) + + use (Partial k) len = ask k len $ Parsing len + use (Fail rest ctx msg) _ = ask k0 0 $ Failed rest (ParserError ctx msg) + use (Done rest result) _ = respond result >> use (k0 rest) 0 + + diff --git a/src/Control/Proxy/Attoparsec/Control.hs b/src/Control/Proxy/Attoparsec/Control.hs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Attoparsec/Control.hs @@ -0,0 +1,80 @@ +-- | This module exports some useful 'Proxy's that act upon +-- 'ParserStatus' values received from downstream. + +module Control.Proxy.Attoparsec.Control + ( skipMalformedChunks + , retryLeftovers + , throwParsingErrors + , limitInputLength + ) where + +import Control.Proxy +import Control.Proxy.Attoparsec.Types +import qualified Control.Proxy.Trans.Either as PE +import Prelude hiding (drop, null) + +-- | If a downstream parsing 'Proxy' reports a parser failure, skip the +-- whole input /chunk/ being processed, including any left-overs, and +-- start processing new input as soon as it's available. +-- +-- Useful when the input found in a single @'ParserSupply' a@ is +-- supposed to be well-formed, so it can be safely skipped if it is not. +skipMalformedChunks + :: (Monad m, Proxy p, AttoparsecInput a) + => ParserStatus a + -> p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r +skipMalformedChunks = runIdentityK . foreverK $ go + where go x@(Failed _ _) = request x >>= \(_,a) -> respond (Start, a) + go x = request x >>= respond + + +-- | If a downstream parsing 'Proxy' reports a parsing failure, then +-- keep retrying with any left-over input, skipping individual bits each +-- time. If there are no left-overs, then more input is requestsd form +-- upstream. +retryLeftovers + :: (Monad m, Proxy p, AttoparsecInput a) + => ParserStatus a + -> p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r +retryLeftovers = runIdentityK . foreverK $ go + where + go s@(Failed _ _) = retry s >>= moreSupply >>= respond + go s = request s >>= respond + + retry s@(Failed rest _) = do + s' <- respond (Start, rest) + if s' == s then return s + else retry s' + retry s = return s + + moreSupply s@(Failed rest _) = do + let rest' = drop 1 rest + if null rest' + then request s + else return (Start, rest') + moreSupply s = request s + + +-- | If a downstream parsing 'Proxy' reports a parser failure, then +-- throw a 'MalformedInput' error in the 'EitherP' proxy transformer. +throwParsingErrors + :: (Monad m, Proxy p, AttoparsecInput a) + => ParserStatus a + -> PE.EitherP BadInput p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r +throwParsingErrors = foreverK go + where go (Failed _ e) = PE.throw $ MalformedInput e + go x = request x >>= respond + + +-- | If a downstream parsing 'Proxy' doesn't produce a value after +-- having consumed input of at least the given length, then throw an +-- 'InputTooLong' error in the 'EitherP' proxy transformer. +limitInputLength + :: (Monad m, Proxy p, AttoparsecInput a) + => Int + -> ParserStatus a + -> PE.EitherP BadInput p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r +limitInputLength n = foreverK go + where go (Parsing m) | m >= n = PE.throw $ InputTooLong m + go x = request x >>= respond + diff --git a/src/Control/Proxy/Attoparsec/Tutorial.lhs b/src/Control/Proxy/Attoparsec/Tutorial.lhs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Attoparsec/Tutorial.lhs @@ -0,0 +1,344 @@ +> {-# LANGUAGE OverloadedStrings #-} + +| In this tutorial you will learn how to use this library. The /Simple example/ +section should be enough to get you going, but you can keep reading if you want +to better understand how to deal with complex parsing scenarios. + +You may import this module and try the subsequent examples as you go. + + +> module Control.Proxy.Attoparsec.Tutorial +> (-- * Simple example +> -- $example-simple +> +> -- * Parsing control proxies +> -- ** Handling parser errors +> -- $example-errors +> +> -- ** Composing +> -- $example-compose-control +> +> -- ** Custom behavior +> -- $example-control-custom +> +> -- * Try for yourself +> -- $example-try +> Name(..) +> , hello +> , input1 +> , input2 +> , helloPipe1 +> , helloPipe2 +> , helloPipe3 +> , helloPipe4 +> , helloPipe5 +> , helloPipe6 +> , skipPartialResults +> ) where +> +> import Control.Proxy +> import Control.Proxy.Attoparsec +> import Control.Proxy.Trans.Either +> import Data.Attoparsec.Text +> import Data.Text +> +> data Name = Name Text +> deriving (Show, Eq) +> +> hello :: Parser Name +> hello = fmap Name $ "Hello " .*> takeWhile1 (/='.') <*. "." +> +> input1 :: [Text] +> input1 = +> [ "Hello Kate." +> , "Hello Mary.Hello Jef" +> , "f." +> , "Hel" +> , "lo Tom." +> ] +> +> input2 :: [Text] +> input2 = +> [ "Hello Amy." +> , "Hello, Hello Tim." +> , "Hello Bob." +> , "Hello James" +> , "Hello" +> , "Hello World." +> , "HexHello Jon." +> , "H" +> , "ello Ann" +> , "." +> , "Hello Jean-Luc." +> ] +> +> helloPipe1 :: (Proxy p, Monad m) => () -> Pipe p Text Name m r +> helloPipe1 = parserInputD >-> parserD hello +> +> helloPipe2 :: (Proxy p, Monad m) => () -> Pipe p Text Name m r +> helloPipe2 = parserInputD >-> retryLeftovers >-> parserD hello +> +> helloPipe3 :: (Proxy p, Monad m) => () -> Pipe (EitherP BadInput p) Text Name m r +> helloPipe3 = parserInputD >-> throwParsingErrors >-> parserD hello +> +> helloPipe4 :: (Proxy p, Monad m) => () -> Pipe (EitherP BadInput p) Text Name m r +> helloPipe4 = parserInputD >-> limitInputLength 10 >-> parserD hello +> +> helloPipe5 :: (Proxy p, Monad m) => () -> Pipe (EitherP BadInput p) Text Name m r +> helloPipe5 = parserInputD >-> limitInputLength 10 >-> retryLeftovers >-> parserD hello +> +> helloPipe6 :: (Proxy p, Monad m) => () -> Pipe p Text Name m r +> helloPipe6 = parserInputD >-> skipPartialResults >-> parserD hello +> +> skipPartialResults +> :: (Monad m, Proxy p, AttoparsecInput a) +> => ParserStatus a +> -> p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r +> skipPartialResults = runIdentityK . foreverK $ go +> where go x@(Parsing _) = request x >>= \(_, a) -> respond (Start, a) +> go x = request x >>= respond + + +$example-simple + +We'll write a simple 'Parser' that turns 'Text' like /“Hello John Doe.”/ +into @'Name' \"John Doe\"@, and then make a 'Pipe' that turns +those 'Text' values flowing downstream into 'Name' values flowing +downstream using that 'Parser'. + +In this example we are using 'Text', but we may as well use +'Data.ByteString.ByteString'. Also, the 'OverloadedStrings' language +extension lets us write our parser easily. + + > {-# LANGUAGE OverloadedStrings #-} + > + > import Control.Proxy + > import Control.Proxy.Attoparsec + > import Control.Proxy.Trans.Either + > import Data.Attoparsec.Text + > import Data.Text + > + > data Name = Name Text + > deriving (Show) + > + > hello :: Parser Name + > hello = fmap Name $ "Hello " .*> takeWhile1 (/='.') <*. "." + +We are done with our parser, now lets make a simple parsing 'Pipe' with it. + + > helloPipe1 :: (Proxy p, Monad m) => () -> Pipe p Text Name m r + > helloPipe1 = parserInputD >-> parserD hello + +As the type indicates, this 'Pipe' receives 'Text' values from upstream and +sends 'Name' values downstream. This 'Pipe' is made of two smaller +two smaller cooperating 'Proxy's: + + 1. 'parserInputD': Prepares @a@ input received from upstream to be + consumed by a downstream parsing 'Proxy'. + + 2. 'parserD': Repeatedly runs a given @'Parser' a b@ on input 'a' from + upstream, and sends 'b' values downstream. + +We need some sample input to test our simple 'helloPipe1'. + + > input1 :: [Text] + > input1 = + > [ "Hello Kate." + > , "Hello Mary.Hello Jef" + > , "f." + > , "Hel" + > , "lo Tom." + > ] + +We'll use @'fromListS' input1@ as our input source, which sends +downstream one element from the list at a time. We'll call each of these +elements a /chunk/. So, @'fromListS' input1@ sends 5 /chunks/ of +'Text' downstream. + +Notice how some of our /chunks/ are not, by themselves, complete inputs +for our 'hello' 'Parser'. This is fine; we want to be able to feed the +'Parser' with either partial or complete input as soon as it's +received from upstream. More input will be requested when needed. +Attoparsec's 'Parser' handles partial parsing just fine. + + >>> runProxy $ fromListS input1 >-> helloPipe1 >-> printD + Name "Kate" + Name "Mary" + Name "Jeff" + Name "Tom" + +We have accomplished our simple goal: We've made a 'Pipe' that parses +downstream flowing input using our 'Parser' 'hello'. + + +$example-errors + +Let's try with some more complex input. + + > input2 :: [Text] + > input2 = + > [ "Hello Amy." + > , "Hello, Hello Tim." + > , "Hello Bob." + > , "Hello James" + > , "Hello" + > , "Hello World." + > , "HexHello Jon." + > , "H" + > , "ello Ann" + > , "." + > , "Hello Jean-Luc." + > ] + + >>> runProxy $ fromListS input2 >-> helloPipe1 >-> printD + Name "Amy" + Name "Bob" + Name "JamesHelloHello World" + Name "Ann" + Name "Jean-Luc" + +The simple @helloPipe1@ we built skips /chunks/ of input that fail to be +parsed, and then continues parsing new input. That approach might be +enough if you are certain your input is always well-formed, but +sometimes you may prefer to act differently on these extraordinary +situations. + +Instead of just using 'parserInputD' and 'parserD' to build our +'helloPipe1', we could have used an additional 'Proxy' in between them to +handle these situations. The module "Control.Proxy.Attoparsec.Control" +exports some useful 'Proxy's that serve this purpose. The default +behavior just mentioned resembles the one provided by +'skipMalformedChunks'. + +Here are some other examples: + +['retryLeftovers'] + On parsing failures, keep retrying with any left-over input, skipping + individual bits each time. If there are no left-overs, then more + input is requests form upstream. + + > helloPipe2 :: (Proxy p, Monad m) => () -> Pipe p Text Name m r + > helloPipe2 = parserInputD >-> retryLeftovers >-> parserD hello + + >>> runProxy $ fromListS input2 >-> helloPipe2 >-> printD + Name "Amy" + Name "Tim" + Name "Bob" + Name "JamesHelloHello World" + Name "Jon" + Name "Ann" + Name "Jean-Luc" + +['throwParsingErrors'] + When a parsing error arises, aborts execution by throwing + 'MalformedInput' in the 'EitherP' proxy transformer. + + > helloPipe3 :: (Proxy p, Monad m) => () -> Pipe (EitherP BadInput p) Text Name m r + > helloPipe3 = parserInputD >-> throwParsingErrors >-> parserD hello + + >>> runProxy . runEitherK $ fromListS input2 >-> helloPipe3 >-> printD + Name "Amy" + Left (MalformedInput {miParserErrror = ParserError {errorContexts = [], errorMessage = "Failed reading: takeWith"}}) + +[@'limitInputLength' n@] + If a @'Parser' a b@ has consumed input @a@ of length longer than + @n@ without producing a @b@ value, and it's still requesting more + input, then throw 'InputTooLong' in the 'EitherP' proxy transformer. + + > helloPipe4 :: (Proxy p, Monad m) => () -> Pipe (EitherP BadInput p) Text Name m r + > helloPipe4 = parserInputD >-> limitInputLength 10 >-> parserD hello + + >>> runProxy . runEitherK $ fromListS input2 >-> helloPipe4 >-> printD + Name "Amy" + Name "Bob" + Left (InputTooLong {itlLenght = 11}) + + Notice that by default, as mentioned earlier, parsing errors are + ignored by skipping the malformed /chunk/. That's why we didn't get any + complaint about the malformed input between /“Amy”/ and /“Bob”/. + + +$example-compose-control + +These 'Proxy's that control the parsing behavior can be easily plugged +together with @('>->')@ to achieve a combined functionality. Keep in +mind that the order in which these 'Proxy's are used is important. + +Suppose you don't want to parse inputs of length longer than 10, and on +parsing failures, you want to retry feeding the parser with any +left-overs. You could achieve that behaviour like this: + + > helloPipe5 :: (Proxy p, Monad m) => () -> Pipe (EitherP BadInput p) Text Name m r + > helloPipe5 = parserInputD >-> limitInputLength 10 >-> retryLeftovers >-> parserD hello + + >>> runProxy . runEitherK $ fromListS input2 >-> helloPipe5 >-> printD + Name "Amy" + Name "Tim" + Name "Bob" + Left (InputTooLong {itlLenght = 11}) + + +$example-control-custom + +In case the 'Proxy's provided by "Control.Proxy.Attoparsec.Control" are not +enough for your needs, you can create your custom parsing control 'Proxy'. + +Through a parsing control 'Proxy', @'ParserStatus' a@ values flow +upstream and @'ParserSupply' a@ values flow downstream. A parsing +control 'Proxy' may use, replace, or alter the flow of these values to +achieve its purpose. A @'ParserStatus' a@ value received from downstream +reports the status of a 'parserD' parsing 'Proxy', and in exchange, +downstream expects a @'ParserSupply' a@ value. + +@'ParserSupply' a@ values carry raw input to be parsed and directives on how it +should be used. @'ParserSupply' a@ is just a type synonym for +@('SupplyUse', a)@. The @a@ value is the input chunk, and the 'SupplyUse' value +could be either 'Resume' if the parser currently waiting for input should be +fed, or 'Start', if a new parser should be started and fed the input, +effectively aborting any parsing activity currently waiting for more input. + +See the documentation about 'ParserStatus' and 'ParserSupply' for more details. + +Suppose you want to write a parsing control 'Proxy' that never provides +additional input to partial parsing results. Let's first take a look at the +type of this 'Proxy': + + > skipPartialResults + > :: (Monad m, Proxy p, AttoparsecInput a) + > => ParserStatus a + > -> p (ParserStatus a) (ParserSupply a) (ParserStatus a) (ParserSupply a) m r + +Just like we said, @'ParserStatus' a@ values flow upstream and @'ParserSupply' +a@ values flow downstream. + +Now to a simple implementation: If we receive @'Parsing' n@ from downstream, +then we know there is a partial parsing result waiting for more input. If we +were to respond to this request with @('Resume', a)@, then the partial parser +would continue consuming input, but if we change our response to @('Start', a)@, +then the partial parser would be aborted and a new parser would start +consuming the given input. A simple implementation is quite straightforward: + + > skipPartialResults = runIdentityK . foreverK $ go + > where go x@(Parsing _) = request x >>= \(_, a) -> respond (Start, a) + > go x = request x >>= respond + +We forward upstream the requests we get from downstream. However, in the case +of a @'Parsing' n@ status, we replace with 'Start' the first value in the +@'ParserSupply' a@ pair we receive from upstream before responding. + +Now we can use this parsing control 'Proxy' with some simple input and see it +working. + + > helloPipe6 :: (Proxy p, Monad m) => () -> Pipe p Text Name m r + > helloPipe6 = parserInputD >-> skipPartialResults >-> parserD hello + + >>> runProxy $ fromListS input1 >-> helloPipe6 >-> printD + Name "Kate" + Name "Mary" + + +$example-try + +This module exports the following previous examples so that you can try +them. + diff --git a/src/Control/Proxy/Attoparsec/Types.hs b/src/Control/Proxy/Attoparsec/Types.hs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Attoparsec/Types.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE KindSignatures #-} + +-- | This module exports common types used throughout +-- @"Control.Proxy.Attoparsec".*@ + +module Control.Proxy.Attoparsec.Types + ( -- * Proxy control + ParserStatus(..) + , SupplyUse(..) + , ParserSupply + -- * Error types + , BadInput(..) + -- * Attoparsec integration + , AttoparsecInput(..) + , ParserError(..) + ) where + +import qualified Data.Attoparsec.ByteString as ABS +import qualified Data.Attoparsec.Text as AT +import Data.Attoparsec.Types +import qualified Data.ByteString as BS +import qualified Data.Text as T + + + +-- | Status of a parsing 'Proxy'. +data ParserStatus a + -- | There is a 'Parser' running and waiting for more @a@ input. + -- + -- Receiving @('Resume', a)@ from upstream would feed input @a@ to the 'Parser' + -- waiting for more input. + = Parsing + { psLength :: Int -- ^Length of input consumed so far. + } + -- | A 'Parser' has failed parsing. + -- + -- Receiving @('Resume', a)@ from upstream would feed input @a@ to a newly + -- started 'Parser'. + | Failed + { psLeftover :: a -- ^Input not yet consumed when the failure occurred. + , psError :: ParserError -- ^Error found while parsing. + } + deriving (Show, Eq) + + +data ParserError = ParserError + { errorContexts :: [String] -- ^ Contexts where the error occurred. + , errorMessage :: String -- ^ Error message. + } deriving (Show, Eq) + + +-- | Indicates how should a parsing 'Proxy' use new input. +data SupplyUse + -- | Start a new parser and fed any new input to it. + = Start + -- | Resume feeding any new input to the current parser waiting for input. + | Resume + deriving (Eq, Show) + + +-- | Input supplied to a parsing 'Proxy'. +-- +-- The 'SupplyUse' value indicates how the @a@ input chunk should be used. +type ParserSupply a = (SupplyUse, a) + + +-- | Reasons for an input value to be unnaceptable. +data BadInput + = InputTooLong + { itlLength :: Int -- ^ Length of the input. + } + | MalformedInput + { miParserErrror :: ParserError -- ^ Error found while parsing. + } + deriving (Show, Eq) + + +-- | A class for valid Attoparsec input types. +class Eq a => AttoparsecInput a where + -- | Run a 'Parser' with input @a@. + parse :: Parser a b -> a -> IResult a b + -- | Tests whether @a@ is empty. + null :: a -> Bool + -- | Skips the first @n@ elements from @a@ and returns the rest. + drop :: Int -> a -> a + -- | Number of elements in @a@. + length :: a -> Int + +instance AttoparsecInput BS.ByteString where + parse = ABS.parse + null = BS.null + drop = BS.drop + length = BS.length + +instance AttoparsecInput T.Text where + parse = AT.parse + null = T.null + drop = T.drop + length = T.length + diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,21 @@ +module 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.Tutorial +import qualified Test.Attoparsec + +main = defaultMain tests + +tests = + [ testGroup "Sample" sampleTests + , testGroup "Tutorial" Test.Tutorial.tests + , testGroup "Attoparsec" Test.Attoparsec.tests + ] + +sampleTests = [ testProperty "QuickCheck" $ \x -> const True (x :: Int) == True + , testCase "HUnit" $ True @?= True + ] diff --git a/tests/Test/Attoparsec.hs b/tests/Test/Attoparsec.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Attoparsec.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Attoparsec (tests) where + +-- TODO + +tests = [] diff --git a/tests/Test/Tutorial.hs b/tests/Test/Tutorial.hs new file mode 100644 --- /dev/null +++ b/tests/Test/Tutorial.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Tutorial where + +import Control.Proxy +import Control.Proxy.Attoparsec +import Control.Proxy.Attoparsec.Tutorial +import Control.Proxy.Trans.Either +import Data.Maybe +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit hiding (test) + + +testPipe pipe input test = fromJust $ do + let proxy = fromListS input >-> pipe >-> toListD + output <- runWriterT . runProxy . runEitherK $ proxy + return . assert $ test output + + +test_helloPipe1_input1 = testPipe helloPipe1 input1 test + where test (Right _, x) = x == fmap Name ["Kate" , "Mary", "Jeff", "Tom"] + test _ = False + +test_helloPipe1_input2 = testPipe helloPipe1 input2 test + where test (Right _, x) = x == fmap Name [ "Amy", "Bob" + , "JamesHelloHello World" , "Ann" + , "Jean-Luc" ] + test _ = False + + +test_helloPipe2_input2 = testPipe helloPipe2 input2 test + where test (Right _, x) = x == fmap Name [ "Amy" ,"Tim", "Bob" + , "JamesHelloHello World", "Jon" + , "Ann" , "Jean-Luc" ] + test _ = False + +test_helloPipe3_input2 = testPipe helloPipe3 input2 test + where test (Left (MalformedInput _), [Name "Amy"]) = True + test _ = False + + +test_helloPipe4_input2 = testPipe helloPipe4 input2 test + where test (Left (InputTooLong 11), [Name "Amy", Name "Bob"]) = True + test _ = False + + +test_helloPipe5_input2 = testPipe helloPipe5 input2 test + where test (Left (InputTooLong 11), + [Name "Amy", Name "Tim", Name "Bob"]) = True + test _ = False + +test_helloPipe6_input1 = testPipe helloPipe6 input1 test + where test (Right _, [Name "Kate", Name "Mary"]) = True + test _ = False + + +tests = + [ testCase "helloPipe1 + input1" test_helloPipe1_input1 + , testCase "helloPipe1 + input2" test_helloPipe1_input2 + , testCase "helloPipe2 + input2" test_helloPipe2_input2 + , testCase "helloPipe3 + input2" test_helloPipe3_input2 + , testCase "helloPipe4 + input2" test_helloPipe4_input2 + , testCase "helloPipe5 + input2" test_helloPipe5_input2 + , testCase "helloPipe6 + input1" test_helloPipe6_input1 + ] +