module CQRSExample.Instances ( ) where import CQRSExample.Aggregates import CQRSExample.Events import Data.CQRS (Eventable(..)) import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Text as T instance Eventable Project Event where applyEvent (ProjectCreated name shortDesc) DefaultProject = ActiveProject name shortDesc -- Project changes to "active". applyEvent (ProjectCreated _ _ ) (ActiveProject _ _) = error "Invalid ProjectCreated event for project that already exists" applyEvent (ProjectRenamed _ ) DefaultProject = error "Cannot rename inactive project" applyEvent (ProjectRenamed name) project@(ActiveProject _ _) = project { projectName = name } applyEvent (TaskAdded _ _) DefaultProject = error "Cannot add task to inactive project" applyEvent (TaskAdded _ _) project@(ActiveProject _ _) = project -- Project doesn't change applyEvent (RecordedWorkUnit _ _ _ _ _) DefaultProject = error "Cannot record work on inactive project" applyEvent (RecordedWorkUnit _ _ _ _ _) project@(ActiveProject _ _) = project -- Project doesn't change applyEvent (TaskStarred _) project = project -- Project doesn't change applyEvent (TaskUnstarred _) project = project -- Project doesn't change applyEvent (UserCreated _ _ _ _) project = project applyEvent (UserRegistered _) project = project instance Eventable Task Event where applyEvent (ProjectCreated _ _) task = task applyEvent (ProjectRenamed _) task = task applyEvent (TaskAdded pId tsd) NewTask = ActiveTask pId tsd T.empty M.empty applyEvent (TaskAdded _ _) (ActiveTask _ _ _ _) = error "Cannot add task which already exists" applyEvent (RecordedWorkUnit _ _ _ _ _) NewTask = error "Cannot record work on inactive task" applyEvent (RecordedWorkUnit wuId wuDay wuDuration wuComment wuUserId) task@(ActiveTask _ _ _ workUnits) = task { taskWorkUnits = M.insert wuDay (WorkUnit wuId wuComment wuDuration wuUserId) workUnits } applyEvent (UserCreated _ _ _ _) task = task applyEvent (TaskStarred _) task = task applyEvent (TaskUnstarred _) task = task applyEvent (UserRegistered _) task = task instance Eventable User Event where applyEvent (ProjectCreated _ _) user = user applyEvent (ProjectRenamed _) user = user applyEvent (TaskAdded _ _) user = user applyEvent (RecordedWorkUnit _ _ _ _ _) user = user applyEvent (TaskStarred _) user = user applyEvent (TaskUnstarred _) user = user applyEvent (UserCreated _ _ _ _) (ActiveUser _ _ _ _) = error "User already exists" applyEvent (UserCreated ucUserName ucPassword ucFirstName ucLastName) UncreatedUser = ActiveUser ucUserName ucPassword ucFirstName ucLastName applyEvent (UserRegistered _) user = user instance Eventable Site Event where applyEvent (ProjectCreated _ _) site = site applyEvent (ProjectRenamed _) site = site applyEvent (TaskAdded _ _) site = site applyEvent (RecordedWorkUnit _ _ _ _ _) site = site applyEvent (TaskStarred _) site = site applyEvent (TaskUnstarred _) site = site applyEvent (UserCreated _ _ _ _) site = site applyEvent (UserRegistered ucUserName) site = site { sUserNames = S.insert ucUserName $ sUserNames site }