{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- | By tracing operations we can transform one type of cache into another.
module Data.Cache.Type
 ( Cache(..)
 , insert, lookup, lookupMaybe, lookupCreating, cached, evict
 , CacheEvent(..)
 , CacheTrace
 , Caching(..)
 , DictCache(..)
 ) where

import qualified Control.Monad.Fail as Fail
import           Control.Monad.Trans
import           Data.Cache.Trace
import           Data.Maybe
import           Prelude hiding (lookup)

-- Time based eviction cache transformer
-- Memory size limit cache transformer
-- LRU
-- MFU
-- FIFOg
-- on disk
-- stripping combiner
-- Rate limiting transformer (like with web service rate limits, so on value querying)
-- key locking transformer for unique gemeration
-- Read through transformer
-- Write through transformer
-- Write behind transformer
-- Refresh ahead transformer (works with expiration transformer?)
--
-- Add resizing class?

-- |
--   c - The cache type.
--   m - The Monad.
--   k - The key.
--   t - The tracking data. This allows caches to store metadata for 3rd parties.
--   v - The value.
class Caching c (m :: * -> *) k t v | c -> m, c -> k, c -> t, c -> v where
  insetTraced    :: forall (trc::Bool) . c -> k -> t -> v -> Tracable trc (CacheTrace k t v) m ()
  lookupTraced   :: forall (trc::Bool) . c -> k -> Tracable trc (CacheTrace k t v) m (Maybe v)
  evictTraced    :: forall (trc::Bool) . c -> k -> Tracable trc (CacheTrace k t v) m ()
  updateTracking :: forall (trc::Bool) . c -> k -> (t -> t) -> Tracable trc (CacheTrace k t v) m ()

data Cache m k t v
 = forall c . Caching c m k t v => Cache c

insert :: (Monad m, Caching c m k () v) => c -> k -> v -> m ()
insert c k v = runUntracedT $ insetTraced c k () v

lookup :: (Fail.MonadFail m, Caching c m k t v) => c -> k -> m v
lookup c k = fmap fromJust $ runUntracedT $ lookupTraced c k

lookupCreating :: (Monad m, Caching c m k () v) => c -> k -> (m v) -> m v
lookupCreating c k a = runUntracedT $ do
  mv <- lookupTraced c k
  case mv of
    Just v -> pure v
    Nothing -> lift a >>= \v -> insetTraced c k () v >> pure v

lookupMaybe :: (Monad m, Caching c m k t v) => c -> k -> m (Maybe v)
lookupMaybe c k = runUntracedT $ lookupTraced c k

cached :: (Monad m, Caching c m k t v) => c -> k -> m Bool
cached c k = isJust <$> lookupMaybe c k

evict :: (Monad m, Caching c m k t v) => c -> k -> m ()
evict c k = runUntracedT $ evictTraced c k

-- | A reified Caching dictionary so that we can assemble them on demand.
data DictCache (m :: * -> *) k t v
 = DictCache
 { dcIns   :: forall (trc::Bool) . k -> t -> v   -> Tracable trc (CacheTrace k t v) m ()
 , dcLook  :: forall (trc::Bool) . k             -> Tracable trc (CacheTrace k t v) m (Maybe v)
 , dcEvict :: forall (trc::Bool) . k             -> Tracable trc (CacheTrace k t v) m ()
 , dcUp    :: forall (trc::Bool) . k -> (t -> t) -> Tracable trc (CacheTrace k t v) m ()
 }

instance Caching (DictCache m k t v) m k t v where
  insetTraced    (DictCache { dcIns=f   }) = f
  lookupTraced   (DictCache { dcLook=f  }) = f
  evictTraced    (DictCache { dcEvict=f }) = f
  updateTracking (DictCache { dcUp=f    }) = f