{-# 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 {
    Store k v -> Int
capacity :: {-# UNPACK #-} !Int
  , Store k v -> Int
size     :: {-# UNPACK #-} !Int
  , Store k v -> Epoch
epoch    :: {-# UNPACK #-} !Epoch
  , Store k v -> HashPSQ k Epoch v
psq      :: !(HashPSQ.HashPSQ k Epoch v)
  }

instance (Show k, Show v, Ord k, Hashable k) => Show (Store k v) where
    show :: Store k v -> String
show st :: Store k v
st = "fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(k, v)] -> String
forall a. Show a => a -> String
show (Store k v -> [(k, v)]
forall k v. (Ord k, Hashable k) => Store k v -> [(k, v)]
toList Store k v
st)

empty :: Ord k => Int -> Store k v
empty :: Int -> Store k v
empty cap :: Int
cap
  | Int
cap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0  = String -> Store k v
forall a. HasCallStack => String -> a
error "empty: invalid capacity"
  | Bool
otherwise = Int -> Int -> Epoch -> HashPSQ k Epoch v -> Store k v
forall k v. Int -> Int -> Epoch -> HashPSQ k Epoch v -> Store k v
Store Int
cap 0 0 HashPSQ k Epoch v
forall k p v. HashPSQ k p v
HashPSQ.empty
{-# INLINABLE empty #-}

insert :: (Ord k, Hashable k) => k -> v -> Store k v -> Store k v
insert :: k -> v -> Store k v -> Store k v
insert k :: k
k v :: v
v st :: Store k v
st@Store{..} = case k
-> Epoch
-> v
-> HashPSQ k Epoch v
-> (Maybe (Epoch, v), HashPSQ k Epoch v)
forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> p -> v -> HashPSQ k p v -> (Maybe (p, v), HashPSQ k p v)
HashPSQ.insertView k
k Epoch
epoch v
v HashPSQ k Epoch v
psq of
  (Just (_, _), psq0 :: HashPSQ k Epoch v
psq0) -> Store k v
st {epoch :: Epoch
epoch = Epoch
epoch Epoch -> Epoch -> Epoch
forall a. Num a => a -> a -> a
+ 1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0}
  (Nothing,     psq0 :: HashPSQ k Epoch v
psq0)
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capacity -> Store k v
st {size :: Int
size = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, epoch :: Epoch
epoch = Epoch
epoch Epoch -> Epoch -> Epoch
forall a. Num a => a -> a -> a
+ 1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0}
    | Bool
otherwise       -> Store k v
st {epoch :: Epoch
epoch = Epoch
epoch Epoch -> Epoch -> Epoch
forall a. Num a => a -> a -> a
+ 1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v -> HashPSQ k Epoch v
forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> HashPSQ k p v
HashPSQ.deleteMin HashPSQ k Epoch v
psq0}
{-# INLINABLE insert #-}

lookup :: (Ord k, Hashable k) => k -> Store k v -> Maybe (v, Store k v)
lookup :: k -> Store k v -> Maybe (v, Store k v)
lookup k :: k
k st :: Store k v
st@Store{..} = case (Maybe (Epoch, v) -> (Maybe v, Maybe (Epoch, v)))
-> k -> HashPSQ k Epoch v -> (Maybe v, HashPSQ k Epoch v)
forall k p v b.
(Hashable k, Ord k, Ord p) =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> k -> HashPSQ k p v -> (b, HashPSQ k p v)
HashPSQ.alter Maybe (Epoch, v) -> (Maybe v, Maybe (Epoch, v))
forall a b. Maybe (a, b) -> (Maybe b, Maybe (Epoch, b))
tick k
k HashPSQ k Epoch v
psq of
  (Nothing, _)   -> Maybe (v, Store k v)
forall a. Maybe a
Nothing
  (Just v :: v
v, psq0 :: HashPSQ k Epoch v
psq0) -> (v, Store k v) -> Maybe (v, Store k v)
forall a. a -> Maybe a
Just (v
v, Store k v
st { epoch :: Epoch
epoch = Epoch
epoch Epoch -> Epoch -> Epoch
forall a. Num a => a -> a -> a
+ 1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0 })
  where tick :: Maybe (a, b) -> (Maybe b, Maybe (Epoch, b))
tick Nothing       = (Maybe b
forall a. Maybe a
Nothing, Maybe (Epoch, b)
forall a. Maybe a
Nothing)
        tick (Just (_, v :: b
v)) = (b -> Maybe b
forall a. a -> Maybe a
Just b
v, (Epoch, b) -> Maybe (Epoch, b)
forall a. a -> Maybe a
Just (Epoch
epoch, b
v))
{-# INLINABLE lookup #-}

delete :: (Ord k, Hashable k) => k -> Store k v -> Store k v
delete :: k -> Store k v -> Store k v
delete k :: k
k st :: Store k v
st@Store{..} = case k -> HashPSQ k Epoch v -> Maybe (Epoch, v, HashPSQ k Epoch v)
forall k p v.
(Hashable k, Ord k, Ord p) =>
k -> HashPSQ k p v -> Maybe (p, v, HashPSQ k p v)
HashPSQ.deleteView k
k HashPSQ k Epoch v
psq of
  Nothing           -> Store k v
st
  Just (_, _, psq0 :: HashPSQ k Epoch v
psq0) -> Store k v
st {size :: Int
size = Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0}
{-# INLINABLE delete #-}

fromList :: (Ord k, Hashable k) => Int -> [(k, v)] -> Store k v
fromList :: Int -> [(k, v)] -> Store k v
fromList = (Store k v -> (k, v) -> Store k v)
-> Store k v -> [(k, v)] -> Store k v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((k, v) -> Store k v -> Store k v)
-> Store k v -> (k, v) -> Store k v
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((k -> v -> Store k v -> Store k v)
-> (k, v) -> Store k v -> Store k v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> v -> Store k v -> Store k v
forall k v. (Ord k, Hashable k) => k -> v -> Store k v -> Store k v
insert)) (Store k v -> [(k, v)] -> Store k v)
-> (Int -> Store k v) -> Int -> [(k, v)] -> Store k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Store k v
forall k v. Ord k => Int -> Store k v
empty
{-# INLINABLE fromList #-}

toList :: (Ord k, Hashable k) => Store k v -> [(k, v)]
toList :: Store k v -> [(k, v)]
toList Store{..} = [(k
k,v
v) | (k :: k
k, _, v :: v
v) <- HashPSQ k Epoch v -> [(k, Epoch, v)]
forall k p v.
(Hashable k, Ord k, Ord p) =>
HashPSQ k p v -> [(k, p, v)]
HashPSQ.toList HashPSQ k Epoch v
psq]
{-# INLINABLE toList #-}