-- |
-- Module:      Data.Cache
-- Copyright:   (c) 2016 Henri Verroken
-- License:     BSD3
-- Maintainer:  Henri Verroken <henriverroken@gmail.com>
-- Stability:   stable
--
-- An in-memory key/value store with expiration support, similar
-- to patrickmn/go-cache for Go.
--
-- The cache is a shared mutable HashMap implemented using STM. It
-- supports item expiration.

module Data.Cache (
    -- * How to use this library
    -- $use

    -- * Creating a cache
    Cache
  , newCache
  , newCacheSTM

    -- * Cache properties
  , defaultExpiration
  , setDefaultExpiration
  , copyCache
  , copyCacheSTM

    -- * Managing items
    -- ** Insertion
  , insert
  , insert'
  , insertSTM
    -- ** Querying
  , lookup
  , lookup'
  , lookupSTM
  , keys
  , keysSTM
    -- ** Deletion
  , delete
  , deleteSTM
  , filterWithKey
  , purge
  , purgeExpired
  , purgeExpiredSTM
    -- ** Combined actions
  , fetchWithCache

    -- * Cache information
  , size
  , sizeSTM
  , toList
) where

import Prelude hiding (lookup)

import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.IO.Class
import Data.Cache.Internal
import qualified Data.HashMap.Strict as HM
import Data.Hashable
import Data.Maybe
import System.Clock

-- | Change the default expiration value of newly added cache items.
--
-- See 'newCache' for more information on the default expiration value.
setDefaultExpiration :: Cache k v -> Maybe TimeSpec -> Cache k v
setDefaultExpiration :: Cache k v -> Maybe TimeSpec -> Cache k v
setDefaultExpiration Cache k v
c Maybe TimeSpec
t = Cache k v
c { defaultExpiration :: Maybe TimeSpec
defaultExpiration = Maybe TimeSpec
t }


isExpired :: TimeSpec -> CacheItem v -> Bool
isExpired :: TimeSpec -> CacheItem v -> Bool
isExpired TimeSpec
t CacheItem v
i = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (CacheItem v -> Maybe TimeSpec
forall v. CacheItem v -> Maybe TimeSpec
itemExpiration CacheItem v
i Maybe TimeSpec -> (TimeSpec -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TimeSpec -> TimeSpec -> Maybe Bool
forall a. Ord a => a -> a -> Maybe Bool
f TimeSpec
t)
    where f :: a -> a -> Maybe Bool
f a
now' a
e
            | a
e a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
now'   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            | Bool
otherwise = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False

-- | Create a new cache with a default expiration value for newly
-- added cache items.
--
-- Items that are added to the cache without an explicit expiration value
-- (using 'insert') will be inserted with the default expiration value.
--
-- If the specified default expiration value is `Nothing`, items inserted
-- by 'insert' will never expire.
newCache :: Maybe TimeSpec -> IO (Cache k v)
newCache :: Maybe TimeSpec -> IO (Cache k v)
newCache Maybe TimeSpec
d = do
    TVar (HashMap k (CacheItem v))
m <- HashMap k (CacheItem v) -> IO (TVar (HashMap k (CacheItem v)))
forall a. a -> IO (TVar a)
newTVarIO HashMap k (CacheItem v)
forall k v. HashMap k v
HM.empty
    Cache k v -> IO (Cache k v)
forall (m :: * -> *) a. Monad m => a -> m a
return Cache :: forall k v.
TVar (HashMap k (CacheItem v)) -> Maybe TimeSpec -> Cache k v
Cache { container :: TVar (HashMap k (CacheItem v))
container = TVar (HashMap k (CacheItem v))
m, defaultExpiration :: Maybe TimeSpec
defaultExpiration = Maybe TimeSpec
d }

-- | STM variant of 'newCache'
newCacheSTM :: Maybe TimeSpec -> STM (Cache k v)
newCacheSTM :: Maybe TimeSpec -> STM (Cache k v)
newCacheSTM Maybe TimeSpec
d = do
    TVar (HashMap k (CacheItem v))
m <- HashMap k (CacheItem v) -> STM (TVar (HashMap k (CacheItem v)))
forall a. a -> STM (TVar a)
newTVar HashMap k (CacheItem v)
forall k v. HashMap k v
HM.empty
    Cache k v -> STM (Cache k v)
forall (m :: * -> *) a. Monad m => a -> m a
return Cache :: forall k v.
TVar (HashMap k (CacheItem v)) -> Maybe TimeSpec -> Cache k v
Cache { container :: TVar (HashMap k (CacheItem v))
container = TVar (HashMap k (CacheItem v))
m, defaultExpiration :: Maybe TimeSpec
defaultExpiration = Maybe TimeSpec
d }

copyCacheSTM :: Cache k v -> STM (Cache k v)
copyCacheSTM :: Cache k v -> STM (Cache k v)
copyCacheSTM Cache k v
c = do
    TVar (HashMap k (CacheItem v))
m <- HashMap k (CacheItem v) -> STM (TVar (HashMap k (CacheItem v)))
forall a. a -> STM (TVar a)
newTVar (HashMap k (CacheItem v) -> STM (TVar (HashMap k (CacheItem v))))
-> STM (HashMap k (CacheItem v))
-> STM (TVar (HashMap k (CacheItem v)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar (Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c)
    Cache k v -> STM (Cache k v)
forall (m :: * -> *) a. Monad m => a -> m a
return Cache k v
c { container :: TVar (HashMap k (CacheItem v))
container = TVar (HashMap k (CacheItem v))
m }

-- | Create a deep copy of the cache.
copyCache :: Cache k v -> IO (Cache k v)
copyCache :: Cache k v -> IO (Cache k v)
copyCache = STM (Cache k v) -> IO (Cache k v)
forall a. STM a -> IO a
atomically (STM (Cache k v) -> IO (Cache k v))
-> (Cache k v -> STM (Cache k v)) -> Cache k v -> IO (Cache k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache k v -> STM (Cache k v)
forall k v. Cache k v -> STM (Cache k v)
copyCacheSTM

-- | STM variant of 'size'
sizeSTM :: Cache k v -> STM Int
sizeSTM :: Cache k v -> STM Int
sizeSTM Cache k v
c = HashMap k (CacheItem v) -> Int
forall k v. HashMap k v -> Int
HM.size (HashMap k (CacheItem v) -> Int)
-> STM (HashMap k (CacheItem v)) -> STM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar (Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c)

-- | Return the size of the cache, including expired items.
size :: Cache k v -> IO Int
size :: Cache k v -> IO Int
size = STM Int -> IO Int
forall a. STM a -> IO a
atomically (STM Int -> IO Int)
-> (Cache k v -> STM Int) -> Cache k v -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache k v -> STM Int
forall k v. Cache k v -> STM Int
sizeSTM

-- | STM variant of 'delete'.
deleteSTM :: (Eq k, Hashable k) => k -> Cache k v -> STM ()
deleteSTM :: k -> Cache k v -> STM ()
deleteSTM k
k Cache k v
c = TVar (HashMap k (CacheItem v)) -> HashMap k (CacheItem v) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (HashMap k (CacheItem v))
v (HashMap k (CacheItem v) -> STM ())
-> STM (HashMap k (CacheItem v)) -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (k -> HashMap k (CacheItem v) -> HashMap k (CacheItem v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete k
k (HashMap k (CacheItem v) -> HashMap k (CacheItem v))
-> STM (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar TVar (HashMap k (CacheItem v))
v) where v :: TVar (HashMap k (CacheItem v))
v = Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c

-- | Delete an item from the cache. Won't do anything if the item is not present.
delete :: (Eq k, Hashable k) => Cache k v -> k -> IO ()
delete :: Cache k v -> k -> IO ()
delete Cache k v
c k
k = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ k -> Cache k v -> STM ()
forall k v. (Eq k, Hashable k) => k -> Cache k v -> STM ()
deleteSTM k
k Cache k v
c

lookupItem' :: (Eq k, Hashable k) => k -> Cache k v -> STM (Maybe (CacheItem v))
lookupItem' :: k -> Cache k v -> STM (Maybe (CacheItem v))
lookupItem' k
k Cache k v
c = k -> HashMap k (CacheItem v) -> Maybe (CacheItem v)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
k (HashMap k (CacheItem v) -> Maybe (CacheItem v))
-> STM (HashMap k (CacheItem v)) -> STM (Maybe (CacheItem v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar (Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c)

lookupItemT :: (Eq k, Hashable k) => Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
lookupItemT :: Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
lookupItemT Bool
del k
k Cache k v
c TimeSpec
t = MaybeT STM (CacheItem v) -> STM (Maybe (CacheItem v))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT STM (CacheItem v) -> STM (Maybe (CacheItem v)))
-> MaybeT STM (CacheItem v) -> STM (Maybe (CacheItem v))
forall a b. (a -> b) -> a -> b
$ do
        CacheItem v
i <- STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (k -> Cache k v -> STM (Maybe (CacheItem v))
forall k v.
(Eq k, Hashable k) =>
k -> Cache k v -> STM (Maybe (CacheItem v))
lookupItem' k
k Cache k v
c)
        let e :: Bool
e = TimeSpec -> CacheItem v -> Bool
forall v. TimeSpec -> CacheItem v -> Bool
isExpired TimeSpec
t CacheItem v
i
        ()
_ <- Bool -> MaybeT STM () -> MaybeT STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
e Bool -> Bool -> Bool
&& Bool
del) (STM (Maybe ()) -> MaybeT STM ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (STM (Maybe ()) -> MaybeT STM ())
-> STM (Maybe ()) -> MaybeT STM ()
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just (() -> Maybe ()) -> STM () -> STM (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> Cache k v -> STM ()
forall k v. (Eq k, Hashable k) => k -> Cache k v -> STM ()
deleteSTM k
k Cache k v
c)
        if Bool
e then STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v))
-> STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v)
forall a b. (a -> b) -> a -> b
$ Maybe (CacheItem v) -> STM (Maybe (CacheItem v))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CacheItem v)
forall a. Maybe a
Nothing else STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v))
-> STM (Maybe (CacheItem v)) -> MaybeT STM (CacheItem v)
forall a b. (a -> b) -> a -> b
$ Maybe (CacheItem v) -> STM (Maybe (CacheItem v))
forall (m :: * -> *) a. Monad m => a -> m a
return (CacheItem v -> Maybe (CacheItem v)
forall a. a -> Maybe a
Just CacheItem v
i)

lookupItem :: (Eq k, Hashable k) => Bool -> k -> Cache k v -> IO (Maybe (CacheItem v))
lookupItem :: Bool -> k -> Cache k v -> IO (Maybe (CacheItem v))
lookupItem Bool
del k
k Cache k v
c = (STM (Maybe (CacheItem v)) -> IO (Maybe (CacheItem v))
forall a. STM a -> IO a
atomically (STM (Maybe (CacheItem v)) -> IO (Maybe (CacheItem v)))
-> (TimeSpec -> STM (Maybe (CacheItem v)))
-> TimeSpec
-> IO (Maybe (CacheItem v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
forall k v.
(Eq k, Hashable k) =>
Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
lookupItemT Bool
del k
k Cache k v
c) (TimeSpec -> IO (Maybe (CacheItem v)))
-> IO TimeSpec -> IO (Maybe (CacheItem v))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO TimeSpec
now

-- | Lookup an item with the given key, but don't delete it if it is expired.
--
-- The function will only return a value if it is present in the cache and if
-- the item is not expired.
--
-- The function will not delete the item from the cache.
lookup' :: (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
lookup' :: Cache k v -> k -> IO (Maybe v)
lookup' Cache k v
c k
k = MaybeT IO v -> IO (Maybe v)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO v -> IO (Maybe v)) -> MaybeT IO v -> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ CacheItem v -> v
forall v. CacheItem v -> v
item (CacheItem v -> v) -> MaybeT IO (CacheItem v) -> MaybeT IO v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (CacheItem v)) -> MaybeT IO (CacheItem v)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Bool -> k -> Cache k v -> IO (Maybe (CacheItem v))
forall k v.
(Eq k, Hashable k) =>
Bool -> k -> Cache k v -> IO (Maybe (CacheItem v))
lookupItem Bool
False k
k Cache k v
c)

-- | Lookup an item with the given key, and delete it if it is expired.
--
-- The function will only return a value if it is present in the cache and if
-- the item is not expired.
--
-- The function will eagerly delete the item from the cache if it is expired.
lookup :: (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
lookup :: Cache k v -> k -> IO (Maybe v)
lookup Cache k v
c k
k = MaybeT IO v -> IO (Maybe v)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO v -> IO (Maybe v)) -> MaybeT IO v -> IO (Maybe v)
forall a b. (a -> b) -> a -> b
$ CacheItem v -> v
forall v. CacheItem v -> v
item (CacheItem v -> v) -> MaybeT IO (CacheItem v) -> MaybeT IO v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (CacheItem v)) -> MaybeT IO (CacheItem v)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Bool -> k -> Cache k v -> IO (Maybe (CacheItem v))
forall k v.
(Eq k, Hashable k) =>
Bool -> k -> Cache k v -> IO (Maybe (CacheItem v))
lookupItem Bool
True k
k Cache k v
c)

-- | Lookup an item with a given key in the 'STM' monad, given the current 'Monotonic' time.
--
-- STM variant of 'lookup' and 'lookup''
lookupSTM :: (Eq k, Hashable k) => Bool             -- ^ Whether or not to eagerly delete the item if its expired
                                -> k                -- ^ The key to lookup
                                -> Cache k v        -- ^ The cache
                                -> TimeSpec         -- ^ The current 'Monotonic' time, i.e. @getTime Monotonic@
                                -> STM (Maybe v)
lookupSTM :: Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe v)
lookupSTM Bool
f k
k Cache k v
c TimeSpec
t = do
    Maybe (CacheItem v)
mv <- Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
forall k v.
(Eq k, Hashable k) =>
Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
lookupItemT Bool
f k
k Cache k v
c TimeSpec
t
    Maybe v -> STM (Maybe v)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> STM (Maybe v)) -> Maybe v -> STM (Maybe v)
forall a b. (a -> b) -> a -> b
$! CacheItem v -> v
forall v. CacheItem v -> v
item (CacheItem v -> v) -> Maybe (CacheItem v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CacheItem v)
mv

insertItem :: (Eq k, Hashable k) => k -> CacheItem v -> Cache k v -> STM ()
insertItem :: k -> CacheItem v -> Cache k v -> STM ()
insertItem k
k CacheItem v
a Cache k v
c = TVar (HashMap k (CacheItem v)) -> HashMap k (CacheItem v) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (HashMap k (CacheItem v))
v (HashMap k (CacheItem v) -> STM ())
-> STM (HashMap k (CacheItem v)) -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (k
-> CacheItem v
-> HashMap k (CacheItem v)
-> HashMap k (CacheItem v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert k
k CacheItem v
a (HashMap k (CacheItem v) -> HashMap k (CacheItem v))
-> STM (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar TVar (HashMap k (CacheItem v))
v) where v :: TVar (HashMap k (CacheItem v))
v = Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c

-- | Insert an item in the cache, with an explicit expiration value, in the
-- 'STM' monad.
--
-- If the expiration value is 'Nothing', the item will never expire. The
-- default expiration value of the cache is ignored.
--
-- The expiration value is the absolute 'Monotonic' time the item expires. You
-- should manually construct the absolute 'Monotonic' time, as opposed to the
-- behaviour of 'insert''.
--
-- E.g.
--
-- > action :: Cache -> IO ()
-- > action c = do
-- >     t <- getTime Monotonic
-- >     let t' = t + (defaultExpiration c)
-- >     atomically $ insertSTM 0 0 c (Just t')
--
insertSTM :: (Eq k, Hashable k) => k -> v -> Cache k v -> Maybe TimeSpec -> STM ()
insertSTM :: k -> v -> Cache k v -> Maybe TimeSpec -> STM ()
insertSTM k
k v
a Cache k v
c Maybe TimeSpec
t = k -> CacheItem v -> Cache k v -> STM ()
forall k v.
(Eq k, Hashable k) =>
k -> CacheItem v -> Cache k v -> STM ()
insertItem k
k (v -> Maybe TimeSpec -> CacheItem v
forall v. v -> Maybe TimeSpec -> CacheItem v
CacheItem v
a Maybe TimeSpec
t) Cache k v
c

-- | Insert an item in the cache, with an explicit expiration value.
--
-- If the expiration value is 'Nothing', the item will never expire. The
-- default expiration value of the cache is ignored.
--
-- The expiration value is relative to the current 'Monotonic' time, i.e. it
-- will be automatically added to the result of @getTime Monotonic@.
insert' :: (Eq k, Hashable k) =>  Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
insert' :: Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
insert' Cache k v
c Maybe TimeSpec
Nothing k
k v
a  = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ k -> v -> Cache k v -> Maybe TimeSpec -> STM ()
forall k v.
(Eq k, Hashable k) =>
k -> v -> Cache k v -> Maybe TimeSpec -> STM ()
insertSTM k
k v
a Cache k v
c Maybe TimeSpec
forall a. Maybe a
Nothing
insert' Cache k v
c (Just TimeSpec
d) k
k v
a = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> (Maybe TimeSpec -> STM ()) -> Maybe TimeSpec -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v -> Cache k v -> Maybe TimeSpec -> STM ()
forall k v.
(Eq k, Hashable k) =>
k -> v -> Cache k v -> Maybe TimeSpec -> STM ()
insertSTM k
k v
a Cache k v
c (Maybe TimeSpec -> IO ()) -> IO (Maybe TimeSpec) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TimeSpec -> Maybe TimeSpec
forall a. a -> Maybe a
Just (TimeSpec -> Maybe TimeSpec)
-> (TimeSpec -> TimeSpec) -> TimeSpec -> Maybe TimeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeSpec
d TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
+) (TimeSpec -> Maybe TimeSpec) -> IO TimeSpec -> IO (Maybe TimeSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeSpec
now

-- | Insert an item in the cache, using the default expiration value of
-- the cache.
insert :: (Eq k, Hashable k) => Cache k v -> k -> v -> IO ()
insert :: Cache k v -> k -> v -> IO ()
insert Cache k v
c = Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
forall k v.
(Eq k, Hashable k) =>
Cache k v -> Maybe TimeSpec -> k -> v -> IO ()
insert' Cache k v
c (Cache k v -> Maybe TimeSpec
forall k v. Cache k v -> Maybe TimeSpec
defaultExpiration Cache k v
c)

-- | Get a value from cache. If not available from cache, use the provided action and update the cache.
-- Note that the cache check and conditional execution of the action is not one atomic action.
fetchWithCache :: (Eq k, Hashable k, MonadIO m) => Cache k v -> k -> (k -> m v) -> m v
fetchWithCache :: Cache k v -> k -> (k -> m v) -> m v
fetchWithCache Cache k v
c k
k k -> m v
f = do
  Maybe v
mv <- IO (Maybe v) -> m (Maybe v)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe v) -> m (Maybe v)) -> IO (Maybe v) -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> IO (Maybe v)
forall k v. (Eq k, Hashable k) => Cache k v -> k -> IO (Maybe v)
lookup Cache k v
c k
k
  case Maybe v
mv of
    Just v
v -> v -> m v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v
    Maybe v
Nothing -> do
       v
v <- k -> m v
f k
k
       IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Cache k v -> k -> v -> IO ()
forall k v. (Eq k, Hashable k) => Cache k v -> k -> v -> IO ()
insert Cache k v
c k
k v
v
       v -> m v
forall (m :: * -> *) a. Monad m => a -> m a
return v
v

-- | STM variant of 'keys'.
keysSTM :: Cache k v -> STM [k]
keysSTM :: Cache k v -> STM [k]
keysSTM Cache k v
c = HashMap k (CacheItem v) -> [k]
forall k v. HashMap k v -> [k]
HM.keys (HashMap k (CacheItem v) -> [k])
-> STM (HashMap k (CacheItem v)) -> STM [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar (Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c)

-- | Return all keys present in the cache.
keys :: Cache k v -> IO [k]
keys :: Cache k v -> IO [k]
keys = STM [k] -> IO [k]
forall a. STM a -> IO a
atomically (STM [k] -> IO [k])
-> (Cache k v -> STM [k]) -> Cache k v -> IO [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache k v -> STM [k]
forall k v. Cache k v -> STM [k]
keysSTM

now :: IO TimeSpec
now :: IO TimeSpec
now = Clock -> IO TimeSpec
getTime Clock
Monotonic

-- | Keeps elements that satify a predicate (used for cache invalidation).
-- Note that the predicate might be called for expired items.
filterWithKey :: (Eq k, Hashable k) => (k -> v -> Bool) -> Cache k v -> IO ()
filterWithKey :: (k -> v -> Bool) -> Cache k v -> IO ()
filterWithKey k -> v -> Bool
f Cache k v
c = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (HashMap k (CacheItem v)) -> HashMap k (CacheItem v) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (HashMap k (CacheItem v))
c' (HashMap k (CacheItem v) -> STM ())
-> STM (HashMap k (CacheItem v)) -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((k -> CacheItem v -> Bool)
-> HashMap k (CacheItem v) -> HashMap k (CacheItem v)
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey (\k
k (CacheItem v
v Maybe TimeSpec
_) -> k -> v -> Bool
f k
k v
v) (HashMap k (CacheItem v) -> HashMap k (CacheItem v))
-> STM (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar TVar (HashMap k (CacheItem v))
c') where c' :: TVar (HashMap k (CacheItem v))
c' = Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c

-- | Delete all elements (cache invalidation).
purge :: (Eq k, Hashable k) => Cache k v -> IO ()
purge :: Cache k v -> IO ()
purge Cache k v
c = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (HashMap k (CacheItem v)) -> HashMap k (CacheItem v) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (HashMap k (CacheItem v))
v HashMap k (CacheItem v)
forall k v. HashMap k v
HM.empty where v :: TVar (HashMap k (CacheItem v))
v = Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c

-- | STM variant of 'purgeExpired'.
--
-- The 'TimeSpec' argument should be the current 'Monotonic' time, i.e.
-- @getTime Monotonic@.
purgeExpiredSTM :: (Eq k, Hashable k) => Cache k v -> TimeSpec -> STM ()
purgeExpiredSTM :: Cache k v -> TimeSpec -> STM ()
purgeExpiredSTM Cache k v
c TimeSpec
t = (k -> STM (Maybe (CacheItem v))) -> [k] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\k
k -> Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
forall k v.
(Eq k, Hashable k) =>
Bool -> k -> Cache k v -> TimeSpec -> STM (Maybe (CacheItem v))
lookupItemT Bool
True k
k Cache k v
c TimeSpec
t) ([k] -> STM ()) -> STM [k] -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cache k v -> STM [k]
forall k v. Cache k v -> STM [k]
keysSTM Cache k v
c

-- | Delete all items that are expired.
--
-- This is one big atomic operation.
purgeExpired :: (Eq k, Hashable k) => Cache k v -> IO ()
purgeExpired :: Cache k v -> IO ()
purgeExpired Cache k v
c = (STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> (TimeSpec -> STM ()) -> TimeSpec -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cache k v -> TimeSpec -> STM ()
forall k v. (Eq k, Hashable k) => Cache k v -> TimeSpec -> STM ()
purgeExpiredSTM Cache k v
c) (TimeSpec -> IO ()) -> IO TimeSpec -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO TimeSpec
now

-- | Returns the cache content as a list.
-- The third element of the tuple is the expiration date. Nothing means that it doesn't expire.
toList :: Cache k v -> IO [(k, v, Maybe TimeSpec)]
toList :: Cache k v -> IO [(k, v, Maybe TimeSpec)]
toList Cache k v
c = STM [(k, v, Maybe TimeSpec)] -> IO [(k, v, Maybe TimeSpec)]
forall a. STM a -> IO a
atomically (STM [(k, v, Maybe TimeSpec)] -> IO [(k, v, Maybe TimeSpec)])
-> STM [(k, v, Maybe TimeSpec)] -> IO [(k, v, Maybe TimeSpec)]
forall a b. (a -> b) -> a -> b
$ do
  HashMap k (CacheItem v)
m <- TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a. TVar a -> STM a
readTVar (TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v)))
-> TVar (HashMap k (CacheItem v)) -> STM (HashMap k (CacheItem v))
forall a b. (a -> b) -> a -> b
$ Cache k v -> TVar (HashMap k (CacheItem v))
forall k v. Cache k v -> TVar (HashMap k (CacheItem v))
container Cache k v
c
  let l :: [(k, CacheItem v)]
l = HashMap k (CacheItem v) -> [(k, CacheItem v)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap k (CacheItem v)
m
  [(k, v, Maybe TimeSpec)] -> STM [(k, v, Maybe TimeSpec)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(k, v, Maybe TimeSpec)] -> STM [(k, v, Maybe TimeSpec)])
-> [(k, v, Maybe TimeSpec)] -> STM [(k, v, Maybe TimeSpec)]
forall a b. (a -> b) -> a -> b
$ ((k, CacheItem v) -> (k, v, Maybe TimeSpec))
-> [(k, CacheItem v)] -> [(k, v, Maybe TimeSpec)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k, (CacheItem v
v Maybe TimeSpec
i)) -> (k
k, v
v, Maybe TimeSpec
i)) [(k, CacheItem v)]
l
  
-- $use
--
-- All operations are automically executed in the IO monad. The
-- underlying data structure is @Data.HashMap.Strict@.
--
-- First create a cache using 'newCache' and possibly a default
-- expiration value. Items can now be inserted using 'insert' and
-- 'insert''.
--
-- 'lookup' and 'lookup'' are used to query items. These functions
-- only return a value when the item is in the cache and it is not
-- expired. The 'lookup' function will automatically delete the
-- item if it is expired, while 'lookup'' won't delete the item.
--
-- Note that items are __not purged automatically__ in the background when they
-- expire. You have to manually call 'lookup' to purge a single item, or call
-- 'purgeExpired' to purge all expired items.
--
-- > >>> c <- newCache Nothing :: IO (Cache String String)
-- > >>> insert c "key" "value"
-- > >>> lookup c "key"
-- > Just "value"
-- > >>> delete c "key"
-- > >>> lookup c "key"
-- > Nothing