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
(Cache a -> Cache a -> Bool)
-> (Cache a -> Cache a -> Bool) -> Eq (Cache a)
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 :: Cache a -> Key -> m a -> m a
fetch (Cache MVar (Map Key a)
var) Key
key m a
action =
do Map Key a
m <- IO (Map Key a) -> m (Map Key a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Key a) -> m (Map Key a))
-> IO (Map Key a) -> m (Map Key a)
forall a b. (a -> b) -> a -> b
$ MVar (Map Key a) -> IO (Map Key a)
forall a. MVar a -> IO a
P.readMVar MVar (Map Key a)
var
case Key -> Map Key a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Key
key Map Key a
m of
Just a
a ->
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Maybe a
Nothing -> do
a
val <- m a
action
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar (Map Key a) -> (Map Key a -> IO (Map Key a)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (Map Key a)
var (\Map Key a
cached -> Map Key a -> IO (Map Key a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Key a -> IO (Map Key a)) -> Map Key a -> IO (Map Key a)
forall a b. (a -> b) -> a -> b
$ Key -> a -> Map Key a -> Map Key a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Key
key a
val Map Key a
cached)
a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
newCache :: IO (Cache a)
newCache :: IO (Cache a)
newCache = MVar (Map Key a) -> Cache a
forall a. MVar (Map Key a) -> Cache a
Cache (MVar (Map Key a) -> Cache a)
-> IO (MVar (Map Key a)) -> IO (Cache a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Key a -> IO (MVar (Map Key a))
forall a. a -> IO (MVar a)
P.newMVar Map Key a
forall a. Monoid a => a
mempty