foldl-transduce 0.1.2.3 → 0.2.0.0

raw patch · 5 files changed

+166/−130 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• foldl-transduce.cabal +1/−1
• src/Control/Foldl/Transduce.hs +145/−119
• src/Control/Foldl/Transduce/Internal.hs +3/−0
• src/Control/Foldl/Transduce/Text.hs +10/−10

@@ -1,3 +1,10 @@+# 0.2.0.0+- Removed the Spliiter type. Now it's transducers for everything!+- generalizeTransducer -> _generalize+- simplifyTransducer -> _simplify+- removed chokepoint and chokepointM++ # 0.1.2.0 - Added explicit bifunctors dependency. - Added Transduce', TransduceM' type synonyms.

@@ -1,5 +1,5 @@ Name: foldl-transduce-Version: 0.1.2.3+Version: 0.2.0.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3

@@ -20,29 +20,27 @@     ,   transduce'     ,   transduceM     ,   transduceM'-        -- * Transducers-    ,   surround-    ,   surroundIO-        -- * Transducer utilities-    ,   generalizeTransducer-    ,   simplifyTransducer-    ,   foldify-    ,   foldifyM-    ,   chokepoint -    ,   chokepointM-    ,   hoistTransducer-    ,   hoistFold-        -- * Splitter types-    ,   Splitter(..)         -- * Working with groups     ,   groups     ,   groups'     ,   groupsM     ,   groupsM'     ,   folds+    ,   folds'     ,   foldsM+    ,   foldsM'+        -- * Transducers+    ,   surround+    ,   surroundIO         -- * Splitters     ,   chunksOf+        -- * Transducer utilities+    ,   _generalize+    ,   _simplify+    ,   foldify+    ,   foldifyM+    ,   hoistTransducer+    ,   hoistFold         -- * Re-exports         -- $reexports     ,   module Data.Functor.Extend@@ -50,6 +48,7 @@     ) where  import Data.Bifunctor+import Data.Monoid import Data.Functor.Identity import Data.Functor.Extend import Data.Foldable (Foldable,foldlM,foldl',toList)@@ -59,7 +58,7 @@ import Control.Comonad import Control.Foldl (Fold(..),FoldM(..)) import qualified Control.Foldl as L-import Control.Foldl.Transduce.Internal (Pair(..),Trio(..))+import Control.Foldl.Transduce.Internal (Pair(..),Trio(..),fstOf3)  {- $setup @@ -105,32 +104,49 @@ -} type Transduction' a b r = forall x. Fold b x -> Fold a (r,x) -{-| Representation of a stateful 'Transduction' with step function, an initial-    accumulator, and a extraction function that returns a summary value of type-    @r@. Both the step function and the extraction function may send output-    downstream.+{-| A stateful process that transforms a stream of inputs into a stream of+    outputs, and may optionally demarcate groups in the stream of outputs. +    Composed of a step function, an initial state, and a extraction function. ++    The step function returns a triplet of:++    * The new internal state.+    * Outputs that continues the last segment detected in the previous step.+    * A list of lists containing outputs for segments detected in the current+    step. If the list is empty, that means no splitting has taken place in the+    current step. 'Transducer's that do not perform grouping never return anything+    other than @[]@ here. In effect, they treat the whole stream as a single group.++    The extraction function returns the 'Transducer's own result value, as+    well as any pending outputs. -} data Transducer i o r-     = forall x. Transducer (x -> i -> (x,[o])) x (x -> (r,[o]))+     = forall x. Transducer (x -> i -> (x,[o],[[o]])) x (x -> (r,[o]))  instance Functor (Transducer i o) where     fmap f (Transducer step begin done) = Transducer step begin (first f . done)  instance Bifunctor (Transducer i) where     first f (Transducer step begin done) =-        Transducer (fmap (fmap (fmap f)) . step) begin (fmap (fmap f) . done)+        Transducer (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . step) begin (fmap (fmap f) . done)     second f w = fmap f w +{-| Like 'Transduction', but works on monadic 'Fold's.		++-} type TransductionM m a b = forall x. Monad m => FoldM m b x -> FoldM m a x +{-| Like 'Transduction'', but works on monadic 'Fold's.		++-} type TransductionM' m a b r = forall x. FoldM m b x -> FoldM m a (r,x)  {-| Like 'Transducer', but monadic.  -} data TransducerM m i o r-     = forall x. TransducerM (x -> i -> m (x,[o])) (m x) (x -> m (r,[o]))+     = forall x. TransducerM (x -> i -> m (x,[o],[[o]])) (m x) (x -> m (r,[o]))  instance Monad m => Functor (TransducerM m i o) where     fmap f (TransducerM step begin done) = TransducerM step begin done'@@ -142,13 +158,13 @@  instance (Functor m, Monad m) => Bifunctor (TransducerM m i) where     first f (TransducerM step begin done) =-        TransducerM (fmap (fmap (fmap (fmap f))) . step) begin (fmap (fmap (fmap f)) . done)+        TransducerM (fmap (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss))) . step) begin (fmap (fmap (fmap f)) . done)     second f w = fmap f w  {-| Apply a 'Transducer' to a 'Fold', discarding the return value of the     'Transducer'.		 ->>> L.fold (transduce (Transducer (\_ i -> ((),[i])) () (\_ -> ('r',[]))) L.list) [1..7]+>>> L.fold (transduce (Transducer (\_ i -> ((),[i],[])) () (\_ -> ('r',[]))) L.list) [1..7] [1,2,3,4,5,6,7] -} transduce :: Transducer i o r -> Transduction i o @@ -157,7 +173,7 @@ {-| Generalized version of 'transduce' that preserves the return value of     the 'Transducer'. ->>> L.fold (transduce' (Transducer (\_ i -> ((),[i])) () (\_ -> ('r',[]))) L.list) [1..7]+>>> L.fold (transduce' (Transducer (\_ i -> ((),[i],[])) () (\_ -> ('r',[]))) L.list) [1..7] ('r',[1,2,3,4,5,6,7]) -} transduce' :: Transducer i o x -> Transduction' i o x@@ -165,25 +181,31 @@     Fold step (Pair wstate fstate) done          where             step (Pair ws fs) i = -                let (ws',os) = wstep ws i +                let (ws',os,oss) = wstep ws i                  in-                Pair ws' (foldl' fstep fs os)  +                Pair ws' (foldl' fstep fs (os ++ mconcat oss))               done (Pair ws fs) =                  let (wr,os) = wdone ws                 in                  (,) wr (fdone (foldl' fstep fs os))  +{-| Like 'transduce', but works on monadic 'Fold's.		++-} transduceM :: Monad m => TransducerM m i o r -> TransductionM m i o  transduceM t = fmap snd . (transduceM' t) +{-| Like 'transduce'', but works on monadic 'Fold's.		++-} transduceM' :: Monad m => TransducerM m i o x -> TransductionM' m i o x transduceM' (TransducerM wstep wstate wdone) (FoldM fstep fstate fdone) =     FoldM step (liftM2 Pair wstate fstate) done          where             step (Pair ws fs) i = do-                (ws',os) <- wstep ws i-                fs' <- foldlM fstep fs os+                (ws',os,oss) <- wstep ws i+                fs' <- foldlM fstep fs (os ++ mconcat oss)                 return $! Pair ws' fs'             done (Pair ws fs) = do                 (wr,os) <- wdone ws@@ -204,9 +226,9 @@     Transducer step PrefixPending done      where         step PrefixPending a = -            (PrefixAdded, ps ++ [a])+            (PrefixAdded, ps ++ [a],[])         step PrefixAdded a = -            (PrefixAdded, [a])+            (PrefixAdded, [a],[])         done PrefixPending = ((), ps ++ ss)         done PrefixAdded = ((), ss) @@ -225,9 +247,9 @@     where         step PrefixPending a = do             ps <- fmap toList prefixa-            return (PrefixAdded, ps ++ [a])+            return (PrefixAdded, ps ++ [a],[])         step PrefixAdded a = -            return (PrefixAdded, [a])+            return (PrefixAdded, [a],[])         done PrefixPending = do             ps <- fmap toList prefixa             ss <- fmap toList suffixa@@ -241,9 +263,9 @@ {-| Generalize a 'Transducer' to a 'TransducerM'.		  -}-generalizeTransducer :: Monad m => Transducer i o r -> TransducerM m i o r-generalizeTransducer (Transducer step begin done) = TransducerM step' begin' done'-  where+_generalize :: Monad m => Transducer i o r -> TransducerM m i o r+_generalize (Transducer step begin done) = TransducerM step' begin' done'+    where     step' x a = return (step x a)     begin'    = return  begin     done' x   = return (done x)@@ -251,23 +273,28 @@ {-| Simplify a pure 'TransducerM' to a 'Transducer'.		  -}-simplifyTransducer :: TransducerM Identity i o r -> Transducer i o r-simplifyTransducer (TransducerM step begin done) = Transducer step' begin' done' where+_simplify :: TransducerM Identity i o r -> Transducer i o r+_simplify (TransducerM step begin done) = Transducer step' begin' done' +    where     step' x a = runIdentity (step x a)     begin'    = runIdentity  begin     done' x   = runIdentity (done x) + {-| Transforms a 'Transducer' into a 'Fold' by forgetting about the data sent     downstream.		  -} foldify :: Transducer i o r -> Fold i r foldify (Transducer step begin done) =-    Fold (\x i -> fst (step x i)) begin (\x -> fst (done x))+    Fold (\x i -> fstOf3 (step x i)) begin (\x -> fst (done x)) +{-| Monadic version of 'foldify'.		++-} foldifyM :: Functor m => TransducerM m i o r -> FoldM m i r foldifyM (TransducerM step begin done) =-    FoldM (\x i -> fmap fst (step x i)) begin (\x -> fmap fst (done x))+    FoldM (\x i -> fmap fstOf3 (step x i)) begin (\x -> fmap fst (done x))  {-| Transforms a 'Fold' into a 'Transducer' that sends the return value of the     'Fold' downstream when upstream closes.		@@ -277,14 +304,14 @@ chokepoint (Fold fstep fstate fdone) =     (Transducer wstep fstate wdone)     where-        wstep = \fstate' i -> (fstep fstate' i,[])+        wstep = \fstate' i -> (fstep fstate' i,[],[])         wdone = \fstate' -> ((),[fdone fstate'])  chokepointM :: Applicative m => FoldM m i b -> TransducerM m i b () chokepointM (FoldM fstep fstate fdone) =      (TransducerM wstep fstate wdone)     where-        wstep = \fstate' i -> fmap (\s -> (s,[])) (fstep fstate' i)+        wstep = \fstate' i -> fmap (\s -> (s,[],[])) (fstep fstate' i)         wdone = \fstate' -> fmap (\r -> ((),[r])) (fdone fstate')  @@ -302,58 +329,35 @@  ------------------------------------------------------------------------------ -{-| A procedure for splitting a stream into delimited segments. It is-    composed of a step function, an initial state, and a /done/ function that-    may flush some accumulated output downstream.--    The step function returns a triplet of:--    * The new internal state.-    * Output that continues the last segment detected in the previous step.-    * A list of lists containing new segments detected in the current step. If-      the list is empty, that means no splitting has taken place in the current-      step.--}-data Splitter i-     = forall x. Splitter (x -> i -> (x,[i],[[i]])) x (x -> [i])--{-| Applies a 'Transduction' to all groups detected by a 'Splitter', returning-    a 'Transduction' that works over the undivided stream of inputs.		+{-| Repeatedly applies a 'Transduction' to process each of the groups+    demarcated by a 'Transducer', returning a 'Fold' what works over the+    undivided stream of inputs. The return value of the 'Transducer' is+    discarded.  >>> L.fold (groups (chunksOf 2) (transduce (surround "<" ">")) L.list) "aabbccdd" "<aa><bb><cc><dd>" -}-groups :: Splitter i -> Transduction i b -> Transduction i b -groups (Splitter sstep sbegin sdone) t f =-    Fold step (Pair sbegin (t (duplicated f))) done -    where-        step (Pair ss fs) i = -           let -               (ss', oldSplit, newSplits) = sstep ss i-               fs' = foldl' (step' . reset) (step' fs oldSplit) newSplits-           in-           Pair ss' fs'-        step' = L.fold . duplicated-        reset (Fold _ fstate fdone) = -           t (duplicated (fdone fstate)) -        done (Pair ss (Fold fstep fstate fdone)) = -            extract (fdone (foldl' fstep fstate (sdone ss)))+groups :: Transducer i i' r -> Transduction i' b -> Transduction i b +groups splitter transduction oldfold = +    let transduction' = fmap ((,) ()) . transduction+        newfold = groups' splitter L.mconcat transduction' oldfold +    in +    fmap snd newfold -{-| Generalized version of 'groups' that obtains a summary value for each-    group, aggregates them into a summary value for the whole stream, and puts-    that information in the final result.		+{-| Generalized version of 'groups' that preserves the return value of the+    'Transducer'. -    In practice, this function behaves like a combinaton of 'groups' and-    'folds' that works in a single pass.+    A summary value for each group is also calculated. They are aggregated for+    the whole stream, with the help of an auxiliary 'Fold'.  >>> L.fold (groups' (chunksOf 2) L.list (\f -> transduce (surround "<" ">") (liftA2 (,) L.list f)) L.list) "aabbccdd"-(["<aa>","<bb>","<cc>","<dd>"],"<aa><bb><cc><dd>")+(((),["<aa>","<bb>","<cc>","<dd>"]),"<aa><bb><cc><dd>") -}-groups' :: Splitter i -        -> Fold u v -- ^ for aggregating the @u@ values produced for each group-        -> Transduction' i a u -        -> Transduction' i a v -- ^ the resulting 'Fold' will return a summary @v@ of the stream-groups' (Splitter sstep sbegin sdone) summarizer t f =+groups' :: Transducer i i' s+        -> Fold u v -- ^ auxiliary 'Fold' that aggregates the @u@ values produced for each group+        -> Transduction' i' a u -- ^ repeatedly applied for processing each group+        -> Transduction' i a (s,v) +groups' (Transducer sstep sbegin sdone) summarizer t f =     Fold step (Trio sbegin summarizer (t (duplicated f))) done        where          step (Trio ss summarizer' fs) i = @@ -372,34 +376,31 @@            let (u,x) = fdone fstate            in (u,t (duplicated x))         done (Trio ss summarizer' (Fold fstep fstate fdone)) = -            let (u,extract -> x) = fdone (foldl' fstep fstate (sdone ss))-            in (L.fold summarizer' [u],x)+            let +                (s,xss) = sdone ss+                (u,extract -> x) = fdone (foldl' fstep fstate xss)+            in ((s,L.fold summarizer' [u]),x) -groupsM :: Monad m => Splitter i -> TransductionM m i b -> TransductionM m i b-groupsM (Splitter sstep sbegin sdone) t f = -    FoldM step (return (Pair sbegin (t (duplicated f)))) done        -    where-        step (Pair ss fs) i = do-             let -                 (ss', oldSplit, newSplits) = sstep ss i-             fs' <- step' fs oldSplit-             fs'' <- foldlM step'' fs' newSplits-             return $! Pair ss' fs''-        step' = L.foldM . duplicated-        step'' = \fs is -> reset fs >>= \fs' -> step' fs' is-        reset (FoldM _ fstate fdone) = -           liftM (t . duplicated) (fstate >>= fdone) -        done (Pair ss (FoldM fstep fstate fdone)) = do-            finalf <- fdone =<< flip (foldlM fstep) (sdone ss) =<< fstate-            L.foldM finalf [] +{-| Monadic version of 'groups'.		 -groupsM' :: Monad m => Splitter i -> FoldM m u v -> TransductionM' m i a u -> TransductionM' m i a v -groupsM' (Splitter sstep sbegin sdone) summarizer t f =-    FoldM step (return (Trio sbegin summarizer (t (duplicated f)))) done        +-}+groupsM :: Monad m => TransducerM m i i' s -> TransductionM m i' b -> TransductionM m i b+groupsM splitter transduction oldfold = +    let transduction' = fmap ((,) ()) . transduction+        newfold = +            groupsM' splitter (L.generalize L.mconcat) transduction' oldfold +    in +    fmap snd newfold++{-| Monadic version of 'groups''.		++-}+groupsM' :: Monad m => TransducerM m i i' s -> FoldM m u v -> TransductionM' m i' a u -> TransductionM' m i a (s,v) +groupsM' (TransducerM sstep sbegin sdone) summarizer t f =+    FoldM step (sbegin >>= \zzz -> return (Trio zzz summarizer (t (duplicated f)))) done             where         step (Trio ss summarizer' fs) i = do-            let -                (ss', oldSplit, newSplits) = sstep ss i+            (ss', oldSplit, newSplits) <- sstep ss i              fs' <- step' fs oldSplit             (summarizer'',fs'') <- foldlM step'' (summarizer',fs') newSplits             return $! Trio ss' summarizer'' fs''@@ -417,21 +418,46 @@            return (u, t . duplicated $ x)          done (Trio ss summarizer' (FoldM fstep fstate fdone)) = do-            (u,finalf) <- fdone =<< flip (foldlM fstep) (sdone ss) =<< fstate+            (s,xss) <- sdone ss+            (u,finalf) <- fdone =<< flip (foldlM fstep) xss =<< fstate             v <- L.foldM summarizer' [u]             r <- L.foldM finalf []-            return (v,r)+            return ((s,v),r) -{-| Summarizes each group detected by a 'Splitter' using a 'Fold', returning a-    'Transduction' that allows a 'Fold' to accept the original ungrouped input. +{-| Summarizes each of the groups demarcated by the 'Transducer' using a+    'Fold'. +    +    The result value of the 'Transducer' is discarded.  -}-folds :: Splitter i -> Fold i b -> Transduction i b+folds :: Transducer i i' r -> Fold i' b -> Transduction i b folds splitter f = groups splitter (transduce (chokepoint f)) -foldsM :: (Applicative m,Monad m) => Splitter i -> FoldM m i b -> TransductionM m i b+{-| Like 'folds', but preserves the return value of the 'Transducer'.++-}+folds' :: Transducer i i' s -> Fold i' b -> Transduction' i b s+folds' splitter innerfold somefold = +    fmap (bimap fst id) (groups' splitter L.mconcat innertrans somefold)+    where+    innertrans = fmap ((,) ()) . transduce (chokepoint innerfold)++{-| Monadic version of 'folds'.		++-}+foldsM :: (Applicative m,Monad m) => TransducerM m i i' r -> FoldM m i' b -> TransductionM m i b foldsM splitter f = groupsM splitter (transduceM (chokepointM f)) ++{-| Monadic version of 'folds''.		++-}+foldsM' :: (Applicative m,Monad m) => TransducerM m i i' s -> FoldM m i' b -> TransductionM' m i b s+foldsM' splitter innerfold somefold = +    fmap (bimap fst id) (groupsM' splitter (L.generalize L.mconcat) innertrans somefold)+    where+    innertrans = fmap ((,) ()) . transduceM (chokepointM innerfold)+ ------------------------------------------------------------------------------  {-| Splits a stream into chunks of fixed size.		@@ -442,13 +468,13 @@ >>> L.fold (groups (chunksOf 2) (transduce (surround [] [0])) L.list) [1..7] [1,2,0,3,4,0,5,6,0,7,0] -}-chunksOf :: Int -> Splitter a-chunksOf 0 = Splitter (\_ _ -> ((),[],repeat [])) () (error "never happens")-chunksOf groupSize = Splitter step groupSize done +chunksOf :: Int -> Transducer a a ()+chunksOf 0 = Transducer (\_ _ -> ((),[],repeat [])) () (error "never happens")+chunksOf groupSize = Transducer step groupSize done      where         step 0 a = (pred groupSize, [], [[a]])         step i a = (pred i, [a], [])-        done _ = []+        done _ = ((),[])  ------------------------------------------------------------------------------ 

@@ -2,9 +2,12 @@         -- * Strict datatypes          Pair(..)     ,   Trio(..)+    ,   fstOf3     ) where  data Pair a b = Pair !a !b  data Trio a b c = Trio !a !b !c +fstOf3 :: (a,b,c) -> a+fstOf3 (x,_,_) = x

@@ -59,7 +59,7 @@         let              T.Some txt leftovers next' = next i          in-        (Pair leftovers next', [txt])+        (Pair leftovers next',[txt],[])     done (Pair leftovers _) =          if B.null leftovers             then ((), [])@@ -120,7 +120,7 @@                 Left ue -> do                     throwE ue                 Right (T.Some txt leftovers next2) -> do-                    return (Pair leftovers next2, [txt])+                    return (Pair leftovers next2,[txt],[])         done (Pair leftovers _) = do             if B.null leftovers                 then return ((), [])@@ -165,11 +165,11 @@ stripStart :: L.Transducer T.Text T.Text () stripStart = L.Transducer step False done     where-        step True i = (True, [i])+        step True i = (True, [i],[])         step False i =             if blank i -                then (False, [])-                else (True, [T.stripStart i])+                then (False,[],[])+                else (True, [T.stripStart i],[])         done _  = ((),[])  {-| Remove trailing white space from a stream of 'Text'.		@@ -188,8 +188,8 @@         step txts i =             if blank i                 -- dangerous!-                then (i:txts, [])-                else ([i], reverse txts)+                then (i:txts, [], [])+                else ([i], reverse txts, [])         done txts = case reverse txts of             txt : _ -> ((), [T.stripEnd txt])             _ -> ((), [])@@ -202,8 +202,8 @@ >>> L.fold (L.groups lines (transduce newline) L.list) (map T.pack ["line 1\n line 2\n"]) ["line 1","\n"," line 2","\n"] -}-lines :: L.Splitter T.Text-lines = L.Splitter step False done +lines :: L.Transducer T.Text T.Text ()+lines = L.Transducer step False done      where         step previousnl txt | Data.Text.null txt = (previousnl,[],[])          step previousnl txt = do@@ -214,5 +214,5 @@                 (_,[]) -> error "never happens"                 (True,_) -> (lastc, [], map pure txts)                 (False,t:ts) -> (lastc, [t], map pure ts)-        done _ = []+        done _ = ((),[])