module CQRSExample.Command ( archiveCompletedTasks , createTask , completeTask , reopenTask ) where import Control.Concurrent.STM.TVar (TVar) import Control.Monad (forM_) import Control.Monad.Trans.Class (lift) import Data.CQRS.Command (createAggregate, loadAggregate, newGUID, publishEvent, UnitOfWorkT, AggregateRef) import Data.Text (Text) import CQRSExample.Aggregates import CQRSExample.Events import CQRSExample.Instances () import CQRSExample.Query (QueryState, runQuery, qCompletedTaskIdList) -- Create new task in a project. createTask :: Text -> UnitOfWorkT Event IO TaskId createTask title = do taskId <- lift $ newGUID (taskRef :: AggregateRef Task Event) <- createAggregate taskId publishEvent taskRef $ TaskEvent $ TaskAdded title return taskId -- Complete a task. completeTask :: TaskId -> UnitOfWorkT Event IO () completeTask taskId = do (taskRef, task :: Task) <- loadAggregate taskId case taskStatus task of TaskStatusOpen -> publishEvent taskRef $ TaskEvent $ TaskCompleted TaskStatusComplete -> return () TaskStatusArchived -> return () -- Reopen a task. reopenTask :: TaskId -> UnitOfWorkT Event IO () reopenTask taskId = do (taskRef, task :: Task) <- loadAggregate taskId case taskStatus task of TaskStatusOpen -> return () TaskStatusComplete -> publishEvent taskRef $ TaskEvent $ TaskReopened TaskStatusArchived -> return () archiveCompletedTasks :: TVar QueryState -> UnitOfWorkT Event IO () archiveCompletedTasks qs = do taskIds <- lift $ runQuery qs qCompletedTaskIdList forM_ taskIds $ \taskId -> do (taskRef, task :: Task) <- loadAggregate taskId case taskStatus task of TaskStatusOpen -> return () TaskStatusComplete -> publishEvent taskRef $ TaskEvent $ TaskArchived TaskStatusArchived -> return ()