{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Cache.Type
( Cache(..)
, insert, lookup, lookupMaybe, lookupCreating, cached, evict
, CacheEvent(..)
, CacheTrace
, Caching(..)
, DictCache(..)
) where
import qualified Control.Monad.Fail as Fail
import Control.Monad.Trans
import Data.Cache.Trace
import Data.Maybe
import Prelude hiding (lookup)
class Caching c (m :: * -> *) k t v | c -> m, c -> k, c -> t, c -> v where
insetTraced :: forall (trc::Bool) . c -> k -> t -> v -> Tracable trc (CacheTrace k t v) m ()
lookupTraced :: forall (trc::Bool) . c -> k -> Tracable trc (CacheTrace k t v) m (Maybe v)
evictTraced :: forall (trc::Bool) . c -> k -> Tracable trc (CacheTrace k t v) m ()
updateTracking :: forall (trc::Bool) . c -> k -> (t -> t) -> Tracable trc (CacheTrace k t v) m ()
data Cache m k t v
= forall c . Caching c m k t v => Cache c
insert :: (Monad m, Caching c m k () v) => c -> k -> v -> m ()
insert c k v = runUntracedT $ insetTraced c k () v
lookup :: (Fail.MonadFail m, Caching c m k t v) => c -> k -> m v
lookup c k = fmap fromJust $ runUntracedT $ lookupTraced c k
lookupCreating :: (Monad m, Caching c m k () v) => c -> k -> (m v) -> m v
lookupCreating c k a = runUntracedT $ do
mv <- lookupTraced c k
case mv of
Just v -> pure v
Nothing -> lift a >>= \v -> insetTraced c k () v >> pure v
lookupMaybe :: (Monad m, Caching c m k t v) => c -> k -> m (Maybe v)
lookupMaybe c k = runUntracedT $ lookupTraced c k
cached :: (Monad m, Caching c m k t v) => c -> k -> m Bool
cached c k = isJust <$> lookupMaybe c k
evict :: (Monad m, Caching c m k t v) => c -> k -> m ()
evict c k = runUntracedT $ evictTraced c k
data DictCache (m :: * -> *) k t v
= DictCache
{ dcIns :: forall (trc::Bool) . k -> t -> v -> Tracable trc (CacheTrace k t v) m ()
, dcLook :: forall (trc::Bool) . k -> Tracable trc (CacheTrace k t v) m (Maybe v)
, dcEvict :: forall (trc::Bool) . k -> Tracable trc (CacheTrace k t v) m ()
, dcUp :: forall (trc::Bool) . k -> (t -> t) -> Tracable trc (CacheTrace k t v) m ()
}
instance Caching (DictCache m k t v) m k t v where
insetTraced (DictCache { dcIns=f }) = f
lookupTraced (DictCache { dcLook=f }) = f
evictTraced (DictCache { dcEvict=f }) = f
updateTracking (DictCache { dcUp=f }) = f