-- decorators


-- | Only cache the first `n` requests (use n=-1 for unlimited).
--   Combine with a cache policy in order to reuse those `n` slots.
--
-- >>> withAssocCache $ withFiniteCache 2 $ testC
-- one
-- two
-- testing
-- testing
-- [3,3,3,3,7,7]
--
-- >>> withAssocCache $ withFiniteCache 1 $ testC
-- one
-- two
-- two
-- testing
-- testing
-- [3,3,3,3,7,7]
--
-- >>> withAssocCache $ withFiniteCache 0 $ testC
-- one
-- two
-- one
-- two
-- testing
-- testing
-- [3,3,3,3,7,7]
--
-- >>> withAssocCache $ withFiniteCache (-1) $ testC
-- one
-- two
-- testing
-- [3,3,3,3,7,7]
finiteCache :: Monad m => Int -> Cache m k a -> Cache (StateT Int m) k a
finiteCache n c = Cache
    { readCache      = \k   ->          (lift $ readCache      c k  )
    , writeCache     = \k v -> do
        alreadyFull <- isFull
        if alreadyFull
          then return False
          else do
            r <- lift $ writeCache c k v
            when r incr
            return r
    , clearCache     =         put 0 >> (lift $ clearCache     c    )
    , clearFromCache = \k   -> decr  >> (lift $ clearFromCache c k  )
    }
  where
    isFull = liftM (== n) $ get
    incr = modify (+1)
    decr = modify (subtract 1)
finiteCache :: Monad m => Int -> Cache m k a -> Cache (StateT Int m) k a
finiteCache n c = Cache
    { readCache      = \k   ->          (lift $ readCache      c k  )
    , writeCache     = \k v -> do
        alreadyFull <- isFull
        if alreadyFull
          then return False
          else do
            r <- lift $ writeCache c k v
            when r incr
            return r
    , clearCache     =         put 0 >> (lift $ clearCache     c    )
    , clearFromCache = \k   -> decr  >> (lift $ clearFromCache c k  )
    }
  where
    isFull = liftM (== n) $ get
    incr = modify (+1)
    decr = modify (subtract 1)
finiteCache n c = Cache
    { readCache      = \k   ->          (lift $ readCache      c k  )
    , writeCache     = \k v -> do
        alreadyFull <- isFull
        if alreadyFull
          then return False
          else do
            r <- lift $ writeCache c k v
            when r incr
            return r
    , clearCache     =         put 0 >> (lift $ clearCache     c    )
    , clearFromCache = \k   -> decr  >> (lift $ clearFromCache c k  )
    }
  where
    isFull = liftM (== n) $ get
    incr = modify (+1)
    decr = modify (subtract 1)