{-# 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (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 forall a. Ord a => a -> a -> Bool
<= Int
0  = forall a. HasCallStack => String -> a
error String
"empty: invalid capacity"
  | Bool
otherwise = forall k v. Int -> Int -> Epoch -> HashPSQ k Epoch v -> Store k v
Store Int
cap Int
0 Epoch
0 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
psq :: HashPSQ k Epoch v
epoch :: Epoch
size :: Int
capacity :: Int
psq :: forall k v. Store k v -> HashPSQ k Epoch v
epoch :: forall k v. Store k v -> Epoch
size :: forall k v. Store k v -> Int
capacity :: forall k v. Store k v -> Int
..} = case 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
epoch = Epoch
epoch forall a. Num a => a -> a -> a
+ Epoch
1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0}
  (Maybe (Epoch, v)
Nothing,     HashPSQ k Epoch v
psq0)
    | Int
size forall a. Ord a => a -> a -> Bool
< Int
capacity -> Store k v
st {size :: Int
size = Int
size forall a. Num a => a -> a -> a
+ Int
1, epoch :: Epoch
epoch = Epoch
epoch forall a. Num a => a -> a -> a
+ Epoch
1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0}
    | Bool
otherwise       -> Store k v
st {epoch :: Epoch
epoch = Epoch
epoch forall a. Num a => a -> a -> a
+ Epoch
1, psq :: HashPSQ k Epoch v
psq = 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 :: 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
psq :: HashPSQ k Epoch v
epoch :: Epoch
size :: Int
capacity :: Int
psq :: forall k v. Store k v -> HashPSQ k Epoch v
epoch :: forall k v. Store k v -> Epoch
size :: forall k v. Store k v -> Int
capacity :: forall k v. Store k v -> Int
..} = case 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 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
_)   -> forall a. Maybe a
Nothing
  (Just v
v, HashPSQ k Epoch v
psq0) -> forall a. a -> Maybe a
Just (v
v, Store k v
st { epoch :: Epoch
epoch = Epoch
epoch forall a. Num a => a -> a -> a
+ Epoch
1, psq :: HashPSQ k Epoch v
psq = HashPSQ k Epoch v
psq0 })
  where tick :: Maybe (a, b) -> (Maybe b, Maybe (Epoch, b))
tick Maybe (a, b)
Nothing       = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
        tick (Just (a
_, b
v)) = (forall a. a -> Maybe a
Just b
v, 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
psq :: HashPSQ k Epoch v
epoch :: Epoch
size :: Int
capacity :: Int
psq :: forall k v. Store k v -> HashPSQ k Epoch v
epoch :: forall k v. Store k v -> Epoch
size :: forall k v. Store k v -> Int
capacity :: forall k v. Store k v -> Int
..} = case 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 :: Int
size = Int
size forall a. Num a => a -> a -> a
- Int
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 :: forall k v. (Ord k, Hashable k) => Int -> [(k, v)] -> Store k v
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v. (Ord k, Hashable k) => k -> v -> Store k v -> Store k v
insert)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
psq :: HashPSQ k Epoch v
epoch :: Epoch
size :: Int
capacity :: Int
psq :: forall k v. Store k v -> HashPSQ k Epoch v
epoch :: forall k v. Store k v -> Epoch
size :: forall k v. Store k v -> Int
capacity :: forall k v. Store k v -> Int
..} = [(k
k,v
v) | (k
k, Epoch
_, v
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 #-}