Aggregate.hs

module Data.CQRS.Internal.Aggregate
       ( Aggregate
       , aggregateSnapshotVersion
       , aggregateSnapshot
       , aggregateValue
       , aggregateVersion0
       , applyEvent
       , applySnapshot
       , emptyAggregate
       , versionedEvents
       , publishEvent
       ) where

import           Control.DeepSeq (NFData, ($!!))
import           Data.CQRS.Types.AggregateAction (AggregateAction)
import           Data.CQRS.Types.PersistedEvent (PersistedEvent(..))
import           Data.CQRS.Types.Snapshot (Snapshot(..))
import qualified Data.Foldable as F
import           Data.Sequence (Seq, (|>))
import qualified Data.Sequence as S
import           Data.Typeable (Typeable)

-- Aggregate's in-memory state.
data Aggregate a e = Aggregate
    { aggregateAction :: AggregateAction a e
    , aggregateValue :: Maybe a
    , aggregateEvents :: Seq e
    , aggregateVersion0 :: {-# UNPACK #-} !Int
    , aggregateSnapshotVersion :: {-# UNPACK #-} !Int
    } deriving (Typeable)

-- Make "empty" aggregate for applying snapshots and events to.
emptyAggregate :: AggregateAction a e -> Aggregate a e
emptyAggregate aggregateAction' =
    Aggregate { aggregateAction = aggregateAction'
                   , aggregateValue = Nothing
                   , aggregateEvents = S.empty
                   , aggregateVersion0 = -1
                   , aggregateSnapshotVersion = -1
                   }

-- Apply snapshot to aggregate.
applySnapshot :: Aggregate a e -> Maybe (Snapshot a) -> Aggregate a e
applySnapshot a0 Nothing = a0
applySnapshot a0 (Just s) =
  a0 { aggregateValue = Just $ sSnapshot s
     , aggregateVersion0 = sVersion s
     , aggregateSnapshotVersion = sVersion s }

-- Apply event from event store to aggregate. The event will not be published.
applyEvent :: Aggregate a e -> PersistedEvent e -> Aggregate a e
applyEvent a pe =
    a { aggregateValue = Just $ (aggregateAction a) (aggregateValue a) $ peEvent pe
      , aggregateVersion0 = max (peSequenceNumber pe) (aggregateVersion0 a)
      }

-- Publish event to aggregate.
publishEvent :: (NFData e, NFData a) => Aggregate a e -> e -> Aggregate a e
publishEvent a e =
    a { aggregateValue = Just $!! (aggregateAction a) (aggregateValue a) e
      , aggregateEvents = (|>) (aggregateEvents a) $!! e
      }

-- Return events with attached version numbers.
versionedEvents :: Aggregate a e -> [(Int, e)]
versionedEvents a = zip [v0+1 ..] evs
  where
    evs = F.toList $ aggregateEvents a
    v0 = aggregateVersion0 a

-- Return a snapshot of the aggregate state.
aggregateSnapshot :: Aggregate a e -> Maybe (Int, a)
aggregateSnapshot a = fmap (\av -> (v, av)) (aggregateValue a)
  where
    v = S.length (aggregateEvents a) + aggregateVersion0 a