{-# LANGUAGE BangPatterns, FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeApplications, DataKinds, KindSignatures #-}

-- |
-- Module      : Data.TinyLRU
-- Description : A lightweight, thread-safe, in-memory LRU cache.
-- Copyright   : (c) 2025 Oleksandr Zhabenko
-- License     : MIT
-- Maintainer  : oleksandr.zhabenko@yahoo.com
-- Stability   : experimental
-- Portability : POSIX
--
-- This module provides a simple, thread-safe, and efficient Least Recently Used (LRU)
-- cache. It is built using Software Transactional Memory (STM), making it suitable
-- for concurrent applications.
--
-- The cache supports:
--
-- *  A fixed capacity, with automatic eviction of the least recently used item.
-- *  Time-based expiration (TTL) for each entry.
-- *  Generic key-value storage, with values being 'ToJSON'/'FromJSON' serializable.
-- *  Atomic operations for safe concurrent access.
--
-- A typical use case involves creating a cache, and then using 'access' or
-- 'updateValue' within an 'atomically' block to interact with it.
--
-- == Example Usage
--
-- @
-- import Control.Concurrent.STM
-- import Data.TinyLRU
-- import Data.Text (Text)
-- import System.Clock
--
-- main :: IO ()
-- main = do
--   -- Initialize a cache with a capacity of 100 items.
--   lru <- atomically $ initTinyLRU 100
--
--   -- Add or retrieve a value.
--   let key1 = "my-key" :: Text
--   let value1 = "my-value" :: Text
--   let ttlSeconds = 3600 -- 1 hour
--
--   -- 'access' is a get-or-insert operation.
--   -- On first run, it inserts 'value1' and returns it.
--   -- On subsequent runs, it returns the existing value.
--   now <- getTime Monotonic
--   retrievedValue <- atomically $ access now key1 value1 ttlSeconds lru
--   print retrievedValue -- Should print: Just "my-value"
--
--   -- Explicitly update a value.
--   let newValue = "a-new-value" :: Text
--   updatedValue <- atomically $ updateValue now key1 newValue ttlSeconds lru
--   print updatedValue -- Should print: Just "a-new-value"
--
--   -- Use the cache for rate limiting.
--   let rateLimitKey = "user:123:login-attempts"
--   -- Allow 5 requests per 60 seconds.
--   isAllowed <- atomically $ allowRequestTinyLRU now lru rateLimitKey 5 60
--   if isAllowed
--     then putStrLn "Request allowed."
--     else putStrLn "Rate limit exceeded."
-- @
--

module Data.TinyLRU
  ( -- * Cache Type
    TinyLRUCache(..)
    -- * Core API
  , initTinyLRU
  , access
  , updateValue
  , deleteKey
  , resetTinyLRU
    -- * Rate Limiting
  , allowRequestTinyLRU
    -- * Internals
    -- | These are lower-level components and functions. Most users will not need them directly.
  , LRUList(..)
  , LRUNode(..)
  , isExpired
  , addToFront
  , removeNode
  , moveToFront
  , evictLRU
  , removeNodeFromCache
  , moveToFrontInCache
  ) where

import Control.Concurrent.STM
import StmContainers.Map (Map)
import qualified StmContainers.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Aeson (FromJSON, ToJSON, encode, decodeStrict)
import System.Clock (TimeSpec(..))
import Data.Maybe (isNothing)
import Control.Monad (when, forM_, foldM)
import qualified ListT

-- | Represents a single node in the LRU cache's doubly-linked list.
-- Each node contains the key, value, expiry time, and pointers to the
-- previous and next nodes.
data LRUNode s = LRUNode
  { forall s. LRUNode s -> Text
nodeKey    :: !Text
    -- ^ The key associated with this cache entry.
  , forall s. LRUNode s -> ByteString
nodeValue  :: !ByteString
    -- ^ The value, stored as a 'ByteString' after JSON encoding.
  , forall s. LRUNode s -> Maybe TimeSpec
nodeExpiry :: !(Maybe TimeSpec)
    -- ^ The absolute expiration time. 'Nothing' means the entry never expires.
  , forall s. LRUNode s -> Maybe (TVar (LRUNode s))
nodePrev   :: !(Maybe (TVar (LRUNode s)))
    -- ^ A transactional variable pointing to the previous node in the list. 'Nothing' if this is the head.
  , forall s. LRUNode s -> Maybe (TVar (LRUNode s))
nodeNext   :: !(Maybe (TVar (LRUNode s)))
    -- ^ A transactional variable pointing to the next node in the list. 'Nothing' if this is the tail.
  }

-- | Represents the doubly-linked list used to track the LRU order.
-- It only stores pointers to the head (most recently used) and
-- tail (least recently used) of the list.
data LRUList s = LRUList
  { forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead :: !(Maybe (TVar (LRUNode s)))
    -- ^ A pointer to the most recently used node.
  , forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail :: !(Maybe (TVar (LRUNode s)))
    -- ^ A pointer to the least recently used node.
  }

-- | The main data structure for the LRU cache.
-- This is the handle you will use for all cache operations.
data TinyLRUCache s = TinyLRUCache
  { forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache :: !(Map Text (TVar (LRUNode s)))
    -- ^ A transactional hash map for O(1) average time complexity lookups.
    -- Maps keys to their corresponding 'LRUNode's in the list.
  , forall s. TinyLRUCache s -> TVar (LRUList s)
lruList  :: !(TVar (LRUList s))
    -- ^ A transactional variable holding the 'LRUList', which manages the usage order.
  , forall s. TinyLRUCache s -> Int
lruCap   :: !Int
    -- ^ The maximum number of items the cache can hold.
  }

-- | Initializes a new 'TinyLRUCache' with a specified capacity.
-- This function must be run within an 'STM' transaction.
--
-- @
-- lruCache <- atomically $ initTinyLRU 1000
-- @
--
-- The capacity must be greater than 0.
--
-- * 'cap' - The maximum number of items the cache can hold. Must be > 0.
-- 
-- Returns an 'STM' action that yields a new, empty 'TinyLRUCache'.
initTinyLRU :: Int -> STM (TinyLRUCache s)
initTinyLRU :: forall s. Int -> STM (TinyLRUCache s)
initTinyLRU Int
cap = do
  Map Text (TVar (LRUNode s))
cache <- STM (Map Text (TVar (LRUNode s)))
forall key value. STM (Map key value)
Map.new
  TVar (LRUList s)
list <- LRUList s -> STM (TVar (LRUList s))
forall a. a -> STM (TVar a)
newTVar (LRUList s -> STM (TVar (LRUList s)))
-> LRUList s -> STM (TVar (LRUList s))
forall a b. (a -> b) -> a -> b
$ Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
forall s.
Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
LRUList Maybe (TVar (LRUNode s))
forall a. Maybe a
Nothing Maybe (TVar (LRUNode s))
forall a. Maybe a
Nothing
  TinyLRUCache s -> STM (TinyLRUCache s)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TinyLRUCache s -> STM (TinyLRUCache s))
-> TinyLRUCache s -> STM (TinyLRUCache s)
forall a b. (a -> b) -> a -> b
$ Map Text (TVar (LRUNode s))
-> TVar (LRUList s) -> Int -> TinyLRUCache s
forall s.
Map Text (TVar (LRUNode s))
-> TVar (LRUList s) -> Int -> TinyLRUCache s
TinyLRUCache Map Text (TVar (LRUNode s))
cache TVar (LRUList s)
list Int
cap

-- | Helper function to calculate the expiry 'TimeSpec' from a TTL in seconds.
mkExpiry :: TimeSpec -> Int -> Maybe TimeSpec
mkExpiry :: TimeSpec -> Int -> Maybe TimeSpec
mkExpiry TimeSpec
now Int
ttl | Int
ttl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe TimeSpec
forall a. Maybe a
Nothing
                 | Bool
otherwise = TimeSpec -> Maybe TimeSpec
forall a. a -> Maybe a
Just (TimeSpec -> Maybe TimeSpec) -> TimeSpec -> Maybe TimeSpec
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int -> TimeSpec
addTTL TimeSpec
now Int
ttl

-- | Checks if a cache node is expired relative to the current time.
--
-- * 'now' - The current 'TimeSpec'.
-- * 'node' - The 'LRUNode' to check.
--
-- Returns 'True' if the node is expired, 'False' otherwise.
isExpired :: TimeSpec -> LRUNode s -> Bool
isExpired :: forall s. TimeSpec -> LRUNode s -> Bool
isExpired TimeSpec
now LRUNode s
node =
  case LRUNode s -> Maybe TimeSpec
forall s. LRUNode s -> Maybe TimeSpec
nodeExpiry LRUNode s
node of
    Maybe TimeSpec
Nothing -> Bool
False
    Just TimeSpec
expTime -> TimeSpec
now TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeSpec
expTime

-- | Atomically removes a node from the doubly-linked list.
-- It correctly updates the 'nodePrev' and 'nodeNext' pointers of the
-- neighboring nodes and the list's 'lruHead' and 'lruTail' pointers if necessary.
--
-- * 'listTVar' - The 'TVar' of the 'LRUList' from which to remove the node.
-- * 'nodeTVar' - The 'TVar' of the 'LRUNode' to remove.
removeNode :: TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
removeNode :: forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
removeNode TVar (LRUList s)
listTVar TVar (LRUNode s)
nodeTVar = do
  LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
nodeTVar
  let mPrev :: Maybe (TVar (LRUNode s))
mPrev = LRUNode s -> Maybe (TVar (LRUNode s))
forall s. LRUNode s -> Maybe (TVar (LRUNode s))
nodePrev LRUNode s
node
      mNext :: Maybe (TVar (LRUNode s))
mNext = LRUNode s -> Maybe (TVar (LRUNode s))
forall s. LRUNode s -> Maybe (TVar (LRUNode s))
nodeNext LRUNode s
node

  -- Link neighbour nodes to each other
  Maybe (TVar (LRUNode s)) -> (TVar (LRUNode s) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (TVar (LRUNode s))
mPrev ((TVar (LRUNode s) -> STM ()) -> STM ())
-> (TVar (LRUNode s) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TVar (LRUNode s)
pRef -> TVar (LRUNode s) -> (LRUNode s -> LRUNode s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (LRUNode s)
pRef (\LRUNode s
p -> LRUNode s
p { nodeNext = mNext })
  Maybe (TVar (LRUNode s)) -> (TVar (LRUNode s) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (TVar (LRUNode s))
mNext ((TVar (LRUNode s) -> STM ()) -> STM ())
-> (TVar (LRUNode s) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TVar (LRUNode s)
nRef -> TVar (LRUNode s) -> (LRUNode s -> LRUNode s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (LRUNode s)
nRef (\LRUNode s
n -> LRUNode s
n { nodePrev = mPrev })

  -- Atomically update the list's head and tail pointers
  TVar (LRUList s) -> (LRUList s -> LRUList s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (LRUList s)
listTVar ((LRUList s -> LRUList s) -> STM ())
-> (LRUList s -> LRUList s) -> STM ()
forall a b. (a -> b) -> a -> b
$ \LRUList s
list ->
    let newHead :: Maybe (TVar (LRUNode s))
newHead = if LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead LRUList s
list Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> Bool
forall a. Eq a => a -> a -> Bool
== TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar then Maybe (TVar (LRUNode s))
mNext else LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead LRUList s
list
        newTail :: Maybe (TVar (LRUNode s))
newTail = if LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> Bool
forall a. Eq a => a -> a -> Bool
== TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar then Maybe (TVar (LRUNode s))
mPrev else LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list
    in LRUList s
list { lruHead = newHead, lruTail = newTail }

-- | Creates a new node and adds it to the front (most recently used position)
-- of the cache's linked list.
--
-- * 'now' - The current 'TimeSpec', used for calculating expiry.
-- * 'ttl' - The time-to-live in seconds. A value <= 0 means it never expires.
-- * 'cache' - The 'TinyLRUCache' instance.
-- * 'key' - The key for the new entry.
-- * 'value' - The 'ByteString' value for the new entry.
--
-- Returns the 'TVar' of the newly created 'LRUNode'.
addToFront :: TimeSpec -> Int -> TinyLRUCache s -> Text -> ByteString -> STM (TVar (LRUNode s))
addToFront :: forall s.
TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
addToFront TimeSpec
now Int
ttl TinyLRUCache s
cache Text
key ByteString
value = do
  let expiry :: Maybe TimeSpec
expiry = TimeSpec -> Int -> Maybe TimeSpec
mkExpiry TimeSpec
now Int
ttl
  LRUList s
list <- TVar (LRUList s) -> STM (LRUList s)
forall a. TVar a -> STM a
readTVar (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache)
  TVar (LRUNode s)
nodeTVar <- LRUNode s -> STM (TVar (LRUNode s))
forall a. a -> STM (TVar a)
newTVar (LRUNode s -> STM (TVar (LRUNode s)))
-> LRUNode s -> STM (TVar (LRUNode s))
forall a b. (a -> b) -> a -> b
$ Text
-> ByteString
-> Maybe TimeSpec
-> Maybe (TVar (LRUNode s))
-> Maybe (TVar (LRUNode s))
-> LRUNode s
forall s.
Text
-> ByteString
-> Maybe TimeSpec
-> Maybe (TVar (LRUNode s))
-> Maybe (TVar (LRUNode s))
-> LRUNode s
LRUNode Text
key ByteString
value Maybe TimeSpec
expiry Maybe (TVar (LRUNode s))
forall a. Maybe a
Nothing (LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead LRUList s
list)
  
  Maybe (TVar (LRUNode s)) -> (TVar (LRUNode s) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead LRUList s
list) ((TVar (LRUNode s) -> STM ()) -> STM ())
-> (TVar (LRUNode s) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TVar (LRUNode s)
oldHeadTVar -> do
    LRUNode s
oldHead <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
oldHeadTVar
    TVar (LRUNode s) -> LRUNode s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (LRUNode s)
oldHeadTVar LRUNode s
oldHead { nodePrev = Just nodeTVar }

  let newTail :: Maybe (TVar (LRUNode s))
newTail = if Maybe (TVar (LRUNode s)) -> Bool
forall a. Maybe a -> Bool
isNothing (LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list) then TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar else LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list
  TVar (LRUList s) -> LRUList s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) (Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
forall s.
Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
LRUList (TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar) Maybe (TVar (LRUNode s))
newTail)
  
  TVar (LRUNode s) -> STM (TVar (LRUNode s))
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return TVar (LRUNode s)
nodeTVar

-- | Moves an existing node to the front of the linked list, marking it as the
-- most recently used. This is a core operation for the LRU logic.
--
-- * 'listTVar' - The 'TVar' of the 'LRUList'.
-- * 'nodeTVar' - The 'TVar' of the 'LRUNode' to move.
moveToFront :: TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront :: forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront TVar (LRUList s)
listTVar TVar (LRUNode s)
nodeTVar = do
  LRUList s
list <- TVar (LRUList s) -> STM (LRUList s)
forall a. TVar a -> STM a
readTVar TVar (LRUList s)
listTVar
  -- Only move if it's not already the head
  Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead LRUList s
list Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> Bool
forall a. Eq a => a -> a -> Bool
/= TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
    TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
removeNode TVar (LRUList s)
listTVar TVar (LRUNode s)
nodeTVar
    LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
nodeTVar
    LRUList s
list' <- TVar (LRUList s) -> STM (LRUList s)
forall a. TVar a -> STM a
readTVar TVar (LRUList s)
listTVar
    let mOldHead :: Maybe (TVar (LRUNode s))
mOldHead = LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruHead LRUList s
list'
    TVar (LRUNode s) -> LRUNode s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (LRUNode s)
nodeTVar LRUNode s
node { nodePrev = Nothing, nodeNext = mOldHead }
    
    Maybe (TVar (LRUNode s)) -> (TVar (LRUNode s) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (TVar (LRUNode s))
mOldHead ((TVar (LRUNode s) -> STM ()) -> STM ())
-> (TVar (LRUNode s) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TVar (LRUNode s)
oldHeadTVar ->
      TVar (LRUNode s) -> (LRUNode s -> LRUNode s) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (LRUNode s)
oldHeadTVar (\LRUNode s
h -> LRUNode s
h { nodePrev = Just nodeTVar })
    
    let newTail :: Maybe (TVar (LRUNode s))
newTail = if Maybe (TVar (LRUNode s)) -> Bool
forall a. Maybe a -> Bool
isNothing (LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list') then TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar else LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list'
    TVar (LRUList s) -> LRUList s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (LRUList s)
listTVar (Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
forall s.
Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
LRUList (TVar (LRUNode s) -> Maybe (TVar (LRUNode s))
forall a. a -> Maybe a
Just TVar (LRUNode s)
nodeTVar) Maybe (TVar (LRUNode s))
newTail)

-- | Evicts the least recently used item from the cache. This involves removing
-- the tail of the linked list and deleting the corresponding entry from the hash map.
--
-- * 'cache' - The 'TinyLRUCache' to perform eviction on.
evictLRU :: TinyLRUCache s -> STM ()
evictLRU :: forall s. TinyLRUCache s -> STM ()
evictLRU TinyLRUCache s
cache = do
  LRUList s
list <- TVar (LRUList s) -> STM (LRUList s)
forall a. TVar a -> STM a
readTVar (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache)
  Maybe (TVar (LRUNode s)) -> (TVar (LRUNode s) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (LRUList s -> Maybe (TVar (LRUNode s))
forall s. LRUList s -> Maybe (TVar (LRUNode s))
lruTail LRUList s
list) ((TVar (LRUNode s) -> STM ()) -> STM ())
-> (TVar (LRUNode s) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TVar (LRUNode s)
tailTVar -> do
    LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
tailTVar
    Text -> Map Text (TVar (LRUNode s)) -> STM ()
forall key value. Hashable key => key -> Map key value -> STM ()
Map.delete (LRUNode s -> Text
forall s. LRUNode s -> Text
nodeKey LRUNode s
node) (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
    TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
removeNode (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) TVar (LRUNode s)
tailTVar

-- | Helper to add a TTL in seconds to a 'TimeSpec'.
addTTL :: TimeSpec -> Int -> TimeSpec
addTTL :: TimeSpec -> Int -> TimeSpec
addTTL (TimeSpec Int64
s Int64
ns) Int
ttl = Int64 -> Int64 -> TimeSpec
TimeSpec (Int64
s Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
ttl)) Int64
ns

-- | Deletes an entry from the cache by its key.
-- This removes the item from both the internal map and the linked list.
--
-- * 'key' - The key of the item to delete.
-- * 'cache' - The 'TinyLRUCache' instance.
deleteKey :: Text -> TinyLRUCache s -> STM ()
deleteKey :: forall s. Text -> TinyLRUCache s -> STM ()
deleteKey Text
key TinyLRUCache s
cache = do
  Maybe (TVar (LRUNode s))
mNodeTVar <- Text
-> Map Text (TVar (LRUNode s)) -> STM (Maybe (TVar (LRUNode s)))
forall key value.
Hashable key =>
key -> Map key value -> STM (Maybe value)
Map.lookup Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
  Maybe (TVar (LRUNode s)) -> (TVar (LRUNode s) -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (TVar (LRUNode s))
mNodeTVar ((TVar (LRUNode s) -> STM ()) -> STM ())
-> (TVar (LRUNode s) -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \TVar (LRUNode s)
nodeTVar -> do
    Text -> Map Text (TVar (LRUNode s)) -> STM ()
forall key value. Hashable key => key -> Map key value -> STM ()
Map.delete Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
    TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
removeNode (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) TVar (LRUNode s)
nodeTVar

-- | Scans the cache and removes all expired items.
-- This is called automatically by 'access', 'updateValue', and 'allowRequestTinyLRU'.
cleanupExpired :: TimeSpec -> TinyLRUCache s -> STM ()
cleanupExpired :: forall s. TimeSpec -> TinyLRUCache s -> STM ()
cleanupExpired TimeSpec
now TinyLRUCache s
cache = do
  [(Text, TVar (LRUNode s))]
pairs <- ListT STM (Text, TVar (LRUNode s))
-> STM [(Text, TVar (LRUNode s))]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
ListT.toList (ListT STM (Text, TVar (LRUNode s))
 -> STM [(Text, TVar (LRUNode s))])
-> ListT STM (Text, TVar (LRUNode s))
-> STM [(Text, TVar (LRUNode s))]
forall a b. (a -> b) -> a -> b
$ Map Text (TVar (LRUNode s)) -> ListT STM (Text, TVar (LRUNode s))
forall key value. Map key value -> ListT STM (key, value)
Map.listT (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
  [Text]
expired <- ([Text] -> (Text, TVar (LRUNode s)) -> STM [Text])
-> [Text] -> [(Text, TVar (LRUNode s))] -> STM [Text]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\[Text]
acc (Text
k, TVar (LRUNode s)
nodeRef) -> do
                      LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
nodeRef
                      if TimeSpec -> LRUNode s -> Bool
forall s. TimeSpec -> LRUNode s -> Bool
isExpired TimeSpec
now LRUNode s
node then [Text] -> STM [Text]
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
kText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
acc) else [Text] -> STM [Text]
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
acc
                   ) [] [(Text, TVar (LRUNode s))]
pairs
  [Text] -> (Text -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
expired ((Text -> STM ()) -> STM ()) -> (Text -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Text
k -> Text -> TinyLRUCache s -> STM ()
forall s. Text -> TinyLRUCache s -> STM ()
deleteKey Text
k TinyLRUCache s
cache

-- | Accesses a cache entry. This is the primary "get-or-insert" function.
--
-- The logic is as follows:
--
-- 1. It first cleans up any expired items in the cache.
-- 2. It looks for the key.
-- 3. If the key exists and is not expired, it moves the item to the front (as it's now
--    the most recently used) and returns its value wrapped in 'Just'.
-- 4. If the key does not exist, or if it exists but has expired, it inserts the
--    provided new value. If the cache is full, it evicts the least recently used
--    item before insertion. It then returns the new value wrapped in 'Just'.
-- 5. If the key is invalid (empty or longer than 256 characters), it returns 'Nothing'.
--
-- * 'now' - The current 'TimeSpec', for expiry checks.
-- * 'key' - The key to look up. Length must be between 1 and 256 characters.
-- * 'val' - The value to insert if the key is not found. It must have 'ToJSON' and 'FromJSON' instances.
-- * 'ttl' - The time-to-live in seconds for the new entry if it's inserted.
-- * 'cache' - The 'TinyLRUCache' instance.
--
-- Returns an 'STM' action that yields 'Just' the value (either existing or newly inserted), or 'Nothing' if the key is invalid.
access :: forall a s. (FromJSON a, ToJSON a) => TimeSpec -> Text -> a -> Int -> TinyLRUCache s -> STM (Maybe a)
access :: forall a s.
(FromJSON a, ToJSON a) =>
TimeSpec -> Text -> a -> Int -> TinyLRUCache s -> STM (Maybe a)
access TimeSpec
now Text
key a
val Int
ttl TinyLRUCache s
cache
  | Text -> Bool
T.null Text
key Bool -> Bool -> Bool
|| Text -> Int
T.length Text
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256 = Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      TimeSpec -> TinyLRUCache s -> STM ()
forall s. TimeSpec -> TinyLRUCache s -> STM ()
cleanupExpired TimeSpec
now TinyLRUCache s
cache
      Maybe (TVar (LRUNode s))
mNodeTVar <- Text
-> Map Text (TVar (LRUNode s)) -> STM (Maybe (TVar (LRUNode s)))
forall key value.
Hashable key =>
key -> Map key value -> STM (Maybe value)
Map.lookup Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      case Maybe (TVar (LRUNode s))
mNodeTVar of
        Just TVar (LRUNode s)
nodeTVar -> do
          -- Key exists - check if expired
          LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
nodeTVar
          if TimeSpec -> LRUNode s -> Bool
forall s. TimeSpec -> LRUNode s -> Bool
isExpired TimeSpec
now LRUNode s
node then do
            -- Expired: delete and re-insert with new value
            Text -> TinyLRUCache s -> STM ()
forall s. Text -> TinyLRUCache s -> STM ()
deleteKey Text
key TinyLRUCache s
cache
            STM (Maybe a)
insertNew
          else do
            -- Not expired: move to front and return existing value (cache hit)
            TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) TVar (LRUNode s)
nodeTVar
            case ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (LRUNode s -> ByteString
forall s. LRUNode s -> ByteString
nodeValue LRUNode s
node) :: Maybe a of
              Just a
existingVal -> Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
existingVal)
              Maybe a
Nothing -> do
                -- Corrupt data, replace it
                Text -> TinyLRUCache s -> STM ()
forall s. Text -> TinyLRUCache s -> STM ()
deleteKey Text
key TinyLRUCache s
cache
                STM (Maybe a)
insertNew
        Maybe (TVar (LRUNode s))
Nothing -> STM (Maybe a)
insertNew
  where
    insertNew :: STM (Maybe a)
insertNew = do
      Int
sz <- Map Text (TVar (LRUNode s)) -> STM Int
forall key value. Map key value -> STM Int
Map.size (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= TinyLRUCache s -> Int
forall s. TinyLRUCache s -> Int
lruCap TinyLRUCache s
cache) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ TinyLRUCache s -> STM ()
forall s. TinyLRUCache s -> STM ()
evictLRU TinyLRUCache s
cache
      TVar (LRUNode s)
nodeTVar <- TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
forall s.
TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
addToFront TimeSpec
now Int
ttl TinyLRUCache s
cache Text
key (LazyByteString -> ByteString
BL.toStrict (a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encode a
val))
      TVar (LRUNode s) -> Text -> Map Text (TVar (LRUNode s)) -> STM ()
forall key value.
Hashable key =>
value -> key -> Map key value -> STM ()
Map.insert TVar (LRUNode s)
nodeTVar Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Updates or inserts a cache entry. This is the primary "write" or "upsert" function.
--
-- The logic is as follows:
--
-- 1. It first cleans up any expired items in the cache.
-- 2. It looks for the key.
-- 3. If the key exists, it updates the value and expiry time, and moves it to the front.
-- 4. If the key does not exist, it inserts the new value. If the cache is full, it
--    evicts the least recently used item first.
-- 5. If the key is invalid (empty or longer than 256 characters), it returns 'Nothing'.
--
-- Unlike 'access', this function /always/ writes the provided value.
--
-- * 'now' - The current 'TimeSpec', for expiry calculations.
-- * 'key' - The key to update or insert. Length must be between 1 and 256 characters.
-- * 'val' - The new value to write. It must have 'ToJSON' and 'FromJSON' instances.
-- * 'ttl' - The new time-to-live in seconds for the entry.
-- * 'cache' - The 'TinyLRUCache' instance.
--
-- Returns an 'STM' action that yields 'Just' the value that was written, or 'Nothing' if the key is invalid.
updateValue :: forall a s. (FromJSON a, ToJSON a) => TimeSpec -> Text -> a -> Int -> TinyLRUCache s -> STM (Maybe a)
updateValue :: forall a s.
(FromJSON a, ToJSON a) =>
TimeSpec -> Text -> a -> Int -> TinyLRUCache s -> STM (Maybe a)
updateValue TimeSpec
now Text
key a
val Int
ttl TinyLRUCache s
cache
  | Text -> Bool
T.null Text
key Bool -> Bool -> Bool
|| Text -> Int
T.length Text
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256 = Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      TimeSpec -> TinyLRUCache s -> STM ()
forall s. TimeSpec -> TinyLRUCache s -> STM ()
cleanupExpired TimeSpec
now TinyLRUCache s
cache
      Maybe (TVar (LRUNode s))
mNodeTVar <- Text
-> Map Text (TVar (LRUNode s)) -> STM (Maybe (TVar (LRUNode s)))
forall key value.
Hashable key =>
key -> Map key value -> STM (Maybe value)
Map.lookup Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      case Maybe (TVar (LRUNode s))
mNodeTVar of
        Just TVar (LRUNode s)
nodeTVar -> do
          -- Key exists - update the value regardless of expiration
          LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
nodeTVar
          let newExpiry :: Maybe TimeSpec
newExpiry = TimeSpec -> Int -> Maybe TimeSpec
mkExpiry TimeSpec
now Int
ttl
          TVar (LRUNode s) -> LRUNode s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (LRUNode s)
nodeTVar LRUNode s
node { 
            nodeValue = BL.toStrict (encode val),
            nodeExpiry = newExpiry
          }
          TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) TVar (LRUNode s)
nodeTVar
          Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
        Maybe (TVar (LRUNode s))
Nothing -> do
          -- Key doesn't exist - insert new
          Int
sz <- Map Text (TVar (LRUNode s)) -> STM Int
forall key value. Map key value -> STM Int
Map.size (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
          Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= TinyLRUCache s -> Int
forall s. TinyLRUCache s -> Int
lruCap TinyLRUCache s
cache) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ TinyLRUCache s -> STM ()
forall s. TinyLRUCache s -> STM ()
evictLRU TinyLRUCache s
cache
          TVar (LRUNode s)
nodeTVar <- TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
forall s.
TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
addToFront TimeSpec
now Int
ttl TinyLRUCache s
cache Text
key (LazyByteString -> ByteString
BL.toStrict (a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encode a
val))
          TVar (LRUNode s) -> Text -> Map Text (TVar (LRUNode s)) -> STM ()
forall key value.
Hashable key =>
value -> key -> Map key value -> STM ()
Map.insert TVar (LRUNode s)
nodeTVar Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
          Maybe a -> STM (Maybe a)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Resets the cache, removing all entries.
--
-- * 'cache' - The 'TinyLRUCache' to reset.
resetTinyLRU :: TinyLRUCache s -> STM ()
resetTinyLRU :: forall s. TinyLRUCache s -> STM ()
resetTinyLRU TinyLRUCache s
cache = do
  Map Text (TVar (LRUNode s)) -> STM ()
forall key value. Map key value -> STM ()
Map.reset (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
  TVar (LRUList s) -> LRUList s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) (LRUList s -> STM ()) -> LRUList s -> STM ()
forall a b. (a -> b) -> a -> b
$ Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
forall s.
Maybe (TVar (LRUNode s)) -> Maybe (TVar (LRUNode s)) -> LRUList s
LRUList Maybe (TVar (LRUNode s))
forall a. Maybe a
Nothing Maybe (TVar (LRUNode s))
forall a. Maybe a
Nothing

-- | A specialized function for rate limiting. It uses the cache to track the number
-- of requests for a given key within a specific time period.
--
-- The logic is as follows:
--
-- 1. It looks for the key. The value associated with the key is treated as a counter ('Int').
-- 2. If the entry for the key exists and is not expired:
--    * If the counter is less than the 'limit', it increments the counter,
--      refreshes the expiry time, and returns 'True' (request allowed).
--    * If the counter has reached the 'limit', it does nothing and returns 'False' (request denied).
-- 3. If the entry does not exist or has expired, it creates a new entry with the
--    counter set to 1 and returns 'True'.
--
-- * 'now' - The current 'TimeSpec'.
-- * 'cache' - The 'TinyLRUCache' instance.
-- * 'key' - The key to identify the entity being rate-limited (e.g., a user ID or IP address).
-- * 'limit' - The maximum number of requests allowed.
-- * 'period' - The time period in seconds for the rate limit window.
--
-- Returns an 'STM' action yielding 'True' if the request is allowed, 'False' otherwise.
allowRequestTinyLRU :: TimeSpec -> TinyLRUCache s -> Text -> Int -> Int -> STM Bool
allowRequestTinyLRU :: forall s.
TimeSpec -> TinyLRUCache s -> Text -> Int -> Int -> STM Bool
allowRequestTinyLRU TimeSpec
now TinyLRUCache s
cache Text
key Int
limit Int
period
  | Text -> Bool
T.null Text
key = Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  | Bool
otherwise = do
      TimeSpec -> TinyLRUCache s -> STM ()
forall s. TimeSpec -> TinyLRUCache s -> STM ()
cleanupExpired TimeSpec
now TinyLRUCache s
cache
      Maybe (TVar (LRUNode s))
mNodeTVar <- Text
-> Map Text (TVar (LRUNode s)) -> STM (Maybe (TVar (LRUNode s)))
forall key value.
Hashable key =>
key -> Map key value -> STM (Maybe value)
Map.lookup Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      case Maybe (TVar (LRUNode s))
mNodeTVar of
        Just TVar (LRUNode s)
nodeTVar -> do
          LRUNode s
node <- TVar (LRUNode s) -> STM (LRUNode s)
forall a. TVar a -> STM a
readTVar TVar (LRUNode s)
nodeTVar
          if TimeSpec -> LRUNode s -> Bool
forall s. TimeSpec -> LRUNode s -> Bool
isExpired TimeSpec
now LRUNode s
node then do
            -- Expired: delete old entry and create new one
            Text -> TinyLRUCache s -> STM ()
forall s. Text -> TinyLRUCache s -> STM ()
deleteKey Text
key TinyLRUCache s
cache
            STM Bool
insertNew
          else do
            -- Not expired: check and update count
            case ByteString -> Maybe Int
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (LRUNode s -> ByteString
forall s. LRUNode s -> ByteString
nodeValue LRUNode s
node) :: Maybe Int of
              Just Int
n
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit -> do
                    -- Update the value and refresh expiry time
                    let newExpiry :: Maybe TimeSpec
newExpiry = TimeSpec -> Int -> Maybe TimeSpec
mkExpiry TimeSpec
now Int
period
                    TVar (LRUNode s) -> LRUNode s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (LRUNode s)
nodeTVar LRUNode s
node { 
                      nodeValue = BL.toStrict (encode (n+1)),
                      nodeExpiry = newExpiry
                    }
                    TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) TVar (LRUNode s)
nodeTVar
                    Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                | Bool
otherwise -> do
                    TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache) TVar (LRUNode s)
nodeTVar
                    Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- Over limit
              Maybe Int
_ -> do
                -- Corrupt data, reset it
                Text -> TinyLRUCache s -> STM ()
forall s. Text -> TinyLRUCache s -> STM ()
deleteKey Text
key TinyLRUCache s
cache
                STM Bool
insertNew
        Maybe (TVar (LRUNode s))
Nothing -> STM Bool
insertNew
  where
    insertNew :: STM Bool
insertNew = do
      Int
sz <- Map Text (TVar (LRUNode s)) -> STM Int
forall key value. Map key value -> STM Int
Map.size (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= TinyLRUCache s -> Int
forall s. TinyLRUCache s -> Int
lruCap TinyLRUCache s
cache) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ TinyLRUCache s -> STM ()
forall s. TinyLRUCache s -> STM ()
evictLRU TinyLRUCache s
cache
      TVar (LRUNode s)
nodeTVar <- TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
forall s.
TimeSpec
-> Int
-> TinyLRUCache s
-> Text
-> ByteString
-> STM (TVar (LRUNode s))
addToFront TimeSpec
now Int
period TinyLRUCache s
cache Text
key (LazyByteString -> ByteString
BL.toStrict (Int -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
encode (Int
1 :: Int)))
      TVar (LRUNode s) -> Text -> Map Text (TVar (LRUNode s)) -> STM ()
forall key value.
Hashable key =>
value -> key -> Map key value -> STM ()
Map.insert TVar (LRUNode s)
nodeTVar Text
key (TinyLRUCache s -> Map Text (TVar (LRUNode s))
forall s. TinyLRUCache s -> Map Text (TVar (LRUNode s))
lruCache TinyLRUCache s
cache)
      Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Low-level function to remove a node from the cache's list.
-- Alias for 'removeNode'. Most users should use 'deleteKey' instead.
--
-- * 'cache' - The 'TinyLRUCache' instance.
-- * 'nodeTVar' - The 'TVar' of the 'LRUNode' to remove.
removeNodeFromCache :: TinyLRUCache s -> TVar (LRUNode s) -> STM ()
removeNodeFromCache :: forall s. TinyLRUCache s -> TVar (LRUNode s) -> STM ()
removeNodeFromCache TinyLRUCache s
cache = TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
removeNode (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache)

-- | Low-level function to move a node to the front of the cache's list.
-- Alias for 'moveToFront'. Most users should use 'access' or 'updateValue' which
-- call this internally.
--
-- * 'cache' - The 'TinyLRUCache' instance.
-- * 'nodeTVar' - The 'TVar' of the 'LRUNode' to move.
moveToFrontInCache :: TinyLRUCache s -> TVar (LRUNode s) -> STM ()
moveToFrontInCache :: forall s. TinyLRUCache s -> TVar (LRUNode s) -> STM ()
moveToFrontInCache TinyLRUCache s
cache = TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
forall s. TVar (LRUList s) -> TVar (LRUNode s) -> STM ()
moveToFront (TinyLRUCache s -> TVar (LRUList s)
forall s. TinyLRUCache s -> TVar (LRUList s)
lruList TinyLRUCache s
cache)