-- | Caching implementation internals.
--
-- This module is not part of the Data.Cache public API and should not be directly relied upon by users.
-- Anything meant for external use defined here will be re-exported by a public module.
module Data.Cache.Internal
  ( MonadCache (..),
    DelayMode (..),
    FailureMode (..),
    CacheOptions (..),
  )
where

import Control.Concurrent
import Control.Monad (forever)
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Time
import System.Random.Stateful

-- | The top-level 'Monad' in which caching operations are performed.
--
-- This exists primarily for testing purposes. Production uses should drop in 'IO' and forget that this exists.
class (MonadCatch m, MonadIO m) => MonadCache m where
  -- | The current system time.
  currentTime :: m UTCTime

  -- | Generate a random number between two bounds (inclusive).
  randomize :: (Int, Int) -> m Int

  -- | Delay execution of the current thread for a number of microseconds.
  delay :: Int -> m ()

  -- | Spawn a new thread of execution to run an action.
  newThread :: m () -> m ThreadId

  -- | Run an action forever.
  repeatedly :: m () -> m ()

  -- | Stop a thread of execution. The thread can be assumed to have been started using 'newThread'.
  killCache :: ThreadId -> m ()

instance MonadCache IO where
  currentTime :: IO UTCTime
currentTime = IO UTCTime
getCurrentTime
  randomize :: (Int, Int) -> IO Int
randomize (Int, Int)
bounds = do
    IOGenM StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
getStdGen IO StdGen -> (StdGen -> IO (IOGenM StdGen)) -> IO (IOGenM StdGen)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdGen -> IO (IOGenM StdGen)
forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
newIOGenM
    (Int, Int) -> IOGenM StdGen -> IO Int
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Int, Int)
bounds IOGenM StdGen
gen
  delay :: Int -> IO ()
delay = Int -> IO ()
threadDelay
  newThread :: IO () -> IO ThreadId
newThread = IO () -> IO ThreadId
forkIO
  repeatedly :: IO () -> IO ()
repeatedly = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever
  killCache :: ThreadId -> IO ()
killCache = ThreadId -> IO ()
killThread

-- | The supported delay modes for a 'Data.Cache.PollingCache' instance.
--
-- The delay associated with a cache instance define the amount of time that will pass between
-- cache refreshes.
data DelayMode a
  = -- | Delay for static number of microseconds between each refresh.
    DelayForMicroseconds Int
  | -- | Delay for a dynamic number of microseconds between each refresh.
    --
    -- This is useful if different delays should be used for successes or failures, or
    -- if the result being retrieved contains information that could affect the delay period.
    DelayDynamically (Either SomeException a -> Int)
  | -- | Delay for a dynamic number of microseconds between each refresh within a set of bounds.
    --
    -- This is similarly useful to 'DelayDynamically', but when a known lower and upper bound should
    -- be applied to the delay period. Regardless of the dynamic delay generated by the user-supplied
    -- function, the delay period will never be below the lower bound or above the upper bound.
    DelayDynamicallyWithBounds (Int, Int) (Either SomeException a -> Int)

-- | The supported failure handling modes for a 'Data.Cache.PollingCache' instance.
--
-- In the context of the cache action, "failure" means an Exception thrown from
-- the user-supplied action that generates values to populate the cache.
--
-- Because these operations are performed in a background thread, the user must decide how failures are to be handled
-- upon cache creation.
data FailureMode
  = -- | Failures should be ignored entirely; the most relaxed failure handling strategy.
    --
    -- This means that 'Data.Cache.LoadFailed' will never be populated as a cache result.
    Ignore
  | -- | If a failure occurs, any previously cached value is immediately evicted from the cache; the strictest failure handling strategy.
    EvictImmediately
  | -- | Failures will be ignored unless they persist beyond the supplied time span.
    --
    -- This is a middle-ground failure handling strategy that probably makes sense to use in most scenarios.
    -- The nature of asynchronous polling implies that somewhat stale values are not an issue to the consumer;
    -- therefore, allowing some level of transient failure can often improve reliability without sacrificing correctness.
    EvictAfterTime NominalDiffTime
  deriving (FailureMode -> FailureMode -> Bool
(FailureMode -> FailureMode -> Bool)
-> (FailureMode -> FailureMode -> Bool) -> Eq FailureMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureMode -> FailureMode -> Bool
$c/= :: FailureMode -> FailureMode -> Bool
== :: FailureMode -> FailureMode -> Bool
$c== :: FailureMode -> FailureMode -> Bool
Eq, Int -> FailureMode -> ShowS
[FailureMode] -> ShowS
FailureMode -> String
(Int -> FailureMode -> ShowS)
-> (FailureMode -> String)
-> ([FailureMode] -> ShowS)
-> Show FailureMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureMode] -> ShowS
$cshowList :: [FailureMode] -> ShowS
show :: FailureMode -> String
$cshow :: FailureMode -> String
showsPrec :: Int -> FailureMode -> ShowS
$cshowsPrec :: Int -> FailureMode -> ShowS
Show)

-- | Options that dictate the behavior of a 'Data.Cache.PollingCache' instance.
data CacheOptions a = CacheOptions
  { -- | The 'DelayMode' to use.
    CacheOptions a -> DelayMode a
delayMode :: DelayMode a,
    -- | The 'FailureMode' to use.
    CacheOptions a -> FailureMode
failureMode :: FailureMode,
    -- | An optional fuzzing factor.
    --
    -- If provided, this factor defines the maximum number of microseconds that can be randomly added to each
    -- delay period. This means that when fuzzing is enabled, the delay between any two refreshes will always be
    -- greater than the delay period generated by the cache's 'DelayMode'. 'Nothing' disables fuzzing completely.
    CacheOptions a -> Maybe Int
delayFuzzing :: Maybe Int
  }