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.GUID (GUID)
import Data.CQRS.Eventable (Eventable(..))
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.Typeable (Typeable)
data AggregateRef a e =
AggregateRef { arValue :: IORef a
, arEvents :: IORef [e]
, arGUID :: GUID a
, arStartVersion :: Int
, arSnapshotVersion :: Int
}
deriving (Typeable)
mkAggregateRef :: (MonadIO m) => a -> GUID a -> Int -> Int -> m (AggregateRef a e)
mkAggregateRef a guid originatingVersion snapshotVersion = do
a' <- liftIO $ newIORef a
e' <- liftIO $ newIORef []
return $ AggregateRef a' e' guid originatingVersion snapshotVersion
publishEvent :: (MonadIO m, Eventable a e) => AggregateRef a e -> e -> m ()
publishEvent aggregateRef event = liftIO $ do
modifyIORef (arValue aggregateRef) $ applyEvent event
modifyIORef (arEvents aggregateRef) $ \es -> event:es
readEvents :: (MonadIO m) => AggregateRef a e -> m [e]
readEvents = 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 length $ liftIO $ readIORef $ arEvents a
return $ nevs + (arStartVersion a)