module Network.Wai.Middleware.Push.Referer.LRU (
Cache(..)
, Priority
, empty
, insert
, lookup
) where
import Data.OrdPSQ (OrdPSQ)
import qualified Data.OrdPSQ as PSQ
import Data.Int (Int64)
import Prelude hiding (lookup)
import Network.Wai.Middleware.Push.Referer.Multi (Multi)
import qualified Network.Wai.Middleware.Push.Referer.Multi as M
type Priority = Int64
data Cache k v = Cache {
forall k v. Cache k v -> Int
cCapacity :: Int
, forall k v. Cache k v -> Int
cSize :: Int
, forall k v. Cache k v -> Int
cValLimit :: Int
, forall k v. Cache k v -> Priority
cTick :: Priority
, forall k v. Cache k v -> OrdPSQ k Priority (Multi v)
cQueue :: OrdPSQ k Priority (Multi v)
} deriving (Cache k v -> Cache k v -> Bool
(Cache k v -> Cache k v -> Bool)
-> (Cache k v -> Cache k v -> Bool) -> Eq (Cache k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Ord k, Eq v) => Cache k v -> Cache k v -> Bool
$c== :: forall k v. (Ord k, Eq v) => Cache k v -> Cache k v -> Bool
== :: Cache k v -> Cache k v -> Bool
$c/= :: forall k v. (Ord k, Eq v) => Cache k v -> Cache k v -> Bool
/= :: Cache k v -> Cache k v -> Bool
Eq, Int -> Cache k v -> ShowS
[Cache k v] -> ShowS
Cache k v -> String
(Int -> Cache k v -> ShowS)
-> (Cache k v -> String)
-> ([Cache k v] -> ShowS)
-> Show (Cache k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show v, Show k) => Int -> Cache k v -> ShowS
forall k v. (Show v, Show k) => [Cache k v] -> ShowS
forall k v. (Show v, Show k) => Cache k v -> String
$cshowsPrec :: forall k v. (Show v, Show k) => Int -> Cache k v -> ShowS
showsPrec :: Int -> Cache k v -> ShowS
$cshow :: forall k v. (Show v, Show k) => Cache k v -> String
show :: Cache k v -> String
$cshowList :: forall k v. (Show v, Show k) => [Cache k v] -> ShowS
showList :: [Cache k v] -> ShowS
Show)
empty :: Int -> Int -> Cache k v
empty :: forall k v. Int -> Int -> Cache k v
empty Int
capacity Int
valLimit
| Int
capacity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> Cache k v
forall a. HasCallStack => String -> a
error String
"Cache.empty: capacity < 1"
| Bool
otherwise = Cache {
cCapacity :: Int
cCapacity = Int
capacity
, cSize :: Int
cSize = Int
0
, cValLimit :: Int
cValLimit = Int
valLimit
, cTick :: Priority
cTick = Priority
0
, cQueue :: OrdPSQ k Priority (Multi v)
cQueue = OrdPSQ k Priority (Multi v)
forall k p v. OrdPSQ k p v
PSQ.empty
}
trim :: Ord k => Cache k v -> Cache k v
trim :: forall k v. Ord k => Cache k v -> Cache k v
trim Cache k v
c
| Cache k v -> Priority
forall k v. Cache k v -> Priority
cTick Cache k v
c Priority -> Priority -> Bool
forall a. Eq a => a -> a -> Bool
== Priority
forall a. Bounded a => a
maxBound = Int -> Int -> Cache k v
forall k v. Int -> Int -> Cache k v
empty (Cache k v -> Int
forall k v. Cache k v -> Int
cCapacity Cache k v
c) (Cache k v -> Int
forall k v. Cache k v -> Int
cValLimit Cache k v
c)
| Cache k v -> Int
forall k v. Cache k v -> Int
cSize Cache k v
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Cache k v -> Int
forall k v. Cache k v -> Int
cCapacity Cache k v
c = Cache k v
c {
cSize = cSize c - 1
, cQueue = PSQ.deleteMin (cQueue c)
}
| Bool
otherwise = Cache k v
c
insert :: (Ord k, Ord v) => k -> v -> Cache k v -> Cache k v
insert :: forall k v. (Ord k, Ord v) => k -> v -> Cache k v -> Cache k v
insert k
k v
v Cache k v
c = case (Maybe (Priority, Multi v) -> (Bool, Maybe (Priority, Multi v)))
-> k
-> OrdPSQ k Priority (Multi v)
-> (Bool, OrdPSQ k Priority (Multi v))
forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
PSQ.alter Maybe (Priority, Multi v) -> (Bool, Maybe (Priority, Multi v))
forall {a}. Maybe (a, Multi v) -> (Bool, Maybe (Priority, Multi v))
lookupAndBump k
k (Cache k v -> OrdPSQ k Priority (Multi v)
forall k v. Cache k v -> OrdPSQ k Priority (Multi v)
cQueue Cache k v
c) of
(Bool
True, OrdPSQ k Priority (Multi v)
q) -> Cache k v -> Cache k v
forall k v. Ord k => Cache k v -> Cache k v
trim (Cache k v -> Cache k v) -> Cache k v -> Cache k v
forall a b. (a -> b) -> a -> b
$ Cache k v
c { cTick = cTick c + 1, cQueue = q, cSize = cSize c + 1}
(Bool
False, OrdPSQ k Priority (Multi v)
q) -> Cache k v -> Cache k v
forall k v. Ord k => Cache k v -> Cache k v
trim (Cache k v -> Cache k v) -> Cache k v -> Cache k v
forall a b. (a -> b) -> a -> b
$ Cache k v
c { cTick = cTick c + 1, cQueue = q }
where
lookupAndBump :: Maybe (a, Multi v) -> (Bool, Maybe (Priority, Multi v))
lookupAndBump Maybe (a, Multi v)
Nothing = (Bool
True, (Priority, Multi v) -> Maybe (Priority, Multi v)
forall a. a -> Maybe a
Just (Cache k v -> Priority
forall k v. Cache k v -> Priority
cTick Cache k v
c, Int -> v -> Multi v
forall a. Int -> a -> Multi a
M.singleton (Cache k v -> Int
forall k v. Cache k v -> Int
cValLimit Cache k v
c) v
v))
lookupAndBump (Just (a
_, Multi v
x)) = (Bool
False, (Priority, Multi v) -> Maybe (Priority, Multi v)
forall a. a -> Maybe a
Just (Cache k v -> Priority
forall k v. Cache k v -> Priority
cTick Cache k v
c, v -> Multi v -> Multi v
forall a. Ord a => a -> Multi a -> Multi a
M.insert v
v Multi v
x))
lookup :: Ord k => k -> Cache k v -> (Cache k v, [v])
lookup :: forall k v. Ord k => k -> Cache k v -> (Cache k v, [v])
lookup k
k Cache k v
c = case (Maybe (Priority, Multi v)
-> (Maybe (Multi v), Maybe (Priority, Multi v)))
-> k
-> OrdPSQ k Priority (Multi v)
-> (Maybe (Multi v), OrdPSQ k Priority (Multi v))
forall k p v b.
(Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> OrdPSQ k p v -> (b, OrdPSQ k p v)
PSQ.alter Maybe (Priority, Multi v)
-> (Maybe (Multi v), Maybe (Priority, Multi v))
forall {a} {b}. Maybe (a, b) -> (Maybe b, Maybe (Priority, b))
lookupAndBump k
k (Cache k v -> OrdPSQ k Priority (Multi v)
forall k v. Cache k v -> OrdPSQ k Priority (Multi v)
cQueue Cache k v
c) of
(Maybe (Multi v)
Nothing, OrdPSQ k Priority (Multi v)
_) -> (Cache k v
c, [])
(Just Multi v
x, OrdPSQ k Priority (Multi v)
q) -> let c' :: Cache k v
c' = Cache k v -> Cache k v
forall k v. Ord k => Cache k v -> Cache k v
trim (Cache k v -> Cache k v) -> Cache k v -> Cache k v
forall a b. (a -> b) -> a -> b
$ Cache k v
c { cTick = cTick c + 1, cQueue = q }
xs :: [v]
xs = Multi v -> [v]
forall a. Multi a -> [a]
M.list Multi v
x
in (Cache k v
c', [v]
xs)
where
lookupAndBump :: Maybe (a, b) -> (Maybe b, Maybe (Priority, b))
lookupAndBump Maybe (a, b)
Nothing = (Maybe b
forall a. Maybe a
Nothing, Maybe (Priority, b)
forall a. Maybe a
Nothing)
lookupAndBump (Just (a
_, b
x)) = (b -> Maybe b
forall a. a -> Maybe a
Just b
x, (Priority, b) -> Maybe (Priority, b)
forall a. a -> Maybe a
Just (Cache k v -> Priority
forall k v. Cache k v -> Priority
cTick Cache k v
c, b
x))