module Reactive.Banana.Internal.Cached (
HasVault(..),
Cached, runCached, mkCached, fromPure,
liftCached1, liftCached2,
) where
import Control.Monad
import Control.Monad.Fix
import Data.Unique.Really
import qualified Data.Vault as Vault
import System.IO.Unsafe
data Cached m a = Cached (m a)
runCached :: Cached m a -> m a
runCached (Cached x) = x
class (Monad m, MonadFix m) => HasVault m where
retrieve :: Vault.Key a -> m (Maybe a)
write :: Vault.Key a -> a -> m ()
mkCached :: HasVault m => m a -> Cached m a
mkCached m = unsafePerformIO $ do
key <- Vault.newKey
return $ Cached $ do
ma <- retrieve key
case ma of
Nothing -> mdo
write key a
a <- m
return a
Just a -> return a
fromPure :: HasVault m => a -> Cached m a
fromPure = Cached . return
liftCached1
:: HasVault m
=> (a -> m b)
-> Cached m a -> Cached m b
liftCached1 f ca = mkCached $ do
a <- runCached ca
f a
liftCached2
:: HasVault m
=> (a -> b -> m c)
-> Cached m a -> Cached m b -> Cached m c
liftCached2 f ca cb = mkCached $ do
a <- runCached ca
b <- runCached cb
f a b