pipes-group (empty) → 1.0.0

raw patch · 5 files changed

+739/−0 lines, 5 filesdep +basedep +freedep +pipessetup-changed

Dependencies added: base, free, pipes, pipes-parse, transformers

Files

LICENSE +24/−0
Setup.hs +2/−0
pipes-group.cabal +38/−0
src/Pipes/Group.hs +321/−0
src/Pipes/Group/Tutorial.hs +354/−0

+ LICENSE view

@@ -0,0 +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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ pipes-group.cabal view

@@ -0,0 +1,38 @@+Name: pipes-group+Version: 1.0.0+Cabal-Version: >=1.8.0.2+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+    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.4+    Exposed-Modules:+        Pipes.Group+        Pipes.Group.Tutorial+    GHC-Options: -O2 -Wall

+ src/Pipes/Group.hs view

@@ -0,0 +1,321 @@+{-| Element-agnostic grouping utilities for @pipes@++    See "Pipes.Group.Tutorial" for an extended tutorial+-}++{-# LANGUAGE RankNTypes #-}++module Pipes.Group (+    -- * Lenses+    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 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+    :: Monad m+    => (a -> a -> Bool) -> Lens' (Producer a 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 #-}++-- | Like 'groupsBy', where the equality predicate is ('==')+groups :: (Monad m, Eq a) => Lens' (Producer a 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+    :: Monad m => Int -> Lens' (Producer a 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'++    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'++    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'++{- $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

@@ -0,0 +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>+-}