Instances.hs

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 }