{-# 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 = Int

-- | 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 -> Int
lcTick :: Priority
    , forall k v. LRUCache k v -> OrdPSQ k Int 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 -> Int -> OrdPSQ k Int v -> LRUCache k v
forall k v. Int -> Int -> Int -> OrdPSQ k Int v -> LRUCache k v
LRUCache Int
lim Int
0 Int
0 OrdPSQ k Int 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
OrdPSQ k Int v
lcLimit :: forall k v. LRUCache k v -> Int
lcSize :: forall k v. LRUCache k v -> Int
lcTick :: forall k v. LRUCache k v -> Int
lcQueue :: forall k v. LRUCache k v -> OrdPSQ k Int v
lcLimit :: Int
lcSize :: Int
lcTick :: Int
lcQueue :: OrdPSQ k Int v
..}
    | Int
lcSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lcLimit =
        let q :: OrdPSQ k Int v
q = k -> Int -> v -> OrdPSQ k Int v -> OrdPSQ k Int v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert k
k Int
lcTick v
v (OrdPSQ k Int v -> OrdPSQ k Int v)
-> OrdPSQ k Int v -> OrdPSQ k Int v
forall a b. (a -> b) -> a -> b
$ OrdPSQ k Int v -> OrdPSQ k Int v
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> OrdPSQ k p v
PSQ.deleteMin OrdPSQ k Int v
lcQueue
         in LRUCache k v
c{lcTick = lcTick + 1, lcQueue = q}
    | Bool
otherwise =
        let q :: OrdPSQ k Int v
q = k -> Int -> v -> OrdPSQ k Int v -> OrdPSQ k Int v
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert k
k Int
lcTick v
v OrdPSQ k Int 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
OrdPSQ k Int v
lcLimit :: forall k v. LRUCache k v -> Int
lcSize :: forall k v. LRUCache k v -> Int
lcTick :: forall k v. LRUCache k v -> Int
lcQueue :: forall k v. LRUCache k v -> OrdPSQ k Int v
lcLimit :: Int
lcSize :: Int
lcTick :: Int
lcQueue :: OrdPSQ k Int v
..} =
    let q :: OrdPSQ k Int v
q = k -> OrdPSQ k Int v -> OrdPSQ k Int v
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete k
k OrdPSQ k Int 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
OrdPSQ k Int v
lcLimit :: forall k v. LRUCache k v -> Int
lcSize :: forall k v. LRUCache k v -> Int
lcTick :: forall k v. LRUCache k v -> Int
lcQueue :: forall k v. LRUCache k v -> OrdPSQ k Int v
lcLimit :: Int
lcSize :: Int
lcTick :: Int
lcQueue :: OrdPSQ k Int v
..} = (Int, v) -> v
forall a b. (a, b) -> b
snd ((Int, v) -> v) -> Maybe (Int, v) -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> OrdPSQ k Int v -> Maybe (Int, v)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
PSQ.lookup k
k OrdPSQ k Int v
lcQueue