module Data.CQRS.Internal.AggregateRef
( AggregateRef
, arGUID
, arSnapshotVersion
, arStartVersion
, getCurrentVersion
, mkAggregateRef
, publishEvent
, readEvents
, readValue
) where
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.CQRS.Eventable (Eventable(..))
import Data.CQRS.GUID (GUID)
import Data.CQRS.PersistedEvent (PersistedEvent(..))
import Data.Foldable (toList)
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as S
import Data.Typeable (Typeable)
data AggregateRef a e =
AggregateRef { arValue :: IORef a
, arEvents :: IORef (Seq (PersistedEvent e))
, arGUID :: GUID
, arStartVersion :: Int
, arSnapshotVersion :: Int
}
deriving (Typeable)
mkAggregateRef :: (MonadIO m) => a -> GUID -> Int -> Int -> m (AggregateRef a e)
mkAggregateRef a guid originatingVersion snapshotVersion = do
a' <- liftIO $ newIORef a
e' <- liftIO $ newIORef S.empty
return $ AggregateRef a' e' guid originatingVersion snapshotVersion
publishEvent :: (MonadIO m, Eventable a e) => AggregateRef a e -> e -> Int -> m ()
publishEvent aggregateRef event gv = liftIO $ do
modifyIORef (arValue aggregateRef) $ applyEvent event
modifyIORef (arEvents aggregateRef) $ \events ->
events |> (PersistedEvent (arGUID aggregateRef) event (arStartVersion aggregateRef + 1 + S.length events) gv)
readEvents :: (MonadIO m) => AggregateRef a e -> m [PersistedEvent e]
readEvents = liftM toList . liftIO . readIORef . arEvents
readValue :: (MonadIO m) => AggregateRef a e -> m a
readValue = liftIO . readIORef . arValue
getCurrentVersion :: (MonadIO m) => AggregateRef a e -> m Int
getCurrentVersion a = do
nevs <- liftM S.length $ liftIO $ readIORef $ arEvents a
return $ nevs + (arStartVersion a)