foldl-transduce 0.3.0.0 → 0.4.0.0

raw patch · 5 files changed

+188/−134 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• foldl-transduce.cabal +1/−1
• src/Control/Foldl/Transduce.hs +175/−130
• src/Control/Foldl/Transduce/Text.hs +2/−2
• tests/tests.hs +1/−1

@@ -1,3 +1,12 @@+# 0.4.0.0++- Changed order of parameters for groups' and groupsM'. Hopefully the new one+  is clearer.+- It was annoying to use "evenly (transduce ...)" every time. Added new+  ToTransductions' typeclass for types that can be converted to an infinite+  list of transductions.+- Added ToFold typeclass as well.+ # 0.3.0.0  - Transducers can now delimit segments in the done function, too.

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

@@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification, RankNTypes #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-}@@ -33,25 +34,25 @@     ,   foldsM     ,   foldsM'         -- * Group operations-    ,   Infinite-    ,   ReifiedTransduction (..)-    ,   groups-    ,   evenly-    ,   bisect    -        ---    ,   Moore     ,   ReifiedTransduction' (..)+    ,   reify+    ,   reify'+    ,   Moore(..)+    ,   ToTransductions' (..)+    ,   moveHead+    ,   groups+    ,   bisect     ,   groups'-    ,   evenly'         -- ** Monadic group operations-    ,   ReifiedTransductionM (..)+    ,   ReifiedTransductionM' (..)+    ,   reifyM+    ,   reifyM'+    ,   MooreM(..)+    ,   ToTransductionsM' (..)+    ,   moveHeadM     ,   groupsM-    ,   evenlyM     ,   bisectM-        ---    ,   ReifiedTransductionM' (..)     ,   groupsM'-    ,   evenlyM'         -- * Transducers     ,   ignore     ,   surround@@ -73,6 +74,8 @@     ,   quiesce     ,   quiesceWith     ,   hoistFold+    ,   ToFold(..)+    ,   ToFoldM(..)         -- * Re-exports         -- $reexports     ,   module Data.Functor.Extend@@ -140,11 +143,6 @@ -} type Transduction a b = forall x. Fold b x -> Fold a x -{-| Helper for storing a 'Transduction' safely on a container.		---}-newtype ReifiedTransduction a b = ReifiedTransduction { getTransduction :: Transduction a b }- {-| A more general from of 'Transduction' that adds new information to the     return value of the 'Fold'. @@ -156,6 +154,15 @@ -} newtype ReifiedTransduction' a b r = ReifiedTransduction' { getTransduction' :: Transduction' a b r } +{-| Convenience constructor, often useful with pure functions like 'id'.		++-}+reify :: Transduction a b -> ReifiedTransduction' a b ()+reify t = reify' (fmap (fmap ((,) ())) t)  ++reify' :: Transduction' a b r -> ReifiedTransduction' a b r+reify' = ReifiedTransduction' + {-| A stateful process that transforms a stream of inputs into a stream of     outputs, and may optionally demarcate groups in the stream of outputs. @@ -214,15 +221,19 @@ instance ToTransducer (TransducerM Identity) where     toTransducer = _simplify -{-| Like 'Transduction', but works on monadic 'Fold's.		+class ToFold t where+    toFold :: t i r -> Fold i r --}-type TransductionM m a b = forall x. Monad m => FoldM m b x -> FoldM m a x+instance ToFold Fold where+    toFold = id -{-| Helper for storing a 'TransductionM' safely on a container.		+instance ToFold (FoldM Identity) where+    toFold = L.simplify +{-| Like 'Transduction', but works on monadic 'Fold's.		+ -}-newtype ReifiedTransductionM m a b = ReifiedTransductionM { getTransductionM :: TransductionM m a b }+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.		 @@ -234,6 +245,18 @@ -} newtype ReifiedTransductionM' m a b r = ReifiedTransductionM' { getTransductionM' :: TransductionM' m a b r } +{-| Monadic version of 'reify'.		++-}+reifyM :: Monad m => TransductionM m a b -> ReifiedTransductionM' m a b ()+reifyM t = reifyM' (fmap (fmap ((,) ())) t)  ++{-| Monadic version of 'reifyM'.		++-}+reifyM' :: TransductionM' m a b r -> ReifiedTransductionM' m a b r+reifyM' = ReifiedTransductionM' + {-| Like 'Transducer', but monadic.  -}@@ -276,6 +299,15 @@ instance Monad m => ToTransducerM m Transducer where     toTransducerM = _generalize +class ToFoldM m t where+    toFoldM :: t i r -> FoldM m i r++instance (m ~ m') => ToFoldM m (FoldM m') where+    toFoldM = id++instance Monad m => ToFoldM m Fold where+    toFoldM = L.generalize+ {-| Apply a 'Transducer' to a 'Fold', discarding the return value of the     'Transducer'.		 @@ -362,7 +394,7 @@     Used as a splitter, it puts the prefix, the original stream and     the suffix in separate groups: ->>> L.fold (groups (surround "prefix" "suffix") (evenly (transduce (surround "[" "]"))) L.list) "middle"+>>> L.fold (groups (surround "prefix" "suffix") (surround "[" "]") L.list) "middle" "[prefix][middle][suffix]"  -}@@ -541,64 +573,94 @@  ------------------------------------------------------------------------------ -{-| Infinite list of values.		+{-| An unending machine that eats @u@ values and returns +    'ReifiedTransduction''s whose result type is also @u@.  -}-type Infinite e = Cofree Identity e+newtype Moore a b u = Moore { getMoore :: Cofree ((->) u) (ReifiedTransduction' a b u) } -{-| Unending machine that gives you a @b@ whenever you give it an @a@.+{-| Monadic version of 'Moore'.		  -}-type Moore a b = Cofree ((->) a) b+newtype MooreM m a b u = MooreM { getMooreM :: Cofree ((->) u) (ReifiedTransductionM' m a b u) } +{-| Prepend the head of the first argument to the second argument.		++-}+moveHead :: (ToTransductions' h,ToTransductions' t) => h a b u -> t a b u -> Moore a b u +moveHead (toTransductions' -> Moore (theHead :< _)) (toTransductions' -> Moore theTail) = Moore (theHead :< const theTail)++{-| Monadic version of 'moveHead'.		++-}+moveHeadM :: (Monad m, ToTransductionsM' m h, ToTransductionsM' m t) => h a b u -> t a b u -> MooreM m a b u +moveHeadM (toTransductionsM' -> MooreM (theHead :< _)) (toTransductionsM' -> MooreM theTail) = MooreM (theHead :< const theTail)++{-| Helper for obtaining infinite sequences of 'Transduction''s from suitable+    types (in order to avoid explicit conversions).		++-}+class ToTransductions' t where+    toTransductions' :: t a b u -> Moore a b u++instance ToTransductions' Moore where+    toTransductions' = id++instance ToTransductions' Transducer where+    toTransductions' t = toTransductions' (reify' (transduce' t))++instance ToTransductions' ReifiedTransduction' where+    toTransductions' = Moore . coiter const++{-| Monadic version of 'ToTransductions''.		++-}+class Monad m => ToTransductionsM' m t where+    toTransductionsM' :: t a b u -> MooreM m a b u++instance (m ~ m', Monad m') => ToTransductionsM' m (MooreM m') where+    toTransductionsM' = id++instance (m ~ m', Monad m') => ToTransductionsM' m (TransducerM m') where+    toTransductionsM' t = toTransductionsM' (reifyM' (transduceM' t))++instance Monad m => ToTransductionsM' m Transducer where+    toTransductionsM' (toTransducerM -> t) = toTransductionsM' (reifyM' (transduceM' t))++instance (m ~ m', Monad m') => ToTransductionsM' m (ReifiedTransductionM' m') where+    toTransductionsM' = MooreM . coiter const+ {-| Processes each of the groups demarcated by a 'Transducer' using      a 'Transduction' taken from an unending supply,      returning a 'Transduction' what works over the undivided stream of inputs.           The return value of the 'Transducer' is discarded. ->>> L.fold (groups (chunksOf 2) (evenly (transduce (surround "<" ">"))) L.list) "aabbccdd"+>>> L.fold (groups (chunksOf 2) (surround "<" ">") L.list) "aabbccdd" "<aa><bb><cc><dd>"  >>> :{      let -      transducers = flip C.unfold 0 $ \i -> (,)-         (ReifiedTransduction (transduce (surround (show i) []))) -         (Identity (succ i))+      transducers = Moore $ flip C.unfold 0 $ \i -> (,)+         (reify (transduce (surround (show i) []))) +         (const (succ i))     in L.fold (groups (chunksOf 2) transducers L.list) "aabbccdd"     :} "0aa1bb2cc3dd" -}-groups :: ToTransducer t -       => t a b s -       -> Infinite (ReifiedTransduction b c) -- ^ infinite list of transductions+groups :: (ToTransducer s, ToTransductions' t) +       => s a b r  -- ^ 'Transducer' working as a splitter.+       -> t b c () -- ^ infinite list of transductions        -> Transduction a c  groups splitter transductions oldfold = -    let transductions' = -              fmap (\rt -> -                        (ReifiedTransduction' (fmap (fmap ((,) ())) (getTransduction rt))))-            . hoistCofree (const . runIdentity)-            $ transductions -        newfold = groups' splitter L.mconcat transductions' oldfold -    in -    fmap snd newfold--{-| Use the same 'Transduction' for each group.		---}-evenly :: Transduction b c -> Infinite (ReifiedTransduction b c) -evenly = coiter Identity . ReifiedTransduction --{-| Use one transduction to process the first group, and another for the second-    and all subsequent groups.		+        fmap snd (groups' splitter transductions L.mconcat oldfold) --}-bisect :: ToTransducer t -       => t a b s -       -> Transduction b c -- ^ head-       -> Transduction b c -       -> Transduction a c -bisect t t0 t1 = groups t (ReifiedTransduction t0 :< Identity (evenly t1))+bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t)+       => s a b r -- ^ 'Transducer' working as a splitter.+       -> h b c () -- ^ Machine to process the first group+       -> t b c () -- ^ Machine to process the second and subsequent groups+       -> Transduction a c+bisect sp t1 t2 = groups sp (moveHead t1 t2)  {-| Generalized version of 'groups' that preserves the return value of the     'Transducer'.@@ -609,18 +671,18 @@  >>> :{      let -        transductions = evenly' $ \f ->-            transduce (surround "<" ">") (liftA2 (,) L.list f)-    in  L.fold (groups' (chunksOf 2) L.list transductions L.list) "aabbccdd"+        transductions = reify' $ +            \f -> transduce (surround "<" ">") (liftA2 (,) L.list f)+    in  L.fold (groups' (chunksOf 2) transductions L.list L.list) "aabbccdd"     :} (((),["<aa>","<bb>","<cc>","<dd>"]),"<aa><bb><cc><dd>") -}-groups' :: ToTransducer t-        => t a b s-        -> Fold u v -- ^ auxiliary 'Fold' that aggregates the @u@ values produced for each group-        -> Moore u (ReifiedTransduction' b c u) -- ^ a machine that eats @u@ values and spits transductions-        -> Transduction' a c (s,v) -groups' (toTransducer -> Transducer sstep sbegin sdone) somesummarizer (ReifiedTransduction' t0 :< somemachine) somefold =+groups' :: (ToTransducer s, ToFold f, ToTransductions' t)+        => s a b r -- ^ 'Transducer' working as a splitter. +        -> t b c u -- ^ machine that eats @u@ values and spits transductions+        -> f     u v -- ^ auxiliary 'Fold' that aggregates the @u@ values produced for each group+        -> Transduction' a c (r,v) +groups' (toTransducer -> Transducer sstep sbegin sdone)  (toTransductions' -> Moore (ReifiedTransduction' t0 :< somemachine)) (toFold -> somesummarizer) somefold =     Fold step (Quartet sbegin somesummarizer (t0 (duplicated somefold)) somemachine) done        where          step (Quartet sstate summarizer innerfold machine) i =@@ -654,59 +716,37 @@                 (u,finalfold) = extract innerfold'             in  ((s,L.fold summarizer' [u]),extract finalfold) -{-| Use the same 'Transduction'' for each group.--    Ignores the inputs to the Moore machine.---}-evenly' :: Transduction' b c u -> Moore u (ReifiedTransduction' b c u) -evenly' = coiter const . ReifiedTransduction' -- {-| Monadic version of 'groups'.		  -}-groupsM :: (Monad m, ToTransducerM m t)-               => t a b s -- ^-               -> Infinite (ReifiedTransductionM m b c)+groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t)+               => s a b r -- ^+               -> t b c ()                -> TransductionM m a c groupsM splitter transductions oldfold = -    let transductions' = -              fmap (\rt -> -                        ReifiedTransductionM'-                        (fmap (fmap ((,) ())) (getTransductionM rt)))-            . hoistCofree (const . runIdentity)-            $ transductions -        newfold = groupsM' splitter (L.generalize L.mconcat) transductions' oldfold -    in -    fmap snd newfold+        fmap snd (groupsM' splitter transductions L.mconcat oldfold) -{-| Monadic version of 'evenly'.		 --}-evenlyM :: TransductionM m b c -> Infinite (ReifiedTransductionM m b c) -evenlyM = coiter Identity . ReifiedTransductionM- {-| Monadic version of 'bisect'.		  -}-bisectM :: ToTransducerM m t -        => t a b s -        -> TransductionM m b c -- ^ head-        -> TransductionM m b c -        -> TransductionM m a c -bisectM t t0 t1 = groupsM t (ReifiedTransductionM t0 :< Identity (evenlyM t1))+bisectM :: (Monad m, ToTransducerM m s, ToTransductionsM' m h, ToTransductionsM' m t)+               => s a b r -- ^+               -> h b c ()+               -> t b c ()+               -> TransductionM m a c+bisectM s t1 t2 = groupsM s (moveHeadM t1 t2)  {-| Monadic version of 'groups''.		  -}-groupsM' :: (Monad m, ToTransducerM m t) -         => t a b s -         -> FoldM m u v -         -> Moore u (ReifiedTransductionM' m b c u) -- ^ a machine that eats @u@ values and spits transductions-         -> TransductionM' m a c (s,v) +groupsM' :: (Monad m, ToTransducerM m s, ToFoldM m f, ToTransductionsM' m t) +         => s a b r +         -> t b c u -- ^ +         -> f     u v +         -> TransductionM' m a c (r,v)  -groupsM' (toTransducerM -> TransducerM sstep sbegin sdone) somesummarizer (ReifiedTransductionM' t0 :< somemachine) somefold =+groupsM' (toTransducerM -> TransducerM sstep sbegin sdone) (toTransductionsM' -> MooreM (ReifiedTransductionM' t0 :< somemachine)) (toFoldM -> somesummarizer) somefold =     FoldM step (sbegin >>= \x -> return (Quartet x somesummarizer (t0 (duplicated somefold)) somemachine)) done             where         step (Quartet sstate summarizer innerfold machine) i = do@@ -738,13 +778,6 @@             r <- L.foldM finalfold []             return ((s,v),r) --{-| Monadic version of 'evenly''.		---}-evenlyM' :: TransductionM' m b c u -> Moore u (ReifiedTransductionM' m b c u) -evenlyM' = coiter const . ReifiedTransductionM'- {-| Summarizes each of the groups demarcated by the 'Transducer' using a     'Fold'.      @@ -753,34 +786,46 @@ >>> L.fold (folds (chunksOf 3) L.sum L.list) [1..7] [6,15,7] -}-folds :: ToTransducer t => t a b s -> Fold b c -> Transduction a c-folds splitter f = groups splitter (evenly (transduce (condense f)))+folds :: (ToTransducer t, ToFold f) +      => t a b s -- ^+      -> f b c +      -> Transduction a c+folds splitter (toFold -> f) = groups splitter (fmap (const ()) (condense 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' :: ToTransducer t => t a b s -> Fold b c -> Transduction' a c s-folds' splitter innerfold somefold = -    fmap (bimap fst id) (groups' splitter L.mconcat innertrans somefold)+folds' :: (ToTransducer t, ToFold f) +       => t a b s -- ^+       -> f b c +       -> Transduction' a c s+folds' splitter (toFold -> innerfold) somefold = +    fmap (bimap fst id) (groups' splitter innertrans L.mconcat somefold)     where-    innertrans = evenly' $ \x -> fmap ((,) ()) (transduce (condense innerfold) x)+    innertrans = reify' $ \x -> fmap ((,) ()) (transduce (condense innerfold) x)  {-| Monadic version of 'folds'.		  -}-foldsM :: (Applicative m, Monad m, ToTransducerM m t) => t a b s -> FoldM m b c -> TransductionM m a c-foldsM splitter f = groupsM splitter (evenlyM (transduceM (condenseM f)))+foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) +       => t a b s -- ^+       -> f b c +       -> TransductionM m a c+foldsM splitter (toFoldM -> f) = groupsM splitter (fmap (const ()) (condenseM f))  {-| Monadic version of 'folds''.		  -}-foldsM' :: (Applicative m,Monad m, ToTransducerM m t) => t 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)+foldsM' :: (Applicative m,Monad m, ToTransducerM m t, ToFoldM m f) +        => t a b s -- ^+        -> f b c +        -> TransductionM' m a c s+foldsM' splitter (toFoldM -> innerfold) somefold = +    fmap (bimap fst id) (groupsM' splitter innertrans L.mconcat somefold)     where-    innertrans = evenlyM' $ \x -> fmap ((,) ()) (transduceM (condenseM innerfold) x)+    innertrans = reifyM' $ \x -> fmap ((,) ()) (transduceM (condenseM innerfold) x)  ------------------------------------------------------------------------------ @@ -789,7 +834,7 @@ >>> L.fold (folds (chunksOf 2) L.list L.list) [1..7] [[1,2],[3,4],[5,6],[7]] ->>> L.fold (groups (chunksOf 2) (evenly (transduce (surround [] [0]))) L.list) [1..7]+>>> L.fold (groups (chunksOf 2) (surround [] [0]) L.list) [1..7] [1,2,0,3,4,0,5,6,0,7,0] -} chunksOf :: Int -> Transducer a a ()@@ -802,7 +847,7 @@  {-| Splits the stream at a given position.		 ->>> L.fold (bisect (splitAt 2) (transduce ignore) id L.list) [1..5]+>>> L.fold (bisect (splitAt 2) ignore (reify id) L.list) [1..5] [3,4,5]  -}@@ -822,7 +867,7 @@ {-| Similar to `splitAt`, but works with streams of "chunked" data like     bytestrings, texts, vectors, lists of lists...		 ->>> L.fold (bisect (chunkedSplitAt 7) (transduce ignore) id L.list) [[1..5],[6..9]]+>>> L.fold (bisect (chunkedSplitAt 7) ignore (reify id) L.list) [[1..5],[6..9]] [[8,9]]  -}@@ -851,7 +896,7 @@  {-| 		 ->>> L.fold (bisect (splitWhen (>3)) id (transduce ignore) L.list) [1..5]+>>> L.fold (bisect (splitWhen (>3)) (reify id) ignore L.list) [1..5] [1,2,3] -} splitWhen :: (a -> Bool) -> Transducer a a ()@@ -869,7 +914,7 @@ {-| Puts the last element of the input stream (if it exists) in a separate     group. ->>> L.fold (bisect splitLast id (transduce ignore) L.list) [1..5]+>>> L.fold (bisect splitLast (reify id) ignore L.list) [1..5] [1,2,3,4] -} splitLast :: Transducer a a (Maybe a)

@@ -198,10 +198,10 @@  {-| Splits a stream of text into lines, removing the newlines. ->>> L.fold (L.groups lines (evenly (transduce (surround [T.pack "x"] []))) L.list) (map T.pack ["line 1\n line 2\n"])+>>> L.fold (L.groups lines (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 (evenly (transduce newline)) L.list) (map T.pack ["line 1\n line 2\n"])+>>> L.fold (L.groups lines 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:

@@ -68,7 +68,7 @@                     inputs =                          map fromString ["invalid \xc3\x28 sequence","xxx","zzz","___"]                     fallbackfold =-                        bisectM (chunkedSplitAt 4) id (transduceM ignore) (L.generalize L.list)+                        bisectM (chunkedSplitAt 4) (reifyM id) ignore (L.generalize L.list)                 in                 do                    r <- L.foldM (quiesceWith fallbackfold foldthatfails) inputs