interruptible/src/Control/Monad/Trans/Interruptible.hs

{-# LANGUAGE TypeFamilies #-}

module Control.Monad.Trans.Interruptible (
  module Control.Monad.Trans.Interruptible.Class,
  -- * Interruptible applications
  intercalateWith,
  intercalateFold,
  intercalateAction,
  intercalateAction'
  )where

import Control.Monad.Trans.Interruptible.Class
import Data.Traversable
import Data.Foldable

{-# DEPRECATED intercalateWith "Use intercalateFold instead" #-}

{- |
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:

@
intercalateFold resume f [b1, b2] [a00, a10, a20] = do
  a01 <- resume (f b1) a00
  a11 <- resume (f b1) a10
  a21 <- resume (f b1) a20
  a02 <- resume (f b2) a11
  a12 <- resume (f b2) a21
  a22 <- resume (f b2) a31
  return [a02, a12, a22]
@

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.
-}
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
folding them over a list like "intercalateWith", it folds them on the result of the monadic
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:

> intercalateFold resume f ["a", "b", "c"] ctxs

> intercalateAction resume f get ctxs

IntercalateAction can intercalate contexts over non-lazy IO.
-}
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')