{-# 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 (a -> Memoized b -> Memoized a
(a -> b) -> Memoized a -> Memoized b
(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
<$ :: a -> Memoized b -> Memoized a
$c<$ :: forall a b. a -> Memoized b -> Memoized a
fmap :: (a -> b) -> Memoized a -> Memoized b
$cfmap :: forall a b. (a -> b) -> Memoized a -> Memoized b
Functor, Functor Memoized
a -> Memoized a
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
Memoized a -> Memoized b -> Memoized b
Memoized a -> Memoized b -> Memoized a
Memoized (a -> b) -> Memoized a -> Memoized b
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
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
<* :: Memoized a -> Memoized b -> Memoized a
$c<* :: forall a b. Memoized a -> Memoized b -> Memoized a
*> :: Memoized a -> Memoized b -> Memoized b
$c*> :: forall a b. Memoized a -> Memoized b -> Memoized b
liftA2 :: (a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Memoized a -> Memoized b -> Memoized c
<*> :: Memoized (a -> b) -> Memoized a -> Memoized b
$c<*> :: forall a b. Memoized (a -> b) -> Memoized a -> Memoized b
pure :: a -> Memoized a
$cpure :: forall a. a -> Memoized a
$cp1Applicative :: Functor Memoized
A.Applicative, Applicative Memoized
a -> Memoized a
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
Memoized a -> (a -> Memoized b) -> Memoized b
Memoized a -> Memoized b -> Memoized b
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 :: a -> Memoized a
$creturn :: forall a. a -> Memoized a
>> :: Memoized a -> Memoized b -> Memoized b
$c>> :: forall a b. Memoized a -> Memoized b -> Memoized b
>>= :: Memoized a -> (a -> Memoized b) -> Memoized b
$c>>= :: forall a b. Memoized a -> (a -> Memoized b) -> Memoized b
$cp1Monad :: Applicative Memoized
Monad)
instance Show (Memoized a) where
show :: Memoized a -> String
show Memoized a
_ = String
"<<Memoized>>"
runMemoized :: MonadIO m => Memoized a -> m a
runMemoized :: Memoized a -> m a
runMemoized (Memoized IO a
m) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
{-# INLINE runMemoized #-}
memoizeRef :: MonadUnliftIO m => m a -> m (Memoized a)
memoizeRef :: m a -> m (Memoized a)
memoizeRef m a
action = ((forall a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a)
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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res
memoizeMVar :: MonadUnliftIO m => m a -> m (Memoized a)
memoizeMVar :: m a -> m (Memoized a)
memoizeMVar m a
action = ((forall a. m a -> IO a) -> IO (Memoized a)) -> m (Memoized a)
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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException a
res)