module Data.Cache (
Cache,
newCache,
readThrough,
EvictionStrategy(..),
SeqLRU,
newSeqLRU,
LRU,
newLRU,
MRU,
newMRU,
RR,
newRR,
LFU,
newLFU,
FIFO,
newFIFO
) where
import Data.Cache.Eviction (EvictionStrategy(..))
import Data.Cache.Eviction.LRU
import Data.Cache.Eviction.MRU
import Data.Cache.Eviction.RR
import Data.Cache.Eviction.LFU
import Data.Cache.Eviction.FIFO
import qualified Data.HashMap.Strict as HM
import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import Numeric.Natural
data Cache k v s =
Cache {
cacheData :: HM.HashMap k v,
evictionStrategy :: s,
maxSize :: !Int,
currentSize :: !Int
}
newCache :: (Hashable k, NFData v, EvictionStrategy s, Eq k, Ord k) =>
Natural
-> s k
-> Cache k v (s k)
newCache 0 _ = error "Invalid cache size"
newCache maxSize evictionStrategy =
Cache {
cacheData = HM.empty,
evictionStrategy,
maxSize = fromIntegral maxSize,
currentSize = 0
}
readThrough :: (Hashable k, NFData v, EvictionStrategy s, Eq k, Ord k, Monad m) =>
Cache k v (s k)
-> k
-> (k -> m v)
-> m (v , Cache k v (s k))
readThrough cache@(Cache {maxSize, cacheData, currentSize}) key onMiss =
case HM.lookup key cacheData of
Nothing | maxSize <= currentSize -> do
v <- onMiss key
let cache' = postEviction v
pure (v, cache' {currentSize = currentSize + 1})
Just v -> do
let cache' = if maxSize <= currentSize
then postEviction v
else cache
strat' = recordLookup key (evictionStrategy cache')
pure (v, cache' {evictionStrategy = strat'} )
Nothing -> do
v <- onMiss key
let strat' = recordLookup key (evictionStrategy cache)
cacheData' = HM.insert key v cacheData
pure (v, cache {cacheData = cacheData', evictionStrategy = strat', currentSize = currentSize + 1})
where
postEviction v = let
(strat', evicted) = evict (evictionStrategy cache)
strat'' = recordLookup key strat'
cacheData' = HM.insert key v $ maybe cacheData (`HM.delete` cacheData) evicted
in cache {cacheData = cacheData', evictionStrategy = strat''}