pipes-group 1.0.3 → 1.0.4
raw patch · 6 files changed
+902/−863 lines, 6 filesdep ~doctestdep ~transformerssetup-changed
Dependency ranges changed: doctest, transformers
Files
- LICENSE +24/−24
- Setup.hs +2/−2
- pipes-group.cabal +50/−50
- src/Pipes/Group.hs +466/−427
- src/Pipes/Group/Tutorial.hs +354/−354
- test/Main.hs +6/−6
LICENSE view
@@ -1,24 +1,24 @@-Copyright (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. +Copyright (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.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
pipes-group.cabal view
@@ -1,50 +1,50 @@-Name: pipes-group -Version: 1.0.3 -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.2, - pipes-parse >= 3.0.0 && < 3.1, - transformers >= 0.2.0.0 && < 0.5 - 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.11 +Name: pipes-group+Version: 1.0.4+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.2,+ 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.12
src/Pipes/Group.hs view
@@ -1,427 +1,466 @@-{-| Element-agnostic grouping utilities for @pipes@ - - See "Pipes.Group.Tutorial" for an extended tutorial --} - -{-# LANGUAGE RankNTypes #-} - -module Pipes.Group ( - -- * Lenses - groupsBy, - groupsBy', - groups, - 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 - ->>> import Lens.Family (view) ->>> import Pipes (yield, each) ->>> import Pipes.Prelude (toList) ->>> (toList . intercalates (yield '|') . view (groupsBy (==))) (each "12233345") -"1|22|333|4|5" - - You can think of this as: - -> groupsBy -> :: Monad m -> => (a -> a -> Bool) -> Lens' (Producer a m x) (FreeT (Producer a m) 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 (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" - - You can think of this as: - -> groupsBy' -> :: Monad m -> => (a -> a -> Bool) -> -> Lens' (Producer a m x) (FreeT (Producer a m) 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 ('==') - ->>> import Lens.Family (view) ->>> import Pipes (yield, each) ->>> import Pipes.Prelude (toList) ->>> (toList . intercalates (yield '|') . view groups) (each "12233345") -"1|22|333|4|5" - - You can think of this as: - -> groups -> :: (Monad m, Eq a) => Lens' (Producer a m x) (FreeT (Producer a m) m x) --} -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 - ->>> import Lens.Family (view) ->>> import Pipes (yield, each) ->>> import Pipes.Prelude (toList) ->>> (toList . intercalates (yield '|') . view (chunksOf 3)) (each "12233345") -"122|333|45" - - You can think of this as: - -> chunksOf -> :: Monad m => Int -> Lens' (Producer a m x) (FreeT (Producer a m) m x) --} -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 => 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 () -> 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' - ->>> import Lens.Family (view) ->>> import Pipes (yield, each) ->>> import Pipes.Prelude (toList) ->>> (toList . intercalates (yield '|') . takes 3 . view groups) (each "12233345") -"1|22|333" - - You can think of this as: - -> takes -> :: (Functor f, Monad m) -> => Int -> FreeT (Producer a m) m () -> FreeT (Producer a m) m () --} -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 -> 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' - ->>> 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 = maps -- ... with a less general type --} -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' - -> purely folds -> :: Monad m => Fold a b -> FreeT (Producer a m) 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 - -> impurely foldsM -> :: Monad m => FoldM a b -> FreeT (Producer a m) 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'. --} +{-|++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'.+-}
src/Pipes/Group/Tutorial.hs view
@@ -1,354 +1,354 @@-{-# 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<Enter> -1<Enter> -2<Enter> -1 -1 -2<Enter> -2<Enter> -3<Enter> -2 -2 -2 -4<Enter> -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 -<Consumes all memory and crashes> - - 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<Enter> -1 -1<Enter> -1 -2<Enter> -2 -2<Enter> -2 -2<Enter> -2 -3<Enter> -3 -4<Enter> - - 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<Enter> -1 -1<Enter> -1 -2<Enter> -2 -2<Enter> -2 -2<Enter> -2 -3<Enter> -3 -4<Enter> ->>> - - 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 -<Exact same behavior> - - 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<Enter> -1 -1<Enter> -1 -2<Enter> -! -2 -2<Enter> -2 -2<Enter> -2 -3<Enter> -! -3 -4<Enter> -! ->>> - - 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 -<Exact same behavior> - --} - -{- $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 occurences 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: - - <https://groups.google.com/forum/#!forum/haskell-pipes> - - ... or you can mail the list directly at: - - <mailto:haskell-pipes@googlegroups.com> --} +{-# 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<Enter>+1<Enter>+2<Enter>+1+1+2<Enter>+2<Enter>+3<Enter>+2+2+2+4<Enter>+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+<Consumes all memory and crashes>++ 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<Enter>+1+1<Enter>+1+2<Enter>+2+2<Enter>+2+2<Enter>+2+3<Enter>+3+4<Enter>++ 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<Enter>+1+1<Enter>+1+2<Enter>+2+2<Enter>+2+2<Enter>+2+3<Enter>+3+4<Enter>+>>>++ 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+<Exact same behavior>++ 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<Enter>+1+1<Enter>+1+2<Enter>+!+2+2<Enter>+2+2<Enter>+2+3<Enter>+!+3+4<Enter>+!+>>>++ 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+<Exact same behavior>++-}++{- $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:++ <https://groups.google.com/forum/#!forum/haskell-pipes>++ ... or you can mail the list directly at:++ <mailto:haskell-pipes@googlegroups.com>+-}
test/Main.hs view
@@ -1,6 +1,6 @@-module Main where - -import Test.DocTest - -main :: IO () -main = doctest ["src/Pipes/Group.hs"] +module Main where++import Test.DocTest++main :: IO ()+main = doctest ["src/Pipes/Group.hs"]