{-# LANGUAGE RecordWildCards #-}

-- | Defines a Command Handler type.
module Eventium.CommandHandler
  ( CommandHandler (..),
    allCommandHandlerStates,
    applyCommandHandler,
    serializedCommandHandler,
  )
where

import Data.Foldable (foldl')
import Data.List (scanl')
import Eventium.Projection
import Eventium.Serializer
import Eventium.Store.Class
import Eventium.UUID

-- | An 'CommandHandler' is a combination of a 'Projection' and a function to
-- validate commands against that 'Projection'. When using a command handler in
-- some service, it is common to simply load the latest projection state from
-- the event store and handle the command. If the command is valid then the new
-- events are applied to the projection in the event store.
data CommandHandler state event command
  = CommandHandler
  { forall state event command.
CommandHandler state event command -> state -> command -> [event]
commandHandlerHandler :: state -> command -> [event],
    forall state event command.
CommandHandler state event command -> Projection state event
commandHandlerProjection :: Projection state event
  }

-- | Given a list commands, produce all of the states the command handler's
-- projection sees. This is useful for unit testing a 'CommandHandler'.
allCommandHandlerStates ::
  CommandHandler state event command ->
  [command] ->
  [state]
allCommandHandlerStates :: forall state event command.
CommandHandler state event command -> [command] -> [state]
allCommandHandlerStates (CommandHandler state -> command -> [event]
commandHandler (Projection state
seed state -> event -> state
eventHandler)) =
  (state -> command -> state) -> state -> [command] -> [state]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' state -> command -> state
go state
seed
  where
    go :: state -> command -> state
go state
state command
command = (state -> event -> state) -> state -> [event] -> state
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' state -> event -> state
eventHandler state
state ([event] -> state) -> [event] -> state
forall a b. (a -> b) -> a -> b
$ state -> command -> [event]
commandHandler state
state command
command

-- | Loads the latest version of a 'Projection' from the event store and tries to
-- apply the 'CommandHandler' command to it. If the command succeeds, then this
-- saves the events back to the store as well.
applyCommandHandler ::
  (Monad m) =>
  VersionedEventStoreWriter m event ->
  VersionedEventStoreReader m event ->
  CommandHandler state event command ->
  UUID ->
  command ->
  m [event]
applyCommandHandler :: forall (m :: * -> *) event state command.
Monad m =>
VersionedEventStoreWriter m event
-> VersionedEventStoreReader m event
-> CommandHandler state event command
-> UUID
-> command
-> m [event]
applyCommandHandler VersionedEventStoreWriter m event
writer VersionedEventStoreReader m event
reader (CommandHandler state -> command -> [event]
handler Projection state event
proj) UUID
uuid command
command = do
  StreamProjection {state
UUID
EventVersion
Projection state event
streamProjectionKey :: UUID
streamProjectionPosition :: EventVersion
streamProjectionProjection :: Projection state event
streamProjectionState :: state
streamProjectionKey :: forall key position state event.
StreamProjection key position state event -> key
streamProjectionPosition :: forall key position state event.
StreamProjection key position state event -> position
streamProjectionProjection :: forall key position state event.
StreamProjection key position state event -> Projection state event
streamProjectionState :: forall key position state event.
StreamProjection key position state event -> state
..} <- VersionedEventStoreReader m event
-> StreamProjection UUID EventVersion state event
-> m (StreamProjection UUID EventVersion state event)
forall (m :: * -> *) position key event state.
(Monad m, Num position) =>
EventStoreReader key position m (StreamEvent key position event)
-> StreamProjection key position state event
-> m (StreamProjection key position state event)
getLatestStreamProjection VersionedEventStoreReader m event
reader (UUID
-> Projection state event
-> StreamProjection UUID EventVersion state event
forall state event.
UUID
-> Projection state event -> VersionedStreamProjection state event
versionedStreamProjection UUID
uuid Projection state event
proj)
  let events :: [event]
events = state -> command -> [event]
handler state
streamProjectionState command
command
  Either (EventWriteError EventVersion) EventVersion
mError <- VersionedEventStoreWriter m event
-> UUID
-> ExpectedPosition EventVersion
-> [event]
-> m (Either (EventWriteError EventVersion) EventVersion)
forall key position (m :: * -> *) event.
EventStoreWriter key position m event
-> key
-> ExpectedPosition position
-> [event]
-> m (Either (EventWriteError position) EventVersion)
storeEvents VersionedEventStoreWriter m event
writer UUID
uuid (EventVersion -> ExpectedPosition EventVersion
forall position. position -> ExpectedPosition position
ExactPosition EventVersion
streamProjectionPosition) [event]
events
  case Either (EventWriteError EventVersion) EventVersion
mError of
    Left EventWriteError EventVersion
err -> [Char] -> m [event]
forall a. HasCallStack => [Char] -> a
error ([Char] -> m [event]) -> [Char] -> m [event]
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: Create CommandHandler restart logic. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ EventWriteError EventVersion -> [Char]
forall a. Show a => a -> [Char]
show EventWriteError EventVersion
err
    Right EventVersion
_ -> [event] -> m [event]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [event]
events

-- | Use a pair of 'Serializer's to wrap a 'CommandHandler' with event type @event@
-- and command type @command@ so it uses the @serializedEvent@ and
-- @serializedCommand@ types.
serializedCommandHandler ::
  CommandHandler state event command ->
  Serializer event serializedEvent ->
  Serializer command serializedCommand ->
  CommandHandler state serializedEvent serializedCommand
serializedCommandHandler :: forall state event command serializedEvent serializedCommand.
CommandHandler state event command
-> Serializer event serializedEvent
-> Serializer command serializedCommand
-> CommandHandler state serializedEvent serializedCommand
serializedCommandHandler (CommandHandler state -> command -> [event]
commandHandler Projection state event
projection) Serializer event serializedEvent
eventSerializer Serializer command serializedCommand
commandSerializer =
  (state -> serializedCommand -> [serializedEvent])
-> Projection state serializedEvent
-> CommandHandler state serializedEvent serializedCommand
forall state event command.
(state -> command -> [event])
-> Projection state event -> CommandHandler state event command
CommandHandler state -> serializedCommand -> [serializedEvent]
serializedHandler Projection state serializedEvent
serializedProjection'
  where
    serializedProjection' :: Projection state serializedEvent
serializedProjection' = Projection state event
-> Serializer event serializedEvent
-> Projection state serializedEvent
forall state event serialized.
Projection state event
-> Serializer event serialized -> Projection state serialized
serializedProjection Projection state event
projection Serializer event serializedEvent
eventSerializer
    -- Try to deserialize the command and apply the handler. If we can't
    -- deserialize, then just return no events. We also need to serialize the
    -- events after of course.
    serializedHandler :: state -> serializedCommand -> [serializedEvent]
serializedHandler state
state = (event -> serializedEvent) -> [event] -> [serializedEvent]
forall a b. (a -> b) -> [a] -> [b]
map (Serializer event serializedEvent -> event -> serializedEvent
forall a b. Serializer a b -> a -> b
serialize Serializer event serializedEvent
eventSerializer) ([event] -> [serializedEvent])
-> (serializedCommand -> [event])
-> serializedCommand
-> [serializedEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [event] -> (command -> [event]) -> Maybe command -> [event]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (state -> command -> [event]
commandHandler state
state) (Maybe command -> [event])
-> (serializedCommand -> Maybe command)
-> serializedCommand
-> [event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializer command serializedCommand
-> serializedCommand -> Maybe command
forall a b. Serializer a b -> b -> Maybe a
deserialize Serializer command serializedCommand
commandSerializer