{-# LANGUAGE RecursiveDo #-}
module Reactive.Banana.Prim.High.Cached (
Cached, runCached, cache, fromPure, don'tCache,
liftCached1, liftCached2,
) where
import Control.Monad.Fix
import Control.Monad.IO.Class
import Data.IORef
import System.IO.Unsafe (unsafePerformIO)
data Cached m a = Cached (m a)
runCached :: Cached m a -> m a
runCached :: Cached m a -> m a
runCached (Cached m a
x) = m a
x
{-# NOINLINE cache #-}
cache :: (MonadFix m, MonadIO m) => m a -> Cached m a
cache :: m a -> Cached m a
cache m a
m = IO (Cached m a) -> Cached m a
forall a. IO a -> a
unsafePerformIO (IO (Cached m a) -> Cached m a) -> IO (Cached m a) -> Cached m a
forall a b. (a -> b) -> a -> b
$ do
IORef (Maybe a)
key <- IO (IORef (Maybe a)) -> IO (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> IO (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> IO (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef Maybe a
forall a. Maybe a
Nothing
Cached m a -> IO (Cached m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cached m a -> IO (Cached m a)) -> Cached m a -> IO (Cached m a)
forall a b. (a -> b) -> a -> b
$ m a -> Cached m a
forall (m :: * -> *) a. m a -> Cached m a
Cached (m a -> Cached m a) -> m a -> Cached m a
forall a b. (a -> b) -> a -> b
$ do
Maybe a
ma <- IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef IORef (Maybe a)
key
case Maybe a
ma of
Just a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Maybe a
Nothing -> mdo
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
key (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
a
a <- m a
m
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
fromPure :: Monad m => a -> Cached m a
fromPure :: a -> Cached m a
fromPure = m a -> Cached m a
forall (m :: * -> *) a. m a -> Cached m a
Cached (m a -> Cached m a) -> (a -> m a) -> a -> Cached m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
don'tCache :: Monad m => m a -> Cached m a
don'tCache :: m a -> Cached m a
don'tCache = m a -> Cached m a
forall (m :: * -> *) a. m a -> Cached m a
Cached
liftCached1 :: (MonadFix m, MonadIO m) =>
(a -> m b) -> Cached m a -> Cached m b
liftCached1 :: (a -> m b) -> Cached m a -> Cached m b
liftCached1 a -> m b
f Cached m a
ca = m b -> Cached m b
forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache (m b -> Cached m b) -> m b -> Cached m b
forall a b. (a -> b) -> a -> b
$ do
a
a <- Cached m a -> m a
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached m a
ca
a -> m b
f a
a
liftCached2 :: (MonadFix m, MonadIO m) =>
(a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 :: (a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c
liftCached2 a -> b -> m c
f Cached m a
ca Cached m b
cb = m c -> Cached m c
forall (m :: * -> *) a.
(MonadFix m, MonadIO m) =>
m a -> Cached m a
cache (m c -> Cached m c) -> m c -> Cached m c
forall a b. (a -> b) -> a -> b
$ do
a
a <- Cached m a -> m a
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached m a
ca
b
b <- Cached m b -> m b
forall (m :: * -> *) a. Cached m a -> m a
runCached Cached m b
cb
a -> b -> m c
f a
a b
b