{-# 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 -> b) -> Memoized a -> Memoized b)
-> (forall a b. a -> Memoized b -> Memoized a) -> Functor Memoized
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
$cfmap :: forall a b. (a -> b) -> Memoized a -> Memoized b
fmap :: forall a b. (a -> b) -> Memoized a -> Memoized b
$c<$ :: forall a b. a -> Memoized b -> Memoized a
<$ :: forall a b. a -> Memoized b -> Memoized a
Functor, Functor Memoized
Functor Memoized =>
(forall a. a -> Memoized a)
-> (forall a b. Memoized (a -> b) -> Memoized a -> Memoized b)
-> (forall a b c.
    (a -> b -> c) -> Memoized a -> Memoized b -> Memoized c)
-> (forall a b. Memoized a -> Memoized b -> Memoized b)
-> (forall a b. Memoized a -> Memoized b -> Memoized a)
-> Applicative 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
$cpure :: forall a. a -> Memoized a
pure :: forall a. a -> Memoized a
$c<*> :: forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
<*> :: forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
liftA2 :: forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
$c*> :: forall a b. Memoized a -> Memoized b -> Memoized b
*> :: forall a b. Memoized a -> Memoized b -> Memoized b
$c<* :: forall a b. Memoized a -> Memoized b -> Memoized a
<* :: forall a b. Memoized a -> Memoized b -> Memoized a
A.Applicative, Applicative Memoized
Applicative Memoized =>
(forall a b. Memoized a -> (a -> Memoized b) -> Memoized b)
-> (forall a b. Memoized a -> Memoized b -> Memoized b)
-> (forall a. a -> Memoized a)
-> Monad 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
$c>>= :: forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
>>= :: forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
$c>> :: forall a b. Memoized a -> Memoized b -> Memoized b
>> :: forall a b. Memoized a -> Memoized b -> Memoized b
$creturn :: forall a. a -> Memoized a
return :: forall a. a -> Memoized a
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) = IO a -> m a
forall a. IO a -> m a
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 a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a))
-> ((forall a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
  IORef (Maybe (Either SomeException a))
ref <- Maybe (Either SomeException a)
-> IO (IORef (Maybe (Either SomeException a)))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe (Either SomeException a)
forall a. Maybe a
Nothing
  Memoized a -> IO (Memoized a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memoized a -> IO (Memoized a)) -> Memoized a -> IO (Memoized a)
forall a b. (a -> b) -> a -> b
$ IO a -> Memoized a
forall a. IO a -> Memoized a
Memoized (IO a -> Memoized a) -> IO a -> Memoized a
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Either SomeException a)
mres <- IORef (Maybe (Either SomeException a))
-> IO (Maybe (Either SomeException a))
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 -> Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
        Maybe (Either SomeException a)
Nothing -> do
          Either SomeException a
res <- IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
action
          IORef (Maybe (Either SomeException a))
-> Maybe (Either SomeException a) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe (Either SomeException a))
ref (Maybe (Either SomeException a) -> IO ())
-> Maybe (Either SomeException a) -> IO ()
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just Either SomeException a
res
          Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
    (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO a -> IO a
forall a. a -> IO a
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 a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a))
-> ((forall a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
  MVar (Maybe (Either SomeException a))
var <- Maybe (Either SomeException a)
-> IO (MVar (Maybe (Either SomeException a)))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Maybe (Either SomeException a)
forall a. Maybe a
Nothing
  Memoized a -> IO (Memoized a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Memoized a -> IO (Memoized a)) -> Memoized a -> IO (Memoized a)
forall a b. (a -> b) -> a -> b
$ IO a -> Memoized a
forall a. IO a -> Memoized a
Memoized (IO a -> Memoized a) -> IO a -> Memoized a
forall a b. (a -> b) -> a -> b
$ IO (IO a) -> IO a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO a) -> IO a) -> IO (IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ MVar (Maybe (Either SomeException a))
-> (Maybe (Either SomeException a)
    -> IO (Maybe (Either SomeException a), IO a))
-> IO (IO a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Maybe (Either SomeException a))
var ((Maybe (Either SomeException a)
  -> IO (Maybe (Either SomeException a), IO a))
 -> IO (IO a))
-> (Maybe (Either SomeException a)
    -> IO (Maybe (Either SomeException a), IO a))
-> IO (IO a)
forall a b. (a -> b) -> a -> b
$ \Maybe (Either SomeException a)
mres -> do
    Either SomeException a
res <- IO (Either SomeException a)
-> (Either SomeException a -> IO (Either SomeException a))
-> Maybe (Either SomeException a)
-> IO (Either SomeException a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (IO a -> IO (Either SomeException a))
-> IO a -> IO (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ m a -> IO a
forall a. m a -> IO a
run m a
action) Either SomeException a -> IO (Either SomeException a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Either SomeException a)
mres
    (Maybe (Either SomeException a), IO a)
-> IO (Maybe (Either SomeException a), IO a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just Either SomeException a
res, (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res)