module Control.Concurrent.Cache (Cache, newCache, fetch) where
import Control.Concurrent.MVar
import Control.Monad (liftM)
import Data.Typeable (Typeable)
newtype Cache a = Cache (MVar (Maybe a))
deriving (Eq, Typeable)
fetch :: Cache a -> IO a -> IO a
fetch (Cache var) action = go where
go = readMVar var >>= \m -> case m of
Just a -> return a
Nothing -> do
modifyMVar_ var $ \m' -> case m' of
Just a -> return (Just a)
Nothing -> liftM Just action
go
newCache :: IO (Cache a)
newCache = do
var <- newMVar Nothing
return (Cache var)