pipes-group 1.0.2 → 1.0.3

raw patch · 3 files changed

+106/−14 lines, 3 filesdep +doctestdep +lens-family-core

Dependencies added: doctest, lens-family-core

Files

• pipes-group.cabal +14/−2
• src/Pipes/Group.hs +86/−12
• test/Main.hs +6/−0

@@ -1,6 +1,6 @@ Name: pipes-group
-Version: 1.0.2
-Cabal-Version: >=1.8.0.2
+Version: 1.0.3
+Cabal-Version: >=1.10
 Build-Type: Simple
 License: BSD3
 License-File: LICENSE
@@ -26,6 +26,7 @@ 
 Library
     HS-Source-Dirs: src
+    Default-Language: Haskell2010
     Build-Depends:
         base         >= 4       && < 5  ,
         free         >= 3.2     && < 5  ,
@@ -36,3 +37,14 @@         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

@@ -8,6 +8,7 @@ module Pipes.Group (
     -- * Lenses
     groupsBy,
+    groupsBy',
     groups,
     chunksOf,
 
@@ -54,7 +55,10 @@ {-| 'groupsBy' splits a 'Producer' into a 'FreeT' of 'Producer's grouped using
     the given equality predicate
 
->>> P.toList . intercalates (P.yield '|') . view (groupsBy (==)) $ P.each "12233345"
+>>> 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:
@@ -65,7 +69,8 @@ -}
 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)
+    => (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
@@ -74,12 +79,72 @@         return $ case x of
             Left   r      -> Pure r
             Right (a, p') -> Free $
-                fmap _groupsBy ((yield a >> p')^.span (equals a))
+                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 ('==')
 
->>> P.toList . intercalates (P.yield '|') . view groups $ P.each "12233345"
+>>> 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:
@@ -94,7 +159,10 @@ {-| 'chunksOf' is an splits a 'Producer' into a 'FreeT' of 'Producer's of fixed
     length
 
->>> P.toList . intercalates (P.yield '|') . view (chunksOf 3) $ P.each "12233345"
+>>> 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:
@@ -153,7 +221,10 @@ 
 {-| @(takes n)@ only keeps the first @n@ functor layers of a 'FreeT'
 
->>> P.toList . intercalates (P.yield '|') . takes 3 . view groups $ P.each "12233345"
+>>> 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:
@@ -202,7 +273,10 @@ 
 {-| @(drops n)@ peels off the first @n@ 'Producer' layers of a 'FreeT'
 
->>> P.toList . intercalates (P.yield '|') . drops 3 . view groups $ P.each "12233345"
+>>> 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@
@@ -294,9 +368,9 @@         case x of
             Pure r -> return r
             Free p -> do
-	        (f', b) <- lift (fold p begin)
-	        yield b
-	        go f'
+                (f', b) <- lift (fold p begin)
+                yield b
+                go f'
 
     fold p x = do
         y <- next p
@@ -330,7 +404,7 @@             Free p -> do
                 (f', b) <- lift $ do
                     x <- begin
-		    foldM p x
+                    foldM p x
                 yield b
                 go f'
 
@@ -343,7 +417,7 @@             Right (a, p') -> do
                 x' <- step x a
                 foldM p' $! x'
-
+{-# INLINABLE foldsM #-}
 {- $reexports
     "Control.Monad.Trans.Class" re-exports 'lift'.
 

@@ -0,0 +1,6 @@+module Main where
+
+import Test.DocTest
+
+main :: IO ()
+main = doctest ["src/Pipes/Group.hs"]