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