streaming-eversion 0.3.1.1 → 0.4.0.0
raw patch · 8 files changed
+672/−684 lines, 8 filesdep ~foldldep ~streaming
Dependency ranges changed: foldl, streaming
Files
- CHANGELOG +23/−18
- LICENSE +28/−28
- README.md +42/−42
- src/Streaming/Eversion.hs +209/−233
- src/Streaming/Eversion/Pipes.hs +115/−133
- streaming-eversion.cabal +65/−64
- tests/doctests.hs +10/−10
- tests/tests.hs +180/−156
CHANGELOG view
@@ -1,18 +1,23 @@-0.3.1.0 - -- Added functions with MonadResource contraints. - -0.3.0.0 - -- Implemented the improvements suggested by Michael Thompson here : -https://groups.google.com/forum/#!topic/haskell-pipes/7n6NPTmxPKY by M.T. -- Removed the newtypes. I mistakenly believed that they were needed to avoid -having to enable -XImpredicativeTypes. - -0.2.0.0 - -- Eversible, not Evertible! -- Removed special purpose error functions. -- Added some utility functions. -- Added Category instances. - +0.4.0.0++- Bumped lower bounds for "streaming" and "foldl".+- Removed functions with MonadResource constraints.++0.3.1.0++- Added functions with MonadResource contraints.++0.3.0.0++- Implemented the improvements suggested by Michael Thompson here :+https://groups.google.com/forum/#!topic/haskell-pipes/7n6NPTmxPKY by M.T.+- Removed the newtypes. I mistakenly believed that they were needed to avoid+having to enable -XImpredicativeTypes.++0.2.0.0++- Eversible, not Evertible!+- Removed special purpose error functions.+- Added some utility functions.+- Added Category instances.+
LICENSE view
@@ -1,28 +1,28 @@-Copyright (c) 2015, Daniel Díaz Carrete -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 foldl-transduce nor the names of its - 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 HOLDER 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. - +Copyright (c) 2015, Daniel Díaz Carrete+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 foldl-transduce nor the names of its+ 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 HOLDER 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.+
README.md view
@@ -1,42 +1,42 @@-## What's in this library? - -Functions that turn pull-based stream operations from the pipes/streaming -ecosystem into push-based, iteratee-like stream operations. - -Inspired by the blog post [Programmatic translation to iteratees from pull-based code](http://pchiusano.blogspot.com.es/2011/12/programmatic-translation-to-iteratees.html). - -## Could you go into more detail? - -There are three streaming libraries that often go together: -[pipes](http://hackage.haskell.org/package/pipes), -[streaming](http://hackage.haskell.org/package/streaming), and -[foldl](http://hackage.haskell.org/package/foldl). - -Of these, the first two are pull-based: you take some (possibly effectful) -source of values and keep extracting stuff until the source is exhausted and/or -you have obtained all the info you need. - -Meanwhile, foldl is push-based: foldl folds are not directly aware of any -source, they are like little state machines that keep running as long as -someone feeds them input. - -Usually, defining stream transformations in pull-based mode is easier and feels -more natural. The pipes ecosystem already provides a lot of them: -[parsers](http://hackage.haskell.org/package/pipes-parse), -[decoders](http://hackage.haskell.org/package/pipes-text), -[splitters](http://hackage.haskell.org/package/pipes-group). - -However, push-based mode also has advantages. Push-based abstractions are not -tied to a particular type of source because data is fed externally. And foldl -folds have very useful Applicative and Comonad instances. - -Also, sometimes a library will only offer a push-based interface. - -Wouldn't it be nice if you could adapt already existing pull-based operations -to work on push-based consumers? For example, using a decoding function from -[Pipes.Text.Encoding](http://hackage.haskell.org/package/pipes-text-0.0.2.4/docs/Pipes-Text-Encoding.html#g:6) -to preprocess the inputs of a -[Fold](http://hackage.haskell.org/package/foldl-1.2.1/docs/Control-Foldl-Text.html). - -This library provides that. - +## What's in this library?++Functions that turn pull-based stream operations from the pipes/streaming+ecosystem into push-based, iteratee-like stream operations. ++Inspired by the blog post [Programmatic translation to iteratees from pull-based code](http://pchiusano.blogspot.com.es/2011/12/programmatic-translation-to-iteratees.html).++## Could you go into more detail?++There are three streaming libraries that often go together:+[pipes](http://hackage.haskell.org/package/pipes),+[streaming](http://hackage.haskell.org/package/streaming), and+[foldl](http://hackage.haskell.org/package/foldl).++Of these, the first two are pull-based: you take some (possibly effectful)+source of values and keep extracting stuff until the source is exhausted and/or+you have obtained all the info you need.++Meanwhile, foldl is push-based: foldl folds are not directly aware of any+source, they are like little state machines that keep running as long as+someone feeds them input. ++Usually, defining stream transformations in pull-based mode is easier and feels+more natural. The pipes ecosystem already provides a lot of them:+[parsers](http://hackage.haskell.org/package/pipes-parse),+[decoders](http://hackage.haskell.org/package/pipes-text),+[splitters](http://hackage.haskell.org/package/pipes-group).++However, push-based mode also has advantages. Push-based abstractions are not+tied to a particular type of source because data is fed externally. And foldl+folds have very useful Applicative and Comonad instances. ++Also, sometimes a library will only offer a push-based interface. ++Wouldn't it be nice if you could adapt already existing pull-based operations+to work on push-based consumers? For example, using a decoding function from+[Pipes.Text.Encoding](http://hackage.haskell.org/package/pipes-text-0.0.2.4/docs/Pipes-Text-Encoding.html#g:6)+to preprocess the inputs of a+[Fold](http://hackage.haskell.org/package/foldl-1.2.1/docs/Control-Foldl-Text.html).++This library provides that.+
src/Streaming/Eversion.hs view
@@ -1,233 +1,209 @@-{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - - -{-| Most pull-to-push transformations in this module require functions that are - polymorphic over a monad transformer. - - Because of this, some of the type signatures look scary, but actually many - (suitably polymorphic) operations on 'Stream's will unify with them. - - To get "interruptible" operations that can exit early with an error, put a - 'ExceptT' transformer just below the polymorphic monad transformer. In - practice, that means lifting functions like - 'Control.Monad.Trans.ExceptT.throwE' and 'Control.Error.Util.hoistEither' a - number of times. - - Inspired by http://pchiusano.blogspot.com.es/2011/12/programmatic-translation-to-iteratees.html --} - -module Streaming.Eversion ( - -- * Stream folds - evert - , evertM - , evertM_ - , evertMIO - , evertMIO_ - , evertMR - , evertMR_ - -- * Stream transformations - , transvert - , transvertM - , transvertMIO - , transvertMR - -- * Internals --- , Feed(..) - , generalEvertM - , generalTransvertM - ) where - -import Prelude -import Control.Foldl (Fold(..),FoldM(..),generalize,simplify) -import Streaming (Stream,Of(..),Sum(..),inspect,unseparate,MonadResource) -import Streaming.Internal -import Control.Monad.IO.Class -import Control.Monad.Trans.Class - -{- $setup ->>> import Data.Functor.Identity ->>> import Control.Monad.Trans.Except ->>> import Control.Monad.Trans.Identity ->>> import Control.Foldl (Fold(..),FoldM(..)) ->>> import qualified Control.Foldl as L ->>> import Streaming (Stream,Of(..),MonadResource,runResourceT) ->>> import Streaming.Prelude (yield,next,for) ->>> import qualified Streaming.Prelude as S --} - ------------------------------------------------------------------------------------------ - -data Feed a = Input a | EOF - -stoppedBeforeEOF :: String -stoppedBeforeEOF = "Stopped before receiving EOF." - -continuedAfterEOF :: String -continuedAfterEOF = "Continued after receiving EOF." - -internalsCat :: Monad m => Stream (Of a) (Stream ((->) (Feed a)) m) () -internalsCat = do - r <- Effect (Step (Return . Return)) - case r of - Input a -> Step (a :> internalsCat) - EOF -> Return () - --- cat :: Monad m => Stream (Of a) (Stream ((->) (Feed a)) m) () --- cat = do --- r <- lift (yields id) --- case r of --- Input a -> do --- yield a --- cat --- EOF -> return () - -evert :: (forall m r. Monad m => Stream (Of a) m r -> m (Of x r)) - -> Fold a x -- ^ -evert phi = simplify (generalEvertM phi) - -{- | Like 'evert', but gives the stream-folding function access to a base monad. - ->>> :{ - let consume stream = lift (putStrLn "x") >> S.effects stream - in L.foldM (evertM_ consume) ["a","b","c"] - :} -x - - Note however that control operations can't be lifted through the transformer. --} -evertM :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) - -> FoldM m a x -- ^ -evertM phi = generalEvertM phi - -evertM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m r) - -> FoldM m a () -- ^ -evertM_ phi = evertM (fmap (fmap ((:>) ())) phi) - -{-| Like 'evertM', but gives the stream-consuming function the ability to use 'liftIO'. - ->>> L.foldM (evertMIO_ S.print) ["a","b","c"] -"a" -"b" -"c" - --} -evertMIO :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) - -> FoldM m a x -- ^ -evertMIO phi = generalEvertM phi - -evertMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m r) - -> FoldM m a () -- ^ -evertMIO_ phi = evertMIO (fmap (fmap ((:>) ())) phi) - -evertMR :: MonadResource m => (forall t r. (MonadTrans t, MonadResource (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) - -> FoldM m a x -- ^ -evertMR phi = generalEvertM phi - -{-| - ->>> runResourceT (L.foldM (evertMR_ (S.writeFile "/dev/null")) ["aaa","bbb"]) - --} -evertMR_ :: MonadResource m => (forall t r. (MonadTrans t, MonadResource (t m)) => Stream (Of a) (t m) r -> t m r) - -> FoldM m a () -- ^ -evertMR_ phi = evertMR (fmap (fmap ((:>) ())) phi) - - -generalEvertM :: (Monad m) - => (forall r. Stream (Of a) (Stream ((->) (Feed a)) m) r -> Stream ((->) (Feed a)) m (Of b r)) - -> FoldM m a b -- ^ -generalEvertM consumer = FoldM step begin done - where - begin = return (consumer internalsCat) - step str i = case str of - Return _ -> error stoppedBeforeEOF - Step f -> return (f (Input i)) - Effect m -> m >>= \str' -> step str' i - done str = do - e <- inspect str - case e of - Left _ -> error stoppedBeforeEOF - Right f -> do - e' <- inspect (f EOF) - case e' of - Left (a :> ()) -> return a - Right _ -> error continuedAfterEOF - -transvert :: (forall m r. Monad m => Stream (Of a) m r -> Stream (Of b) m r) - -> Fold b x -- ^ - -> Fold a x -transvert phi = \somefold -> simplify ((generalTransvertM phi) (generalize somefold)) - -transvertM :: Monad m - => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r) - -> FoldM m b x -- ^ - -> FoldM m a x -transvertM phi = generalTransvertM phi - -transvertMIO :: MonadIO m - => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r) - -> FoldM m b x -- ^ - -> FoldM m a x -transvertMIO phi = generalTransvertM phi - -transvertMR :: MonadResource m - => (forall t r. (MonadTrans t, MonadResource (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r) - -> FoldM m b x -- ^ - -> FoldM m a x -transvertMR phi = generalTransvertM phi - -data Pair a b = Pair !a !b - -data StreamStateM m a b = PristineM (Stream (Sum (Of b) ((->) (Feed a))) m ()) - | WaitingM (Feed a -> Stream (Sum (Of b) ((->) (Feed a))) m ()) - -generalTransvertM :: Monad m - => (forall r. Stream (Of a) (Stream ((->) (Feed a)) m) r -> Stream (Of b) (Stream ((->) (Feed a)) m) r) -- ^ - -> FoldM m b x - -> FoldM m a x -generalTransvertM transducer (FoldM innerstep innerbegin innerdone) = FoldM step begin done - where - begin = do - innerbegin' <- innerbegin - return (Pair innerbegin' (PristineM (unseparate (transducer internalsCat)))) - step (Pair innerstate (PristineM pristine)) i = do - s <- advance innerstate pristine - step s i - step (Pair innerstate (WaitingM waiting)) i = do - s <- inspect (waiting (Input i)) - case s of - Left () -> error stoppedBeforeEOF - Right (InL (a :> future)) -> do - step1 <- innerstep innerstate a - advance step1 future - Right (InR f) -> return (Pair innerstate (WaitingM f)) - advance innerstate stream = do - r <- inspect stream - case r of - Left () -> error stoppedBeforeEOF - Right (InL (a :> future)) -> do - step1 <- innerstep innerstate a - advance step1 future - Right (InR f) -> return (Pair innerstate (WaitingM f)) - done (Pair innerstate (PristineM pristine)) = do - s <- advance innerstate pristine - done s - done (Pair innerstate (WaitingM waiting)) = do - s <- inspect (waiting EOF) - case s of - Left () -> do - innerdone innerstate - Right (InL (a :> future)) -> do - step1 <- innerstep innerstate a - r <- advancefinal step1 future - innerdone r - Right _ -> error continuedAfterEOF - advancefinal innerstate stream = do - r <- inspect stream - case r of - Left () -> return innerstate - Right (InL (a :> future)) -> do - step1 <- innerstep innerstate a - advancefinal step1 future - Right (InR _) -> error continuedAfterEOF - +{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-| Most pull-to-push transformations in this module require functions that are + polymorphic over a monad transformer. + + Because of this, some of the type signatures look scary, but actually many+ (suitably polymorphic) operations on 'Stream's will unify with them.+ + To get "interruptible" operations that can exit early with an error, put a+ 'ExceptT' transformer just below the polymorphic monad transformer. In+ practice, that means lifting functions like+ 'Control.Monad.Trans.ExceptT.throwE' and 'Control.Error.Util.hoistEither' a+ number of times.+ + Inspired by http://pchiusano.blogspot.com.es/2011/12/programmatic-translation-to-iteratees.html+-}++module Streaming.Eversion (+ -- * Stream folds + evert+ , evertM+ , evertM_+ , evertMIO+ , evertMIO_+ -- * Stream transformations + , transvert+ , transvertM+ , transvertMIO+ -- * Internals+-- , Feed(..)+ , generalEvertM+ , generalTransvertM+ ) where++import Prelude +import Control.Foldl (Fold(..),FoldM(..),generalize,simplify)+import Streaming (Stream,Of(..),Sum(..),inspect,unseparate)+import Streaming.Internal+import Control.Monad.IO.Class+import Control.Monad.Trans.Class++{- $setup+>>> import Data.Functor.Identity+>>> import Control.Monad.Trans.Except+>>> import Control.Monad.Trans.Identity+>>> import Control.Foldl (Fold(..),FoldM(..))+>>> import qualified Control.Foldl as L+>>> import Streaming (Stream,Of(..))+>>> import Streaming.Prelude (yield,next,for)+>>> import qualified Streaming.Prelude as S+-}++-----------------------------------------------------------------------------------------++data Feed a = Input a | EOF++stoppedBeforeEOF :: String+stoppedBeforeEOF = "Stopped before receiving EOF."++continuedAfterEOF :: String+continuedAfterEOF = "Continued after receiving EOF."++internalsCat :: Monad m => Stream (Of a) (Stream ((->) (Feed a)) m) () +internalsCat = do+ r <- Effect (Step (Return . Return))+ case r of+ Input a -> Step (a :> internalsCat)+ EOF -> Return () ++-- cat :: Monad m => Stream (Of a) (Stream ((->) (Feed a)) m) ()+-- cat = do+-- r <- lift (yields id)+-- case r of+-- Input a -> do+-- yield a+-- cat+-- EOF -> return ()++evert :: (forall m r. Monad m => Stream (Of a) m r -> m (Of x r)) + -> Fold a x -- ^+evert phi = simplify (generalEvertM phi)++{- | Like 'evert', but gives the stream-folding function access to a base monad.+ +>>> :{+ let consume stream = lift (putStrLn "x") >> S.effects stream+ in L.foldM (evertM_ consume) ["a","b","c"]+ :}+x++ Note however that control operations can't be lifted through the transformer.+-}+evertM :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) + -> FoldM m a x -- ^+evertM phi = generalEvertM phi++evertM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m r) + -> FoldM m a () -- ^+evertM_ phi = evertM (fmap (fmap ((:>) ())) phi)++{-| Like 'evertM', but gives the stream-consuming function the ability to use 'liftIO'.+ +>>> L.foldM (evertMIO_ S.print) ["a","b","c"]+"a"+"b"+"c"++-}+evertMIO :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) + -> FoldM m a x -- ^+evertMIO phi = generalEvertM phi++evertMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m r) + -> FoldM m a () -- ^+evertMIO_ phi = evertMIO (fmap (fmap ((:>) ())) phi)++generalEvertM :: (Monad m) + => (forall r. Stream (Of a) (Stream ((->) (Feed a)) m) r -> Stream ((->) (Feed a)) m (Of b r))+ -> FoldM m a b -- ^+generalEvertM consumer = FoldM step begin done+ where+ begin = return (consumer internalsCat)+ step str i = case str of + Return _ -> error stoppedBeforeEOF+ Step f -> return (f (Input i))+ Effect m -> m >>= \str' -> step str' i+ done str = do+ e <- inspect str+ case e of+ Left _ -> error stoppedBeforeEOF+ Right f -> do+ e' <- inspect (f EOF)+ case e' of+ Left (a :> ()) -> return a+ Right _ -> error continuedAfterEOF ++transvert :: (forall m r. Monad m => Stream (Of a) m r -> Stream (Of b) m r)+ -> Fold b x -- ^+ -> Fold a x +transvert phi = \somefold -> simplify ((generalTransvertM phi) (generalize somefold))++transvertM :: Monad m + => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertM phi = generalTransvertM phi++transvertMIO :: MonadIO m + => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertMIO phi = generalTransvertM phi++data Pair a b = Pair !a !b++data StreamStateM m a b = PristineM (Stream (Sum (Of b) ((->) (Feed a))) m ())+ | WaitingM (Feed a -> Stream (Sum (Of b) ((->) (Feed a))) m ())++generalTransvertM :: Monad m + => (forall r. Stream (Of a) (Stream ((->) (Feed a)) m) r -> Stream (Of b) (Stream ((->) (Feed a)) m) r) -- ^+ -> FoldM m b x + -> FoldM m a x+generalTransvertM transducer (FoldM innerstep innerbegin innerdone) = FoldM step begin done+ where+ begin = do+ innerbegin' <- innerbegin+ return (Pair innerbegin' (PristineM (unseparate (transducer internalsCat))))+ step (Pair innerstate (PristineM pristine)) i = do+ s <- advance innerstate pristine + step s i+ step (Pair innerstate (WaitingM waiting)) i = do + s <- inspect (waiting (Input i))+ case s of+ Left () -> error stoppedBeforeEOF+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a+ advance step1 future + Right (InR f) -> return (Pair innerstate (WaitingM f))+ advance innerstate stream = do + r <- inspect stream + case r of+ Left () -> error stoppedBeforeEOF+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a+ advance step1 future+ Right (InR f) -> return (Pair innerstate (WaitingM f))+ done (Pair innerstate (PristineM pristine)) = do+ s <- advance innerstate pristine + done s+ done (Pair innerstate (WaitingM waiting)) = do+ s <- inspect (waiting EOF)+ case s of+ Left () -> do+ innerdone innerstate+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a+ r <- advancefinal step1 future+ innerdone r+ Right _ -> error continuedAfterEOF+ advancefinal innerstate stream = do+ r <- inspect stream+ case r of+ Left () -> return innerstate+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a+ advancefinal step1 future+ Right (InR _) -> error continuedAfterEOF+
src/Streaming/Eversion/Pipes.hs view
@@ -1,133 +1,115 @@-{-# LANGUAGE RankNTypes #-} - --- | Like "Streaming.Eversion", but for Producer folds and transformations. --- - -module Streaming.Eversion.Pipes ( - -- * Producer folds - evert - , evertM - , evertM_ - , evertMIO - , evertMIO_ --- , evertMR --- , evertMR_ - -- * Producer transformations - , transvert - , transvertM - , transvertMIO --- , transvertMR - -- * Examples - -- $examples - ) where - -import Control.Monad.IO.Class -import Control.Monad.Trans.Class - -import Streaming(MonadResource,strictly) -import qualified Streaming.Prelude -import qualified Streaming.Eversion -import Pipes -import Pipes.Prelude -import Control.Foldl (Fold(..),FoldM(..)) - -{- $setup ->>> :set -XOverloadedStrings ->>> import Control.Monad ->>> import Control.Monad.Trans.Except ->>> import Control.Foldl (Fold(..),FoldM(..)) ->>> import qualified Control.Foldl as L ->>> import Streaming.Prelude (yield,next) ->>> import qualified Streaming.Prelude as S ->>> import Pipes ->>> import qualified Pipes.Prelude as P ->>> import qualified Pipes.Text as PT ->>> import qualified Pipes.Text.Encoding as PT ->>> import qualified Pipes.ByteString as PB ->>> import Lens.Micro.Extras --} - ------------------------------------------------------------------------------------------ - -evert :: (forall m r. Monad m => Producer a m r -> m (x,r)) - -> Fold a x -- ^ -evert phi = Streaming.Eversion.evert (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - -evertM :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m (x,r)) - -> FoldM m a x -- ^ -evertM phi = Streaming.Eversion.evertM (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - -evertM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m r) - -> FoldM m a () -- ^ -evertM_ phi = Streaming.Eversion.evertM_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)) - -evertMIO :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m (x,r)) - -> FoldM m a x -- ^ -evertMIO phi = Streaming.Eversion.evertMIO (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - -evertMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m r) - -> FoldM m a () -- ^ -evertMIO_ phi = Streaming.Eversion.evertMIO_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)) - ---evertMR :: MonadResource m => (forall t r. (MonadTrans t, MonadResource (t m)) => Producer a (t m) r -> t m (x,r)) --- -> FoldM m a x -- ^ ---evertMR phi = Streaming.Eversion.evertMR (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - ---evertMR_ :: MonadResource m => (forall t r. (MonadTrans t, MonadResource (t m)) => Producer a (t m) r -> t m r) --- -> FoldM m a () -- ^ ---evertMR_ phi = Streaming.Eversion.evertMR_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)) - -transvert :: (forall m r. Monad m => Producer a m r -> Producer b m r) - -> Fold b x -- ^ - -> Fold a x -transvert phi = Streaming.Eversion.transvert (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - -transvertM :: Monad m - => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> Producer b (t m) r) - -> FoldM m b x -- ^ - -> FoldM m a x -transvertM phi = Streaming.Eversion.transvertM (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - -transvertMIO :: MonadIO m - => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> Producer b (t m) r) - -> FoldM m b x -- ^ - -> FoldM m a x -transvertMIO phi = Streaming.Eversion.transvertMIO (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - ---transvertMR :: MonadResource m --- => (forall t r. (MonadTrans t, MonadResource (t m)) => Producer a (t m) r -> Producer b (t m) r) --- -> FoldM m b x -- ^ --- -> FoldM m a x ---transvertMR phi = Streaming.Eversion.transvertMR (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) - - -{- $examples - - Applying a decoder from "Pipes.Text.Encoding" to the inputs of a Fold. In - case the decoding fails, part of the leftovers are read in order to build the - error value. - ->>> :{ - let trans = transvertM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer - lift (case result of - Left ls -> sample ls >>= lift . throwE - Right r -> return r)) - sample leftovers = L.purely P.fold L.mconcat (void (view (PB.splitAt 5) leftovers)) - in runExceptT $ L.foldM (trans (L.generalize L.mconcat)) ["decode","this"] - :} -Right "decodethis" - ->>> :{ - let trans = transvertM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer - lift (case result of - Left ls -> sample ls >>= lift . throwE - Right r -> return r)) - sample leftovers = L.purely P.fold L.mconcat (void (view (PB.splitAt 8) leftovers)) - in runExceptT $ L.foldM (trans (L.generalize L.mconcat)) ["invalid \xc3\x28","sequence"] - :} -Left "\195(sequen" - -Note that the errors are thrown in an 'ExceptT' layer below the 'Pipes.Producer' -and the polymorphic transformer. - --} +{-# LANGUAGE RankNTypes #-}++-- | Like "Streaming.Eversion", but for Producer folds and transformations.+-- ++module Streaming.Eversion.Pipes (+ -- * Producer folds + evert+ , evertM+ , evertM_+ , evertMIO+ , evertMIO_+ -- * Producer transformations + , transvert+ , transvertM+ , transvertMIO+ -- * Examples+ -- $examples+ ) where++import Control.Monad.IO.Class+import Control.Monad.Trans.Class++import Streaming(strictly)+import qualified Streaming.Prelude+import qualified Streaming.Eversion+import Pipes+import Pipes.Prelude+import Control.Foldl (Fold(..),FoldM(..))++{- $setup+>>> :set -XOverloadedStrings+>>> import Control.Monad+>>> import Control.Monad.Trans.Except+>>> import Control.Foldl (Fold(..),FoldM(..))+>>> import qualified Control.Foldl as L+>>> import Streaming.Prelude (yield,next)+>>> import qualified Streaming.Prelude as S+>>> import Pipes+>>> import qualified Pipes.Prelude as P+>>> import qualified Pipes.Text as PT+>>> import qualified Pipes.Text.Encoding as PT+>>> import qualified Pipes.ByteString as PB+>>> import Lens.Micro.Extras+-}++-----------------------------------------------------------------------------------------++evert :: (forall m r. Monad m => Producer a m r -> m (x,r)) + -> Fold a x -- ^+evert phi = Streaming.Eversion.evert (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))++evertM :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m (x,r)) + -> FoldM m a x -- ^+evertM phi = Streaming.Eversion.evertM (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))++evertM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m r) + -> FoldM m a () -- ^+evertM_ phi = Streaming.Eversion.evertM_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))++evertMIO :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m (x,r)) + -> FoldM m a x -- ^+evertMIO phi = Streaming.Eversion.evertMIO (\stream -> fmap strictly (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))++evertMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m r) + -> FoldM m a () -- ^+evertMIO_ phi = Streaming.Eversion.evertMIO_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))++transvert :: (forall m r. Monad m => Producer a m r -> Producer b m r)+ -> Fold b x -- ^+ -> Fold a x +transvert phi = Streaming.Eversion.transvert (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))++transvertM :: Monad m + => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> Producer b (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertM phi = Streaming.Eversion.transvertM (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))++transvertMIO :: MonadIO m + => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> Producer b (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertMIO phi = Streaming.Eversion.transvertMIO (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))++{- $examples+ + Applying a decoder from "Pipes.Text.Encoding" to the inputs of a Fold. In+ case the decoding fails, part of the leftovers are read in order to build the+ error value. ++>>> :{ + let trans = transvertM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer + lift (case result of+ Left ls -> sample ls >>= lift . throwE+ Right r -> return r))+ sample leftovers = L.purely P.fold L.mconcat (void (view (PB.splitAt 5) leftovers))+ in runExceptT $ L.foldM (trans (L.generalize L.mconcat)) ["decode","this"]+ :}+Right "decodethis"++>>> :{ + let trans = transvertM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer + lift (case result of+ Left ls -> sample ls >>= lift . throwE+ Right r -> return r))+ sample leftovers = L.purely P.fold L.mconcat (void (view (PB.splitAt 8) leftovers))+ in runExceptT $ L.foldM (trans (L.generalize L.mconcat)) ["invalid \xc3\x28","sequence"]+ :}+Left "\195(sequen"++Note that the errors are thrown in an 'ExceptT' layer below the 'Pipes.Producer'+and the polymorphic transformer.++-}
streaming-eversion.cabal view
@@ -1,64 +1,65 @@-Name: streaming-eversion -Version: 0.3.1.1 -Cabal-Version: >=1.8.0.2 -Build-Type: Simple -License: BSD3 -License-File: LICENSE -Copyright: 2016 Daniel Diaz -Author: Daniel Diaz -Maintainer: diaz_carrete@yahoo.com -Bug-Reports: https://github.com/danidiaz/streaming-eversion/issues -Synopsis: Translate pull-based stream folds into push-based iteratees. -Description: Translate pull-based folds from the "streaming" package into - push-based folds from the "foldl" package. -Category: Control - -Extra-Source-Files: - README.md - CHANGELOG - -Source-Repository head - Type: git - Location: git@github.com:danidiaz/streaming-eversion.git - -Library - HS-Source-Dirs: src - Build-Depends: - base >= 4 && < 5 , - transformers >= 0.4.0.0 , - foldl >= 1.1.5 , - pipes >= 4.1.0 , - streaming >= 0.1.4.2 - Exposed-Modules: - Streaming.Eversion - Streaming.Eversion.Pipes - GHC-Options: -O2 -Wall - -test-suite doctests - type: exitcode-stdio-1.0 - ghc-options: -Wall -threaded - hs-source-dirs: tests - main-is: doctests.hs - build-depends: - base >= 4.4 && < 5 , - doctest >= 0.10.1 , - foldl >= 1.1.5 , - pipes >= 4.1.0 , - pipes-text >= 0.0.2.2 , - pipes-bytestring >= 2.1.1 , - streaming >= 0.1.4.2 , - microlens >= 0.4.2.1 -test-suite tests - type: exitcode-stdio-1.0 - ghc-options: -Wall -threaded - hs-source-dirs: tests - main-is: tests.hs - build-depends: - base >= 4.4 && < 5 , - tasty >= 0.10.1.1 , - tasty-hunit >= 0.9.2 , - tasty-quickcheck >= 0.8.3.2 , - streaming , - foldl , - streaming-eversion - +Name: streaming-eversion+Version: 0.4.0.0+Cabal-Version: >=1.8.0.2+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: 2016 Daniel Diaz+Author: Daniel Diaz+Maintainer: diaz_carrete@yahoo.com+Bug-Reports: https://github.com/danidiaz/streaming-eversion/issues+Synopsis: Translate pull-based stream folds into push-based iteratees.+Description: Translate pull-based folds from the "streaming" package into+ push-based folds from the "foldl" package. +Category: Control++Extra-Source-Files:+ README.md+ CHANGELOG++Source-Repository head+ Type: git+ Location: git@github.com:danidiaz/streaming-eversion.git++Library+ HS-Source-Dirs: src+ Build-Depends:+ base >= 4.8 && < 5,+ transformers >= 0.4.0.0 ,+ foldl >= 1.4.0 ,+ pipes >= 4.1.0 ,+ streaming >= 0.2.0.0 + Exposed-Modules:+ Streaming.Eversion+ Streaming.Eversion.Pipes+ GHC-Options: -O2 -Wall++test-suite doctests+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded+ hs-source-dirs: tests+ main-is: doctests.hs+ build-depends:+ base >= 4.8 && < 5,+ doctest >= 0.10.1 ,+ foldl >= 1.1.5 ,+ pipes >= 4.1.0 ,+ pipes-text >= 0.0.2.2 ,+ pipes-bytestring >= 2.1.1 ,+ streaming >= 0.1.4.2 , + microlens >= 0.4.2.1 ++test-suite tests+ type: exitcode-stdio-1.0+ ghc-options: -Wall -threaded+ hs-source-dirs: tests+ main-is: tests.hs+ build-depends:+ base >= 4.8 && < 5,+ tasty >= 0.10.1.1 ,+ tasty-hunit >= 0.9.2 ,+ tasty-quickcheck >= 0.8.3.2 , + streaming ,+ foldl ,+ streaming-eversion+
tests/doctests.hs view
@@ -1,10 +1,10 @@-module Main where - -import Test.DocTest - -main :: IO () -main = doctest - [ - "src/Streaming/Eversion.hs", - "src/Streaming/Eversion/Pipes.hs" - ] +module Main where++import Test.DocTest++main :: IO ()+main = doctest + [+ "src/Streaming/Eversion.hs",+ "src/Streaming/Eversion/Pipes.hs"+ ]
tests/tests.hs view
@@ -1,156 +1,180 @@-module Main where - -import Data.Functor.Identity -import Data.IORef -import Test.Tasty -import Test.Tasty.HUnit --- import Test.Tasty.QuickCheck - -import qualified Control.Foldl as Foldl -import Streaming -import qualified Streaming.Prelude as S -import Streaming.Eversion - -main :: IO () -main = defaultMain tests - -tests :: TestTree -tests = testGroup "tests" - [ - testGroup "evert" - [ - testCaseEq - "empty" - ([]::[Integer]) - (Foldl.fold (evert S.toList) []) - , testCaseEq - "toList" - [1..10::Integer] - (Foldl.fold (evert S.toList) [1..10]) - ] - , testGroup "evertM" - [ - testCaseEq - "empty" - ([]::[Integer]) - (runIdentity (Foldl.foldM (evertM S.toList) [])) - , testCaseEq - "toList" - [1..10::Integer] - (runIdentity (Foldl.foldM (evertM S.toList) [1..10])) - , testCaseEqIO - "ref" - (True,[1..10::Integer]) - (do ref <- newIORef False - res <- Foldl.foldM (evertM (\s -> S.toList s <* lift (writeIORef ref True))) [1..10] - refval <- readIORef ref - return (refval,res)) - ] - , testGroup "evertMIO" - [ - testCaseEqIO - "empty" - ([]::[Integer]) - (Foldl.foldM (evertMIO S.toList) []) - , testCaseEqIO - "toList" - [1..10::Integer] - (Foldl.foldM (evertMIO S.toList) [1..10]) - , testCaseEqIO - "ref" - (True,[1..10::Integer]) - (do ref <- newIORef False - res <- Foldl.foldM (evertMIO (\s -> S.toList s <* liftIO (writeIORef ref True))) [1..10] - refval <- readIORef ref - return (refval,res)) - ] - , testGroup "transduce" - [ - testCaseEq - "empty" - ([]::[Integer]) - (Foldl.fold (transvert id Foldl.list) []) - , testCaseEq - "notempty" - ([1..5]::[Integer]) - (Foldl.fold (transvert id Foldl.list) [1..5]) - , testCaseEq - "surroundempty" - ([1,2,3,4]::[Integer]) - (Foldl.fold (transvert (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) Foldl.list) []) - , testCaseEq - "surround" - ([1,2,3,4,5,6]::[Integer]) - (Foldl.fold (transvert (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) Foldl.list) [3,4]) - , testCaseEq - "group" - ([[1,1],[2,2,2],[3,3,3]]::[[Integer]]) - (Foldl.fold (transvert (mapped S.toList . S.group) Foldl.list) [1,1,2,2,2,3,3,3]) - ] - , testGroup "transduceM" - [ - testCaseEq - "empty" - ([]::[Integer]) - (runIdentity (Foldl.foldM (transvertM id (Foldl.generalize Foldl.list)) [])) - , testCaseEq - "notempty" - ([1..5]::[Integer]) - (runIdentity (Foldl.foldM (transvertM id (Foldl.generalize Foldl.list)) [1..5])) - , testCaseEq - "surroundempty" - ([1,2,3,4]::[Integer]) - (runIdentity (Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) (Foldl.generalize Foldl.list)) [])) - , testCaseEq - "surround" - ([1,2,3,4,5,6]::[Integer]) - (runIdentity (Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4])) - , testCaseEq - "group" - ([[1,1],[2,2,2],[3,3,3]]::[[Integer]]) - (runIdentity (Foldl.foldM (transvertM (mapped S.toList . S.group) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3])) - , testCaseEqIO - "ref" - (True,[1,2,3,4,5,6]::[Integer]) - (do ref <- newIORef False - res <- Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> (lift (lift (writeIORef ref True))) *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4] - refval <- readIORef ref - return (refval,res)) - ] - , testGroup "transduceMIO" - [ - testCaseEqIO - "empty" - ([]::[Integer]) - (Foldl.foldM (transvertMIO id (Foldl.generalize Foldl.list)) []) - , testCaseEqIO - "notempty" - ([1..5]::[Integer]) - (Foldl.foldM (transvertMIO id (Foldl.generalize Foldl.list)) [1..5]) - , testCaseEqIO - "surroundempty" - ([1,2,3,4]::[Integer]) - (Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) (Foldl.generalize Foldl.list)) []) - , testCaseEqIO - "surround" - ([1,2,3,4,5,6]::[Integer]) - (Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4]) - , testCaseEqIO - "group" - ([[1,1],[2,2,2],[3,3,3]]::[[Integer]]) - (Foldl.foldM (transvertMIO (mapped S.toList . S.group) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3]) - , testCaseEqIO - "ref" - (True,[1,2,3,4,5,6]::[Integer]) - (do ref <- newIORef False - res <- Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> (liftIO (writeIORef ref True)) *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4] - refval <- readIORef ref - return (refval,res)) - ] - ] - where - testCaseEq :: (Eq a, Show a) => TestName -> a -> a -> TestTree - testCaseEq name a1 a2 = testCase name (assertEqual "" a1 a2) - testCaseEqIO :: (Eq a, Show a) => TestName -> a -> IO a -> TestTree - testCaseEqIO name a1 action = testCase name (action >>= assertEqual "" a1) - +module Main where++import Data.Functor.Identity+import Data.IORef+import Test.Tasty+import Test.Tasty.HUnit+-- import Test.Tasty.QuickCheck++import qualified Control.Foldl as Foldl+import Streaming+import qualified Streaming.Prelude as S+import Streaming.Eversion++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "tests" + [ + testGroup "evert"+ [+ testCaseEq+ "empty"+ ([]::[Integer])+ (Foldl.fold (evert S.toList) [])+ , testCaseEq+ "toList"+ [1..10::Integer]+ (Foldl.fold (evert S.toList) [1..10])+ ]+ , testGroup "evertM"+ [+ testCaseEq+ "empty"+ ([]::[Integer])+ (runIdentity (Foldl.foldM (evertM S.toList) []))+ , testCaseEq+ "toList"+ [1..10::Integer]+ (runIdentity (Foldl.foldM (evertM S.toList) [1..10]))+ , testCaseEqIO+ "ref"+ (True,[1..10::Integer])+ (do ref <- newIORef False + res <- Foldl.foldM (evertM (\s -> S.toList s <* lift (writeIORef ref True))) [1..10]+ refval <- readIORef ref+ return (refval,res))+ ]+ , testGroup "evertMIO"+ [+ testCaseEqIO+ "empty"+ ([]::[Integer])+ (Foldl.foldM (evertMIO S.toList) [])+ , testCaseEqIO+ "toList"+ [1..10::Integer]+ (Foldl.foldM (evertMIO S.toList) [1..10])+ , testCaseEqIO+ "ref"+ (True,[1..10::Integer])+ (do ref <- newIORef False + res <- Foldl.foldM (evertMIO (\s -> S.toList s <* liftIO (writeIORef ref True))) [1..10]+ refval <- readIORef ref+ return (refval,res))+ ]+ , testGroup "transduce"+ [+ testCaseEq+ "empty"+ ([]::[Integer])+ (Foldl.fold (transvert id Foldl.list) [])+ , testCaseEq+ "notempty"+ ([1..5]::[Integer])+ (Foldl.fold (transvert id Foldl.list) [1..5])+ , testCaseEq+ "surroundempty"+ ([1,2,3,4]::[Integer])+ (Foldl.fold (transvert (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) Foldl.list) [])+ , testCaseEq+ "surround"+ ([1,2,3,4,5,6]::[Integer])+ (Foldl.fold (transvert (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) Foldl.list) [3,4])+ , testCaseEq+ "dropnprefixmore"+ ([11,22,33,44,5,6]::[Integer])+ (Foldl.fold (transvert (\s -> do rest <- lift $ S.effects (S.splitAt 3 s)+ S.yield 11 *> S.yield 22 *> S.yield 33 *> S.yield 44 *> rest) Foldl.list) + [2,3,4,5,6])+ , testCaseEq+ "dropnprefixsame"+ ([11,22,33,5,6]::[Integer])+ (Foldl.fold (transvert (\s -> do rest <- lift $ S.effects (S.splitAt 3 s)+ S.yield 11 *> S.yield 22 *> S.yield 33 *> rest) Foldl.list) + [2,3,4,5,6])+ , testCaseEq+ "dropnprefixless"+ ([11,22,5,6]::[Integer])+ (Foldl.fold (transvert (\s -> do rest <- lift $ S.effects (S.splitAt 3 s)+ S.yield 11 *> S.yield 22 *> rest) Foldl.list) + [2,3,4,5,6])+ , testCaseEq+ "dropnprefix2"+ ([11,22]::[Integer])+ (Foldl.fold (transvert (\s -> do rest <- lift $ S.effects (S.splitAt 4 s)+ S.yield 11 *> S.yield 22 *> rest) Foldl.list) + [2,3])+ , testCaseEq+ "group"+ ([[1,1],[2,2,2],[3,3,3]]::[[Integer]])+ (Foldl.fold (transvert (mapped S.toList . S.group) Foldl.list) [1,1,2,2,2,3,3,3])+ ]+ , testGroup "transduceM"+ [+ testCaseEq + "empty"+ ([]::[Integer])+ (runIdentity (Foldl.foldM (transvertM id (Foldl.generalize Foldl.list)) []))+ , testCaseEq+ "notempty"+ ([1..5]::[Integer])+ (runIdentity (Foldl.foldM (transvertM id (Foldl.generalize Foldl.list)) [1..5]))+ , testCaseEq+ "surroundempty"+ ([1,2,3,4]::[Integer])+ (runIdentity (Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) (Foldl.generalize Foldl.list)) []))+ , testCaseEq+ "surround"+ ([1,2,3,4,5,6]::[Integer])+ (runIdentity (Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4]))+ , testCaseEq+ "group"+ ([[1,1],[2,2,2],[3,3,3]]::[[Integer]])+ (runIdentity (Foldl.foldM (transvertM (mapped S.toList . S.group) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3]))+ , testCaseEqIO+ "ref"+ (True,[1,2,3,4,5,6]::[Integer])+ (do ref <- newIORef False + res <- Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> (lift (lift (writeIORef ref True))) *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4]+ refval <- readIORef ref+ return (refval,res))+ ]+ , testGroup "transduceMIO"+ [+ testCaseEqIO+ "empty"+ ([]::[Integer])+ (Foldl.foldM (transvertMIO id (Foldl.generalize Foldl.list)) [])+ , testCaseEqIO+ "notempty"+ ([1..5]::[Integer])+ (Foldl.foldM (transvertMIO id (Foldl.generalize Foldl.list)) [1..5])+ , testCaseEqIO+ "surroundempty"+ ([1,2,3,4]::[Integer])+ (Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) (Foldl.generalize Foldl.list)) [])+ , testCaseEqIO+ "surround"+ ([1,2,3,4,5,6]::[Integer])+ (Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4])+ , testCaseEqIO+ "group"+ ([[1,1],[2,2,2],[3,3,3]]::[[Integer]])+ (Foldl.foldM (transvertMIO (mapped S.toList . S.group) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3])+ , testCaseEqIO+ "ref"+ (True,[1,2,3,4,5,6]::[Integer])+ (do ref <- newIORef False + res <- Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> (liftIO (writeIORef ref True)) *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4]+ refval <- readIORef ref+ return (refval,res))+ ]+ ]+ where+ testCaseEq :: (Eq a, Show a) => TestName -> a -> a -> TestTree+ testCaseEq name a1 a2 = testCase name (assertEqual "" a1 a2)+ testCaseEqIO :: (Eq a, Show a) => TestName -> a -> IO a -> TestTree+ testCaseEqIO name a1 action = testCase name (action >>= assertEqual "" a1)+