module Eventium.ReadModel.Memory
  ( memoryReadModel,
  )
where

import Control.Concurrent.STM
import Control.Monad.IO.Class
import Eventium.ReadModel.Class
import Eventium.Store.Class
import Safe (maximumDef)

data MemoryReadModelData modeldata
  = MemoryReadModelData
  { forall modeldata. MemoryReadModelData modeldata -> SequenceNumber
memoryReadModelDataLatestSequenceNumber :: SequenceNumber,
    forall modeldata. MemoryReadModelData modeldata -> modeldata
_memoryReadModelDataValue :: modeldata
  }
  deriving (Int -> MemoryReadModelData modeldata -> ShowS
[MemoryReadModelData modeldata] -> ShowS
MemoryReadModelData modeldata -> String
(Int -> MemoryReadModelData modeldata -> ShowS)
-> (MemoryReadModelData modeldata -> String)
-> ([MemoryReadModelData modeldata] -> ShowS)
-> Show (MemoryReadModelData modeldata)
forall modeldata.
Show modeldata =>
Int -> MemoryReadModelData modeldata -> ShowS
forall modeldata.
Show modeldata =>
[MemoryReadModelData modeldata] -> ShowS
forall modeldata.
Show modeldata =>
MemoryReadModelData modeldata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall modeldata.
Show modeldata =>
Int -> MemoryReadModelData modeldata -> ShowS
showsPrec :: Int -> MemoryReadModelData modeldata -> ShowS
$cshow :: forall modeldata.
Show modeldata =>
MemoryReadModelData modeldata -> String
show :: MemoryReadModelData modeldata -> String
$cshowList :: forall modeldata.
Show modeldata =>
[MemoryReadModelData modeldata] -> ShowS
showList :: [MemoryReadModelData modeldata] -> ShowS
Show)

-- | Creates a read model that wraps some pure data in a TVar and manages the
-- latest sequence number for you.
memoryReadModel ::
  (MonadIO m) =>
  modeldata ->
  (modeldata -> [GlobalStreamEvent serialized] -> m modeldata) ->
  IO (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m)
memoryReadModel :: forall (m :: * -> *) modeldata serialized.
MonadIO m =>
modeldata
-> (modeldata -> [GlobalStreamEvent serialized] -> m modeldata)
-> IO
     (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m)
memoryReadModel modeldata
initialValue modeldata -> [GlobalStreamEvent serialized] -> m modeldata
handleEvents = do
  TVar (MemoryReadModelData modeldata)
tvar <- MemoryReadModelData modeldata
-> IO (TVar (MemoryReadModelData modeldata))
forall a. a -> IO (TVar a)
newTVarIO (MemoryReadModelData modeldata
 -> IO (TVar (MemoryReadModelData modeldata)))
-> MemoryReadModelData modeldata
-> IO (TVar (MemoryReadModelData modeldata))
forall a b. (a -> b) -> a -> b
$ SequenceNumber -> modeldata -> MemoryReadModelData modeldata
forall modeldata.
SequenceNumber -> modeldata -> MemoryReadModelData modeldata
MemoryReadModelData (-SequenceNumber
1) modeldata
initialValue
  ReadModel (TVar (MemoryReadModelData modeldata)) serialized m
-> IO
     (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m
 -> IO
      (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m))
-> ReadModel (TVar (MemoryReadModelData modeldata)) serialized m
-> IO
     (ReadModel (TVar (MemoryReadModelData modeldata)) serialized m)
forall a b. (a -> b) -> a -> b
$ TVar (MemoryReadModelData modeldata)
-> (TVar (MemoryReadModelData modeldata) -> m SequenceNumber)
-> (TVar (MemoryReadModelData modeldata)
    -> [GlobalStreamEvent serialized] -> m ())
-> ReadModel (TVar (MemoryReadModelData modeldata)) serialized m
forall model serialized (m :: * -> *).
model
-> (model -> m SequenceNumber)
-> (model -> [GlobalStreamEvent serialized] -> m ())
-> ReadModel model serialized m
ReadModel TVar (MemoryReadModelData modeldata)
tvar TVar (MemoryReadModelData modeldata) -> m SequenceNumber
forall {m :: * -> *} {modeldata}.
MonadIO m =>
TVar (MemoryReadModelData modeldata) -> m SequenceNumber
getLatestSequence TVar (MemoryReadModelData modeldata)
-> [GlobalStreamEvent serialized] -> m ()
handleTVarEvents
  where
    getLatestSequence :: TVar (MemoryReadModelData modeldata) -> m SequenceNumber
getLatestSequence TVar (MemoryReadModelData modeldata)
tvar' = IO SequenceNumber -> m SequenceNumber
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SequenceNumber -> m SequenceNumber)
-> IO SequenceNumber -> m SequenceNumber
forall a b. (a -> b) -> a -> b
$ MemoryReadModelData modeldata -> SequenceNumber
forall modeldata. MemoryReadModelData modeldata -> SequenceNumber
memoryReadModelDataLatestSequenceNumber (MemoryReadModelData modeldata -> SequenceNumber)
-> IO (MemoryReadModelData modeldata) -> IO SequenceNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (MemoryReadModelData modeldata)
-> IO (MemoryReadModelData modeldata)
forall a. TVar a -> IO a
readTVarIO TVar (MemoryReadModelData modeldata)
tvar'
    handleTVarEvents :: TVar (MemoryReadModelData modeldata)
-> [GlobalStreamEvent serialized] -> m ()
handleTVarEvents TVar (MemoryReadModelData modeldata)
tvar' [GlobalStreamEvent serialized]
events = do
      (MemoryReadModelData SequenceNumber
latestSeq modeldata
modelData) <- IO (MemoryReadModelData modeldata)
-> m (MemoryReadModelData modeldata)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MemoryReadModelData modeldata)
 -> m (MemoryReadModelData modeldata))
-> IO (MemoryReadModelData modeldata)
-> m (MemoryReadModelData modeldata)
forall a b. (a -> b) -> a -> b
$ TVar (MemoryReadModelData modeldata)
-> IO (MemoryReadModelData modeldata)
forall a. TVar a -> IO a
readTVarIO TVar (MemoryReadModelData modeldata)
tvar'
      let latestSeq' :: SequenceNumber
latestSeq' = SequenceNumber -> [SequenceNumber] -> SequenceNumber
forall a. Ord a => a -> [a] -> a
maximumDef SequenceNumber
latestSeq (GlobalStreamEvent serialized -> SequenceNumber
forall key position event.
StreamEvent key position event -> position
streamEventPosition (GlobalStreamEvent serialized -> SequenceNumber)
-> [GlobalStreamEvent serialized] -> [SequenceNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlobalStreamEvent serialized]
events)
      modeldata
modelData' <- modeldata -> [GlobalStreamEvent serialized] -> m modeldata
handleEvents modeldata
modelData [GlobalStreamEvent serialized]
events
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (MemoryReadModelData modeldata -> IO ())
-> MemoryReadModelData modeldata
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> (MemoryReadModelData modeldata -> STM ())
-> MemoryReadModelData modeldata
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (MemoryReadModelData modeldata)
-> MemoryReadModelData modeldata -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (MemoryReadModelData modeldata)
tvar' (MemoryReadModelData modeldata -> m ())
-> MemoryReadModelData modeldata -> m ()
forall a b. (a -> b) -> a -> b
$ SequenceNumber -> modeldata -> MemoryReadModelData modeldata
forall modeldata.
SequenceNumber -> modeldata -> MemoryReadModelData modeldata
MemoryReadModelData SequenceNumber
latestSeq' modeldata
modelData'