Memory.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}

module Eventium.ProjectionCache.Memory
  ( ProjectionMap,
    emptyProjectionMap,
    projectionMapTVar,
    tvarProjectionCache,
    embeddedStateProjectionCache,
    module Eventium.ProjectionCache.Types,
  )
where

import Control.Concurrent.STM
import Control.Monad.State.Class hiding (state)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Eventium.ProjectionCache.Types

-- | A 'ProjectionMap' just stores the latest snapshot for each UUID.
type ProjectionMap key position serialized = Map key (position, serialized)

emptyProjectionMap :: ProjectionMap key position serialized
emptyProjectionMap = Map.empty

projectionMapTVar :: IO (TVar (ProjectionMap key position serialized))
projectionMapTVar = newTVarIO emptyProjectionMap

storeProjectionInMap ::
  (Ord key) =>
  key ->
  position ->
  serialized ->
  ProjectionMap key position serialized ->
  ProjectionMap key position serialized
storeProjectionInMap uuid version state = Map.insert uuid (version, state)

-- | A 'ProjectionCache' that uses a 'TVar' and runs in 'STM'.
tvarProjectionCache ::
  (Ord key) =>
  TVar (ProjectionMap key position serialized) ->
  ProjectionCache key position serialized STM
tvarProjectionCache tvar =
  let storeProjectionSnapshot uuid version projState = modifyTVar' tvar (storeProjectionInMap uuid version projState)
      loadProjectionSnapshot uuid = Map.lookup uuid <$> readTVar tvar
   in ProjectionCache {..}

-- | A 'ProjectionCache' for some 'MonadState' that contains a 'ProjectionMap'.
embeddedStateProjectionCache ::
  (MonadState s m, Ord key) =>
  (s -> ProjectionMap key position serialized) ->
  (s -> ProjectionMap key position serialized -> s) ->
  ProjectionCache key position serialized m
embeddedStateProjectionCache getMap setMap =
  let storeProjectionSnapshot uuid version projState = modify' (storeProjectionSnapshot' uuid version projState)
      loadProjectionSnapshot uuid = Map.lookup uuid <$> gets getMap
   in ProjectionCache {..}
  where
    storeProjectionSnapshot' uuid version projState state =
      setMap state $ storeProjectionInMap uuid version projState $ getMap state