{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}

module Eventium.ProcessManager
  ( ProcessManager (..),
    ProcessManagerCommand (..),
    applyProcessManagerCommandsAndEvents,
  )
where

import Control.Monad (forM_, void)
import Eventium.CommandHandler
import Eventium.Projection
import Eventium.Store.Class
import Eventium.UUID

-- | A 'ProcessManager' manages interaction between event streams. It works by
-- listening to events on an event bus and applying events to its internal
-- 'Projection' (see 'applyProcessManagerCommandsAndEvents'). Then, pending
-- commands and events are plucked off of that Projection and applied to the
-- appropriate 'CommandHandler' or Projections in other streams.
data ProcessManager state event command
  = ProcessManager
  { forall state event command.
ProcessManager state event command
-> Projection state (VersionedStreamEvent event)
processManagerProjection :: Projection state (VersionedStreamEvent event),
    forall state event command.
ProcessManager state event command
-> state -> [ProcessManagerCommand event command]
processManagerPendingCommands :: state -> [ProcessManagerCommand event command],
    forall state event command.
ProcessManager state event command
-> state -> [StreamEvent UUID () event]
processManagerPendingEvents :: state -> [StreamEvent UUID () event]
  }

-- | This is a @command@ along with the UUID of the target 'CommandHandler', as
-- well as the 'CommandHandler' type. Note that this uses an existential type
-- to hide the @state@ type parameter on the CommandHandler.
data ProcessManagerCommand event command
  = forall state. ProcessManagerCommand
  { forall event command. ProcessManagerCommand event command -> UUID
processManagerCommandTargetId :: UUID,
    ()
processManagerCommandCommandHandler :: CommandHandler state event command,
    forall event command.
ProcessManagerCommand event command -> command
processManagerCommandCommand :: command
  }

instance (Show command, Show event) => Show (ProcessManagerCommand event command) where
  show :: ProcessManagerCommand event command -> String
show (ProcessManagerCommand UUID
uuid CommandHandler state event command
_ command
command) =
    String
"ProcessManagerCommand{processManagerCommandCommandHandlerId = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ UUID -> String
forall a. Show a => a -> String
show UUID
uuid
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", processManagerCommandCommand = "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ command -> String
forall a. Show a => a -> String
show command
command
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

-- | Plucks the pending commands and events off of the process manager's state
-- and applies them to the appropriate locations in the event store.
applyProcessManagerCommandsAndEvents ::
  (Monad m) =>
  ProcessManager state event command ->
  VersionedEventStoreWriter m event ->
  VersionedEventStoreReader m event ->
  state ->
  m ()
applyProcessManagerCommandsAndEvents :: forall (m :: * -> *) state event command.
Monad m =>
ProcessManager state event command
-> VersionedEventStoreWriter m event
-> VersionedEventStoreReader m event
-> state
-> m ()
applyProcessManagerCommandsAndEvents ProcessManager {Projection state (VersionedStreamEvent event)
state -> [StreamEvent UUID () event]
state -> [ProcessManagerCommand event command]
processManagerProjection :: forall state event command.
ProcessManager state event command
-> Projection state (VersionedStreamEvent event)
processManagerPendingCommands :: forall state event command.
ProcessManager state event command
-> state -> [ProcessManagerCommand event command]
processManagerPendingEvents :: forall state event command.
ProcessManager state event command
-> state -> [StreamEvent UUID () event]
processManagerProjection :: Projection state (VersionedStreamEvent event)
processManagerPendingCommands :: state -> [ProcessManagerCommand event command]
processManagerPendingEvents :: state -> [StreamEvent UUID () event]
..} VersionedEventStoreWriter m event
writer VersionedEventStoreReader m event
reader state
state = do
  [ProcessManagerCommand event command]
-> (ProcessManagerCommand event command -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (state -> [ProcessManagerCommand event command]
processManagerPendingCommands state
state) ((ProcessManagerCommand event command -> m ()) -> m ())
-> (ProcessManagerCommand event command -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(ProcessManagerCommand UUID
targetId CommandHandler state event command
commandHandler command
command) ->
    m [event] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [event] -> m ()) -> m [event] -> m ()
forall a b. (a -> b) -> a -> b
$ VersionedEventStoreWriter m event
-> VersionedEventStoreReader m event
-> CommandHandler state event command
-> UUID
-> command
-> m [event]
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 event command
commandHandler UUID
targetId command
command
  [StreamEvent UUID () event]
-> (StreamEvent UUID () event
    -> m (Either (EventWriteError EventVersion) EventVersion))
-> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (state -> [StreamEvent UUID () event]
processManagerPendingEvents state
state) ((StreamEvent UUID () event
  -> m (Either (EventWriteError EventVersion) EventVersion))
 -> m ())
-> (StreamEvent UUID () event
    -> m (Either (EventWriteError EventVersion) EventVersion))
-> m ()
forall a b. (a -> b) -> a -> b
$ \(StreamEvent UUID
projectionId () event
event) ->
    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
projectionId ExpectedPosition EventVersion
forall position. ExpectedPosition position
AnyPosition [event
event]