EventSourcing1

EventSourcing1.hs

module EventSourcing where

import Control.Monad.State

data Command = CreateToDoItemCommand { cmdTodoId :: String, cmdDescription :: String }
             | MarkCompletedCommand { cmdTodoId :: String }
  deriving (Eq, Ord, Show)

data Event = ToDoItemCreatedEvent { evtTodoId :: String, evtDescription :: String }
           | ToDoItemCompletedEvent { evtTodoId :: String }
  deriving (Eq, Ord, Show)

type Store = [Event]

type EventSourced = State Store

dispatch :: Command -> EventSourced [Event]
dispatch cmd = do
  store <- get
  let events = dispatch' cmd store
  put (store ++ events)
  return events

dispatch' :: Command -> Store -> [Event]
dispatch' (CreateToDoItemCommand i desc) _ = [ToDoItemCreatedEvent i desc]
dispatch' (MarkCompletedCommand i)       _ = [ToDoItemCompletedEvent i]

runEventSourced :: EventSourced a -> a
runEventSourced s = evalState s []

thenDispatch :: EventSourced [Event] -> Command -> EventSourced [Event]
thenDispatch es cmd = do
  events1 <- es
  events2 <- dispatch cmd
  return (events1 ++ events2)

test :: [Event]
test = runEventSourced $
  dispatch (CreateToDoItemCommand "1" "example") 
  `thenDispatch` CreateToDoItemCommand "2" "another"
  `thenDispatch` MarkCompletedCommand "1"