{-# 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 #-}