{-# language Safe #-}

module LazyAsync.Actions.Memoize where

import LazyAsync.Actions.Spawn     (lazyAsync)
import LazyAsync.Actions.StartWait (startWait)

import LazyAsync.Prelude (ContT, IO, MonadBaseControl, Traversable, fmap,
                          runContT, traverse)

{- | Creates a situation wherein:

  * The action shall begin running only once the memoized action runs
  * The action shall run at most once
  * The action shall run only within the continuation (when the continuation ends, the action is stopped)
-}
memoize :: (MonadBaseControl IO m) =>
    m a -- ^ Action
    -> ContT r m (m a) -- ^ Memoized action, in a continuation
memoize :: forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (m a)
memoize m a
action = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (base :: * -> *) (m :: * -> *) a.
(MonadBaseControl base m, MonadIO base) =>
LazyAsync (StM m a) -> m a
startWait (forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (LazyAsync (StM m a))
lazyAsync m a
action)

-- | Akin to 'memoize'
withMemoizedIO :: IO a -> (IO a -> IO b) -> IO b
withMemoizedIO :: forall a b. IO a -> (IO a -> IO b) -> IO b
withMemoizedIO IO a
action = forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (m a)
memoize IO a
action)

-- | 🌈 'memoizeMany' is equivalent to @('traverse' 'memoize')@
memoizeMany :: (MonadBaseControl IO m, Traversable t) => t (m a) -> ContT r m (t (m a))
memoizeMany :: forall (m :: * -> *) (t :: * -> *) a r.
(MonadBaseControl IO m, Traversable t) =>
t (m a) -> ContT r m (t (m a))
memoizeMany = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *) a r.
MonadBaseControl IO m =>
m a -> ContT r m (m a)
memoize

-- | Akin to 'memoizeMany'
withMemoizedListIO :: [IO a] -> ([IO a] -> IO b) -> IO b
withMemoizedListIO :: forall a b. [IO a] -> ([IO a] -> IO b) -> IO b
withMemoizedListIO [IO a]
x = forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (forall (m :: * -> *) (t :: * -> *) a r.
(MonadBaseControl IO m, Traversable t) =>
t (m a) -> ContT r m (t (m a))
memoizeMany [IO a]
x)