pipes-group-1.0.8/0000755000000000000000000000000013152665062012166 5ustar0000000000000000pipes-group-1.0.8/pipes-group.cabal0000644000000000000000000000303313152665062015423 0ustar0000000000000000Name: pipes-group Version: 1.0.8 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 License-File: LICENSE Copyright: 2014 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Group-Library/issues Synopsis: Group streams into substreams Description: @pipes-group@ uses @FreeT@ and lenses to group streams into sub-streams. Notable features include: . * /Perfect Streaming/: Group elements without collecting them into memory . * /Lens Support/: Use lenses to simplify many common operations . @Pipes.Group@ contains the full documentation for this library. . Read @Pipes.Group.Tutorial@ for an extensive tutorial. Category: Control, Pipes Source-Repository head Type: git Location: https://github.com/Gabriel439/Haskell-Pipes-Group-Library Library HS-Source-Dirs: src Default-Language: Haskell2010 Build-Depends: base >= 4 && < 5 , free >= 3.2 && < 5 , pipes >= 4.0 && < 4.4, pipes-parse >= 3.0.0 && < 3.1, transformers >= 0.2.0.0 && < 0.6 Exposed-Modules: Pipes.Group Pipes.Group.Tutorial GHC-Options: -O2 -Wall Test-Suite tests Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-Is: Main.hs GHC-Options: -Wall Default-Language: Haskell2010 Build-Depends: base >= 4 && < 5 , lens-family-core < 1.3, doctest >= 0.9.12 && < 0.14 pipes-group-1.0.8/Setup.hs0000644000000000000000000000005613152665062013623 0ustar0000000000000000import Distribution.Simple main = defaultMain pipes-group-1.0.8/LICENSE0000644000000000000000000000275713152665062013206 0ustar0000000000000000Copyright (c) 2014 Gabriel Gonzalez 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 Gabriel Gonzalez nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pipes-group-1.0.8/test/0000755000000000000000000000000013152665062013145 5ustar0000000000000000pipes-group-1.0.8/test/Main.hs0000644000000000000000000000013413152665062014363 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["src/Pipes/Group.hs"] pipes-group-1.0.8/src/0000755000000000000000000000000013152665062012755 5ustar0000000000000000pipes-group-1.0.8/src/Pipes/0000755000000000000000000000000013152665062014035 5ustar0000000000000000pipes-group-1.0.8/src/Pipes/Group.hs0000644000000000000000000003263713152665062015500 0ustar0000000000000000{-| Element-agnostic grouping utilities for @pipes@ See "Pipes.Group.Tutorial" for an extended tutorial Some type signatures below refer to the aliases below, which are not used in this library, but are included to simplify the documentation. @ type Groups a m x = 'FreeT' ('Producer' a m) m x type Splitter a m x = 'Producer' a m x -> Groups a m x type Transformation a m x = Groups a m x -> Groups a m x type Joiner a m x = Groups a m x -> 'Producer' a m x @ -} {-# LANGUAGE RankNTypes #-} module Pipes.Group ( -- * Lenses groups, groupsBy, groupsBy', chunksOf, -- * Transformations takes, takes', drops, maps, individually, -- * Joiners concats, intercalates, -- * Folds -- $folds folds, foldsM, -- * Re-exports -- $reexports module Control.Monad.Trans.Class, module Control.Monad.Trans.Free, module Pipes ) where import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Free (FreeF(Pure, Free), FreeT(FreeT, runFreeT)) import qualified Control.Monad.Trans.Free as F import Data.Functor.Constant (Constant(Constant, getConstant)) import Data.Functor.Identity (Identity(Identity, runIdentity)) import Pipes (Producer, yield, next) import Pipes.Parse (span, splitAt) import qualified Pipes as P import Prelude hiding (span, splitAt) type Lens a' a b' b = forall f . Functor f => (b' -> f b) -> (a' -> f a) type Setter a' a b' b = (b' -> Identity b) -> (a' -> Identity a) (^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b a ^. lens = getConstant (lens Constant a) {-| 'groupsBy' splits a 'Producer' into a 'FreeT' of 'Producer's grouped using the given equality predicate @ groupsBy p :: Monad m => Lens' ('Producer' a m x) (Groups a m x) view (groupsBy p) :: Monad m => Splitter a m x set (groupsBy p) :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x over (groupsBy p) :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x @ >>> import Lens.Family (view) >>> import Pipes (yield, each) >>> import Pipes.Prelude (toList) >>> (toList . intercalates (yield '|') . view (groupsBy (==))) (each "12233345") "1|22|333|4|5" -} groupsBy :: Monad m => (a' -> a' -> Bool) -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) groupsBy equals k p0 = fmap concats (k (_groupsBy p0)) where -- _groupsBy :: Monad m => Producer a m r -> FreeT (Producer a m) m r _groupsBy p = FreeT $ do x <- next p return $ case x of Left r -> Pure r Right (a, p') -> Free $ fmap _groupsBy (yield a >> (p' ^. span (equals a))) {-# INLINABLE groupsBy #-} {-| `groupsBy'` splits a 'Producer' into a 'FreeT' of 'Producer's grouped using the given equality predicate This differs from `groupsBy` by comparing successive elements for equality instead of comparing each element to the first member of the group >>> import Lens.Family (view) >>> import Pipes (yield, each) >>> import Pipes.Prelude (toList) >>> let cmp c1 c2 = succ c1 == c2 >>> (toList . intercalates (yield '|') . view (groupsBy' cmp)) (each "12233345") "12|23|3|345" >>> (toList . intercalates (yield '|') . view (groupsBy cmp)) (each "12233345") "122|3|3|34|5" @ groupsBy' p :: Monad m => Lens' ('Producer' a m x) (Groups a m x) view (groupsBy' p) :: Monad m => Splitter a m x set (groupsBy' p) :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x over (groupsBy' p) :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x @ -} groupsBy' :: Monad m => (a' -> a' -> Bool) -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) groupsBy' equals k p0 = fmap concats (k (_groupsBy p0)) where -- _groupsBy :: Monad m => Producer a m r -> FreeT (Producer a m) m r _groupsBy p = FreeT $ do x <- next p return $ case x of Left r -> Pure r Right (a, p') -> Free (fmap _groupsBy (loop0 (yield a >> p'))) -- loop0 -- :: Monad m -- => Producer a m r -- -> Producer a m (Producer a m r) loop0 p1 = do x <- lift (next p1) case x of Left r -> return (return r) Right (a2, p2) -> do yield a2 let loop1 a p = do y <- lift (next p) case y of Left r -> return (return r) Right (a', p') -> if equals a a' then do yield a' loop1 a' p' else return (yield a' >> p') loop1 a2 p2 {-# INLINABLE groupsBy' #-} {-| Like 'groupsBy', where the equality predicate is ('==') @ groups :: Monad m => Lens' ('Producer' a m x) (Groups a m x) view groups :: Monad m => Splitter a m x set groups :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x over groups :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x @ >>> import Lens.Family (view) >>> import Pipes (yield, each) >>> import Pipes.Prelude (toList) >>> (toList . intercalates (yield '|') . view groups) (each "12233345") "1|22|333|4|5" -} groups :: (Monad m, Eq a') => Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) groups = groupsBy (==) {-# INLINABLE groups #-} {-| 'chunksOf' is an splits a 'Producer' into a 'FreeT' of 'Producer's of fixed length @ chunksOf n :: Monad m => Lens' ('Producer' a m x) (Groups a m x) view (chunksOf n) :: Monad m => Splitter a m x set (chunksOf n) :: Monad m => Groups a m x -> 'Producer' a m x -> 'Producer' a m x over (chunksOf n) :: Monad m => Transformation a m x -> 'Producer' a m x -> 'Producer' a m x @ >>> import Lens.Family (view) >>> import Pipes (yield, each) >>> import Pipes.Prelude (toList) >>> (toList . intercalates (yield '|') . view (chunksOf 3)) (each "12233345") "122|333|45" -} chunksOf :: Monad m => Int -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) chunksOf n0 k p0 = fmap concats (k (_chunksOf p0)) where -- _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x _chunksOf p = FreeT $ do x <- next p return $ case x of Left r -> Pure r Right (a, p') -> Free $ fmap _chunksOf ((yield a >> p')^.splitAt n0) {-# INLINABLE chunksOf #-} -- | Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' -- -- @ -- concats :: Monad m => Joiner a m x -- @ concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x concats = go where go f = do x <- lift (runFreeT f) case x of Pure r -> return r Free p -> do f' <- p go f' {-# INLINABLE concats #-} {-| Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' by intercalating a 'Producer' in between them @ intercalates :: Monad m => 'Producer' a m () -> Joiner a m x @ -} intercalates :: Monad m => Producer a m () -> FreeT (Producer a m) m x -> Producer a m x intercalates sep = go0 where go0 f = do x <- lift (runFreeT f) case x of Pure r -> return r Free p -> do f' <- p go1 f' go1 f = do x <- lift (runFreeT f) case x of Pure r -> return r Free p -> do sep f' <- p go1 f' {-# INLINABLE intercalates #-} {-| @(takes n)@ only keeps the first @n@ functor layers of a 'FreeT' @ takes :: Monad m => Int -> Groups a m () -> Groups a m () @ >>> import Lens.Family (view) >>> import Pipes (yield, each) >>> import Pipes.Prelude (toList) >>> (toList . intercalates (yield '|') . takes 3 . view groups) (each "12233345") "1|22|333" -} takes :: (Functor f, Monad m) => Int -> FreeT f m () -> FreeT f m () takes = go where go n f = if (n > 0) then FreeT $ do x <- runFreeT f case x of Pure () -> return (Pure ()) Free w -> return (Free (fmap (go $! n - 1) w)) else return () {-# INLINABLE takes #-} {-| @(takes' n)@ only keeps the first @n@ 'Producer's of a 'FreeT' 'takes'' differs from 'takes' by draining unused 'Producer's in order to preserve the return value. This makes it a suitable argument for 'maps'. @ takes' :: Monad m => Int -> Transformation a m x @ -} takes' :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x takes' = go0 where go0 n f = FreeT $ if (n > 0) then do x <- runFreeT f return $ case x of Pure r -> Pure r Free p -> Free $ fmap (go0 $! n - 1) p else go1 f go1 f = do x <- runFreeT f case x of Pure r -> return (Pure r) Free p -> do f' <- P.runEffect (P.for p P.discard) go1 f' {-# INLINABLE takes' #-} {-| @(drops n)@ peels off the first @n@ 'Producer' layers of a 'FreeT' @ drops :: Monad m => Int -> Transformation a m x @ >>> import Lens.Family (view) >>> import Pipes (yield, each) >>> import Pipes.Prelude (toList) >>> (toList . intercalates (yield '|') . drops 3 . view groups) (each "12233345") "4|5" __Use carefully__: the peeling off is not free. This runs the first @n@ layers, just discarding everything they produce. -} drops :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x drops = go where go n ft | n <= 0 = ft | otherwise = FreeT $ do ff <- runFreeT ft case ff of Pure _ -> return ff Free f -> do ft' <- P.runEffect $ P.for f P.discard runFreeT $ go (n-1) ft' {-# INLINABLE drops #-} {-| Transform each individual functor layer of a 'FreeT' You can think of this as: > maps > :: (forall r . Producer a m r -> Producer b m r) > -> FreeT (Producer a m) m x -> FreeT (Producer b m) m x This is just a synonym for 'F.transFreeT' -} maps :: (Monad m, Functor g) => (forall r . f r -> g r) -> FreeT f m x -> FreeT g m x maps = F.transFreeT {-# INLINABLE maps #-} {-| Lens to transform each individual functor layer of a 'FreeT'. (@over 'individually'@) is equivalent to 'maps', but with a less general type. @ type Group a m x = 'Producer' a m (Groups a m x) set individually :: Monad m => Group a m x -> Transformation a m x over individually :: Monad m => (Group a m x -> Group a m x) -> Transformation a m x @ -} individually :: (Monad m, Functor g) => Setter (FreeT f m x) (FreeT g m x) (f (FreeT f m x)) (g (FreeT f m x)) individually nat f0 = Identity (go f0) where nat' = runIdentity . nat go f = FreeT $ do x <- runFreeT f return $ case x of Pure r -> Pure r Free w -> Free (fmap go (nat' w)) {-# INLINABLE individually #-} {- $folds These folds are designed to be compatible with the @foldl@ library. See the 'Control.Foldl.purely' and 'Control.Foldl.impurely' functions from that library for more details. For example, to count the number of 'Producer' layers in a 'FreeT', you can write: > import Control.Applicative (pure) > import qualified Control.Foldl as L > import Pipes.Group > import qualified Pipes.Prelude as P > > count :: Monad m => FreeT (Producer a m) m () -> m Int > count = P.sum . L.purely folds (pure 1) -} {-| Fold each 'Producer' of a 'FreeT' @ 'Control.Foldl.purely' folds :: Monad m => 'Control.Foldl.Fold' a b -> Groups a m r -> 'Producer' b m r @ -} folds :: Monad m => (x -> a -> x) -- ^ Step function -> x -- ^ Initial accumulator -> (x -> b) -- ^ Extraction function -> FreeT (Producer a m) m r -- ^ -> Producer b m r folds step begin done = go where go f = do x <- lift (runFreeT f) case x of Pure r -> return r Free p -> do (f', b) <- lift (fold p begin) yield b go f' fold p x = do y <- next p case y of Left f -> return (f, done x) Right (a, p') -> fold p' $! step x a {-# INLINABLE folds #-} {-| Fold each 'Producer' of a 'FreeT', monadically @ 'Control.Foldl.impurely' foldsM :: Monad m => 'Control.Foldl.FoldM' a b -> Groups a m r -> 'Producer' b m r @ -} foldsM :: Monad m => (x -> a -> m x) -- ^ Step function -> m x -- ^ Initial accumulator -> (x -> m b) -- ^ Extraction function -> FreeT (Producer a m) m r -- ^ -> Producer b m r foldsM step begin done = go where go f = do y <- lift (runFreeT f) case y of Pure r -> return r Free p -> do (f', b) <- lift $ do x <- begin foldM p x yield b go f' foldM p x = do y <- next p case y of Left f -> do b <- done x return (f, b) Right (a, p') -> do x' <- step x a foldM p' $! x' {-# INLINABLE foldsM #-} {- $reexports "Control.Monad.Trans.Class" re-exports 'lift'. "Control.Monad.Trans.Free" re-exports 'FreeF' and 'FreeT' "Pipes" re-exports 'Producer', 'yield', and 'next'. -} pipes-group-1.0.8/src/Pipes/Group/0000755000000000000000000000000013152665062015131 5ustar0000000000000000pipes-group-1.0.8/src/Pipes/Group/Tutorial.hs0000644000000000000000000002611113152665062017271 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-| @pipes-group@ builds upon @pipes@ to establish idioms for grouping streams into sub-streams without collecting elements into memory. This tutorial assumes familiarity with @pipes@ and @pipes-parse@. -} module Pipes.Group.Tutorial ( -- * Motivation -- $motivation -- * FreeT -- $freeT -- * How FreeT Works -- $advanced -- * Conclusion -- $conclusion ) where import Pipes import Pipes.Group {- $motivation Dividing a stream into sub-streams is non-trivial. To illustrate the problem, consider the following task: limit a stream to the first three groups of elements (a group means consecutive equal elements). The wrong way to do it is to read each group into memory like this: > import Lens.Family.State.Strict (zoom) > import Pipes > import Pipes.Parse > import qualified Pipes.Prelude as P > > threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () > threeGroups p0 = loop 3 p0 > where > loop 0 _ = return () > loop n p = do > (as, p') <- lift $ runStateT (zoom group drawAll) p > each as > loop (n - 1) p' The first problem is that this approach does not output any elements from each group until after parsing the entire group: >>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn 1 1 2 1 1 2 2 3 2 2 2 4 3 >>> Worse, this program will crash without outputting a single value if fed an infinitely long group of identical elements: >>> runEffect $ threeGroups (each (repeat 1)) >-> P.print A better approach is to just stream directly from the first three groups instead of storing the groups in intermediate lists: > import Lens.Family ((^.)) > import Pipes > import Pipes.Parse > import qualified Pipes.Prelude as P > > threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () > threeGroups p0 = loop 3 p0 > where > loop 0 _ = return () > loop n p = do > p' <- p ^. group > loop (n - 1) p' This will run in constant memory and stream values immediately: >>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn 1 1 1 1 2 2 2 2 2 2 3 3 4 However, this code is not very modular: we have to integrate our group creation logic with our group consumption logic. This conflicts with the @pipes@ philosophy of decoupling streaming programs into modular components. An more modular approach would be to split our logic into three steps: * Split our 'Producer' into groups * Take the first three groups * Join these three groups back into a 'Producer' But how do we split our 'Producer' into groups without loading an entire group into memory? We want to avoid solutions like the following code: > import Control.Monad (when, liftM2) > import Lens.Family.State.Strict (zoom) > import Pipes.Parse > > split :: (Monad m, Eq a) => Producer a m () -> Producer [a] m () > split p = do > ((as, eof), p') <- lift (runStateT parser p) > yield as > when (not eof) (split p') > where > parser = liftM2 (,) (zoom group drawAll) isEndOfInput ... because then we're back where we started, loading entire groups into memory. -} {- $freeT Fortunately, you can group elements while still streaming individual elements at a time. The 'FreeT' type from the @free@ package solves this problem by allowing us to build \"linked lists\" of 'Producer's. This lets you work with streams in a list-like manner. The key idea is that: > -- '~' means "is analogous to" > > -- If a Producer is like a list > Producer a m () ~ [a] > > -- ... then a 'FreeT'-delimited 'Producer' is like a list of lists > FreeT (Producer a m) m () ~ [[a]] Think of @(FreeT (Producer a m) m ())@ as a \"list of 'Producer's\". 'FreeT' nests each subsequent 'Producer' within the return value of the previous 'Producer' so that you cannot access the next 'Producer' until you completely drain the current 'Producer'. However, you rarely need to work with 'FreeT' directly. Instead, you can structure most things using \"splitters\", \"transformations\" and \"joiners\": > -- A "splitter" > Producer a m () -> FreeT (Producer a m) m () ~ [a] -> [[a]] > > -- A "transformation" > FreeT (Producer a m) m () -> FreeT (Producer a m) m () ~ [[a]] -> [[a]] > > -- A "joiner" > FreeT (Producer a m) m () -> Producer a m () ~ [[a]] -> [a] An example splitter is @(view groups)@, which splits a 'Producer' into 'FreeT'-delimited 'Producer's, one for each group of consecutive equal elements: > view groups :: (Eq a, Monad m) => Producer a m x -> FreeT (Producer a m) m x An example transformation is @(takes 3)@, which takes the first three 'Producer's from a 'FreeT' and drops the rest: > takes 3 :: Monad m => FreeT (Producer a m) m () -> FreeT (Producer a m) m () An example joiner is @concats@, which collapses a 'FreeT' of 'Producer's back down into a single 'Producer': > concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x If you compose these three functions together, you will create a function that transforms a 'Producer' to keep only the first three groups of consecutive equal elements: > import Lens.Family > import Pipes > import Pipes.Group > import qualified Pipes.Prelude as P > > threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () > threeGroups = concats . takes 3 . view groups Both splitting and joining preserve the streaming nature of 'Producer's and do not collect or buffer any values. The transformed 'Producer' still outputs values immediately and does not wait for groups to complete before producing results. >>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn 1 1 1 1 2 2 2 2 2 2 3 3 4 >>> Also, lenses simplify things even further. The reason that 'groups' is a lens is because it actually combines both a splitter and joiner into a single package. We can then use 'over' to handle both the splitting and joining for us: >>> runEffect $ over groups (takes 3) P.stdinLn >-> P.stdoutLn This behaves the same because 'over' takes care of calling the splitter before applying the transformation, then calling the inverse joiner afterward. Another useful lens is 'individually', which lets you apply transformations to each 'Producer' layer of a 'FreeT'. For example, if we wanted to add an extra @"!"@ line to the end of every group, we would write: >>> import Control.Applicative ((<*)) >>> runEffect $ over (groups . individually) (<* yield "!") P.stdinLn >-> P.stdoutLn 1 1 1 1 2 ! 2 2 2 2 2 3 ! 3 4 ! >>> Note that 'individually' is only compatible with the @lens@ package. You can alternatively use 'maps' if you are using @lens-family-core@: >>> runEffect $ over groups (maps (<* yield "!")) P.stdinLn >-> P.stdoutLn -} {- $advanced You don't necessarily have to restrict yourself to predefined 'FreeT' functions. You can also manually build or recurse over 'FreeT's of 'Producer's. For example, here is how 'concats' is implemented, which collapses all the 'Producer's within a 'FreeT' into a single 'Producer': > concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x > concats = go > where > go f = do > x <- lift (runFreeT f) -- Match against the "head" of the "list" > case x of > Pure r -> return r -- The "list" is empty > Free p -> do -- The "list" is non-empty > f' <- p -- The return value of the 'Producer' is > go f' -- the "tail" of the "list" Many patterns for 'FreeT's have equivalent analogs for lists. 'runFreeT' behaves like pattern matching on the list, except that you have to bind the result. 'Pure' is analogous to @[]@ and 'Free' is analogous to @(:)@. When you receive a 'Free' constructor that means you have a 'Producer' whose return value is the rest of the list (i.e. another 'FreeT'). You cannot access the rest of the list without running the 'Producer' to completion to retrieve this return value. The above example just runs the entire 'Producer', binds the remainder of the list to @f'@ and then recurses on that value. You can also build 'FreeT's in a manner similar to lists. For example, the 'chunksOf' lens uses the following splitter function internally: > _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x > _chunksOf p = FreeT $ do > x <- next p -- Pattern match on the 'Producer' > return $ case x of > Left r -> Pure r -- Build an empty "list" > Right (a, p') -> Free $ do -- Build a non-empty "list" > p'' <- (yield a >> p')^.splitAt n0 -- Emit the "head" > return (_chunksOf p'') -- Return the "tail" 'Pure' signifies an empty 'FreeT' (one with no 'Producer' layers), just like @[]@ signifies an empty list (one with no elements). We return 'Pure' whenever we cannot emit any more 'Producer's. 'Free' indicates that we wish to emit a 'Producer' followed by another \"list\". The 'Producer' we run directly within the body of the 'Free'. However, we store the remainder of the \"list\" within the return value of the 'Producer'. This is where @_chunksOf@ recurses to build the rest of the \"list\". To gain a better understanding for how 'FreeT' works, consult the definition of the type, which you can find in "Control.Monad.Trans.Free": > newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) } > > data FreeF f a b = Pure a | Free (f b) ... and just replace all occurrences of @f@ with @(Producer e m)@: > -- This is pseudocode > > newtype FreeT' m a = FreeT { runFreeT :: m (FreeF' a (FreeT' m a)) } > > data FreeF' a b = Pure a | Free (Producer e m b) ... which you can further think of as: > -- More pseudocode > > newtype FreeT' m a = > FreeT { runFreeT :: m (Pure a | Producer e m (FreeT' m a)) } In other words, 'runFreeT' unwraps a 'FreeT' to produce an action in the base monad which either finishes with a value of type @a@ or continues with a 'Producer' which returns a new 'FreeT'. Vice versa, if you want to build a 'FreeT', you must create an action in the base monad which returns either a 'Pure' or a 'Producer' wrapping another 'FreeT'. -} {- $conclusion This library is very small since it only contains element-agnostic grouping utilities. Downstream libraries that provide richer grouping utilities include @pipes-bytestring@ and @pipes-text@. To learn more about @pipes-group@, ask questions, or follow development, you can subscribe to the @haskell-pipes@ mailing list at: ... or you can mail the list directly at: -}