-- | The Cache module allows us to cache results of expensive stateful
-- computations in memory.
-- Possible improvements -
--    (1) use hashing instead
module Util.Cache(
   Cache,    -- a cache (a stateful object).  Takes parameters key and elt.
             -- key must be an instance of Ord.
   newCache, -- :: Ord key => (key -> IO elt) -> IO(Cache key elt)
   getCached -- :: Ord key => Cache key elt -> key -> IO elt
   ) 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)

{- We do this in two stages so as not to hold up the whole
   cache at once. -}
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