{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module : Caching.ExpiringCacheMap.OrdECM
-- Copyright: (c) 2014 Edward L. Blake
-- License: BSD-style
-- Maintainer: Edward L. Blake <edwardlblake@gmail.com>
-- Stability: experimental
-- Portability: portable
--
-- A cache that holds values for a length of time that uses 'Ord' keys with 
-- "Data.Map.Strict".
-- 
-- An example of creating a cache for accessing files:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > 
-- > import Caching.ExpiringCacheMap.OrdECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration)
-- > 
-- > import qualified Data.Time.Clock.POSIX as POSIX (POSIXTime, getPOSIXTime)
-- > import qualified Data.ByteString.Char8 as BS
-- > import System.IO (withFile, IOMode(ReadMode))
-- > 
-- > example = do
-- >   filecache <- newECMIO
-- >         (consistentDuration 100 -- Duration between access and expiry time of each item
-- >           (\state id -> do BS.putStrLn "Reading a file again..."
-- >                            withFile (case id :: BS.ByteString of
-- >                                        "file1" -> "file1.txt"
-- >                                        "file2" -> "file2.txt")
-- >                               ReadMode $
-- >                               \fh -> do content <- BS.hGetContents fh
-- >                                         return $! (state, content)))
-- >         (do time <- POSIX.getPOSIXTime
-- >             return (round (time * 100)))
-- >         1 -- Time check frequency: (accumulator `mod` this_number) == 0.
-- >         (CacheWithLRUList
-- >           6     -- Expected size of key-value map when removing elements.
-- >           6     -- Size of map when to remove items from key-value map.
-- >           12    -- Size of list when to compact
-- >           )
-- >   
-- >   -- Use lookupECM whenever the contents of "file1" is needed.
-- >   b <- lookupECM filecache "file1"
-- >   BS.putStrLn b
-- >   return ()
-- > 
--

module Caching.ExpiringCacheMap.OrdECM (
    -- * Create cache
    newECMIO,
    newECMForM,
    consistentDuration,
    
    -- * Request value from cache
    lookupECM,
    
    -- * Value request function state
    getValReqState,
    
    -- * Invalidate cache
    invalidate,
    invalidateCache,
    
    -- * List keys
    keysCached,
    keysNotExpired,
    
    -- * Type
    ECM,
    CacheSettings(..)
) where

import qualified Control.Concurrent.MVar as MV
import qualified Data.Map.Strict as M
import qualified Data.List as L

import Caching.ExpiringCacheMap.Internal.Internal (updateUses, detECM, detNotExpired)
import Caching.ExpiringCacheMap.Types
import Caching.ExpiringCacheMap.Internal.Types

-- | Create a new expiring cache for retrieving uncached values via 'IO'
-- interaction (such as in the case of reading a file from disk), with
-- a shared state lock via an 'MV.MVar' to manage cache state.
--
-- Value request and time check request functions are provided as arguments.
--
-- The time check frequency value has to be 1 or higher, with higher values
-- postponing time checks for longer periods of time.
-- 
-- A cache setting specifies how the cache should remove entries when the
-- cache becomes a certain size. The only constructor for this is
-- 'CacheWithLRUList'.
--
newECMIO :: Ord k => (Maybe s -> k -> IO (TimeUnits, (Maybe s, v))) -> (IO TimeUnits)
  -> ECMIncr 
  -> CacheSettings
    -> IO (ECM IO MV.MVar s M.Map k v)
newECMIO :: forall k s v.
Ord k =>
(Maybe s -> k -> IO (TimeUnits, (Maybe s, v)))
-> IO TimeUnits
-> ECMIncr
-> CacheSettings
-> IO (ECM IO MVar s Map k v)
newECMIO Maybe s -> k -> IO (TimeUnits, (Maybe s, v))
retr IO TimeUnits
gettime ECMIncr
timecheckmodulo CacheSettings
settings = do
  (Maybe s -> k -> IO (TimeUnits, (Maybe s, v)))
-> IO TimeUnits
-> ECMIncr
-> CacheSettings
-> ECMNewState IO MVar s Map k v
-> ECMEnterState IO MVar s Map k v
-> ECMReadState IO MVar s Map k v
-> IO (ECM IO MVar s Map k v)
forall (m1 :: * -> *) (m2 :: * -> *) k s v (mv :: * -> *).
(Monad m1, Monad m2, Ord k) =>
(Maybe s -> k -> m1 (TimeUnits, (Maybe s, v)))
-> m1 TimeUnits
-> ECMIncr
-> CacheSettings
-> ECMNewState m2 mv s Map k v
-> ECMEnterState m1 mv s Map k v
-> ECMReadState m1 mv s Map k v
-> m2 (ECM m1 mv s Map k v)
newECMForM Maybe s -> k -> IO (TimeUnits, (Maybe s, v))
retr IO TimeUnits
gettime ECMIncr
timecheckmodulo CacheSettings
settings
    ECMNewState IO MVar s Map k v
forall a. a -> IO (MVar a)
MV.newMVar ECMEnterState IO MVar s Map k v
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MV.modifyMVar ECMReadState IO MVar s Map k v
forall a. MVar a -> IO a
MV.readMVar

-- | Create a new expiring cache along arbitrary monads with provided
-- functions to create cache state in 'Monad' m2, and modify and read
-- cache state in 'Monad' m1.
--
-- 'newECMIO' is just a wrapper to this function with 'MV.MVar' functions:
--
-- @
--  newECMIO retr gettime timecheckmodulo cachesettings =
--    newECMForM retr gettime timecheckmodulo cachesettings
--      'MV.newMVar' 'MV.modifyMVar' 'MV.readMVar'
-- @
--
-- Value request and time check request functions are provided as arguments.
--
-- The time check frequency value has to be 1 or higher, with higher values
-- postponing time checks for longer periods of time.
-- 
-- A cache setting specifies how the cache should remove entries when the
-- cache becomes a certain size. The only constructor for this is
-- 'CacheWithLRUList'.
--
newECMForM :: (Monad m1, Monad m2) => Ord k => (Maybe s -> k -> m1 (TimeUnits, (Maybe s, v))) -> (m1 TimeUnits)
  -> ECMIncr
  -> CacheSettings
  -> ECMNewState m2 mv s M.Map k v
  -> ECMEnterState m1 mv s M.Map k v
  -> ECMReadState m1 mv s M.Map k v
    -> m2 (ECM m1 mv s M.Map k v)
newECMForM :: forall (m1 :: * -> *) (m2 :: * -> *) k s v (mv :: * -> *).
(Monad m1, Monad m2, Ord k) =>
(Maybe s -> k -> m1 (TimeUnits, (Maybe s, v)))
-> m1 TimeUnits
-> ECMIncr
-> CacheSettings
-> ECMNewState m2 mv s Map k v
-> ECMEnterState m1 mv s Map k v
-> ECMReadState m1 mv s Map k v
-> m2 (ECM m1 mv s Map k v)
newECMForM Maybe s -> k -> m1 (TimeUnits, (Maybe s, v))
retr m1 TimeUnits
gettime ECMIncr
timecheckmodulo (CacheWithLRUList TimeUnits
minimumkeep TimeUnits
removalsize TimeUnits
compactlistsize)
           ECMNewState m2 mv s Map k v
newstate ECMEnterState m1 mv s Map k v
enterstate ECMReadState m1 mv s Map k v
readstate =
  if ECMIncr
timecheckmodulo ECMIncr -> ECMIncr -> Bool
forall a. Ord a => a -> a -> Bool
<= ECMIncr
0
    then [Char] -> m2 (ECM m1 mv s Map k v)
forall a. HasCallStack => [Char] -> a
error [Char]
"Modulo time check must be 1 or higher."
    else do
      mv (CacheState s Map k v)
m'maps <- ECMNewState m2 mv s Map k v
newstate ECMNewState m2 mv s Map k v -> ECMNewState m2 mv s Map k v
forall a b. (a -> b) -> a -> b
$ (Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> CacheState s Map k v
forall s (m :: * -> * -> *) k v.
(Maybe s, m k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> CacheState s m k v
CacheState ( Maybe s
forall a. Maybe a
Nothing, Map k (TimeUnits, TimeUnits, v)
forall k a. Map k a
M.empty, TimeUnits
0, ([], TimeUnits
0), ECMIncr
0 )
      ECM m1 mv s Map k v -> m2 (ECM m1 mv s Map k v)
forall a. a -> m2 a
forall (m :: * -> *) a. Monad m => a -> m a
return (ECM m1 mv s Map k v -> m2 (ECM m1 mv s Map k v))
-> ECM m1 mv s Map k v -> m2 (ECM m1 mv s Map k v)
forall a b. (a -> b) -> a -> b
$ (mv (CacheState s Map k v),
 Maybe s -> k -> m1 (TimeUnits, (Maybe s, v)), m1 TimeUnits,
 TimeUnits, ECMIncr, TimeUnits, TimeUnits,
 ECMEnterState m1 mv s Map k v, ECMReadState m1 mv s Map k v)
-> ECM m1 mv s Map k v
forall (a :: * -> *) (b :: * -> *) s (m :: * -> * -> *) k v.
(b (CacheState s m k v),
 Maybe s -> k -> a (TimeUnits, (Maybe s, v)), a TimeUnits,
 TimeUnits, ECMIncr, TimeUnits, TimeUnits,
 ECMEnterState a b s m k v, ECMReadState a b s m k v)
-> ECM a b s m k v
ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m1 (TimeUnits, (Maybe s, v))
retr, m1 TimeUnits
gettime, TimeUnits
minimumkeep, ECMIncr
timecheckmodulo, TimeUnits
removalsize,
                     TimeUnits
compactlistsize, ECMEnterState m1 mv s Map k v
enterstate, ECMReadState m1 mv s Map k v
readstate )

-- | Request a value associated with a key from the cache.
--
--  * If the value is not in the cache, it will be requested through the 
--    function defined through 'newECM', its computation returned and the
--    value stored in the cache state map.
-- 
--  * If the value is in the cache and has not expired, it will be returned.
--
--  * If the value is in the cache and a new time is computed in the same
--    lookup, and the value has been determined to have since expired, it 
--    will be discarded and a new value will be requested for this computation.
--
-- Every 'lookupECM' computation increments an accumulator in the cache state 
-- which is used to keep track of the succession of key accesses. Based on the
-- parameters provided with the 'CacheWithLRUList' constructor, this history 
-- of key accesses is then used to remove entries from the cache back down to 
-- a minimum size. Also, when the modulo of the accumulator and the modulo 
-- value computes to 0, the time request function is invoked. In some cases
-- the accumulator may get incremented more than once in a 'lookupECM'
-- computation.
--
-- As the accumulator is a bound unsigned integer, when the accumulator
-- increments back to 0, the cache state is completely cleared.
-- 
-- The time request function is invoked in one of two different conditions
-- 
--  * When a new key-value entry is requested, the current time is also
--    requested during the same lookup, as a recent time determination is
--    needed for a new entry in the key-value cache.
-- 
--  * When the modulo of the accumulator and a specified value equals to 0.
--
-- When the current time is determined during a lookup, access times of the
-- entries in the key-value cache are compared with the new time to filter
-- out expired entries from the key-value map.
-- 
lookupECM :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m v
lookupECM :: forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Ord k) =>
ECM m mv s Map k v -> k -> m v
lookupECM ECM m mv s Map k v
ecm k
id = do
  ECMEnterState m mv s Map k v
enter mv (CacheState s Map k v)
m'maps ((CacheState s Map k v -> m (CacheState s Map k v, v)) -> m v)
-> (CacheState s Map k v -> m (CacheState s Map k v, v)) -> m v
forall a b. (a -> b) -> a -> b
$
    \(CacheState (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps, TimeUnits
mapsize, ([(k, ECMIncr)], TimeUnits)
uses, ECMIncr
incr)) ->
      let incr' :: ECMIncr
incr' = ECMIncr
incr ECMIncr -> ECMIncr -> ECMIncr
forall a. Num a => a -> a -> a
+ ECMIncr
1
       in if ECMIncr
incr' ECMIncr -> ECMIncr -> Bool
forall a. Ord a => a -> a -> Bool
< ECMIncr
incr
            -- Word incrementor has cycled back to 0,
            -- so may as well clear the cache completely.
            then (Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), Integer)
-> ECMIncr -> m (CacheState s Map k v, v)
forall {e}.
(Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), e)
-> ECMIncr -> m (CacheState s Map k v, v)
lookupECM' (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
forall k a. Map k a
M.empty, TimeUnits
0, ([], TimeUnits
0), Integer
0) (ECMIncr
0ECMIncr -> ECMIncr -> ECMIncr
forall a. Num a => a -> a -> a
+ECMIncr
1)
            else (Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> ECMIncr -> m (CacheState s Map k v, v)
forall {e}.
(Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), e)
-> ECMIncr -> m (CacheState s Map k v, v)
lookupECM' (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps, TimeUnits
mapsize, ([(k, ECMIncr)], TimeUnits)
uses, ECMIncr
incr) ECMIncr
incr'
  where
    
    ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m (TimeUnits, (Maybe s, v))
retr, m TimeUnits
gettime, TimeUnits
minimumkeep, ECMIncr
timecheckmodulo, TimeUnits
removalsize,
          TimeUnits
compactlistsize, ECMEnterState m mv s Map k v
enter, ECMReadState m mv s Map k v
_ro ) = ECM m mv s Map k v
ecm
  
    -- Reversing the list first before turning into a map, so the higher value
    -- which is at the beginning will be at the end. And fromList retains the
    -- last value for a key in the list.
    mnub :: [(k, a)] -> [(k, a)]
mnub = Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList (Map k a -> [(k, a)])
-> ([(k, a)] -> Map k a) -> [(k, a)] -> [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, a)] -> Map k a)
-> ([(k, a)] -> [(k, a)]) -> [(k, a)] -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> [(k, a)]
forall a. [a] -> [a]
reverse 
    lookupECM' :: (Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), e)
-> ECMIncr -> m (CacheState s Map k v, v)
lookupECM' (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps, TimeUnits
mapsize, ([(k, ECMIncr)], TimeUnits)
uses, e
incr) ECMIncr
incr' = do
      let uses' :: ([(k, ECMIncr)], TimeUnits)
uses' = ([(k, ECMIncr)], TimeUnits)
-> k
-> ECMIncr
-> TimeUnits
-> ([(k, ECMIncr)] -> [(k, ECMIncr)])
-> ([(k, ECMIncr)], TimeUnits)
forall k.
Eq k =>
([(k, ECMIncr)], TimeUnits)
-> k
-> ECMIncr
-> TimeUnits
-> ([(k, ECMIncr)] -> [(k, ECMIncr)])
-> ([(k, ECMIncr)], TimeUnits)
updateUses ([(k, ECMIncr)], TimeUnits)
uses k
id ECMIncr
incr' TimeUnits
compactlistsize [(k, ECMIncr)] -> [(k, ECMIncr)]
forall {a}. [(k, a)] -> [(k, a)]
mnub
      ((CacheState s Map k v, v)
ret, Bool
do_again) <- Maybe s
-> Map k (TimeUnits, TimeUnits, v)
-> TimeUnits
-> ([(k, ECMIncr)], TimeUnits)
-> ECMIncr
-> m ((CacheState s Map k v, v), Bool)
det Maybe s
retr_state Map k (TimeUnits, TimeUnits, v)
maps TimeUnits
mapsize ([(k, ECMIncr)], TimeUnits)
uses' ECMIncr
incr'
      if Bool
do_again
        then do let (CacheState (Maybe s
retr_state', Map k (TimeUnits, TimeUnits, v)
maps', TimeUnits
mapsize', ([(k, ECMIncr)], TimeUnits)
uses'', ECMIncr
incr''), v
_) = (CacheState s Map k v, v)
ret
                    uses''' :: ([(k, ECMIncr)], TimeUnits)
uses''' = ([(k, ECMIncr)], TimeUnits)
-> k
-> ECMIncr
-> TimeUnits
-> ([(k, ECMIncr)] -> [(k, ECMIncr)])
-> ([(k, ECMIncr)], TimeUnits)
forall k.
Eq k =>
([(k, ECMIncr)], TimeUnits)
-> k
-> ECMIncr
-> TimeUnits
-> ([(k, ECMIncr)] -> [(k, ECMIncr)])
-> ([(k, ECMIncr)], TimeUnits)
updateUses ([(k, ECMIncr)], TimeUnits)
uses'' k
id ECMIncr
incr'' TimeUnits
compactlistsize [(k, ECMIncr)] -> [(k, ECMIncr)]
forall {a}. [(k, a)] -> [(k, a)]
mnub
                ((CacheState s Map k v, v)
ret', Bool
_) <- Maybe s
-> Map k (TimeUnits, TimeUnits, v)
-> TimeUnits
-> ([(k, ECMIncr)], TimeUnits)
-> ECMIncr
-> m ((CacheState s Map k v, v), Bool)
det Maybe s
retr_state' Map k (TimeUnits, TimeUnits, v)
maps' TimeUnits
mapsize' ([(k, ECMIncr)], TimeUnits)
uses''' ECMIncr
incr''
                (CacheState s Map k v, v) -> m (CacheState s Map k v, v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CacheState s Map k v, v)
ret'
        else (CacheState s Map k v, v) -> m (CacheState s Map k v, v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CacheState s Map k v, v)
ret
    
    det :: Maybe s
-> Map k (TimeUnits, TimeUnits, v)
-> TimeUnits
-> ([(k, ECMIncr)], TimeUnits)
-> ECMIncr
-> m ((CacheState s Map k v, v), Bool)
det Maybe s
retr_state Map k (TimeUnits, TimeUnits, v)
maps TimeUnits
mapsize ([(k, ECMIncr)], TimeUnits)
uses' ECMIncr
incr' =
      Maybe (TimeUnits, TimeUnits, v)
-> Maybe s
-> m (TimeUnits, (Maybe s, v))
-> ((TimeUnits, TimeUnits, v) -> Map k (TimeUnits, TimeUnits, v),
    (TimeUnits, TimeUnits, v)
    -> [(k, ECMIncr)] -> Map k (TimeUnits, TimeUnits, v),
    [(k, ECMIncr)] -> [(k, ECMIncr)], TimeUnits, TimeUnits)
-> m TimeUnits
-> (((TimeUnits, TimeUnits, v) -> Bool)
    -> Map k (TimeUnits, TimeUnits, v)
    -> Map k (TimeUnits, TimeUnits, v))
-> TimeUnits
-> (Map k (TimeUnits, TimeUnits, v) -> TimeUnits)
-> ([(k, ECMIncr)], TimeUnits)
-> ECMIncr
-> ECMIncr
-> Map k (TimeUnits, TimeUnits, v)
-> m ((CacheState s Map k v, v), Bool)
forall (m :: * -> *) k v s (mp :: * -> * -> *).
(Monad m, Eq k) =>
Maybe (TimeUnits, TimeUnits, v)
-> Maybe s
-> m (TimeUnits, (Maybe s, v))
-> ((TimeUnits, TimeUnits, v) -> mp k (TimeUnits, TimeUnits, v),
    (TimeUnits, TimeUnits, v)
    -> [(k, ECMIncr)] -> mp k (TimeUnits, TimeUnits, v),
    [(k, ECMIncr)] -> [(k, ECMIncr)], TimeUnits, TimeUnits)
-> m TimeUnits
-> (((TimeUnits, TimeUnits, v) -> Bool)
    -> mp k (TimeUnits, TimeUnits, v)
    -> mp k (TimeUnits, TimeUnits, v))
-> TimeUnits
-> (mp k (TimeUnits, TimeUnits, v) -> TimeUnits)
-> ([(k, ECMIncr)], TimeUnits)
-> ECMIncr
-> ECMIncr
-> mp k (TimeUnits, TimeUnits, v)
-> m ((CacheState s mp k v, v), Bool)
detECM (k
-> Map k (TimeUnits, TimeUnits, v)
-> Maybe (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
id Map k (TimeUnits, TimeUnits, v)
maps) Maybe s
retr_state (Maybe s -> k -> m (TimeUnits, (Maybe s, v))
retr Maybe s
retr_state k
id)
        ( (\(TimeUnits, TimeUnits, v)
time_r -> k
-> (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
id (TimeUnits, TimeUnits, v)
time_r Map k (TimeUnits, TimeUnits, v)
maps),
          (\(TimeUnits, TimeUnits, v)
time_r [(k, ECMIncr)]
keepuses -> k
-> (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
id (TimeUnits, TimeUnits, v)
time_r (Map k (TimeUnits, TimeUnits, v)
 -> Map k (TimeUnits, TimeUnits, v))
-> Map k (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
forall a b. (a -> b) -> a -> b
$! Map k (TimeUnits, TimeUnits, v)
-> Map k ECMIncr -> Map k (TimeUnits, TimeUnits, v)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection Map k (TimeUnits, TimeUnits, v)
maps (Map k ECMIncr -> Map k (TimeUnits, TimeUnits, v))
-> Map k ECMIncr -> Map k (TimeUnits, TimeUnits, v)
forall a b. (a -> b) -> a -> b
$ [(k, ECMIncr)] -> Map k ECMIncr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, ECMIncr)]
keepuses),
          [(k, ECMIncr)] -> [(k, ECMIncr)]
forall {a}. [(k, a)] -> [(k, a)]
mnub, TimeUnits
minimumkeep, TimeUnits
removalsize )
        m TimeUnits
gettime
        ((TimeUnits, TimeUnits, v) -> Bool)
-> Map k (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter
        TimeUnits
mapsize Map k (TimeUnits, TimeUnits, v) -> TimeUnits
forall k a. Map k a -> TimeUnits
M.size
        ([(k, ECMIncr)], TimeUnits)
uses' ECMIncr
incr' ECMIncr
timecheckmodulo Map k (TimeUnits, TimeUnits, v)
maps


getValReqState :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m (Maybe s)
getValReqState :: forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Ord k) =>
ECM m mv s Map k v -> k -> m (Maybe s)
getValReqState ECM m mv s Map k v
ecm k
id = do
  CacheState (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps, TimeUnits
mapsize, ([(k, ECMIncr)], TimeUnits)
uses, ECMIncr
incr) <- ECMReadState m mv s Map k v
read mv (CacheState s Map k v)
m'maps
  Maybe s -> m (Maybe s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe s
retr_state
  where
    ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m (TimeUnits, (Maybe s, v))
_, m TimeUnits
_, TimeUnits
_, ECMIncr
_, TimeUnits
_, TimeUnits
_, ECMEnterState m mv s Map k v
_, ECMReadState m mv s Map k v
read ) = ECM m mv s Map k v
ecm


-- | Invalidates a key from the cache and returns its value if any.
--   Note that this is a sequential composition of a read and modify of the
--   mutable cache container (e.g. 'MV.readMVar' followed by 'MV.modifyMVar'
--   with 'newECMIO' instances).
--
invalidate :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m (Maybe v)
invalidate :: forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Ord k) =>
ECM m mv s Map k v -> k -> m (Maybe v)
invalidate ECM m mv s Map k v
ecm k
id = do
  CacheState (Maybe s
_, Map k (TimeUnits, TimeUnits, v)
maps0, TimeUnits
_, ([(k, ECMIncr)], TimeUnits)
_, ECMIncr
_) <- ECMReadState m mv s Map k v
read mv (CacheState s Map k v)
m'maps
  case k
-> Map k (TimeUnits, TimeUnits, v)
-> Maybe (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
id Map k (TimeUnits, TimeUnits, v)
maps0 of
    Just (TimeUnits, TimeUnits, v)
time_prev0 -> do
      v
prev0' <- ECMEnterState m mv s Map k v
enter mv (CacheState s Map k v)
m'maps ((CacheState s Map k v -> m (CacheState s Map k v, v)) -> m v)
-> (CacheState s Map k v -> m (CacheState s Map k v, v)) -> m v
forall a b. (a -> b) -> a -> b
$
        \(CacheState (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps, TimeUnits
mapsize, ([(k, ECMIncr)], TimeUnits)
uses, ECMIncr
incr)) ->
          let (TimeUnits
_, TimeUnits
_, v
prev) =
                case k
-> Map k (TimeUnits, TimeUnits, v)
-> Maybe (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
id Map k (TimeUnits, TimeUnits, v)
maps of
                  Just (TimeUnits, TimeUnits, v)
time_prev -> (TimeUnits, TimeUnits, v)
time_prev
                  Maybe (TimeUnits, TimeUnits, v)
Nothing -> (TimeUnits, TimeUnits, v)
time_prev0
              maps' :: Map k (TimeUnits, TimeUnits, v)
maps' = k
-> Map k (TimeUnits, TimeUnits, v)
-> Map k (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
id Map k (TimeUnits, TimeUnits, v)
maps
           in (CacheState s Map k v, v) -> m (CacheState s Map k v, v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> CacheState s Map k v
forall s (m :: * -> * -> *) k v.
(Maybe s, m k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> CacheState s m k v
CacheState (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps', TimeUnits
mapsize, ([(k, ECMIncr)], TimeUnits)
uses, ECMIncr
incr), v
prev)
      Maybe v -> m (Maybe v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe v -> m (Maybe v)) -> Maybe v -> m (Maybe v)
forall a b. (a -> b) -> a -> b
$ v -> Maybe v
forall a. a -> Maybe a
Just v
prev0'
    Maybe (TimeUnits, TimeUnits, v)
Nothing -> Maybe v -> m (Maybe v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe v
forall a. Maybe a
Nothing
  where
    ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m (TimeUnits, (Maybe s, v))
_, m TimeUnits
_, TimeUnits
_, ECMIncr
_, TimeUnits
_, TimeUnits
compactlistsize, ECMEnterState m mv s Map k v
enter, ECMReadState m mv s Map k v
read ) = ECM m mv s Map k v
ecm


-- | Invalidates the entire cache and returns the last key and value if any.
--   Note that this is a sequential composition of a read and modify of the
--   mutable cache container (e.g. 'MV.readMVar' followed by 'MV.modifyMVar'
--   with 'newECMIO' instances).
--
invalidateCache :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m (Maybe (k, v))
invalidateCache :: forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Ord k) =>
ECM m mv s Map k v -> m (Maybe (k, v))
invalidateCache ECM m mv s Map k v
ecm = do
  CacheState (Maybe s
_, Map k (TimeUnits, TimeUnits, v)
maps0, TimeUnits
_, ([(k, ECMIncr)]
uses0, TimeUnits
_), ECMIncr
_) <- ECMReadState m mv s Map k v
read mv (CacheState s Map k v)
m'maps
  case (Map k ECMIncr -> [(k, ECMIncr)]
forall k a. Map k a -> [(k, a)]
M.toList (Map k ECMIncr -> [(k, ECMIncr)])
-> Map k ECMIncr -> [(k, ECMIncr)]
forall a b. (a -> b) -> a -> b
$ Map k ECMIncr -> Map k (TimeUnits, TimeUnits, v) -> Map k ECMIncr
forall k a b. Ord k => Map k a -> Map k b -> Map k a
M.intersection ([(k, ECMIncr)] -> Map k ECMIncr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, ECMIncr)] -> Map k ECMIncr)
-> [(k, ECMIncr)] -> Map k ECMIncr
forall a b. (a -> b) -> a -> b
$ [(k, ECMIncr)] -> [(k, ECMIncr)]
forall a. [a] -> [a]
reverse [(k, ECMIncr)]
uses0) Map k (TimeUnits, TimeUnits, v)
maps0) of
    [] -> Maybe (k, v) -> m (Maybe (k, v))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (k, v)
forall a. Maybe a
Nothing
    [(k, ECMIncr)]
uses0' -> 
      let (k
id, ECMIncr
_) = ((k, ECMIncr) -> (k, ECMIncr) -> Ordering)
-> [(k, ECMIncr)] -> (k, ECMIncr)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.maximumBy (\(k
_,ECMIncr
a) (k
_,ECMIncr
b) -> ECMIncr -> ECMIncr -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ECMIncr
a ECMIncr
b) [(k, ECMIncr)]
uses0' in
      case k
-> Map k (TimeUnits, TimeUnits, v)
-> Maybe (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
id Map k (TimeUnits, TimeUnits, v)
maps0 of
        Just (TimeUnits, TimeUnits, v)
time_prev0 -> do
          v
prev0' <- ECMEnterState m mv s Map k v
enter mv (CacheState s Map k v)
m'maps ((CacheState s Map k v -> m (CacheState s Map k v, v)) -> m v)
-> (CacheState s Map k v -> m (CacheState s Map k v, v)) -> m v
forall a b. (a -> b) -> a -> b
$
            \(CacheState (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
maps, TimeUnits
_mapsize, ([(k, ECMIncr)], TimeUnits)
_uses, ECMIncr
_incr)) ->
              let (TimeUnits
_, TimeUnits
_, v
prev) =
                    case k
-> Map k (TimeUnits, TimeUnits, v)
-> Maybe (TimeUnits, TimeUnits, v)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
id Map k (TimeUnits, TimeUnits, v)
maps of
                      Just (TimeUnits, TimeUnits, v)
time_prev -> (TimeUnits, TimeUnits, v)
time_prev
                      Maybe (TimeUnits, TimeUnits, v)
Nothing -> (TimeUnits, TimeUnits, v)
time_prev0
               in (CacheState s Map k v, v) -> m (CacheState s Map k v, v)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe s, Map k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> CacheState s Map k v
forall s (m :: * -> * -> *) k v.
(Maybe s, m k (TimeUnits, TimeUnits, v), TimeUnits,
 ([(k, ECMIncr)], TimeUnits), ECMIncr)
-> CacheState s m k v
CacheState (Maybe s
retr_state, Map k (TimeUnits, TimeUnits, v)
forall k a. Map k a
M.empty, TimeUnits
0, ([], TimeUnits
0), ECMIncr
0), v
prev)
          Maybe (k, v) -> m (Maybe (k, v))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (k, v) -> m (Maybe (k, v)))
-> Maybe (k, v) -> m (Maybe (k, v))
forall a b. (a -> b) -> a -> b
$ (k, v) -> Maybe (k, v)
forall a. a -> Maybe a
Just (k
id, v
prev0')
  where
    ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m (TimeUnits, (Maybe s, v))
_, m TimeUnits
_, TimeUnits
_, ECMIncr
_, TimeUnits
_, TimeUnits
compactlistsize, ECMEnterState m mv s Map k v
enter, ECMReadState m mv s Map k v
read ) = ECM m mv s Map k v
ecm


-- | List of keys in the cache map without performing a time check, returning
--   both stored keys that are expired and keys that are not expired. keys are
--   in an unspecified order.
--
keysCached :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m [k]
keysCached :: forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Ord k) =>
ECM m mv s Map k v -> m [k]
keysCached ECM m mv s Map k v
ecm = do
  CacheState (Maybe s
_, Map k (TimeUnits, TimeUnits, v)
maps0, TimeUnits
_, ([(k, ECMIncr)], TimeUnits)
_, ECMIncr
_) <- ECMReadState m mv s Map k v
read mv (CacheState s Map k v)
m'maps
  [k] -> m [k]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([k] -> m [k]) -> [k] -> m [k]
forall a b. (a -> b) -> a -> b
$ Map k (TimeUnits, TimeUnits, v) -> [k]
forall k a. Map k a -> [k]
M.keys Map k (TimeUnits, TimeUnits, v)
maps0
  where
    ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m (TimeUnits, (Maybe s, v))
_, m TimeUnits
_, TimeUnits
_, ECMIncr
_, TimeUnits
_, TimeUnits
_, ECMEnterState m mv s Map k v
_, ECMReadState m mv s Map k v
read ) = ECM m mv s Map k v
ecm


-- | List of keys in the cache map that are not expired values. A time check
--   is always performed to compare with the elapsed time left with each key.
--   The cache state is not modified and the time check is not performed from
--   within a modifying state context, e.g. not within 'MV.modifyMVar' with a 
--   'newECMIO' instance. Keys are in an unspecified order. 
--
keysNotExpired :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m [k]
keysNotExpired :: forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Ord k) =>
ECM m mv s Map k v -> m [k]
keysNotExpired ECM m mv s Map k v
ecm = do
  CacheState (Maybe s
_, Map k (TimeUnits, TimeUnits, v)
maps0, TimeUnits
_, ([(k, ECMIncr)], TimeUnits)
_, ECMIncr
_) <- ECMReadState m mv s Map k v
read mv (CacheState s Map k v)
m'maps
  TimeUnits
current_time <- m TimeUnits
gettime
  [k] -> m [k]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([k] -> m [k]) -> [k] -> m [k]
forall a b. (a -> b) -> a -> b
$ TimeUnits -> [(k, (TimeUnits, TimeUnits, v))] -> [k]
forall k v. TimeUnits -> [(k, (TimeUnits, TimeUnits, v))] -> [k]
detNotExpired TimeUnits
current_time ([(k, (TimeUnits, TimeUnits, v))] -> [k])
-> [(k, (TimeUnits, TimeUnits, v))] -> [k]
forall a b. (a -> b) -> a -> b
$ Map k (TimeUnits, TimeUnits, v) -> [(k, (TimeUnits, TimeUnits, v))]
forall k a. Map k a -> [(k, a)]
M.toList Map k (TimeUnits, TimeUnits, v)
maps0
  where
    ECM ( mv (CacheState s Map k v)
m'maps, Maybe s -> k -> m (TimeUnits, (Maybe s, v))
_, m TimeUnits
gettime, TimeUnits
_, ECMIncr
_, TimeUnits
_, TimeUnits
_, ECMEnterState m mv s Map k v
_, ECMReadState m mv s Map k v
read ) = ECM m mv s Map k v
ecm



{-

These functions would require inclusion of a enter_ function (like modifyMVar_)

putValReqState :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> Maybe s -> m (Maybe s)
putValReqState ecm id new_state = do
  enter_ m'maps $
    \(CacheState (retr_state, maps, mapsize, uses, incr)) ->
      return (CacheState (new_state, maps, mapsize, uses, incr), retr_state)
  where
    
    ECM ( m'maps, _, _, _, _, _, _, _, enter_, _ro ) = ecm


clearCache :: (Monad m, Ord k) => ECM m mv s M.Map k v -> m ()
clearCache ecm = do
  enter_ m'maps $
    \(CacheState (retr_state, maps, mapsize, uses, incr)) ->
      return $ CacheState (retr_state, M.empty, 0, ([], 0), 0)
  where
    ECM ( m'maps, _, _, _, _, _, _, enter, enter_, _ ) = ecm

-}


{-
-- This function differs from 'lookupECM' only in the case that the value
-- being requested also causes a new time to have been computed during the 
-- same lookup, and have been found to be out of date. When the condition 
-- happens, this function returns the old cached value without attempting
-- to request a new value, despite being out of date. However, it does
-- clear the key from the key-value store for the next request.
--
lookupECMUse :: (Monad m, Ord k) => ECM m mv s M.Map k v -> k -> m v
lookupECMUse ecm id = do
  enter m'maps $
    \(CacheState (retr_state, maps, mapsize, uses, incr)) ->
      let incr' = incr + 1
       in if incr' < incr
            -- Word incrementor has cycled back to 0,
            -- so may as well clear the cache completely.
            then lookupECM' (retr_state, M.empty, 0, ([], 0), 0) (0+1)
            else lookupECM' (retr_state, maps, mapsize, uses, incr) incr'
  where
    
    ECM ( m'maps, retr, gettime, minimumkeep, timecheckmodulo, removalsize,
          compactlistsize, enter, _ro ) = ecm
  
    mnub = M.toList . M.fromList . reverse
    lookupECM' (retr_state, maps, mapsize, uses, incr) incr' = do
      let uses' = updateUses uses id incr' compactlistsize mnub
      (ret, _) <-
          detECM (M.lookup id maps) retr_state (retr retr_state id)
            ( (\time_r -> M.insert id time_r maps),
              (\time_r keepuses -> M.insert id time_r $! M.intersection maps $ M.fromList keepuses),
              mnub, minimumkeep, removalsize )
            gettime
            M.filter mapsize M.size
            uses' incr' timecheckmodulo maps
      return ret
-}


-- | Used with 'newECMIO' or 'newECMForM' to provide a consistent duration for requested values.
consistentDuration :: (Monad m, Ord k) => TimeUnits -> (Maybe s -> k -> m (Maybe s, v)) -> (Maybe s -> k -> m (TimeUnits, (Maybe s, v)))
consistentDuration :: forall (m :: * -> *) k s v.
(Monad m, Ord k) =>
TimeUnits
-> (Maybe s -> k -> m (Maybe s, v))
-> Maybe s
-> k
-> m (TimeUnits, (Maybe s, v))
consistentDuration TimeUnits
duration Maybe s -> k -> m (Maybe s, v)
fun =
  \Maybe s
state k
id -> do
    (Maybe s, v)
ret <- Maybe s -> k -> m (Maybe s, v)
fun Maybe s
state k
id
    (TimeUnits, (Maybe s, v)) -> m (TimeUnits, (Maybe s, v))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeUnits
duration, (Maybe s, v)
ret)