module Util.Cache(
Cache,
newCache,
getCached
) where
import qualified Data.Map as Map
import Control.Concurrent
data Ord key =>
Cache key elt = Cache (MVar(Map.Map key (MVar elt))) (key -> IO elt)
newCache :: Ord key => (key -> IO elt) -> IO(Cache key elt)
newCache :: (key -> IO elt) -> IO (Cache key elt)
newCache key -> IO elt
getAct =
do
MVar (Map key (MVar elt))
cacheMVar <- Map key (MVar elt) -> IO (MVar (Map key (MVar elt)))
forall a. a -> IO (MVar a)
newMVar Map key (MVar elt)
forall k a. Map k a
Map.empty
Cache key elt -> IO (Cache key elt)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVar (Map key (MVar elt)) -> (key -> IO elt) -> Cache key elt
forall key elt.
MVar (Map key (MVar elt)) -> (key -> IO elt) -> Cache key elt
Cache MVar (Map key (MVar elt))
cacheMVar key -> IO elt
getAct)
getCached :: Ord key => Cache key elt -> key -> IO elt
getCached :: Cache key elt -> key -> IO elt
getCached (Cache MVar (Map key (MVar elt))
cacheMVar key -> IO elt
getAct) key
key =
do
Map key (MVar elt)
cacheMap <- MVar (Map key (MVar elt)) -> IO (Map key (MVar elt))
forall a. MVar a -> IO a
takeMVar MVar (Map key (MVar elt))
cacheMVar
case key -> Map key (MVar elt) -> Maybe (MVar elt)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
key Map key (MVar elt)
cacheMap of
Just MVar elt
mVar ->
do
MVar (Map key (MVar elt)) -> Map key (MVar elt) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Map key (MVar elt))
cacheMVar Map key (MVar elt)
cacheMap
MVar elt -> IO elt
forall a. MVar a -> IO a
readMVar MVar elt
mVar
Maybe (MVar elt)
Nothing ->
do
MVar elt
mVar <- IO (MVar elt)
forall a. IO (MVar a)
newEmptyMVar
MVar (Map key (MVar elt)) -> Map key (MVar elt) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Map key (MVar elt))
cacheMVar (key -> MVar elt -> Map key (MVar elt) -> Map key (MVar elt)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
key MVar elt
mVar Map key (MVar elt)
cacheMap)
elt
value <- key -> IO elt
getAct key
key
MVar elt -> elt -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar elt
mVar elt
value
elt -> IO elt
forall (m :: * -> *) a. Monad m => a -> m a
return elt
value