{-# LANGUAGE RecordWildCards #-}

module Network.Control.LRUCache (
    -- * LRU cache
    LRUCache,
    empty,
    insert,
    delete,
    lookup,
) where

import Prelude hiding (lookup)

import Data.OrdPSQ (OrdPSQ)
import qualified Data.OrdPSQ as PSQ

type Priority = Integer

-- | Sized cache based on least recently used.
data LRUCache k v = LRUCache
    { forall k v. LRUCache k v -> Int
lcLimit :: Int
    , forall k v. LRUCache k v -> Int
lcSize :: Int
    , forall k v. LRUCache k v -> Priority
lcTick :: Priority
    , forall k v. LRUCache k v -> OrdPSQ k Priority v
lcQueue :: OrdPSQ k Priority v
    }

-- | Empty 'LRUCache'.
empty
    :: Int
    -- ^ The size of 'LRUCache'.
    -> LRUCache k v
empty :: forall k v. Int -> LRUCache k v
empty Int
lim = Int -> Int -> Priority -> OrdPSQ k Priority v -> LRUCache k v
forall k v.
Int -> Int -> Priority -> OrdPSQ k Priority v -> LRUCache k v
LRUCache Int
lim Int
0 Priority
0 OrdPSQ k Priority v
forall k p v. OrdPSQ k p v
PSQ.empty

-- | Inserting.
insert :: Ord k => k -> v -> LRUCache k v -> LRUCache k v
insert :: forall k v. Ord k => k -> v -> LRUCache k v -> LRUCache k v
insert k
k v
v c :: LRUCache k v
c@LRUCache{Int
Priority
OrdPSQ k Priority v
lcLimit :: forall k v. LRUCache k v -> Int
lcSize :: forall k v. LRUCache k v -> Int
lcTick :: forall k v. LRUCache k v -> Priority
lcQueue :: forall k v. LRUCache k v -> OrdPSQ k Priority v
lcLimit :: Int
lcSize :: Int
lcTick :: Priority
lcQueue :: OrdPSQ k Priority v
..}
    | Int
lcSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lcLimit =
        let q :: OrdPSQ k Priority v
q = k -> Priority -> v -> OrdPSQ k Priority v -> OrdPSQ k Priority v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert k
k Priority
lcTick v
v (OrdPSQ k Priority v -> OrdPSQ k Priority v)
-> OrdPSQ k Priority v -> OrdPSQ k Priority v
forall a b. (a -> b) -> a -> b
$ OrdPSQ k Priority v -> OrdPSQ k Priority v
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> OrdPSQ k p v
PSQ.deleteMin OrdPSQ k Priority v
lcQueue
         in LRUCache k v
c{lcTick = lcTick + 1, lcQueue = q}
    | Bool
otherwise =
        let q :: OrdPSQ k Priority v
q = k -> Priority -> v -> OrdPSQ k Priority v -> OrdPSQ k Priority v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert k
k Priority
lcTick v
v OrdPSQ k Priority v
lcQueue
         in LRUCache k v
c{lcTick = lcTick + 1, lcQueue = q, lcSize = lcSize + 1}

-- | Deleting.
delete :: Ord k => k -> LRUCache k v -> LRUCache k v
delete :: forall k v. Ord k => k -> LRUCache k v -> LRUCache k v
delete k
k c :: LRUCache k v
c@LRUCache{Int
Priority
OrdPSQ k Priority v
lcLimit :: forall k v. LRUCache k v -> Int
lcSize :: forall k v. LRUCache k v -> Int
lcTick :: forall k v. LRUCache k v -> Priority
lcQueue :: forall k v. LRUCache k v -> OrdPSQ k Priority v
lcLimit :: Int
lcSize :: Int
lcTick :: Priority
lcQueue :: OrdPSQ k Priority v
..} =
    let q :: OrdPSQ k Priority v
q = k -> OrdPSQ k Priority v -> OrdPSQ k Priority v
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete k
k OrdPSQ k Priority v
lcQueue
     in LRUCache k v
c{lcQueue = q, lcSize = lcSize - 1}

-- | Looking up.
lookup :: Ord k => k -> LRUCache k v -> Maybe v
lookup :: forall k v. Ord k => k -> LRUCache k v -> Maybe v
lookup k
k LRUCache{Int
Priority
OrdPSQ k Priority v
lcLimit :: forall k v. LRUCache k v -> Int
lcSize :: forall k v. LRUCache k v -> Int
lcTick :: forall k v. LRUCache k v -> Priority
lcQueue :: forall k v. LRUCache k v -> OrdPSQ k Priority v
lcLimit :: Int
lcSize :: Int
lcTick :: Priority
lcQueue :: OrdPSQ k Priority v
..} = (Priority, v) -> v
forall a b. (a, b) -> b
snd ((Priority, v) -> v) -> Maybe (Priority, v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> OrdPSQ k Priority v -> Maybe (Priority, v)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
PSQ.lookup k
k OrdPSQ k Priority v
lcQueue