Aggregates.hs

module CQRSExample.Aggregates
       ( Project(..)
       , ProjectId
       , Site(..)
       , siteGUID
       , Task(..)
       , TaskId
       , User(..)
       , UserId
       , WorkUnit(..)
       , WorkUnitId
       ) where

import           CQRSExample.Duration (Duration)
import           Data.CQRS (Aggregate(..), GUID)
import           Data.CQRS.Serialize (decode', encode)
import           Data.Default (Default(..))
import           Data.Map (Map)
import           Data.SafeCopy (base, deriveSafeCopySimple)
import           Data.Set (Set)
import qualified Data.Set as S
import           Data.Text (Text)
import           Data.Time.Calendar(Day(..))
import           Data.Typeable (Typeable)

-- Site aggregate. This keeps track of things which must be "per site"
-- (per installation), e.g. a list of used user names such that we
-- can be sure that there are no users with the same login name.
--
-- Note that only data required for command verification is necessary
-- here!
data Site = Site { sUserNames :: Set Text
                 } deriving (Typeable, Eq, Show)

instance Aggregate Site where
  encodeAggregate = encode
  decodeAggregate = decode'

instance Default Site where
  def = Site S.empty

-- GUID for the single Site aggregate.
siteGUID :: GUID
siteGUID = def

-- Projects.

type ProjectId = GUID

data Project = UninitializedProject
             | ActiveProject { projectName :: Text
                             , projectCustomer :: Text
                             }
             deriving (Typeable, Eq, Show)

instance Aggregate Project where
  encodeAggregate = encode
  decodeAggregate = decode'

instance Default Project where
  def = UninitializedProject

-- Tasks.

type TaskId = GUID

data Task = UninitializedTask
          | ActiveTask { taskProjectId :: ProjectId
                       , taskShortDescription :: Text
                       , taskLongDescription :: Text
                       , taskWorkUnits :: Map Day WorkUnit
                       }
          deriving (Typeable, Eq, Show)

instance Aggregate Task where
  encodeAggregate = encode
  decodeAggregate = decode'

instance Default Task where
  def = UninitializedTask

-- Users.

type UserId = GUID

data User = UninitializedUser
          | ActiveUser { auUserName :: Text
                       , auPassword :: Text
                       , auLastName :: Text
                       , auFirstName :: Text
                       }
            deriving (Typeable, Eq, Show)

instance Aggregate User where
  encodeAggregate = encode
  decodeAggregate = decode'

instance Default User where
  def = UninitializedUser


-- Work Units (NOT aggregates!)
type WorkUnitId = GUID

data WorkUnit = WorkUnit { workUnitId :: GUID
                         , workUnitComment :: Text
                         , workUnitDuration :: Duration
                         , workUnitUser :: UserId
                         }
                deriving (Eq, Show)

-- SafeCopy instances.

$(deriveSafeCopySimple 1 'base ''Task)
$(deriveSafeCopySimple 1 'base ''Site)
$(deriveSafeCopySimple 1 'base ''Project)
$(deriveSafeCopySimple 1 'base ''User)
$(deriveSafeCopySimple 1 'base ''WorkUnit)