module Data.Registry.Internal.Cache where
import Data.Map.Strict
import Data.Registry.Internal.Types (SpecializationPath)
import Protolude as P
newtype Cache a = Cache (MVar (Map Key a))
deriving (Cache a -> Cache a -> Bool
forall a. Cache a -> Cache a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cache a -> Cache a -> Bool
$c/= :: forall a. Cache a -> Cache a -> Bool
== :: Cache a -> Cache a -> Bool
$c== :: forall a. Cache a -> Cache a -> Bool
Eq, Typeable)
type Key = Maybe [SpecializationPath]
fetch :: forall a m. (MonadIO m, Typeable a) => Cache a -> Key -> m a -> m a
fetch :: forall a (m :: * -> *).
(MonadIO m, Typeable a) =>
Cache a -> Key -> m a -> m a
fetch (Cache MVar (Map Key a)
var) Key
key m a
action = do
Map Key a
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
P.readMVar MVar (Map Key a)
var
case forall k a. Ord k => k -> Map k a -> Maybe a
lookup Key
key Map Key a
m of
Just a
a ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Maybe a
Nothing -> do
a
val <- m a
action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map Key a)
var (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Key
key a
val)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
newCache :: IO (Cache a)
newCache :: forall a. IO (Cache a)
newCache = forall a. MVar (Map Key a) -> Cache a
Cache forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
P.newMVar forall a. Monoid a => a
mempty