Policy.hs

-- | Evaluation of a stream's 'SnapshotPolicy'.
--
-- This is the single decision procedure command handling consults after an
-- append to decide whether to persist a snapshot of the folded state. It
-- keeps the 'SnapshotPolicy' constructors purely declarative — the meaning
-- of each constructor lives here.
module Keiro.Snapshot.Policy
  ( shouldSnapshot,
    shouldSnapshotSpan,
  )
where

import Keiro.EventStream (SnapshotPolicy (..), Terminality (..))
import Keiro.Prelude
import Kiroku.Store.Types (StreamVersion (..))
import Prelude qualified

-- | Decide whether to snapshot given a policy, a terminality flag, the
-- folded state, and the post-append stream version.
--
-- * 'Never' is always 'False'.
-- * 'Every' @n@ is 'True' when the version is a positive multiple of @n@
--   (a non-positive interval never fires).
-- * 'OnTerminal' mirrors the @terminal@ flag — snapshot exactly when the
--   machine has reached a final state.
-- * 'Custom' defers to the caller-supplied predicate over state and version.
shouldSnapshot :: SnapshotPolicy state -> Terminality -> state -> StreamVersion -> Bool
shouldSnapshot Never _ _ _ = False
shouldSnapshot (Every interval) _ _ (StreamVersion version)
  | interval <= 0 = False
  | otherwise = version > 0 Prelude.&& version `Prelude.mod` Prelude.fromIntegral interval == 0
shouldSnapshot OnTerminal terminality _ _ = terminality == Terminal
shouldSnapshot (Custom decide) terminality state version = decide terminality state version

-- | Like 'shouldSnapshot', but evaluated over the half-open stream-version
-- span @(preVersion, postVersion]@ that one append covered.
--
-- For 'Every' @n@, this fires when any positive multiple of @n@ lies inside
-- the span, so a batch append that jumps over a boundary still snapshots at
-- the post-append version. The other policies ignore the span and behave like
-- 'shouldSnapshot'.
shouldSnapshotSpan ::
  SnapshotPolicy state ->
  Terminality ->
  state ->
  StreamVersion ->
  StreamVersion ->
  Bool
shouldSnapshotSpan Never _ _ _ _ = False
shouldSnapshotSpan (Every interval) _ _ (StreamVersion preVersion) (StreamVersion postVersion)
  | interval <= 0 = False
  | postVersion <= 0 = False
  | otherwise = postVersion `Prelude.div` n > preVersion `Prelude.div` n
  where
    n = Prelude.fromIntegral interval
shouldSnapshotSpan OnTerminal terminality _ _ _ = terminality == Terminal
shouldSnapshotSpan (Custom decide) terminality state _ postVersion = decide terminality state postVersion