streaming-eversion 0.3.1.0 → 0.3.1.1
raw patch · 8 files changed
+684/−685 lines, 8 filesdep ~basedep ~foldldep ~pipes
Dependency ranges changed: base, foldl, pipes, streaming, transformers
Files
- CHANGELOG +18/−18
- LICENSE +28/−28
- README.md +42/−42
- src/Streaming/Eversion.hs +233/−233
- src/Streaming/Eversion/Pipes.hs +133/−134
- streaming-eversion.cabal +64/−64
- tests/doctests.hs +10/−10
- tests/tests.hs +156/−156
CHANGELOG view
@@ -1,18 +1,18 @@-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.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,233 @@-{-# 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_ + , 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 +
src/Streaming/Eversion/Pipes.hs view
@@ -1,134 +1,133 @@-{-# 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.Error->>> 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_ +-- , 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. + +-}
streaming-eversion.cabal view
@@ -1,64 +1,64 @@-Name: streaming-eversion-Version: 0.3.1.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 && < 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.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 +
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,156 @@-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 + "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) +