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.Event (Event(..))
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.Typeable (Typeable)

-- | Aggregate root reference.
data AggregateRef a e =
  AggregateRef { arValue :: IORef a
               , arEvents :: IORef [e]
               , arGUID :: GUID a
               , arStartVersion :: Int
               , arSnapshotVersion :: Int
               }
  deriving (Typeable)

-- | Make aggregate
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

-- | Publish event to aggregate.
publishEvent :: (MonadIO m, Event e a) => AggregateRef a e -> e -> m ()
publishEvent aggregateRef event = liftIO $ do
  -- Apply event to aggregate state.
  modifyIORef (arValue aggregateRef) $ applyEvent event
  -- Add event to aggregate.
  modifyIORef (arEvents aggregateRef) $ \es -> event:es

-- | Read aggregate events.
readEvents :: (MonadIO m) => AggregateRef a e -> m [e]
readEvents = liftIO . readIORef . arEvents

-- | Read aggregate state.
readValue :: (MonadIO m) => AggregateRef a e -> m a
readValue = liftIO . readIORef . arValue

-- | Get the current version of the aggregate in aggregate ref.
getCurrentVersion :: (MonadIO m) => AggregateRef a e -> m Int
getCurrentVersion a = do
  nevs <- liftM length $ liftIO $ readIORef $ arEvents a
  return $ nevs + (arStartVersion a)