Browse Source

New intercalate functions, better documentation, more generic types

Marcos Dumay de Medeiros 7 years ago
parent
commit
f983406247
2 changed files with 59 additions and 16 deletions
  1. 4 4
      interruptible.cabal
  2. 55 12
      src/Control/Monad/Trans/Interruptible.hs

+ 4 - 4
interruptible.cabal

@@ -24,8 +24,8 @@ description:
     .
     > do
     >     let c0 = inTCtx 1
-    >     c1 <- resume f c0
-    >     _ <- resume g c1
+    >     resume f c0 >>=
+    >     resume g
     .
     That makes it possible to intercalate the execution of different contexts, and
     treat contexts like data, for iterating or returning them.
@@ -41,8 +41,8 @@ description:
     .
     > do
     >     let c0 = inT2Ctx . inT1Ctx $ 1
-    >     c1 <- (resume . resume) f c0
-    >     _ <- (resume . resume) g c1
+    >     (resume . resume) f c0 >>=
+    >     (resume . resume) g
     > where
     >     f :: Monad m => Int -> T1 T2 M a
     >     g :: Monad m => a -> T1 T2 M b

+ 55 - 12
src/Control/Monad/Trans/Interruptible.hs

@@ -4,17 +4,26 @@ module Control.Monad.Trans.Interruptible (
   module Control.Monad.Trans.Interruptible.Class,
   -- * Interruptible applications
   intercalateWith,
-  intercalateAction
+  intercalateFold,
+  intercalateAction,
+  intercalateAction'
   )where
 
 import Control.Monad.Trans.Interruptible.Class
+import Data.Traversable
+import Data.Foldable
+
+{-# DEPRECATED intercalateWith "Use intercalateFold instead" #-}
 
 {- |
-Folds the second list with the function applied to the first,
-intercalating the evaluation. That is:
+Intercalates folding the given function in each of contexts on the traversable.
+
+The first argument is the resume function that will be used on the folds.
+
+That is:
 
 @
-intercalateWith resume f [b1, b2] [a00, a10, a20] = do
+intercalateFold resume f [b1, b2] [a00, a10, a20] = do
   a01 <- resume (f b1) a00
   a11 <- resume (f b1) a10
   a21 <- resume (f b1) a20
@@ -24,16 +33,27 @@ intercalateWith resume f [b1, b2] [a00, a10, a20] = do
   return [a02, a12, a22]
 @
 
-Usefull for consuming lazy sequences.
+Where the order of the operations is guaranteed.
+This is usefull for consuming lazy sequences.
 
 The resume function is parametric for allowing resuming deeper Interruptible chains, with
 resume2, resume3, etc.
 -}
-intercalateWith :: Monad m => ((a -> t a) -> rsta -> m (rsta)) -> (b -> a -> t a) -> [b] -> [rsta] -> m [rsta]
-intercalateWith _ _ [] aa = return aa
-intercalateWith res f (b:bb) aa = do
-  aa' <- mapM (res $ f b) aa
-  intercalateWith res f bb aa'
+intercalateFold :: (Traversable t, Foldable f, Monad m) =>
+  ((a -> transf a) -> transfCtx -> m (transfCtx)) ->
+  (b -> a -> transf a) -> f b -> t transfCtx -> m (t transfCtx)
+intercalateFold res f bb aa = intercalateFold' res f (toList bb) aa
+  where
+    intercalateFold' _ _ [] aa = return aa
+    intercalateFold' res f (b:bb) aa = do
+      aa' <- mapM (res $ f b) aa
+      intercalateFold' res f bb aa'
+
+-- | Exactly the same as intercalateFold, for backwards compatibility.
+intercalateWith :: (Traversable t, Foldable f, Monad m) =>
+  ((a -> transf a) -> transfCtx -> m (transfCtx)) ->
+  (b -> a -> transf a) -> f b -> t transfCtx -> m (t transfCtx)
+intercalateWith = intercalateFold
 
 {- |
 Intercalates the execution of the function, on the interrupted contexts given, but instead of
@@ -43,15 +63,38 @@ action untill it returns Nothing.
 That is, if @get@ is a monadic action that when repeated called returns @Just "a"@, @Just "b"@,
 @Just "c"@ and @Nothing@, those two lines are equivalent:
 
-> intercalateWith resume f ["a", "b", "c"] ctxs
+> intercalateFold resume f ["a", "b", "c"] ctxs
 
 > intercalateAction resume f get ctxs
 
 IntercalateAction can intercalate contexts over non-lazy IO.
 -}
-intercalateAction :: Monad m => ((a -> t a) -> rsta -> m (rsta)) -> (b -> a -> t a) -> m (Maybe b) -> [rsta] -> m [rsta]
+intercalateAction :: (Traversable t, Monad m) =>
+  ((a -> transf a) -> transfCtx -> m (transfCtx)) ->
+  (b -> a -> transf a) -> m (Maybe b) -> t transfCtx -> m (t transfCtx)
 intercalateAction res f get ctx = do
   v' <- get
   case v' of
     Nothing -> return ctx
     Just v -> mapM (res $ f v) ctx >>= intercalateAction res f get
+
+{- |
+Behaves like intercalateAction, but the action will update a parameter.
+
+Those are equivalent:
+
+> intercalateAction resume f get ctxs
+
+> get' x = (\v -> (v, x)) <$> get
+> fst <$> intercalateAction' resume f () get' ctxs
+-}
+intercalateAction' :: (Traversable t, Monad m) =>
+  ((a -> transf a) -> transfCtx -> m (transfCtx)) ->
+  (b -> a -> transf a) -> (p -> m (Maybe b, p)) -> (t transfCtx, p) -> m (t transfCtx, p)
+intercalateAction' res f get (ctx, p) = do
+  (v', p') <- get p
+  case v' of
+    Nothing -> return (ctx, p)
+    Just v -> do
+      ctx' <- mapM (res $ f v) ctx
+      intercalateAction' res f get (ctx', p')