diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2012-2013, Renzo Carbonara +Copyright (c) 2012-, Renzo Carbonara Copyright (c) 2012, Paolo Capriotti All rights reserved. diff --git a/NEWS b/NEWS deleted file mode 100644 --- a/NEWS +++ /dev/null @@ -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. diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -6,3 +6,5 @@ Renzo Carbonara Gabriel Gonzalez Patrick Wheeler +Danny Navarro +Michael Thompson diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,75 @@ +# Version 0.6.0 + +* Remove support for `Control.Monad.Trans.Error`. + + +# 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. diff --git a/pipes-attoparsec.cabal b/pipes-attoparsec.cabal --- a/pipes-attoparsec.cabal +++ b/pipes-attoparsec.cabal @@ -1,23 +1,22 @@ +cabal-version: 2.4 name: pipes-attoparsec -version: 0.3.1 -license: BSD3 +version: 0.6.0 +license: BSD-3-Clause license-file: LICENSE -copyright: Copyright (c) Renzo Carbonara 2012-2013, Paolo Capriotti 2012 +copyright: Copyright (c) Renzo Carbonara 2012-, 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.md 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.md@ file in the source distribution to learn about any important changes between version. source-repository head @@ -25,20 +24,21 @@ location: git://github.com/k0001/pipes-attoparsec.git library + default-language: Haskell2010 hs-source-dirs: src exposed-modules: Pipes.Attoparsec - , Pipes.Attoparsec.Internal build-depends: - base (==4.*) - , attoparsec (>=0.10 && <0.12) + base (>=4.5 && <5.0) + , attoparsec (>=0.10) , 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) + , pipes (>=4.1) + , pipes-parse (>=3.0.1) + , text (>=0.11.2.0) + , transformers (>=0.2) ghc-options: -Wall -O2 test-suite tests + default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs @@ -54,9 +54,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 diff --git a/src/Pipes/Attoparsec.hs b/src/Pipes/Attoparsec.hs --- a/src/Pipes/Attoparsec.hs +++ b/src/Pipes/Attoparsec.hs @@ -1,98 +1,217 @@ -{-# 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 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 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.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) -------------------------------------------------------------------------------- --- | 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". +-- +-- 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, 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 (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 #-} --- | 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 successfully, +-- 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 = 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 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 '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 +-- | 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 + +-------------------------------------------------------------------------------- +-- 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 #-} diff --git a/src/Pipes/Attoparsec/Internal.hs b/src/Pipes/Attoparsec/Internal.hs deleted file mode 100644 --- a/src/Pipes/Attoparsec/Internal.hs +++ /dev/null @@ -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 #-} diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 + ] diff --git a/tests/Test/Attoparsec.hs b/tests/Test/Attoparsec.hs --- a/tests/Test/Attoparsec.hs +++ b/tests/Test/Attoparsec.hs @@ -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