{-# 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 {
    forall k v. Store k v -> Int
capacity :: {-# UNPACK #-} !Int
  , forall k v. Store k v -> Int
size     :: {-# UNPACK #-} !Int
  , forall k v. Store k v -> Epoch
epoch    :: {-# UNPACK #-} !Epoch
  , forall k v. 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 Store k v
st = String
"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 :: forall k v. Ord k => Int -> Store k v
empty Int
cap
  | Int
cap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = String -> Store k v
forall a. HasCallStack => String -> a
error String
"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 Int
0 Epoch
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 :: forall k v. (Ord k, Hashable k) => k -> v -> Store k v -> Store k v
insert k
k v
v st :: Store k v
st@Store{Int
Epoch
HashPSQ k Epoch v
capacity :: forall k v. Store k v -> Int
size :: forall k v. Store k v -> Int
epoch :: forall k v. Store k v -> Epoch
psq :: forall k v. Store k v -> HashPSQ k Epoch v
capacity :: Int
size :: Int
epoch :: Epoch
psq :: HashPSQ k Epoch v
..} = 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 (Epoch
_, v
_), HashPSQ k Epoch v
psq0) -> Store k v
st {epoch = epoch + 1, psq = psq0}
  (Maybe (Epoch, v)
Nothing,     HashPSQ k Epoch v
psq0)
    | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capacity -> Store k v
st {size = size + 1, epoch = epoch + 1, psq = psq0}
    | Bool
otherwise       -> Store k v
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 :: forall k v.
(Ord k, Hashable k) =>
k -> Store k v -> Maybe (v, Store k v)
lookup k
k st :: Store k v
st@Store{Int
Epoch
HashPSQ k Epoch v
capacity :: forall k v. Store k v -> Int
size :: forall k v. Store k v -> Int
epoch :: forall k v. Store k v -> Epoch
psq :: forall k v. Store k v -> HashPSQ k Epoch v
capacity :: Int
size :: Int
epoch :: Epoch
psq :: HashPSQ k Epoch v
..} = 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
  (Maybe v
Nothing, HashPSQ k Epoch v
_)   -> Maybe (v, Store k v)
forall a. Maybe a
Nothing
  (Just v
v, 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 + 1, psq = psq0 })
  where tick :: Maybe (a, b) -> (Maybe b, Maybe (Epoch, b))
tick Maybe (a, b)
Nothing       = (Maybe b
forall a. Maybe a
Nothing, Maybe (Epoch, b)
forall a. Maybe a
Nothing)
        tick (Just (a
_, 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 :: forall k v. (Ord k, Hashable k) => k -> Store k v -> Store k v
delete k
k st :: Store k v
st@Store{Int
Epoch
HashPSQ k Epoch v
capacity :: forall k v. Store k v -> Int
size :: forall k v. Store k v -> Int
epoch :: forall k v. Store k v -> Epoch
psq :: forall k v. Store k v -> HashPSQ k Epoch v
capacity :: Int
size :: Int
epoch :: Epoch
psq :: HashPSQ k Epoch v
..} = 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
  Maybe (Epoch, v, HashPSQ k Epoch v)
Nothing           -> Store k v
st
  Just (Epoch
_, v
_, HashPSQ k Epoch v
psq0) -> Store k v
st {size = size - 1, psq = psq0}
{-# INLINABLE delete #-}

fromList :: (Ord k, Hashable k) => Int -> [(k, v)] -> Store k v
fromList :: forall k v. (Ord k, Hashable k) => Int -> [(k, v)] -> Store k v
fromList = (Store k v -> (k, v) -> Store k v)
-> Store k v -> [(k, v)] -> Store k v
forall b a. (b -> a -> b) -> b -> [a] -> b
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 :: forall k v. (Ord k, Hashable k) => Store k v -> [(k, v)]
toList Store{Int
Epoch
HashPSQ k Epoch v
capacity :: forall k v. Store k v -> Int
size :: forall k v. Store k v -> Int
epoch :: forall k v. Store k v -> Epoch
psq :: forall k v. Store k v -> HashPSQ k Epoch v
capacity :: Int
size :: Int
epoch :: Epoch
psq :: HashPSQ k Epoch v
..} = [(k
k,v
v) | (k
k, Epoch
_, 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 #-}