foldl-transduce 0.4.7.0 → 0.5.0.0
raw patch · 8 files changed
+106/−225 lines, 8 filesdep ~bytestringdep ~containersdep ~foldlPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring, containers, foldl, text, transformers
API changes (from Hackage documentation)
- Control.Foldl.Transduce: instance (GHC.Base.Functor m, GHC.Base.Monad m, GHC.Base.Monoid r) => Data.Profunctor.Choice (Control.Foldl.Transduce.Fallible m r)
- Control.Foldl.Transduce: quiesceWith :: (Functor m, Monad m) => FoldM m a v -> FoldM (ExceptT e m) a r -> FoldM m a (Either (e, v) r)
- Control.Foldl.Transduce: splitWhen :: (a -> Bool) -> Transducer a a ()
- Control.Foldl.Transduce.ByteString.IO: driveHandle :: (MonadIO m, ToFoldM m f) => f ByteString r -> Int -> Handle -> m r
- Control.Foldl.Transduce.ByteString.IO: toHandle :: (MonadIO m) => Handle -> FoldM m ByteString ()
- Control.Foldl.Transduce.ByteString.IO: toHandleBuilder :: (MonadIO m) => Handle -> FoldM m Builder ()
- Control.Foldl.Transduce.Internal: Pair :: !a -> !b -> Pair a b
- Control.Foldl.Transduce.Internal: Quartet :: !a -> !b -> !c -> !d -> Quartet a b c d
- Control.Foldl.Transduce.Internal: data Pair a b
- Control.Foldl.Transduce.Internal: data Quartet a b c d
- Control.Foldl.Transduce.Internal: fst3 :: (a, b, c) -> a
- Control.Foldl.Transduce.Textual: textualBreak :: TextualMonoid m => (Char -> Bool) -> Transducer m m ()
- Control.Foldl.Transduce.Textual: textualSplit :: TextualMonoid m => (Char -> Bool) -> Transducer m m ()
- Control.Foldl.Transduce.Textual: textualSplitWhen :: TextualMonoid m => (Char -> Bool) -> Transducer m m ()
+ Control.Foldl.Transduce: instance (GHC.Base.Functor m, GHC.Base.Monad m, GHC.Base.Monoid r) => Data.Profunctor.Choice.Choice (Control.Foldl.Transduce.Fallible m r)
- Control.Foldl.Transduce: bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t) => s a b r -> h b c () -> t b c () -> Transduction a c
+ Control.Foldl.Transduce: bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t) => s a b () -> h b c () -> t b c () -> Transduction a c
- Control.Foldl.Transduce: 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
+ Control.Foldl.Transduce: bisectM :: (Monad m, ToTransducerM m s, ToTransductionsM' m h, ToTransductionsM' m t) => s a b () -> h b c () -> t b c () -> TransductionM m a c
- Control.Foldl.Transduce: folds :: (ToTransducer t, ToFold f) => t a b s -> f b c -> Transduction a c
+ Control.Foldl.Transduce: folds :: (ToTransducer t, ToFold f) => t a b () -> f b c -> Transduction a c
- Control.Foldl.Transduce: foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) => t a b s -> f b c -> TransductionM m a c
+ Control.Foldl.Transduce: foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) => t a b () -> f b c -> TransductionM m a c
- Control.Foldl.Transduce: groups :: (ToTransducer s, ToTransductions' t) => s a b r -> t b c () -> Transduction a c
+ Control.Foldl.Transduce: groups :: (ToTransducer s, ToTransductions' t) => s a b () -> t b c () -> Transduction a c
- Control.Foldl.Transduce: groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t) => s a b r -> t b c () -> TransductionM m a c
+ Control.Foldl.Transduce: groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t) => s a b () -> t b c () -> TransductionM m a c
- Control.Foldl.Transduce: transduce :: ToTransducer t => t i o s -> Transduction i o
+ Control.Foldl.Transduce: transduce :: ToTransducer t => t i o () -> Transduction i o
- Control.Foldl.Transduce: transduceM :: (Monad m, ToTransducerM m t) => t i o s -> TransductionM m i o
+ Control.Foldl.Transduce: transduceM :: (Monad m, ToTransducerM m t) => t i o () -> TransductionM m i o
Files
- CHANGELOG +7/−0
- foldl-transduce.cabal +7/−10
- src/Control/Foldl/Transduce.hs +87/−68
- src/Control/Foldl/Transduce/ByteString/IO.hs +0/−60
- src/Control/Foldl/Transduce/Internal.hs +0/−13
- src/Control/Foldl/Transduce/Text.hs +2/−3
- src/Control/Foldl/Transduce/Textual.hs +0/−67
- tests/tests.hs +3/−4
CHANGELOG view
@@ -1,3 +1,10 @@+# 0.5.0.0++- Before, splitters always found at least one group, even for empty streams.+ Now, no groups are found for empty streams.+- Made some type signatures a bit more strict.+- Eliminated previously deprecated functions and modules.+ # 0.4.7.0 - Added "sections" splitter.
foldl-transduce.cabal view
@@ -1,5 +1,5 @@ Name: foldl-transduce-Version: 0.4.7.0+Version: 0.5.0.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -24,15 +24,15 @@ HS-Source-Dirs: src Build-Depends: base >= 4 && < 5 ,- bytestring >= 0.9.2.1 && < 0.11,- text >= 0.11.2.0 && < 1.3 ,- transformers >= 0.2.0.0 && < 0.5 ,- containers < 0.6 ,+ bytestring >= 0.9.2.1 ,+ text >= 0.11.2.0 ,+ transformers >= 0.2.0.0 ,+ containers , bifunctors == 5.* , profunctors == 5.* , semigroups >= 0.18 , semigroupoids >= 5.0 ,- foldl >= 1.1 && < 2 ,+ foldl >= 1.1.5 , comonad == 4.* , free == 4.* , void >= 0.6 ,@@ -40,11 +40,8 @@ monoid-subclasses == 0.4.* Exposed-Modules: Control.Foldl.Transduce,- Control.Foldl.Transduce.Text,- Control.Foldl.Transduce.Textual, Control.Foldl.Transduce.ByteString,- Control.Foldl.Transduce.ByteString.IO,- Control.Foldl.Transduce.Internal+ Control.Foldl.Transduce.Text GHC-Options: -O2 -Wall test-suite doctests
src/Control/Foldl/Transduce.hs view
@@ -88,14 +88,12 @@ , Fallible(..) , ToFold(..) , ToFoldM(..)+ -- * Deprecated -- * Re-exports -- $reexports , module Data.Functor.Extend , module Control.Foldl , module Control.Comonad.Cofree- -- * Deprecated- , splitWhen- , quiesceWith ) where import Prelude hiding (split,splitAt,break)@@ -119,9 +117,8 @@ import Control.Monad.Trans.Except import Control.Comonad import Control.Comonad.Cofree -import Control.Foldl (Fold(..),FoldM(..))+import Control.Foldl (Fold(..),FoldM(..),hoists) import qualified Control.Foldl as L-import Control.Foldl.Transduce.Internal (Pair(..),Quartet(..),fst3) {- $setup @@ -155,6 +152,15 @@ ------------------------------------------------------------------------------ +data Pair a b = Pair !a !b++data Quartet a b c d = Quartet !a !b !c !d++fst3 :: (a,b,c) -> a+fst3 (x,_,_) = x++------------------------------------------------------------------------------+ {-| A (possibly stateful) transformation on the inputs of a 'Fold'. Functions constructed with combinators like 'L.premap' or 'L.handles' from@@ -334,7 +340,7 @@ >>> L.fold (transduce (Transducer (\_ i -> ((),[i],[])) () (\_ -> ('r',[],[]))) L.list) [1..7] [1,2,3,4,5,6,7] -}-transduce :: ToTransducer t => t i o s -> Transduction i o +transduce :: ToTransducer t => t i o () -> Transduction i o transduce t = fmap snd . (transduce' t) {-| Generalized version of 'transduce' that preserves the return value of@@ -360,7 +366,7 @@ {-| Like 'transduce', but works on monadic 'Fold's. -}-transduceM :: (Monad m, ToTransducerM m t) => t i o s -> TransductionM m i o +transduceM :: (Monad m, ToTransducerM m t) => t i o () -> TransductionM m i o transduceM t = fmap snd . (transduceM' t) {-| Like 'transduce'', but works on monadic 'Fold's. @@ -525,9 +531,10 @@ {-| Changes the base monad used by a 'FoldM'. + Another name for 'Control.Foldl.hoists'. -} hoistFold :: Monad m => (forall a. m a -> n a) -> FoldM m i r -> FoldM n i r -hoistFold g (FoldM step begin done) = FoldM (\s i -> g (step s i)) (g begin) (g . done)+hoistFold = Control.Foldl.hoists {-| Turn a 'FoldM' that fails abruptly into one that encodes the error into its return value.@@ -554,21 +561,6 @@ Left e -> return (Left e) Right r -> return (Right r) ---{-| Generalized version of 'quiesce' to turn a fallible 'FoldM' into another--- that starts a "fallback fold" when it encounters an error.------ "Start folding this way, if you encounter an error, start folding this --- other way". ------ >>> L.foldM (quiesceWith (L.generalize L.length) (FoldM (\_ _-> throwE ()) (return ()) (\_ -> throwE ()))) [1..7]--- Left ((),7)----}-{-# DEPRECATED quiesceWith "The signature of this function will change." #-}-quiesceWith :: (Functor m,Monad m) => FoldM m a v -> FoldM (ExceptT e m) a r -> FoldM m a (Either (e,v) r)-quiesceWith fallback original = hoistFold (fmap (either absurd id) . runExceptT) (getFallible (do- e <- Fallible (fmap Right original)- Fallible (hoistFold lift (fmap (\x -> Left (e,x)) fallback))))- newtype Fallible m r i e = Fallible { getFallible :: FoldM (ExceptT e m) i r } bindFallible :: (Functor m,Monad m) => Fallible m r i e -> (e -> Fallible m r i e') -> Fallible m r i e'@@ -733,7 +725,7 @@ "0aa1bb2cc3dd" -} groups :: (ToTransducer s, ToTransductions' t) - => s a b r -- ^ 'Transducer' working as a splitter.+ => s a b () -- ^ 'Transducer' working as a splitter. -> t b c () -- ^ infinite list of transductions -> Transduction a c groups splitter transductions oldfold = @@ -748,12 +740,14 @@ "bbccdd" -} bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t)- => s a b r -- ^ 'Transducer' working as a splitter.+ => s a b () -- ^ '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) +data StrictSum a b = Left' !a | Right' !b+ {-| Generalized version of 'groups' that preserves the return value of the 'Transducer'. @@ -774,33 +768,48 @@ -> 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)) + (toTransductions' -> Moore (rt0 :< somemachine)) (toFold -> Fold astep abegin adone) somefold =- Fold step (Quartet sbegin somemachine abegin (t0 (duplicated somefold))) done - where + Fold step (Quartet sbegin somemachine abegin (Left' (rt0,somefold))) done + where step (Quartet sstate machine astate innerfold) i =- let - (sstate',oldSplit,newSplits) = sstep sstate i- (machine',astate',innerfold') = - foldl' - step'- (machine,astate,feed innerfold oldSplit) - newSplits+ let (sstate',oldSplit,newSplits) = sstep sstate i in- Quartet sstate' machine' astate' innerfold' + case (oldSplit,newSplits) of+ ([],[]) -> + Quartet sstate' machine astate innerfold -- pass innerfold untouched+ _ -> + let actualinnerfold = case innerfold of+ Left' (ReifiedTransduction' t0,pristine) -> t0 (duplicated pristine)+ Right' touched -> touched+ (machine',astate',innerfold') = + foldl' + step'+ (machine,astate,feed actualinnerfold oldSplit) + newSplits+ in+ Quartet sstate' machine' astate' (Right' innerfold') done (Quartet sstate machine astate innerfold) = - let - (s,oldSplit,newSplits) = sdone sstate- (_,astate',innerfold') = - foldl' - step'- (machine,astate,feed innerfold oldSplit) - newSplits- (u,finalfold) = extract innerfold'- in ((s,adone (astep astate' u)),extract finalfold)+ let (s,oldSplit,newSplits) = sdone sstate+ in+ case (oldSplit,newSplits,innerfold) of+ ([],[],Left' (_,pristine)) -> + ((s,adone astate), extract pristine)+ _ -> + let actualinnerfold = case innerfold of+ Left' (ReifiedTransduction' t0,pristine) -> t0 (duplicated pristine)+ Right' touched -> touched+ (_,astate',innerfold') = + foldl' + step'+ (machine,astate,feed actualinnerfold oldSplit) + newSplits+ (u,finalfold) = extract innerfold'+ in + ((s,adone (astep astate' u)),extract finalfold) step' (machine_,astate,innerfold_) somesplit = let (u,resetted,nextmachine) = reset machine_ innerfold_@@ -813,12 +822,11 @@ ReifiedTransduction' t1 :< nextmachine = machine u in (u,t1 (duplicated nextfold),nextmachine) - {-| Monadic version of 'groups'. -} groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t)- => s a b r -- ^+ => s a b () -- ^ -> t b c () -> TransductionM m a c groupsM splitter transductions oldfold = @@ -829,7 +837,7 @@ -} bisectM :: (Monad m, ToTransducerM m s, ToTransductionsM' m h, ToTransductionsM' m t)- => s a b r -- ^+ => s a b () -- ^ -> h b c () -> t b c () -> TransductionM m a c@@ -844,30 +852,46 @@ -> f u v -> TransductionM' m a c (r,v) groupsM' (toTransducerM -> TransducerM sstep sbegin sdone) - (toTransductionsM' -> MooreM (ReifiedTransductionM' t0 :< somemachine)) + (toTransductionsM' -> MooreM (rt0 :< somemachine)) (toFoldM -> FoldM astep abegin adone) somefold = FoldM step (do sbegin' <- sbegin abegin' <- abegin- return (Quartet sbegin' somemachine abegin' (t0 (duplicated somefold))))+ return (Quartet sbegin' somemachine abegin' (Left' (rt0,somefold)))) done where step (Quartet sstate machine astate innerfold) i = do (sstate',oldSplit, newSplits) <- sstep sstate i - innerfold' <- feed innerfold oldSplit- (machine',astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits- return $! Quartet sstate' machine' astate' innerfold'' + case (oldSplit,newSplits) of + ([],[]) -> + return $! Quartet sstate' machine astate innerfold -- pass innerfold untouched+ _ -> do+ let actualinnerfold = case innerfold of+ Left' (ReifiedTransductionM' t0,pristine) -> t0 (duplicated pristine)+ Right' touched -> touched+ innerfold' <- feed actualinnerfold oldSplit+ (machine',astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits+ return $! Quartet sstate' machine' astate' (Right' innerfold'') done (Quartet sstate machine astate innerfold) = do (s,oldSplit,newSplits) <- sdone sstate- innerfold' <- feed innerfold oldSplit- (_,astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits- (u,finalfold) <- L.foldM innerfold'' []- v <- adone =<< astep astate' u- r <- L.foldM finalfold []- return ((s,v),r)+ case (oldSplit,newSplits,innerfold) of + ([],[],Left' (_,pristine)) -> do+ a <- adone astate+ p <- L.foldM pristine []+ return ((s,a),p)+ _ -> do+ let actualinnerfold = case innerfold of+ Left' (ReifiedTransductionM' t0,pristine) -> t0 (duplicated pristine)+ Right' touched -> touched+ innerfold' <- feed actualinnerfold oldSplit+ (_,astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits+ (u,finalfold) <- L.foldM innerfold'' []+ v <- adone =<< astep astate' u+ r <- L.foldM finalfold []+ return ((s,v),r) step' (machine,astate,innerfold) is = do (u,innerfold',machine') <- reset machine innerfold @@ -892,7 +916,7 @@ [6,15,7] -} folds :: (ToTransducer t, ToFold f) - => t a b s -- ^ 'Transducer' working as a splitter.+ => t a b () -- ^ 'Transducer' working as a splitter. -> f b c -> Transduction a c folds splitter (toFold -> f) = groups splitter (fmap (const ()) (condense f))@@ -909,13 +933,13 @@ folds' splitter (toFold -> innerfold) somefold = fmap (bimap fst id) (groups' splitter innertrans unit somefold) where- innertrans = reify' $ \x -> fmap ((,) ()) (transduce (condense innerfold) x)+ innertrans = reify' $ \x -> fmap ((,) () . snd) (transduce' (condense innerfold) x) {-| Monadic version of 'folds'. -} foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) - => t a b s -- ^+ => t a b () -- ^ -> f b c -> TransductionM m a c foldsM splitter (toFoldM -> f) = groupsM splitter (fmap (const ()) (condenseM f))@@ -930,7 +954,7 @@ foldsM' splitter (toFoldM -> innerfold) somefold = fmap (bimap fst id) (groupsM' splitter innertrans unit somefold) where- innertrans = reifyM' $ \x -> fmap ((,) ()) (transduceM (condenseM innerfold) x)+ innertrans = reifyM' $ \x -> fmap ((,) () . snd) (transduceM' (condenseM innerfold) x) ------------------------------------------------------------------------------ @@ -1102,8 +1126,3 @@ {- $reexports -}---{-# DEPRECATED splitWhen "use break instead" #-}-splitWhen :: (a -> Bool) -> Transducer a a ()-splitWhen = break
− src/Control/Foldl/Transduce/ByteString/IO.hs
@@ -1,60 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ViewPatterns #-}---- |------ Pour handles into folds,--- write to handles using folds. -module Control.Foldl.Transduce.ByteString.IO {-# DEPRECATED "Use Control.Foldl.Transduce.ByteString instead." #-} (- driveHandle- , toHandle- , toHandleBuilder - ) where--import qualified Control.Foldl as L-import Control.Foldl.Transduce -import qualified Data.ByteString as B-import qualified Data.ByteString.Builder as B-import Control.Monad.IO.Class-import System.IO--{-| Feed a fold with bytes read from a 'Handle'.---}-driveHandle :: (MonadIO m,ToFoldM m f) - => f B.ByteString r - -> Int -- ^ max chunk size- -> Handle - -> m r -driveHandle (toFoldM -> f) chunkSize handle = - L.impurely consumeFunc f (B.hGetSome handle chunkSize,hIsEOF handle)- where- -- adapted from foldM in Pipes.Prelude- consumeFunc step begin done (readChunk,checkEOF) = do- x0 <- begin- loop x0- where- loop x = do- atEOF <- liftIO checkEOF- if atEOF - then done x - else do- chunk <- liftIO readChunk- x' <- step x chunk- loop $! x'---toHandle :: (MonadIO m) => Handle -> L.FoldM m B.ByteString ()-toHandle handle = - L.FoldM - (\_ b -> liftIO (B.hPut handle b)) - (return ()) - (\_ -> return ())---toHandleBuilder :: (MonadIO m) => Handle -> L.FoldM m B.Builder ()-toHandleBuilder handle = - L.FoldM- (\_ b -> liftIO (B.hPutBuilder handle b)) - (return ()) - (\_ -> return ())
− src/Control/Foldl/Transduce/Internal.hs
@@ -1,13 +0,0 @@-module Control.Foldl.Transduce.Internal (- -- * Strict datatypes - Pair(..)- , Quartet(..)- , fst3- ) where--data Pair a b = Pair !a !b--data Quartet a b c d = Quartet !a !b !c !d--fst3 :: (a,b,c) -> a-fst3 (x,_,_) = x
src/Control/Foldl/Transduce/Text.hs view
@@ -47,10 +47,7 @@ import Control.Monad.IO.Class import Control.Exception.Base import qualified Control.Foldl.Transduce as L-import Control.Foldl.Transduce.Internal (Pair(..)) import qualified Data.List-import Data.List.Split-import qualified Data.List.Split import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty @@ -65,6 +62,8 @@ >>> import Control.Foldl.Transduce -}++data Pair a b = Pair !a !b {-| Builds a decoding 'Transducer' out of a stream-oriented decoding function from "Data.Text.Encoding" and an error handler from
− src/Control/Foldl/Transduce/Textual.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE ViewPatterns #-}---- |------ This module has transducers that work on 'Text' and other text-like types.-module Control.Foldl.Transduce.Textual {-# DEPRECATED "Use Control.Foldl.Transduce.Text instead." #-} (- -- * Splitters- textualSplit- , textualBreak- -- * Deprecated- , textualSplitWhen- ) where--import Data.Monoid (mempty)-import qualified Data.Monoid.Textual as MT-import qualified Data.Monoid.Null as MN-import Control.Foldl.Transduce---{- $setup-->>> import Control.Applicative->>> import qualified Control.Foldl as L->>> import Control.Foldl.Transduce---}---{-| -->>> L.fold (folds (textualSplit (=='.')) L.list L.list) [".","bb.bb","c.c."]-[[""],["","bb"],["bb","c"],["c"],[""]]--}-textualSplit :: MT.TextualMonoid m => (Char -> Bool) -> Transducer m m ()-textualSplit predicate = Transducer step () done - where- step _ txt = case MT.split predicate txt of- x:xs -> ((),[x],map (:[]) xs)- _ -> error "never happens"- done _ = mempty---data SplitWhenWhenState = - SplitWhenConditionEncountered - | SplitWhenConditionPending--{-| -->>> L.fold (bisect (textualBreak (=='.')) (reify id) ignore L.list) ["aa","bb.bb","cc"]-["aa","bb"]--}-textualBreak :: MT.TextualMonoid m => (Char -> Bool) -> Transducer m m ()-textualBreak predicate = - Transducer step SplitWhenConditionPending done - where- step SplitWhenConditionPending (MT.break (const False) predicate -> (i0,i1)) = - if MN.null i1- then (SplitWhenConditionPending,[i0],[])- else (SplitWhenConditionEncountered,[i0],[[i1]])- step SplitWhenConditionEncountered i = - (SplitWhenConditionEncountered,[i],[])- done = mempty--{-# DEPRECATED textualSplitWhen "use textualBreak instead" #-}-textualSplitWhen :: MT.TextualMonoid m => (Char -> Bool) -> Transducer m m ()-textualSplitWhen = textualBreak -
tests/tests.hs view
@@ -161,7 +161,7 @@ testGroup "chunksOf" [ testCaseEq "emptyList3"- ([[]]::[[Int]])+ ([]::[[Int]]) (L.fold (folds (chunksOf 3) L.list L.list) []) , testCaseEq "size1" @@ -199,9 +199,8 @@ testProperty "quickcheck1" (\chunks -> -- list of words let tchunks = fmap getWord chunks in- (case TL.words (TL.fromChunks tchunks) of- [] -> [mempty]- x -> x) ==+ TL.words (TL.fromChunks tchunks)+ == (fmap TL.fromChunks (L.fold (folds words L.list L.list) tchunks))) ] ],