{-# 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 :: forall key position serialized.
ProjectionMap key position serialized
emptyProjectionMap = Map key (position, serialized)
forall k a. Map k a
Map.empty

projectionMapTVar :: IO (TVar (ProjectionMap key position serialized))
projectionMapTVar :: forall key position serialized.
IO (TVar (ProjectionMap key position serialized))
projectionMapTVar = ProjectionMap key position serialized
-> IO (TVar (ProjectionMap key position serialized))
forall a. a -> IO (TVar a)
newTVarIO ProjectionMap key position serialized
forall key position serialized.
ProjectionMap key position serialized
emptyProjectionMap

storeProjectionInMap ::
  (Ord key) =>
  key ->
  position ->
  serialized ->
  ProjectionMap key position serialized ->
  ProjectionMap key position serialized
storeProjectionInMap :: forall key position serialized.
Ord key =>
key
-> position
-> serialized
-> ProjectionMap key position serialized
-> ProjectionMap key position serialized
storeProjectionInMap key
uuid position
version serialized
state = key
-> (position, serialized)
-> Map key (position, serialized)
-> Map key (position, serialized)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert key
uuid (position
version, serialized
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 :: forall key position serialized.
Ord key =>
TVar (ProjectionMap key position serialized)
-> ProjectionCache key position serialized STM
tvarProjectionCache TVar (ProjectionMap key position serialized)
tvar =
  let storeProjectionSnapshot :: key -> position -> serialized -> STM ()
storeProjectionSnapshot key
uuid position
version serialized
projState = TVar (ProjectionMap key position serialized)
-> (ProjectionMap key position serialized
    -> ProjectionMap key position serialized)
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (ProjectionMap key position serialized)
tvar (key
-> position
-> serialized
-> ProjectionMap key position serialized
-> ProjectionMap key position serialized
forall key position serialized.
Ord key =>
key
-> position
-> serialized
-> ProjectionMap key position serialized
-> ProjectionMap key position serialized
storeProjectionInMap key
uuid position
version serialized
projState)
      loadProjectionSnapshot :: key -> STM (Maybe (position, serialized))
loadProjectionSnapshot key
uuid = key
-> ProjectionMap key position serialized
-> Maybe (position, serialized)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
uuid (ProjectionMap key position serialized
 -> Maybe (position, serialized))
-> STM (ProjectionMap key position serialized)
-> STM (Maybe (position, serialized))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (ProjectionMap key position serialized)
-> STM (ProjectionMap key position serialized)
forall a. TVar a -> STM a
readTVar TVar (ProjectionMap key position serialized)
tvar
   in ProjectionCache {key -> STM (Maybe (position, serialized))
key -> position -> serialized -> STM ()
storeProjectionSnapshot :: key -> position -> serialized -> STM ()
loadProjectionSnapshot :: key -> STM (Maybe (position, serialized))
loadProjectionSnapshot :: key -> STM (Maybe (position, serialized))
storeProjectionSnapshot :: key -> position -> serialized -> STM ()
..}

-- | 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 :: forall s (m :: * -> *) key position serialized.
(MonadState s m, Ord key) =>
(s -> ProjectionMap key position serialized)
-> (s -> ProjectionMap key position serialized -> s)
-> ProjectionCache key position serialized m
embeddedStateProjectionCache s -> ProjectionMap key position serialized
getMap s -> ProjectionMap key position serialized -> s
setMap =
  let storeProjectionSnapshot :: key -> position -> serialized -> m ()
storeProjectionSnapshot key
uuid position
version serialized
projState = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (key -> position -> serialized -> s -> s
storeProjectionSnapshot' key
uuid position
version serialized
projState)
      loadProjectionSnapshot :: key -> f (Maybe (position, serialized))
loadProjectionSnapshot key
uuid = key
-> ProjectionMap key position serialized
-> Maybe (position, serialized)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup key
uuid (ProjectionMap key position serialized
 -> Maybe (position, serialized))
-> f (ProjectionMap key position serialized)
-> f (Maybe (position, serialized))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s -> ProjectionMap key position serialized)
-> f (ProjectionMap key position serialized)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets s -> ProjectionMap key position serialized
getMap
   in ProjectionCache {key -> m (Maybe (position, serialized))
key -> position -> serialized -> m ()
forall {f :: * -> *}.
MonadState s f =>
key -> f (Maybe (position, serialized))
forall {m :: * -> *}.
MonadState s m =>
key -> position -> serialized -> m ()
loadProjectionSnapshot :: key -> m (Maybe (position, serialized))
storeProjectionSnapshot :: key -> position -> serialized -> m ()
storeProjectionSnapshot :: forall {m :: * -> *}.
MonadState s m =>
key -> position -> serialized -> m ()
loadProjectionSnapshot :: forall {f :: * -> *}.
MonadState s f =>
key -> f (Maybe (position, serialized))
..}
  where
    storeProjectionSnapshot' :: key -> position -> serialized -> s -> s
storeProjectionSnapshot' key
uuid position
version serialized
projState s
state =
      s -> ProjectionMap key position serialized -> s
setMap s
state (ProjectionMap key position serialized -> s)
-> ProjectionMap key position serialized -> s
forall a b. (a -> b) -> a -> b
$ key
-> position
-> serialized
-> ProjectionMap key position serialized
-> ProjectionMap key position serialized
forall key position serialized.
Ord key =>
key
-> position
-> serialized
-> ProjectionMap key position serialized
-> ProjectionMap key position serialized
storeProjectionInMap key
uuid position
version serialized
projState (ProjectionMap key position serialized
 -> ProjectionMap key position serialized)
-> ProjectionMap key position serialized
-> ProjectionMap key position serialized
forall a b. (a -> b) -> a -> b
$ s -> ProjectionMap key position serialized
getMap s
state