foldl-transduce 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+255/−89 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−0
• README.md +5/−2
• foldl-transduce.cabal +1/−1
• src/Control/Foldl/Transduce.hs +170/−69
• src/Control/Foldl/Transduce/Internal.hs +3/−3
• src/Control/Foldl/Transduce/Text.hs +68/−14

@@ -1,4 +1,11 @@+# 0.2.1.0++- Comonad and Extend instances for Transducer +- Added words splitter+- Added take, drop, takeWhile, dropWhile transducers+ # 0.2.0.0+ - Removed the Spliiter type. Now it's transducers for everything! - generalizeTransducer -> _generalize - simplifyTransducer -> _simplify@@ -6,6 +13,7 @@   # 0.1.2.0+ - Added explicit bifunctors dependency. - Added Transduce', TransduceM' type synonyms. - Added groups', groupsM'.

@@ -27,7 +27,10 @@ Grouping fold-side has limitations as well:  - You can't perform bracketing operations like "withFile" that span the folding-of an entire group. You can do that in pipes-group.+  of an entire group. pipes-group allows them. +- There doesn't seem to be a way to just take the first N groups in a stream+  and afterwards rejoin them.+ - You have more flexibility in pipes-group to decide how to fold a group based-on previous results.+  on previous results.

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

@@ -30,6 +30,10 @@     ,   foldsM     ,   foldsM'         -- * Transducers+    ,   take+    ,   takeWhile+    ,   drop+    ,   dropWhile     ,   surround     ,   surroundIO         -- * Splitters@@ -47,6 +51,8 @@     ,   module Control.Foldl     ) where +import Prelude hiding (take,drop,takeWhile,dropWhile)+ import Data.Bifunctor import Data.Monoid import Data.Functor.Identity@@ -58,13 +64,14 @@ import Control.Comonad import Control.Foldl (Fold(..),FoldM(..)) import qualified Control.Foldl as L-import Control.Foldl.Transduce.Internal (Pair(..),Trio(..),fstOf3)+import Control.Foldl.Transduce.Internal (Pair(..),Trio(..),_1of3)  {- $setup  >>> import qualified Control.Foldl as L >>> import Control.Foldl.Transduce >>> import Control.Applicative+>>> import Prelude hiding (take,drop,takeWhile,dropWhile)  -} @@ -112,11 +119,11 @@     The step function returns a triplet of:      * The new internal state.-    * Outputs that continues the last segment detected in the previous step.+    * Outputs that continue 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.+      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.@@ -124,6 +131,17 @@ data Transducer i o r      = forall x. Transducer (x -> i -> (x,[o],[[o]])) x (x -> (r,[o])) +instance Comonad (Transducer i o) where+    extract (Transducer _ begin done) = fst (done begin)+    {-# INLINABLE extract #-}++    duplicate (Transducer step begin done) = Transducer step begin (\x -> (Transducer step x done,[]))+    {-# INLINABLE duplicate #-}++instance Extend (Transducer i o) where+    duplicated f = duplicate f+    {-# INLINABLE duplicated #-}+ instance Functor (Transducer i o) where     fmap f (Transducer step begin done) = Transducer step begin (first f . done) @@ -161,13 +179,18 @@         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 +instance Monad m => Extend (TransducerM m i o) where+    duplicated (TransducerM step begin done) = +        TransducerM step begin (\x -> return $! (TransducerM step (return x) done,[]))+    {-# INLINABLE duplicated #-}+ {-| Apply a 'Transducer' to a 'Fold', discarding the return value of the     'Transducer'.		  >>> 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 +transduce :: Transducer i o s -> Transduction i o  transduce t = fmap snd . (transduce' t)  {-| Generalized version of 'transduce' that preserves the return value of@@ -176,7 +199,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+transduce' :: Transducer i o s -> Transduction' i o s transduce' (Transducer wstep wstate wdone) (Fold fstep fstate fdone) =     Fold step (Pair wstate fstate) done          where@@ -193,13 +216,13 @@ {-| Like 'transduce', but works on monadic 'Fold's.		  -}-transduceM :: Monad m => TransducerM m i o r -> TransductionM m i o +transduceM :: Monad m => TransducerM m i o s -> 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' :: Monad m => TransducerM m i o s -> TransductionM' m i o s transduceM' (TransducerM wstep wstate wdone) (FoldM fstep fstate fdone) =     FoldM step (liftM2 Pair wstate fstate) done          where@@ -214,6 +237,78 @@  ------------------------------------------------------------------------------ +{-| Pass the first @n@ inputs to the 'Fold', and ignore the rest.		++>>> L.fold (transduce (take 2) L.list) [1..5]+[1,2]++>>> L.fold (transduce (take 0) L.list) [1..5]+[]+-}+take :: Int -> Transducer a a ()+take howmany = +    Transducer step howmany done +    where+        step howmanypending i +            | howmanypending == 0 = +                (0,[],[])+            | otherwise = +                (pred howmanypending,[i],[]) +        done = const ((),[])++{-| 		++>>> L.fold (transduce (takeWhile (<3)) L.list) [1..5]+[1,2]+-}+takeWhile :: (a -> Bool) -> Transducer a a ()+takeWhile predicate = +    Transducer step False done +    where+        step False i = +            if predicate i +               then (False,[i],[])+               else (True,[],[])+        step True _ = +               (True,[],[])+        done = const ((),[])++{-| Ignore the firs @n@ inputs, pass all subsequent inputs to the 'Fold'.		++>>> L.fold (transduce (drop 2) L.list) [1..5]+[3,4,5]++>>> L.fold (transduce (drop 0) L.list) [1..5]+[1,2,3,4,5]+-}+drop :: Int -> Transducer a a ()+drop howmany = +    Transducer step howmany done +    where+        step howmanypending i +            | howmanypending == 0 = +                (0,[i],[]) +            | otherwise = +                (pred howmanypending,[],[])+        done = const ((),[])++{-| 		++>>> L.fold (transduce (dropWhile (<3)) L.list) [1..5]+[3,4,5]+-}+dropWhile :: (a -> Bool) -> Transducer a a ()+dropWhile predicate = +    Transducer step False done +    where+        step False i = +            if predicate i +               then (False,[],[])+               else (True,[i],[])+        step True i = +               (True,[i],[])+        done = const ((),[])+ data SurroundState = PrefixAdded | PrefixPending  {-| Adds a prefix and a suffix to the stream arriving into a 'Fold'.		@@ -229,8 +324,10 @@             (PrefixAdded, ps ++ [a],[])         step PrefixAdded a =              (PrefixAdded, [a],[])-        done PrefixPending = ((), ps ++ ss)-        done PrefixAdded = ((), ss)+        done PrefixPending = +            ((), ps ++ ss)+        done PrefixAdded = +            ((), ss)  {-| Like 'surround', but the prefix and suffix are obtained using a 'IO'     action.@@ -263,7 +360,7 @@ {-| Generalize a 'Transducer' to a 'TransducerM'.		  -}-_generalize :: Monad m => Transducer i o r -> TransducerM m i o r+_generalize :: Monad m => Transducer i o s -> TransducerM m i o s _generalize (Transducer step begin done) = TransducerM step' begin' done'     where     step' x a = return (step x a)@@ -273,7 +370,7 @@ {-| Simplify a pure 'TransducerM' to a 'Transducer'.		  -}-_simplify :: TransducerM Identity i o r -> Transducer i o r+_simplify :: TransducerM Identity i o s -> Transducer i o s _simplify (TransducerM step begin done) = Transducer step' begin' done'      where     step' x a = runIdentity (step x a)@@ -285,29 +382,29 @@     downstream.		  -}-foldify :: Transducer i o r -> Fold i r+foldify :: Transducer i o s -> Fold i s foldify (Transducer step begin done) =-    Fold (\x i -> fstOf3 (step x i)) begin (\x -> fst (done x))+    Fold (\x i -> _1of3 (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 :: Functor m => TransducerM m i o s -> FoldM m i s foldifyM (TransducerM step begin done) =-    FoldM (\x i -> fmap fstOf3 (step x i)) begin (\x -> fmap fst (done x))+    FoldM (\x i -> fmap _1of3 (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.		  -}-chokepoint :: Fold i b -> Transducer i b ()+chokepoint :: Fold a r -> Transducer a r () chokepoint (Fold fstep fstate fdone) =     (Transducer wstep fstate wdone)     where         wstep = \fstate' i -> (fstep fstate' i,[],[])         wdone = \fstate' -> ((),[fdone fstate']) -chokepointM :: Applicative m => FoldM m i b -> TransducerM m i b ()+chokepointM :: Applicative m => FoldM m a r -> TransducerM m a r () chokepointM (FoldM fstep fstate fdone) =      (TransducerM wstep fstate wdone)     where@@ -318,7 +415,7 @@ {-| Changes the base monad used by a 'TransducerM'.		  -}-hoistTransducer :: Monad m => (forall a. m a -> n a) -> TransducerM m i o r -> TransducerM n i o r +hoistTransducer :: Monad m => (forall a. m a -> n a) -> TransducerM m i o s -> TransducerM n i o s  hoistTransducer g (TransducerM step begin done) = TransducerM (\s i -> g (step s i)) (g begin) (g . done)  {-| Changes the base monad used by a 'FoldM'.		@@ -331,13 +428,14 @@  {-| 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.+    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 :: Transducer i i' r -> Transduction i' b -> Transduction i b +groups :: Transducer a b s -> Transduction b c -> Transduction a c  groups splitter transduction oldfold =      let transduction' = fmap ((,) ()) . transduction         newfold = groups' splitter L.mconcat transduction' oldfold @@ -353,38 +451,37 @@ >>> 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>") -}-groups' :: Transducer i i' s+groups' :: Transducer a b 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 +        -> Transduction' b c u -- ^ repeatedly applied for processing each group+        -> Transduction' a c (s,v) +groups' (Transducer sstep sbegin sdone) somesummarizer t somefold =+    Fold step (Trio sbegin somesummarizer (t (duplicated somefold))) done        where -        step (Trio ss summarizer' fs) i = +        step (Trio sstate summarizer innerfold) i =             let -               (ss', oldSplit, newSplits) = sstep ss i-               (summarizer'',fs') = foldl' -                   (\(summarizer_,fs_) split_ -> -                       let (u, renewed) = reset fs_-                       in (L.fold (duplicated summarizer_) [u], step' renewed split_))-                   (summarizer', step' fs oldSplit) +               (sstate', oldSplit, newSplits) = sstep sstate i+               (summarizer',innerfold') = +                   foldl' +                   (\(summarizer_,innerfold_) somesplit -> +                       let (u,resetted) = reset innerfold_+                       in  (L.fold (duplicated summarizer_) [u], feed resetted somesplit))+                   (summarizer, feed innerfold oldSplit)                     newSplits            in-           Trio ss' summarizer'' fs'-        step' = L.fold . duplicated-        reset (Fold _ fstate fdone) = -           let (u,x) = fdone fstate-           in (u,t (duplicated x))-        done (Trio ss summarizer' (Fold fstep fstate fdone)) = +           Trio sstate' summarizer' innerfold'+        feed = L.fold . duplicated+        reset (Fold _ fstate fdone) = fmap (t . duplicated) (fdone fstate) +        done (Trio sstate summarizer (Fold fstep fstate fdone)) =              let -                (s,xss) = sdone ss-                (u,extract -> x) = fdone (foldl' fstep fstate xss)-            in ((s,L.fold summarizer' [u]),x)+                (s,bss) = sdone sstate+                (u,extract -> x) = fdone (foldl' fstep fstate bss)+            in  ((s,L.fold summarizer [u]),x)  {-| Monadic version of 'groups'.		  -}-groupsM :: Monad m => TransducerM m i i' s -> TransductionM m i' b -> TransductionM m i b+groupsM :: Monad m => TransducerM m a b s -> TransductionM m b c -> TransductionM m a c groupsM splitter transduction oldfold =      let transduction' = fmap ((,) ()) . transduction         newfold = @@ -395,33 +492,33 @@ {-| 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        +groupsM' :: Monad m => TransducerM m a b s -> FoldM m u v -> TransductionM' m b c u -> TransductionM' m a c (s,v) +groupsM' (TransducerM sstep sbegin sdone) somesummarizer t somefold =+    FoldM step (sbegin >>= \x -> return (Trio x somesummarizer (t (duplicated somefold)))) done             where-        step (Trio ss summarizer' fs) i = do-            (ss', oldSplit, newSplits) <- sstep ss i -            fs' <- step' fs oldSplit-            (summarizer'',fs'') <- foldlM step'' (summarizer',fs') newSplits-            return $! Trio ss' summarizer'' fs''+        step (Trio sstate summarizer innerfold) i = do+            (sstate', oldSplit, newSplits) <- sstep sstate i +            innerfold' <- feed innerfold oldSplit+            (summarizer',innerfold'') <- foldlM step' (summarizer,innerfold') newSplits+            return $! Trio sstate' summarizer' innerfold'' -        step' = L.foldM . duplicated+        step' = \(summarizer, innerfold) is -> do+            (u,innerfold') <- reset innerfold +            summarizer' <- L.foldM (duplicated summarizer) [u]+            innerfold'' <- feed innerfold' is+            return $! (summarizer',innerfold'')  -        step'' = \(summarizer_, fs) is -> do-            (u,fs') <- reset fs -            u' <- L.foldM (duplicated summarizer_) [u]-            fs'' <- step' fs' is-            return $! (u',fs'') +        feed = L.foldM . duplicated          reset (FoldM _ fstate fdone) = do            (u,x) <- fdone =<< fstate -           return (u, t . duplicated $ x)+           return (u, t (duplicated x)) -        done (Trio ss summarizer' (FoldM fstep fstate fdone)) = do-            (s,xss) <- sdone ss-            (u,finalf) <- fdone =<< flip (foldlM fstep) xss =<< fstate-            v <- L.foldM summarizer' [u]-            r <- L.foldM finalf []+        done (Trio sstate summarizer (FoldM fstep fstate fdone)) = do+            (s,bss) <- sdone sstate+            (u,finalfold) <- fdone =<< flip (foldlM fstep) bss =<< fstate+            v <- L.foldM summarizer [u]+            r <- L.foldM finalfold []             return ((s,v),r)  {-| Summarizes each of the groups demarcated by the 'Transducer' using a@@ -429,14 +526,18 @@          The result value of the 'Transducer' is discarded. +>>> L.fold (folds (chunksOf 3) L.sum L.list) [1..7]+[6,15,7] -}-folds :: Transducer i i' r -> Fold i' b -> Transduction i b+folds :: Transducer a b s -> Fold b c -> Transduction a c folds splitter f = groups splitter (transduce (chokepoint f))  {-| Like 'folds', but preserves the return value of the 'Transducer'. +>>> L.fold (folds' (chunksOf 3) L.sum L.list) [1..7]+((),[6,15,7]) -}-folds' :: Transducer i i' s -> Fold i' b -> Transduction' i b s+folds' :: Transducer a b s -> Fold b c -> Transduction' a c s folds' splitter innerfold somefold =      fmap (bimap fst id) (groups' splitter L.mconcat innertrans somefold)     where@@ -445,14 +546,14 @@ {-| Monadic version of 'folds'.		  -}-foldsM :: (Applicative m,Monad m) => TransducerM m i i' r -> FoldM m i' b -> TransductionM m i b+foldsM :: (Applicative m,Monad m) => TransducerM m a b s -> FoldM m b c -> TransductionM m a c 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' :: (Applicative m,Monad m) => TransducerM m a b s -> FoldM m b c -> TransductionM' m a c s foldsM' splitter innerfold somefold =      fmap (bimap fst id) (groupsM' splitter (L.generalize L.mconcat) innertrans somefold)     where

@@ -2,12 +2,12 @@         -- * Strict datatypes          Pair(..)     ,   Trio(..)-    ,   fstOf3+    ,   _1of3     ) 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+_1of3 :: (a,b,c) -> a+_1of3 (x,_,_) = x

@@ -18,9 +18,10 @@     ,   stripEnd         -- * Splitters     ,   lines+    ,   words     ) where -import Prelude hiding (lines)+import Prelude hiding (lines,words) import Data.Char import Data.Monoid (mempty) import Data.Foldable (foldMap)@@ -38,7 +39,7 @@  {- $setup ->>> import Data.String hiding (lines)+>>> import Data.String hiding (lines,words) >>> import Data.Text (Text) >>> import Control.Applicative >>> import Control.Monad.Trans.Except@@ -194,25 +195,78 @@             txt : _ -> ((), [T.stripEnd txt])             _ -> ((), []) -{-| Splits a stream into lines, removing the newlines.+{-| Splits a stream of text into lines, removing the newlines. ->>> L.fold (L.groups lines id L.list) (map T.pack ["line 1\n line 2\n"])-["line 1"," line 2"]+>>> L.fold (L.groups lines (transduce (surround [T.pack "x"] [])) L.list) (map T.pack ["line 1\n line 2\n"])+["x","line 1","x"," line 2"]  >>> L.fold (L.groups lines (transduce newline) L.list) (map T.pack ["line 1\n line 2\n"]) ["line 1","\n"," line 2","\n"]++    Used with 'L.transduce', it simply removes newlines:++>>> L.fold (L.transduce lines L.list) (map T.pack ["line 1\n line 2\n"])+["line 1"," line 2"] -} 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-            let-                lastc = Data.Text.last txt == '\n'-                txts = T.lines txt-            case (previousnl,txts) of-                (_,[]) -> error "never happens"-                (True,_) -> (lastc, [], map pure txts)-                (False,t:ts) -> (lastc, [t], map pure ts)+        step previousnl txt =+            if Data.Text.null txt+               then  +                   (previousnl,[],[])+               else+                   let+                       lastc = Data.Text.last txt == '\n'+                       txts = T.lines txt+                   in+                   case (previousnl,txts) of+                       (_,[]) -> error "never happens"+                       (True,_) -> (lastc, [], map pure txts)+                       (False,t:ts) -> (lastc, [t], map pure ts)++        done _ = ((),[])+++data WordsState = +      NoLastChar+    | LastCharSpace+    | LastCharNotSpace++{-| Splits a stream of text into words, removing whitespace.++>>> L.fold (folds words L.list L.list) (map T.pack ["  a","aa ", "bb c","cc dd ","ee f","f"])+[["a","aa"],["bb"],["c","cc"],["dd"],["ee"],["f","f"]]++    Used with 'L.transduce', it simply removes all whitespace:++>>> L.fold (L.transduce words L.list) (map T.pack ["  a","aa ", "bb c","cc dd ","ee f","f"])+["a","aa","bb","c","cc","dd","ee","f","f"]+-}+words :: L.Transducer T.Text T.Text ()+words = L.Transducer step NoLastChar done +    where+        step tstate txt +            | Data.Text.null txt = (tstate,[],[])+            | blank txt = +                case tstate of+                    NoLastChar -> (NoLastChar,[],[])+                    _ -> (LastCharSpace,[],[])+            | otherwise =                    +                let nextstate = +                        if isSpace (T.last txt) +                           then LastCharSpace +                           else LastCharNotSpace+                    (oldgroup,newgroups) = case (tstate, T.words txt) of+                        (NoLastChar,w:ws) -> +                            ([w],map pure ws)+                        (LastCharSpace,ws) -> +                            ([],map pure ws)+                        (LastCharNotSpace,w:ws) -> +                            if isSpace (T.head txt)+                               then ([],map pure (w:ws))+                               else ([w],map pure ws)+                        (_,[]) -> error "never happens, txt not blank"+                in (nextstate,oldgroup,newgroups)         done _ = ((),[])