{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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
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>>"
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 #-}
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
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)