1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{-# LANGUAGE BangPatterns, DeriveFunctor, RecordWildCards #-}
module Network.Wreq.Cache.Store
(
Store
, empty
, insert
, delete
, lookup
, fromList
, toList
) where
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.List (foldl')
import Prelude hiding (lookup, map)
import qualified Data.HashPSQ as HashPSQ
type Epoch = Int64
data Store k v = Store {
capacity :: {-# UNPACK #-} !Int
, size :: {-# UNPACK #-} !Int
, epoch :: {-# UNPACK #-} !Epoch
, psq :: !(HashPSQ.HashPSQ k Epoch v)
}
instance (Show k, Show v, Ord k, Hashable k) => Show (Store k v) where
show st = "fromList " ++ show (toList st)
empty :: Ord k => Int -> Store k v
empty cap
| cap <= 0 = error "empty: invalid capacity"
| otherwise = Store cap 0 0 HashPSQ.empty
{-# INLINABLE empty #-}
insert :: (Ord k, Hashable k) => k -> v -> Store k v -> Store k v
insert k v st@Store{..} = case HashPSQ.insertView k epoch v psq of
(Just (_, _), psq0) -> st {epoch = epoch + 1, psq = psq0}
(Nothing, psq0)
| size < capacity -> st {size = size + 1, epoch = epoch + 1, psq = psq0}
| otherwise -> st {epoch = epoch + 1, psq = HashPSQ.deleteMin psq0}
{-# INLINABLE insert #-}
lookup :: (Ord k, Hashable k) => k -> Store k v -> Maybe (v, Store k v)
lookup k st@Store{..} = case HashPSQ.alter tick k psq of
(Nothing, _) -> Nothing
(Just v, psq0) -> Just (v, st { epoch = epoch + 1, psq = psq0 })
where tick Nothing = (Nothing, Nothing)
tick (Just (_, v)) = (Just v, Just (epoch, v))
{-# INLINABLE lookup #-}
delete :: (Ord k, Hashable k) => k -> Store k v -> Store k v
delete k st@Store{..} = case HashPSQ.deleteView k psq of
Nothing -> st
Just (_, _, psq0) -> st {size = size - 1, psq = psq0}
{-# INLINABLE delete #-}
fromList :: (Ord k, Hashable k) => Int -> [(k, v)] -> Store k v
fromList = foldl' (flip (uncurry insert)) . empty
{-# INLINABLE fromList #-}
toList :: (Ord k, Hashable k) => Store k v -> [(k, v)]
toList Store{..} = [(k,v) | (k, _, v) <- HashPSQ.toList psq]
{-# INLINABLE toList #-}
|
