module Eventful.ProjectionCache.Memory
( ProjectionMap
, emptyProjectionMap
, projectionMapTVar
, tvarProjectionCache
, embeddedStateProjectionCache
, module Eventful.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 Eventful.ProjectionCache.Types
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)
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{..}
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