deferred-folds 0.6.12 → 0.7

raw patch · 12 files changed

+584/−389 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• deferred-folds.cabal +14/−3
• library/DeferredFolds/Defs/Unfoldl.hs +136/−0
• library/DeferredFolds/Defs/UnfoldlM.hs +194/−0
• library/DeferredFolds/Defs/Unfoldr.hs +129/−0
• library/DeferredFolds/Defs/UnfoldrM.hs +11/−0
• library/DeferredFolds/Types.hs +68/−0
• library/DeferredFolds/Unfold.hs +0/−190
• library/DeferredFolds/UnfoldM.hs +0/−196
• library/DeferredFolds/Unfoldl.hs +8/−0
• library/DeferredFolds/UnfoldlM.hs +8/−0
• library/DeferredFolds/Unfoldr.hs +8/−0
• library/DeferredFolds/UnfoldrM.hs +8/−0

@@ -1,7 +1,11 @@ name: deferred-folds-version: 0.6.12+version: 0.7 category: Folding synopsis: Abstractions over deferred folds+description:+  This library is in an experimental state.+  Users should be prepared for frequent updates.+stability: Experimental homepage: https://github.com/metrix-ai/deferred-folds bug-reports: https://github.com/metrix-ai/deferred-folds/issues author: Nikita Volkov <nikita.y.volkov@mail.ru>@@ -21,9 +25,16 @@   default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples   default-language: Haskell2010   exposed-modules:-    DeferredFolds.Unfold-    DeferredFolds.UnfoldM+    DeferredFolds.Unfoldl+    DeferredFolds.UnfoldlM+    DeferredFolds.Unfoldr   other-modules:+    DeferredFolds.Types+    DeferredFolds.UnfoldrM+    DeferredFolds.Defs.Unfoldl+    DeferredFolds.Defs.UnfoldlM+    DeferredFolds.Defs.Unfoldr+    DeferredFolds.Defs.UnfoldrM     DeferredFolds.Prelude   build-depends:     base >=4.7 && <5,

@@ -0,0 +1,136 @@+module DeferredFolds.Defs.Unfoldl+where++import DeferredFolds.Prelude hiding (fold)+import DeferredFolds.Types+import qualified DeferredFolds.Prelude as A+import qualified DeferredFolds.UnfoldlM as B+import qualified Data.Map.Strict as C+import qualified Data.IntMap.Strict as D+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Short.Internal as ShortByteString+++deriving instance Functor Unfoldl++instance Applicative Unfoldl where+  pure x =+    Unfoldl (\ step init -> step init x)+  (<*>) = ap++instance Alternative Unfoldl where+  empty =+    Unfoldl (const id)+  {-# INLINE (<|>) #-}+  (<|>) (Unfoldl left) (Unfoldl right) =+    Unfoldl (\ step init -> right step (left step init))++instance Monad Unfoldl where+  return = pure+  (>>=) (Unfoldl left) rightK =+    Unfoldl $ \ step init ->+    let+      newStep output x =+        case rightK x of+          Unfoldl right ->+            right step output+      in left newStep init++instance MonadPlus Unfoldl where+  mzero = empty+  mplus = (<|>)++instance Semigroup (Unfoldl a) where+  (<>) = (<|>)++instance Monoid (Unfoldl a) where+  mempty = empty+  mappend = (<>)++instance Foldable Unfoldl where+  {-# INLINE foldMap #-}+  foldMap inputMonoid = foldl' step mempty where+    step monoid input = mappend monoid (inputMonoid input)+  foldl = foldl'+  {-# INLINE foldl' #-}+  foldl' step init (Unfoldl run) = run step init++instance Eq a => Eq (Unfoldl a) where+  (==) left right = toList left == toList right++instance Show a => Show (Unfoldl a) where+  show = show . toList++{-| Apply a Gonzalez fold -}+{-# INLINE fold #-}+fold :: Fold input output -> Unfoldl input -> output+fold (Fold step init extract) (Unfoldl run) = extract (run step init)++{-| Unlift a monadic unfold -}+{-# INLINE unfoldlM #-}+unfoldlM :: UnfoldlM Identity input -> Unfoldl input+unfoldlM (UnfoldlM runFoldM) = Unfoldl (\ step init -> runIdentity (runFoldM (\ a b -> return (step a b)) init))++{-| Lift a fold input mapping function into a mapping of unfolds -}+{-# INLINE mapFoldInput #-}+mapFoldInput :: (forall x. Fold b x -> Fold a x) -> Unfoldl a -> Unfoldl b+mapFoldInput newFold unfold = Unfoldl $ \ step init -> fold (newFold (Fold step init id)) unfold++{-| Construct from any foldable -}+{-# INLINE foldable #-}+foldable :: Foldable foldable => foldable a -> Unfoldl a+foldable foldable = Unfoldl (\ step init -> A.foldl' step init foldable)++{-| Filter the values given a predicate -}+{-# INLINE filter #-}+filter :: (a -> Bool) -> Unfoldl a -> Unfoldl a+filter test (Unfoldl run) = Unfoldl (\ step -> run (\ state element -> if test element then step state element else state))++{-| Ints in the specified inclusive range -}+{-# INLINE intsInRange #-}+intsInRange :: Int -> Int -> Unfoldl Int+intsInRange from to =+  Unfoldl $ \ step init ->+  let+    loop !state int =+      if int <= to+        then loop (step state int) (succ int)+        else state+    in loop init from++{-| Associations of a map -}+{-# INLINE mapAssocs #-}+mapAssocs :: Map key value -> Unfoldl (key, value)+mapAssocs map =+  Unfoldl (\ step init -> C.foldlWithKey' (\ state key value -> step state (key, value)) init map)++{-| Associations of an intmap -}+{-# INLINE intMapAssocs #-}+intMapAssocs :: IntMap value -> Unfoldl (Int, value)+intMapAssocs intMap =+  Unfoldl (\ step init -> D.foldlWithKey' (\ state key value -> step state (key, value)) init intMap)++{-| Bytes of a bytestring -}+{-# INLINE byteStringBytes #-}+byteStringBytes :: ByteString -> Unfoldl Word8+byteStringBytes bs = Unfoldl (\ step init -> ByteString.foldl' step init bs)++{-| Bytes of a short bytestring -}+{-# INLINE shortByteStringBytes #-}+shortByteStringBytes :: ShortByteString -> Unfoldl Word8+shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#)++{-| Elements of a prim array -}+{-# INLINE primArray #-}+primArray :: (Prim prim) => PrimArray prim -> Unfoldl prim+primArray ba = Unfoldl $ \ f z -> foldlPrimArray' f z ba++{-| Elements of a prim array coming paired with indices -}+{-# INLINE primArrayWithIndices #-}+primArrayWithIndices :: (Prim prim) => PrimArray prim -> Unfoldl (Int, prim)+primArrayWithIndices pa = Unfoldl $ \ step state -> let+  !size = sizeofPrimArray pa+  iterate index !state = if index < size+    then iterate (succ index) (step state (index, indexPrimArray pa index))+    else state+  in iterate 0 state

@@ -0,0 +1,194 @@+module DeferredFolds.Defs.UnfoldlM+where++import DeferredFolds.Prelude hiding (mapM_, foldM)+import DeferredFolds.Types+import qualified DeferredFolds.Prelude as A+import qualified Data.ByteString.Internal as ByteString+import qualified Data.ByteString.Short.Internal as ShortByteString+++deriving instance Functor m => Functor (UnfoldlM m)++instance Monad m => Applicative (UnfoldlM m) where+  pure x =+    UnfoldlM (\ step init -> step init x)+  (<*>) = ap++instance Monad m => Alternative (UnfoldlM m) where+  empty =+    UnfoldlM (const return)+  {-# INLINE (<|>) #-}+  (<|>) (UnfoldlM left) (UnfoldlM right) =+    UnfoldlM (\ step init -> left step init >>= right step)++instance Monad m => Monad (UnfoldlM m) where+  return = pure+  {-# INLINE (>>=) #-}+  (>>=) (UnfoldlM left) rightK =+    UnfoldlM $ \ step init ->+    let+      newStep output x =+        case rightK x of+          UnfoldlM right ->+            right step output+      in left newStep init++instance Monad m => MonadPlus (UnfoldlM m) where+  mzero = empty+  mplus = (<|>)++instance MonadTrans UnfoldlM where+  lift m = UnfoldlM (\ step init -> m >>= step init)++instance Monad m => Semigroup (UnfoldlM m a) where+  (<>) = (<|>)++instance Monad m => Monoid (UnfoldlM m a) where+  mempty = empty+  mappend = (<>)++instance Foldable (UnfoldlM Identity) where+  {-# INLINE foldMap #-}+  foldMap inputMonoid = foldl' step mempty where+    step monoid input = mappend monoid (inputMonoid input)+  foldl = foldl'+  {-# INLINE foldl' #-}+  foldl' step init (UnfoldlM run) =+    runIdentity (run identityStep init)+    where+      identityStep state input = return (step state input)++instance Eq a => Eq (UnfoldlM Identity a) where+  (==) left right = toList left == toList right++instance Show a => Show (UnfoldlM Identity a) where+  show = show . toList++{-| Check whether it's empty -}+{-# INLINE null #-}+null :: Monad m => UnfoldlM m input -> m Bool+null (UnfoldlM run) = run (\ _ _ -> return False) True++{-| Perform a monadic strict left fold -}+{-# INLINE foldlM' #-}+foldlM' :: Monad m => (output -> input -> m output) -> output -> UnfoldlM m input -> m output+foldlM' step init (UnfoldlM run) =+  run step init++{-| A more efficient implementation of mapM_ -}+{-# INLINE mapM_ #-}+mapM_ :: Monad m => (input -> m ()) -> UnfoldlM m input -> m ()+mapM_ step = foldlM' (const step) ()++{-| Same as 'mapM_' with arguments flipped -}+{-# INLINE forM_ #-}+forM_ :: Monad m => UnfoldlM m input -> (input -> m ()) -> m ()+forM_ = flip mapM_++{-| Apply a Gonzalez fold -}+{-# INLINE fold #-}+fold :: Fold input output -> UnfoldlM Identity input -> output+fold (Fold step init extract) = extract . foldl' step init++{-| Apply a monadic Gonzalez fold -}+{-# INLINE foldM #-}+foldM :: Monad m => FoldM m input output -> UnfoldlM m input -> m output+foldM (FoldM step init extract) view =+  do+    initialState <- init+    finalState <- foldlM' step initialState view+    extract finalState++{-| Lift a fold input mapping function into a mapping of unfolds -}+{-# INLINE mapFoldMInput #-}+mapFoldMInput :: Monad m => (forall x. FoldM m b x -> FoldM m a x) -> UnfoldlM m a -> UnfoldlM m b+mapFoldMInput newFoldM unfoldM = UnfoldlM $ \ step init -> foldM (newFoldM (FoldM step (return init) return)) unfoldM++{-| Construct from any foldable -}+{-# INLINE foldable #-}+foldable :: (Monad m, Foldable foldable) => foldable a -> UnfoldlM m a+foldable foldable = UnfoldlM (\ step init -> A.foldlM step init foldable)++{-| Construct from a specification of how to execute a left-fold -}+{-# INLINE foldlRunner #-}+foldlRunner :: Monad m => (forall x. (x -> a -> x) -> x -> x) -> UnfoldlM m a+foldlRunner run = UnfoldlM (\ stepM state -> run (\ stateM a -> stateM >>= \state -> stepM state a) (return state))++{-| Construct from a specification of how to execute a right-fold -}+{-# INLINE foldrRunner #-}+foldrRunner :: Monad m => (forall x. (a -> x -> x) -> x -> x) -> UnfoldlM m a+foldrRunner run = UnfoldlM (\ stepM -> run (\ x k z -> stepM z x >>= k) return)++unfoldr :: Monad m => Unfoldr a -> UnfoldlM m a+unfoldr (Unfoldr unfoldr) = foldrRunner unfoldr++{-| Filter the values given a predicate -}+{-# INLINE filter #-}+filter :: Monad m => (a -> m Bool) -> UnfoldlM m a -> UnfoldlM m a+filter test (UnfoldlM run) = UnfoldlM (\ step -> run (\ state element -> test element >>= bool (return state) (step state element)))++{-| Ints in the specified inclusive range -}+{-# INLINE intsInRange #-}+intsInRange :: Monad m => Int -> Int -> UnfoldlM m Int+intsInRange from to =+  UnfoldlM $ \ step init ->+  let+    loop !state int =+      if int <= to+        then do+          newState <- step state int+          loop newState (succ int)+        else return state+    in loop init from++{-| TVar contents -}+{-# INLINE tVarValue #-}+tVarValue :: TVar a -> UnfoldlM STM a+tVarValue var = UnfoldlM $ \ step state -> do+  a <- readTVar var+  step state a++{-| Change the base monad using invariant natural transformations -}+{-# INLINE hoist #-}+hoist :: (forall a. m a -> n a) -> (forall a. n a -> m a) -> UnfoldlM m a -> UnfoldlM n a+hoist trans1 trans2 (UnfoldlM unfold) = UnfoldlM $ \ step init -> +  trans1 (unfold (\ a b -> trans2 (step a b)) init)++{-| Bytes of a bytestring -}+{-# INLINABLE byteStringBytes #-}+byteStringBytes :: ByteString -> UnfoldlM IO Word8+byteStringBytes (ByteString.PS fp off len) =+  UnfoldlM $ \ step init ->+  withForeignPtr fp $ \ ptr ->+  let+    endPtr = plusPtr ptr (off + len)+    iterate !state !ptr = if ptr == endPtr+      then return state+      else do+        x <- peek ptr+        newState <- step state x+        iterate newState (plusPtr ptr 1)+    in iterate init (plusPtr ptr off)++{-| Bytes of a short bytestring -}+{-# INLINE shortByteStringBytes #-}+shortByteStringBytes :: Monad m => ShortByteString -> UnfoldlM m Word8+shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#)++{-| Elements of a prim array -}+{-# INLINE primArray #-}+primArray :: (Monad m, Prim prim) => PrimArray prim -> UnfoldlM m prim+primArray pa = UnfoldlM $ \ f z -> foldlPrimArrayM' f z pa++{-| Elements of a prim array coming paired with indices -}+{-# INLINE primArrayWithIndices #-}+primArrayWithIndices :: (Monad m, Prim prim) => PrimArray prim -> UnfoldlM m (Int, prim)+primArrayWithIndices pa = UnfoldlM $ \ step state -> let+  !size = sizeofPrimArray pa+  iterate index !state = if index < size+    then do+      newState <- step state (index, indexPrimArray pa index)+      iterate (succ index) newState+    else return state+  in iterate 0 state

@@ -0,0 +1,129 @@+module DeferredFolds.Defs.Unfoldr+where++import DeferredFolds.Prelude hiding (fold)+import DeferredFolds.Types+import qualified Data.Map.Strict as Map+import qualified Data.IntMap.Strict as IntMap+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Short.Internal as ShortByteString+++deriving instance Functor Unfoldr++instance Applicative Unfoldr where+  pure x = Unfoldr (\ step -> step x)+  (<*>) = ap++instance Alternative Unfoldr where+  empty = Unfoldr (const id)+  {-# INLINE (<|>) #-}+  (<|>) (Unfoldr left) (Unfoldr right) = Unfoldr (\ step init -> left step (right step init))++instance Monad Unfoldr where+  return = pure+  {-# INLINE (>>=) #-}+  (>>=) (Unfoldr left) rightK =+    Unfoldr $ \ step -> left $ \ input -> case rightK input of Unfoldr right -> right step++instance MonadPlus Unfoldr where+  mzero = empty+  mplus = (<|>)++instance Semigroup (Unfoldr a) where+  (<>) = (<|>)++instance Monoid (Unfoldr a) where+  mempty = empty+  mappend = (<>)++instance Foldable Unfoldr where+  {-# INLINE foldMap #-}+  foldMap fn (Unfoldr unfoldr) = unfoldr (mappend . fn) mempty+  {-# INLINE foldr #-}+  foldr step state (Unfoldr run) = run step state+  foldl = foldl'+  {-# INLINE foldl' #-}+  foldl' leftStep state (Unfoldr unfoldr) = unfoldr rightStep id state where+    rightStep element k state = k $! leftStep state element++instance Eq a => Eq (Unfoldr a) where+  (==) left right = toList left == toList right++instance Show a => Show (Unfoldr a) where+  show = show . toList++{-| Apply a Gonzalez fold -}+{-# INLINE fold #-}+fold :: Fold input output -> Unfoldr input -> output+fold (Fold step init extract) = extract . foldl' step init++{-| Unlift a monadic unfold -}+{-# INLINE unfoldrM #-}+unfoldrM :: UnfoldrM Identity input -> Unfoldr input+unfoldrM (UnfoldrM runFoldM) = Unfoldr (\ step init -> runIdentity (runFoldM (\ a b -> return (step a b)) init))++{-| Construct from any foldable -}+{-# INLINE foldable #-}+foldable :: Foldable foldable => foldable a -> Unfoldr a+foldable foldable = Unfoldr (\ step init -> foldr step init foldable)++{-| Filter the values given a predicate -}+{-# INLINE filter #-}+filter :: (a -> Bool) -> Unfoldr a -> Unfoldr a+filter test (Unfoldr run) = Unfoldr (\ step -> run (\ element state -> if test element then step element state else state))++{-# INLINE intsFrom #-}+intsFrom :: Int -> Unfoldr Int+intsFrom from = Unfoldr $ \ step init -> let+  loop int = step int (loop (succ int))+  in loop from++{-| Ints in the specified inclusive range -}+{-# INLINE intsInRange #-}+intsInRange :: Int -> Int -> Unfoldr Int+intsInRange from to =+  Unfoldr $ \ step init ->+  let+    loop int =+      if int <= to+        then step int (loop (succ int))+        else init+    in loop from++{-| Associations of a map -}+{-# INLINE mapAssocs #-}+mapAssocs :: Map key value -> Unfoldr (key, value)+mapAssocs map =+  Unfoldr (\ step init -> Map.foldrWithKey (\ key value state -> step (key, value) state) init map)++{-| Associations of an intmap -}+{-# INLINE intMapAssocs #-}+intMapAssocs :: IntMap value -> Unfoldr (Int, value)+intMapAssocs intMap =+  Unfoldr (\ step init -> IntMap.foldrWithKey (\ key value state -> step (key, value) state) init intMap)++{-| Bytes of a bytestring -}+{-# INLINE byteStringBytes #-}+byteStringBytes :: ByteString -> Unfoldr Word8+byteStringBytes bs = Unfoldr (\ step init -> ByteString.foldr step init bs)++{-| Bytes of a short bytestring -}+{-# INLINE shortByteStringBytes #-}+shortByteStringBytes :: ShortByteString -> Unfoldr Word8+shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#)++{-| Elements of a prim array -}+{-# INLINE primArray #-}+primArray :: (Prim prim) => PrimArray prim -> Unfoldr prim+primArray ba = Unfoldr $ \ f z -> foldrPrimArray f z ba++{-| Elements of a prim array coming paired with indices -}+{-# INLINE primArrayWithIndices #-}+primArrayWithIndices :: (Prim prim) => PrimArray prim -> Unfoldr (Int, prim)+primArrayWithIndices pa = Unfoldr $ \ step state -> let+  !size = sizeofPrimArray pa+  loop index = if index < size+    then step (index, indexPrimArray pa index) (loop (succ index))+    else state+  in loop 0

@@ -0,0 +1,11 @@+module DeferredFolds.Defs.UnfoldrM+where++import DeferredFolds.Prelude+import DeferredFolds.Types+++unfoldr :: Monad m => Unfoldr a -> UnfoldrM m a+unfoldr (Unfoldr unfoldr) = UnfoldrM $ \ stepM -> let+  step input act state = stepM input state >>= act+  in unfoldr step return

@@ -0,0 +1,68 @@+module DeferredFolds.Types+where++import DeferredFolds.Prelude+++{-|+A projection on data, which only knows how to execute a strict left-fold.++It is a monad and a monoid, and is very useful for+efficiently aggregating the projections on data intended for left-folding,+since its concatenation (`<>`) has complexity of @O(1)@.++[Intuition]++The intuition of what this abstraction is all about can be derived from lists.++Let's consider the `Data.List.foldl'` function for lists:++>foldl' :: (b -> a -> b) -> b -> [a] -> b++If we reverse its parameters we get++>foldl' :: [a] -> (b -> a -> b) -> b -> b++Which in Haskell is essentially the same as++>foldl' :: [a] -> (forall b. (b -> a -> b) -> b -> b)++We can isolate that part into an abstraction:++>newtype Unfoldl a = Unfoldl (forall b. (b -> a -> b) -> b -> b)++Then we get to this simple morphism:++>list :: [a] -> Unfoldl a+>list list = Unfoldl (\ step init -> foldl' step init list)++We can do the same with say "Data.Text.Text":++>text :: Text -> Unfoldl Char+>text text = Unfoldl (\ step init -> Data.Text.foldl' step init text)++And then we can use those both to concatenate with just an @O(1)@ cost:++>abcdef :: Unfoldl Char+>abcdef = list ['a', 'b', 'c'] <> text "def"++Please notice that up until this moment no actual data materialization has happened and+hence no traversals have appeared.+All that we've done is just composed a function,+which only specifies which parts of data structures to traverse to perform a left-fold.+Only at the moment where the actual folding will happen will we actually traverse the source data.+E.g., using the "fold" function:++>abcdefLength :: Int+>abcdefLength = fold Control.Foldl.length abcdef+-}+newtype Unfoldl a = Unfoldl (forall x. (x -> a -> x) -> x -> x)++{-|+A monadic variation of "DeferredFolds.Unfoldl"+-}+newtype UnfoldlM m a = UnfoldlM (forall x. (x -> a -> m x) -> x -> m x)++newtype Unfoldr a = Unfoldr (forall x. (a -> x -> x) -> x -> x)++newtype UnfoldrM m a = UnfoldrM (forall x. (a -> x -> m x) -> x -> m x)

@@ -1,190 +0,0 @@-module DeferredFolds.Unfold-where--import DeferredFolds.Prelude hiding (fold)-import qualified DeferredFolds.Prelude as A-import qualified DeferredFolds.UnfoldM as B-import qualified Data.Map.Strict as C-import qualified Data.IntMap.Strict as D-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Short.Internal as ShortByteString---{-|-A projection on data, which only knows how to execute a strict left-fold.--It is a monad and a monoid, and is very useful for-efficiently aggregating the projections on data intended for left-folding,-since its concatenation (`<>`) has complexity of @O(1)@.--[Intuition]--The intuition of what this abstraction is all about can be derived from lists.--Let's consider the `Data.List.foldl'` function for lists:-->foldl' :: (b -> a -> b) -> b -> [a] -> b--If we reverse its parameters we get-->foldl' :: [a] -> (b -> a -> b) -> b -> b--Which in Haskell is essentially the same as-->foldl' :: [a] -> (forall b. (b -> a -> b) -> b -> b)--We can isolate that part into an abstraction:-->newtype Unfold a = Unfold (forall b. (b -> a -> b) -> b -> b)--Then we get to this simple morphism:-->list :: [a] -> Unfold a->list list = Unfold (\ step init -> foldl' step init list)--We can do the same with say "Data.Text.Text":-->text :: Text -> Unfold Char->text text = Unfold (\ step init -> Data.Text.foldl' step init text)--And then we can use those both to concatenate with just an @O(1)@ cost:-->abcdef :: Unfold Char->abcdef = list ['a', 'b', 'c'] <> text "def"--Please notice that up until this moment no actual data materialization has happened and-hence no traversals have appeared.-All that we've done is just composed a function,-which only specifies which parts of data structures to traverse to perform a left-fold.-Only at the moment where the actual folding will happen will we actually traverse the source data.-E.g., using the "fold" function:-->abcdefLength :: Int->abcdefLength = fold Control.Foldl.length abcdef--}-newtype Unfold input =-  Unfold (forall output. (output -> input -> output) -> output -> output)--deriving instance Functor Unfold--instance Applicative Unfold where-  pure x =-    Unfold (\ step init -> step init x)-  (<*>) = ap--instance Alternative Unfold where-  empty =-    Unfold (const id)-  {-# INLINE (<|>) #-}-  (<|>) (Unfold left) (Unfold right) =-    Unfold (\ step init -> right step (left step init))--instance Monad Unfold where-  return = pure-  (>>=) (Unfold left) rightK =-    Unfold $ \ step init ->-    let-      newStep output x =-        case rightK x of-          Unfold right ->-            right step output-      in left newStep init--instance MonadPlus Unfold where-  mzero = empty-  mplus = (<|>)--instance Semigroup (Unfold a) where-  (<>) = (<|>)--instance Monoid (Unfold a) where-  mempty = empty-  mappend = (<>)--instance Foldable Unfold where-  {-# INLINE foldMap #-}-  foldMap inputMonoid = foldl' step mempty where-    step monoid input = mappend monoid (inputMonoid input)-  foldl = foldl'-  {-# INLINE foldl' #-}-  foldl' step init (Unfold run) = run step init--instance Eq a => Eq (Unfold a) where-  (==) left right = toList left == toList right--instance Show a => Show (Unfold a) where-  show = show . toList--{-| Apply a Gonzalez fold -}-{-# INLINE fold #-}-fold :: Fold input output -> Unfold input -> output-fold (Fold step init extract) (Unfold run) = extract (run step init)--{-| Unlift a monadic unfold -}-{-# INLINE unfoldM #-}-unfoldM :: B.UnfoldM Identity input -> Unfold input-unfoldM (B.UnfoldM runFoldM) = Unfold (\ step init -> runIdentity (runFoldM (\ a b -> return (step a b)) init))--{-| Lift a fold input mapping function into a mapping of unfolds -}-{-# INLINE mapFoldInput #-}-mapFoldInput :: (forall x. Fold b x -> Fold a x) -> Unfold a -> Unfold b-mapFoldInput newFold unfold = Unfold $ \ step init -> fold (newFold (Fold step init id)) unfold--{-| Construct from any foldable -}-{-# INLINE foldable #-}-foldable :: Foldable foldable => foldable a -> Unfold a-foldable foldable = Unfold (\ step init -> A.foldl' step init foldable)--{-| Filter the values given a predicate -}-{-# INLINE filter #-}-filter :: (a -> Bool) -> Unfold a -> Unfold a-filter test (Unfold run) = Unfold (\ step -> run (\ state element -> if test element then step state element else state))--{-| Ints in the specified inclusive range -}-{-# INLINE intsInRange #-}-intsInRange :: Int -> Int -> Unfold Int-intsInRange from to =-  Unfold $ \ step init ->-  let-    loop !state int =-      if int <= to-        then loop (step state int) (succ int)-        else state-    in loop init from--{-| Associations of a map -}-{-# INLINE map #-}-map :: Map key value -> Unfold (key, value)-map map =-  Unfold (\ step init -> C.foldlWithKey' (\ state key value -> step state (key, value)) init map)--{-| Associations of an intmap -}-{-# INLINE intMap #-}-intMap :: IntMap value -> Unfold (Int, value)-intMap intMap =-  Unfold (\ step init -> D.foldlWithKey' (\ state key value -> step state (key, value)) init intMap)--{-| Bytes of a bytestring -}-{-# INLINE byteStringBytes #-}-byteStringBytes :: ByteString -> Unfold Word8-byteStringBytes bs = Unfold (\ step init -> ByteString.foldl' step init bs)--{-| Bytes of a short bytestring -}-{-# INLINE shortByteStringBytes #-}-shortByteStringBytes :: ShortByteString -> Unfold Word8-shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#)--{-| Elements of a prim array -}-{-# INLINE primArray #-}-primArray :: (Prim prim) => PrimArray prim -> Unfold prim-primArray ba = Unfold $ \ f z -> foldlPrimArray' f z ba--{-| Elements of a prim array coming paired with indices -}-{-# INLINE primArrayWithIndices #-}-primArrayWithIndices :: (Prim prim) => PrimArray prim -> Unfold (Int, prim)-primArrayWithIndices pa = Unfold $ \ step state -> let-  !size = sizeofPrimArray pa-  iterate index !state = if index < size-    then iterate (succ index) (step state (index, indexPrimArray pa index))-    else state-  in iterate 0 state

@@ -1,196 +0,0 @@-module DeferredFolds.UnfoldM-where--import DeferredFolds.Prelude hiding (mapM_, foldM)-import qualified DeferredFolds.Prelude as A-import qualified Data.ByteString.Internal as ByteString-import qualified Data.ByteString.Short.Internal as ShortByteString---{-|-A monadic variation of "DeferredFolds.Unfold"--}-newtype UnfoldM m input =-  UnfoldM (forall output. (output -> input -> m output) -> output -> m output)--deriving instance Functor m => Functor (UnfoldM m)--instance Monad m => Applicative (UnfoldM m) where-  pure x =-    UnfoldM (\ step init -> step init x)-  (<*>) = ap--instance Monad m => Alternative (UnfoldM m) where-  empty =-    UnfoldM (const return)-  {-# INLINE (<|>) #-}-  (<|>) (UnfoldM left) (UnfoldM right) =-    UnfoldM (\ step init -> left step init >>= right step)--instance Monad m => Monad (UnfoldM m) where-  return = pure-  {-# INLINE (>>=) #-}-  (>>=) (UnfoldM left) rightK =-    UnfoldM $ \ step init ->-    let-      newStep output x =-        case rightK x of-          UnfoldM right ->-            right step output-      in left newStep init--instance Monad m => MonadPlus (UnfoldM m) where-  mzero = empty-  mplus = (<|>)--instance MonadTrans UnfoldM where-  lift m = UnfoldM (\ step init -> m >>= step init)--instance Monad m => Semigroup (UnfoldM m a) where-  (<>) = (<|>)--instance Monad m => Monoid (UnfoldM m a) where-  mempty = empty-  mappend = (<>)--instance Foldable (UnfoldM Identity) where-  {-# INLINE foldMap #-}-  foldMap inputMonoid = foldl' step mempty where-    step monoid input = mappend monoid (inputMonoid input)-  foldl = foldl'-  {-# INLINE foldl' #-}-  foldl' step init (UnfoldM run) =-    runIdentity (run identityStep init)-    where-      identityStep state input = return (step state input)--instance Eq a => Eq (UnfoldM Identity a) where-  (==) left right = toList left == toList right--instance Show a => Show (UnfoldM Identity a) where-  show = show . toList--{-| Check whether it's empty -}-{-# INLINE null #-}-null :: Monad m => UnfoldM m input -> m Bool-null (UnfoldM run) = run (\ _ _ -> return False) True--{-| Perform a monadic strict left fold -}-{-# INLINE foldlM' #-}-foldlM' :: Monad m => (output -> input -> m output) -> output -> UnfoldM m input -> m output-foldlM' step init (UnfoldM run) =-  run step init--{-| A more efficient implementation of mapM_ -}-{-# INLINE mapM_ #-}-mapM_ :: Monad m => (input -> m ()) -> UnfoldM m input -> m ()-mapM_ step = foldlM' (const step) ()--{-| Same as 'mapM_' with arguments flipped -}-{-# INLINE forM_ #-}-forM_ :: Monad m => UnfoldM m input -> (input -> m ()) -> m ()-forM_ = flip mapM_--{-| Apply a Gonzalez fold -}-{-# INLINE fold #-}-fold :: Fold input output -> UnfoldM Identity input -> output-fold (Fold step init extract) = extract . foldl' step init--{-| Apply a monadic Gonzalez fold -}-{-# INLINE foldM #-}-foldM :: Monad m => FoldM m input output -> UnfoldM m input -> m output-foldM (FoldM step init extract) view =-  do-    initialState <- init-    finalState <- foldlM' step initialState view-    extract finalState--{-| Lift a fold input mapping function into a mapping of unfolds -}-{-# INLINE mapFoldMInput #-}-mapFoldMInput :: Monad m => (forall x. FoldM m b x -> FoldM m a x) -> UnfoldM m a -> UnfoldM m b-mapFoldMInput newFoldM unfoldM = UnfoldM $ \ step init -> foldM (newFoldM (FoldM step (return init) return)) unfoldM--{-| Construct from any foldable -}-{-# INLINE foldable #-}-foldable :: (Monad m, Foldable foldable) => foldable a -> UnfoldM m a-foldable foldable = UnfoldM (\ step init -> A.foldlM step init foldable)--{-| Construct from a specification of how to execute a left-fold -}-{-# INLINE foldlRunner #-}-foldlRunner :: Monad m => (forall x. (x -> a -> x) -> x -> x) -> UnfoldM m a-foldlRunner run = UnfoldM (\ stepM state -> run (\ stateM a -> stateM >>= \state -> stepM state a) (return state))--{-| Construct from a specification of how to execute a right-fold -}-{-# INLINE foldrRunner #-}-foldrRunner :: Monad m => (forall x. (a -> x -> x) -> x -> x) -> UnfoldM m a-foldrRunner run = UnfoldM (\ stepM -> run (\ x k z -> stepM z x >>= k) return)--{-| Filter the values given a predicate -}-{-# INLINE filter #-}-filter :: Monad m => (a -> m Bool) -> UnfoldM m a -> UnfoldM m a-filter test (UnfoldM run) = UnfoldM (\ step -> run (\ state element -> test element >>= bool (return state) (step state element)))--{-| Ints in the specified inclusive range -}-{-# INLINE intsInRange #-}-intsInRange :: Monad m => Int -> Int -> UnfoldM m Int-intsInRange from to =-  UnfoldM $ \ step init ->-  let-    loop !state int =-      if int <= to-        then do-          newState <- step state int-          loop newState (succ int)-        else return state-    in loop init from--{-| TVar contents -}-{-# INLINE tVarValue #-}-tVarValue :: TVar a -> UnfoldM STM a-tVarValue var = UnfoldM $ \ step state -> do-  a <- readTVar var-  step state a--{-| Change the base monad using invariant natural transformations -}-{-# INLINE hoist #-}-hoist :: (forall a. m a -> n a) -> (forall a. n a -> m a) -> UnfoldM m a -> UnfoldM n a-hoist trans1 trans2 (UnfoldM unfold) = UnfoldM $ \ step init -> -  trans1 (unfold (\ a b -> trans2 (step a b)) init)--{-| Bytes of a bytestring -}-{-# INLINABLE byteStringBytes #-}-byteStringBytes :: ByteString -> UnfoldM IO Word8-byteStringBytes (ByteString.PS fp off len) =-  UnfoldM $ \ step init ->-  withForeignPtr fp $ \ ptr ->-  let-    endPtr = plusPtr ptr (off + len)-    iterate !state !ptr = if ptr == endPtr-      then return state-      else do-        x <- peek ptr-        newState <- step state x-        iterate newState (plusPtr ptr 1)-    in iterate init (plusPtr ptr off)--{-| Bytes of a short bytestring -}-{-# INLINE shortByteStringBytes #-}-shortByteStringBytes :: Monad m => ShortByteString -> UnfoldM m Word8-shortByteStringBytes (ShortByteString.SBS ba#) = primArray (PrimArray ba#)--{-| Elements of a prim array -}-{-# INLINE primArray #-}-primArray :: (Monad m, Prim prim) => PrimArray prim -> UnfoldM m prim-primArray pa = UnfoldM $ \ f z -> foldlPrimArrayM' f z pa--{-| Elements of a prim array coming paired with indices -}-{-# INLINE primArrayWithIndices #-}-primArrayWithIndices :: (Monad m, Prim prim) => PrimArray prim -> UnfoldM m (Int, prim)-primArrayWithIndices pa = UnfoldM $ \ step state -> let-  !size = sizeofPrimArray pa-  iterate index !state = if index < size-    then do-      newState <- step state (index, indexPrimArray pa index)-      iterate (succ index) newState-    else return state-  in iterate 0 state

@@ -0,0 +1,8 @@+module DeferredFolds.Unfoldl+(+  module Exports,+)+where++import DeferredFolds.Types as Exports (Unfoldl(..))+import DeferredFolds.Defs.Unfoldl as Exports

@@ -0,0 +1,8 @@+module DeferredFolds.UnfoldlM+(+  module Exports,+)+where++import DeferredFolds.Types as Exports (UnfoldlM(..))+import DeferredFolds.Defs.UnfoldlM as Exports

@@ -0,0 +1,8 @@+module DeferredFolds.Unfoldr+(+  module Exports,+)+where++import DeferredFolds.Types as Exports (Unfoldr(..))+import DeferredFolds.Defs.Unfoldr as Exports

@@ -0,0 +1,8 @@+module DeferredFolds.UnfoldrM+(+  module Exports,+)+where++import DeferredFolds.Types as Exports (UnfoldrM(..))+import DeferredFolds.Defs.UnfoldrM as Exports