{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Memoize the results of actions. In other words: actions
-- will be run once, on demand, and their results saved.
--
-- Exceptions semantics: if a synchronous exception is thrown while performing
-- the computation, that result will be saved and rethrown each time
-- 'runMemoized' is called subsequently.'
--
-- @since 0.2.8.0
module UnliftIO.Memoize
  ( Memoized
  , runMemoized
  , memoizeRef
  , memoizeMVar
  ) where

import Control.Applicative as A
import Control.Monad (join)
import Control.Monad.IO.Unlift
import UnliftIO.Exception
import UnliftIO.IORef
import UnliftIO.MVar

-- | A \"run once\" value, with results saved. Extract the value with
-- 'runMemoized'. For single-threaded usage, you can use 'memoizeRef' to
-- create a value. If you need guarantees that only one thread will run the
-- action at a time, use 'memoizeMVar'.
--
-- Note that this type provides a 'Show' instance for convenience, but not
-- useful information can be provided.
--
-- @since 0.2.8.0
newtype Memoized a = Memoized (IO a)
  deriving (forall a b. a -> Memoized b -> Memoized a
forall a b. (a -> b) -> Memoized a -> Memoized b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Memoized b -> Memoized a
$c<$ :: forall a b. a -> Memoized b -> Memoized a
fmap :: forall a b. (a -> b) -> Memoized a -> Memoized b
$cfmap :: forall a b. (a -> b) -> Memoized a -> Memoized b
Functor, Functor Memoized
forall a. a -> Memoized a
forall a b. Memoized a -> Memoized b -> Memoized a
forall a b. Memoized a -> Memoized b -> Memoized b
forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Memoized a -> Memoized b -> Memoized a
$c<* :: forall a b. Memoized a -> Memoized b -> Memoized a
*> :: forall a b. Memoized a -> Memoized b -> Memoized b
$c*> :: forall a b. Memoized a -> Memoized b -> Memoized b
liftA2 :: forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
<*> :: forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
$c<*> :: forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
pure :: forall a. a -> Memoized a
$cpure :: forall a. a -> Memoized a
A.Applicative, Applicative Memoized
forall a. a -> Memoized a
forall a b. Memoized a -> Memoized b -> Memoized b
forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Memoized a
$creturn :: forall a. a -> Memoized a
>> :: forall a b. Memoized a -> Memoized b -> Memoized b
$c>> :: forall a b. Memoized a -> Memoized b -> Memoized b
>>= :: forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
$c>>= :: forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
Monad)
instance Show (Memoized a) where
  show :: Memoized a -> String
show Memoized a
_ = String
"<<Memoized>>"

-- | Extract a value from a 'Memoized', running an action if no cached value is
-- available.
--
-- @since 0.2.8.0
runMemoized :: MonadIO m => Memoized a -> m a
runMemoized :: forall (m :: * -> *) a. MonadIO m => Memoized a -> m a
runMemoized (Memoized IO a
m) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
{-# INLINE runMemoized #-}

-- | Create a new 'Memoized' value using an 'IORef' under the surface. Note that
-- the action may be run in multiple threads simultaneously, so this may not be
-- thread safe (depending on the underlying action). Consider using
-- 'memoizeMVar'.
--
-- @since 0.2.8.0
memoizeRef :: MonadUnliftIO m => m a -> m (Memoized a)
memoizeRef :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeRef m a
action = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
  IORef (Maybe (Either SomeException a))
ref <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. IO a -> Memoized a
Memoized forall a b. (a -> b) -> a -> b
$ do
    Maybe (Either SomeException a)
mres <- forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe (Either SomeException a))
ref
    Either SomeException a
res <-
      case Maybe (Either SomeException a)
mres of
        Just Either SomeException a
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
        Maybe (Either SomeException a)
Nothing -> do
          Either SomeException a
res <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
action
          forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe (Either SomeException a))
ref forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Either SomeException a
res
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res

-- | Same as 'memoizeRef', but uses an 'MVar' to ensure that an action is
-- only run once, even in a multithreaded application.
--
-- @since 0.2.8.0
memoizeMVar :: MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar m a
action = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
  MVar (Maybe (Either SomeException a))
var <- forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. IO a -> Memoized a
Memoized forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Maybe (Either SomeException a))
var forall a b. (a -> b) -> a -> b
$ \Maybe (Either SomeException a)
mres -> do
    Either SomeException a
res <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
action) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either SomeException a)
mres
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Either SomeException a
res, forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res)