content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE RecordWildCards #-}
  
  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
  
  -- | 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
  