Skip to content
Create a gist now

Instantly share code, notes, and snippets.

Simple in-process key/value cache for Haskell
-- | Simple in-process key/value cache
-- Of course, for really simple stuff you could probably use unsafeInterleaveIO
module Cache (Cache, newCache, fromCache) where
import Control.Monad (void)
-- Could also use STM instead
import Control.Concurrent (forkIO, Chan, newChan, readChan, writeChan, MVar, newEmptyMVar, putMVar, takeMVar)
import qualified Data.Map as Map
data CacheMsg k v = CacheMsg k (IO v) (MVar v)
-- | A single cache
newtype Cache k v = Cache (Chan (CacheMsg k v))
cacheThread :: (Ord k) => Chan (CacheMsg k v) -> IO ()
cacheThread chan = next Map.empty
next m = readChan chan >>= go m
go m (CacheMsg k io reply) = case Map.lookup k m of
Just v -> putMVar reply v >> next m
Nothing -> do
v <- io
putMVar reply v
next (Map.insert k v m)
-- | Create a new cache
newCache :: (Ord k) => IO (Cache k v)
newCache = do
chan <- newChan
-- This cache thread never terminates, so this is for a process-life cache
-- That would be easy to change, but I won't bother here
void $ forkIO (cacheThread chan)
return (Cache chan)
syncCall :: Chan a -> (MVar r -> a) -> IO r
syncCall chan msg = do
r <- newEmptyMVar
writeChan chan (msg r)
takeMVar r
-- | Get a value from the cache, or compute it and cache it
fromCache :: Cache k v -> k -> IO v -> IO v
fromCache (Cache chan) k io = syncCall chan (CacheMsg k io)
co-dan commented Aug 9, 2013

So, if I understand this correctly, this cache is supposed to be thread-safe and it locks the cache upon every operation? That means that even read-read operations can not be performed simultaneously, doesn't it?

co-dan commented Aug 9, 2013

Also I think it would make more sense to use strict MVars and strict Map, but I am not sure. Am I wrong on this one?


Yes, this design means only one operation can happen at a time, and that includes reads.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.