module Freckle.App.GlobalCache
( GlobalCache
, newGlobalCache
, globallyCache
, withGlobalCacheCleanup
) where
import Freckle.App.Prelude
import Control.Concurrent.MVar (mkWeakMVar, modifyMVar_, newMVar)
import Data.IORef
newtype GlobalCache a = GlobalCache
{ forall a. GlobalCache a -> IORef (Maybe a)
_unGlobalCache :: IORef (Maybe a)
}
newGlobalCache :: IO (GlobalCache a)
newGlobalCache :: forall a. IO (GlobalCache a)
newGlobalCache = forall a. IORef (Maybe a) -> GlobalCache a
GlobalCache forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
globallyCache :: GlobalCache a -> IO a -> IO a
globallyCache :: forall a. GlobalCache a -> IO a -> IO a
globallyCache (GlobalCache IORef (Maybe a)
var) IO a
construct = do
Maybe a
mv <- forall a. IORef a -> IO a
readIORef IORef (Maybe a)
var
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> IO a
cache forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
construct) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
mv
where
cache :: a -> IO a
cache a
v = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Maybe a)
var forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just a
v, a
v)
withGlobalCacheCleanup :: GlobalCache a -> IO b -> IO ()
withGlobalCacheCleanup :: forall a b. GlobalCache a -> IO b -> IO ()
withGlobalCacheCleanup (GlobalCache IORef (Maybe a)
var) IO b
action = do
MVar ()
cleanup <- forall a. a -> IO (MVar a)
newMVar ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO () -> IO (Weak (MVar a))
mkWeakMVar MVar ()
cleanup forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
var forall a. Maybe a
Nothing
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO b
action
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar ()
cleanup (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())