{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wmissing-import-lists #-}

{- | Description: Monadic interaction with an EventFold. -}
module Data.CRDT.EventFold.Monad (
  MonadUpdateEF(..),
  MonadInspectEF(..),
  EventFoldT,
  runEventFoldT,
) where


import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Logger (MonadLogger, MonadLoggerIO)
import Control.Monad.Reader (MonadReader(ask), ReaderT(runReaderT))
import Control.Monad.State (MonadState(state), StateT, get, gets,
  runStateT)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Data.CRDT.EventFold (Event(Output), UpdateResult(UpdateResult),
  Diff, EventFold, EventId, MergeError, urEventFold)
import qualified Data.CRDT.EventFold as EF (diffMerge, disassociate,
  event, fullMerge, participate)


{- |
  The interface for monadically updating an EventFold, where the
  monadic context is intended to manage:

  - The local participant.
  - The current state of the EventFold.
  - The accumulated consistent outputs.
  - Whether the 'EventFold' needs to be propagated to other participants.
-}
class MonadUpdateEF o p e m | m -> o p e where
  {- | Apply an event. See 'EF.event'. -}
  event :: e -> m (Output e, EventId p)

  {- | Perform a full merge. See 'EF.fullMerge'. -}
  fullMerge :: EventFold o p e -> m (Either (MergeError o p e) ())

  {- | Perform a diff merge. See 'EF.diffMerge'. -}
  diffMerge :: Diff o p e -> m (Either (MergeError o p e) ())

  {- | Allow a new participant to join in the cluster. See 'EF.participate'. -}
  participate :: p -> m (EventId p)

  {- | Remove a peer from participation. See 'EF.disassociate'. -}
  disassociate :: p -> m (EventId p)

  {- | Get the outstanding update results. -}
  getResult :: m (UpdateResult o p e)


{- |
  Interface for inspecting an Eventfold contained within the monadic
  context.
-}
class (Monad m) => MonadInspectEF o p e m | m -> o p e where
  efAsks :: (EventFold o p e -> a) -> m a
  efAsks EventFold o p e -> a
f = EventFold o p e -> a
f (EventFold o p e -> a) -> m (EventFold o p e) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (EventFold o p e)
forall o p e (m :: * -> *).
MonadInspectEF o p e m =>
m (EventFold o p e)
efAsk

  efAsk :: m (EventFold o p e)
  efAsk = (EventFold o p e -> EventFold o p e) -> m (EventFold o p e)
forall o p e (m :: * -> *) a.
MonadInspectEF o p e m =>
(EventFold o p e -> a) -> m a
efAsks EventFold o p e -> EventFold o p e
forall a. a -> a
id


{- | A transformer providing 'MonadUpdateEF' and 'MonadInspectEF'. -}
newtype EventFoldT o p e m a = EventFoldT {
    forall o p e (m :: * -> *) a.
EventFoldT o p e m a -> StateT (UpdateResult o p e) (ReaderT p m) a
unEventFoldT ::
      StateT (UpdateResult o p e) (
      ReaderT p m)
      a
  }
  deriving newtype
    ( Functor (EventFoldT o p e m)
Functor (EventFoldT o p e m)
-> (forall a. a -> EventFoldT o p e m a)
-> (forall a b.
    EventFoldT o p e m (a -> b)
    -> EventFoldT o p e m a -> EventFoldT o p e m b)
-> (forall a b c.
    (a -> b -> c)
    -> EventFoldT o p e m a
    -> EventFoldT o p e m b
    -> EventFoldT o p e m c)
-> (forall a b.
    EventFoldT o p e m a
    -> EventFoldT o p e m b -> EventFoldT o p e m b)
-> (forall a b.
    EventFoldT o p e m a
    -> EventFoldT o p e m b -> EventFoldT o p e m a)
-> Applicative (EventFoldT o p e m)
forall a. a -> EventFoldT o p e m a
forall a b.
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m a
forall a b.
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
forall a b.
EventFoldT o p e m (a -> b)
-> EventFoldT o p e m a -> EventFoldT o p e m b
forall a b c.
(a -> b -> c)
-> EventFoldT o p e m a
-> EventFoldT o p e m b
-> EventFoldT o p e m c
forall {o} {p} {e} {m :: * -> *}.
Monad m =>
Functor (EventFoldT o p e m)
forall o p e (m :: * -> *) a. Monad m => a -> EventFoldT o p e m a
forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m a
forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m (a -> b)
-> EventFoldT o p e m a -> EventFoldT o p e m b
forall o p e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> EventFoldT o p e m a
-> EventFoldT o p e m b
-> EventFoldT o p e m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m a
$c<* :: forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m a
*> :: forall a b.
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
$c*> :: forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
liftA2 :: forall a b c.
(a -> b -> c)
-> EventFoldT o p e m a
-> EventFoldT o p e m b
-> EventFoldT o p e m c
$cliftA2 :: forall o p e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> EventFoldT o p e m a
-> EventFoldT o p e m b
-> EventFoldT o p e m c
<*> :: forall a b.
EventFoldT o p e m (a -> b)
-> EventFoldT o p e m a -> EventFoldT o p e m b
$c<*> :: forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m (a -> b)
-> EventFoldT o p e m a -> EventFoldT o p e m b
pure :: forall a. a -> EventFoldT o p e m a
$cpure :: forall o p e (m :: * -> *) a. Monad m => a -> EventFoldT o p e m a
Applicative
    , (forall a b.
 (a -> b) -> EventFoldT o p e m a -> EventFoldT o p e m b)
-> (forall a b. a -> EventFoldT o p e m b -> EventFoldT o p e m a)
-> Functor (EventFoldT o p e m)
forall a b. a -> EventFoldT o p e m b -> EventFoldT o p e m a
forall a b.
(a -> b) -> EventFoldT o p e m a -> EventFoldT o p e m b
forall o p e (m :: * -> *) a b.
Functor m =>
a -> EventFoldT o p e m b -> EventFoldT o p e m a
forall o p e (m :: * -> *) a b.
Functor m =>
(a -> b) -> EventFoldT o p e m a -> EventFoldT o p e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> EventFoldT o p e m b -> EventFoldT o p e m a
$c<$ :: forall o p e (m :: * -> *) a b.
Functor m =>
a -> EventFoldT o p e m b -> EventFoldT o p e m a
fmap :: forall a b.
(a -> b) -> EventFoldT o p e m a -> EventFoldT o p e m b
$cfmap :: forall o p e (m :: * -> *) a b.
Functor m =>
(a -> b) -> EventFoldT o p e m a -> EventFoldT o p e m b
Functor
    , Applicative (EventFoldT o p e m)
Applicative (EventFoldT o p e m)
-> (forall a b.
    EventFoldT o p e m a
    -> (a -> EventFoldT o p e m b) -> EventFoldT o p e m b)
-> (forall a b.
    EventFoldT o p e m a
    -> EventFoldT o p e m b -> EventFoldT o p e m b)
-> (forall a. a -> EventFoldT o p e m a)
-> Monad (EventFoldT o p e m)
forall a. a -> EventFoldT o p e m a
forall a b.
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
forall a b.
EventFoldT o p e m a
-> (a -> EventFoldT o p e m b) -> EventFoldT o p e m b
forall o p e (m :: * -> *).
Monad m =>
Applicative (EventFoldT o p e m)
forall o p e (m :: * -> *) a. Monad m => a -> EventFoldT o p e m a
forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> (a -> EventFoldT o p e m b) -> EventFoldT o p e m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> EventFoldT o p e m a
$creturn :: forall o p e (m :: * -> *) a. Monad m => a -> EventFoldT o p e m a
>> :: forall a b.
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
$c>> :: forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
>>= :: forall a b.
EventFoldT o p e m a
-> (a -> EventFoldT o p e m b) -> EventFoldT o p e m b
$c>>= :: forall o p e (m :: * -> *) a b.
Monad m =>
EventFoldT o p e m a
-> (a -> EventFoldT o p e m b) -> EventFoldT o p e m b
Monad
    , Monad (EventFoldT o p e m)
Monad (EventFoldT o p e m)
-> (forall a. IO a -> EventFoldT o p e m a)
-> MonadIO (EventFoldT o p e m)
forall a. IO a -> EventFoldT o p e m a
forall {o} {p} {e} {m :: * -> *}.
MonadIO m =>
Monad (EventFoldT o p e m)
forall o p e (m :: * -> *) a.
MonadIO m =>
IO a -> EventFoldT o p e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> EventFoldT o p e m a
$cliftIO :: forall o p e (m :: * -> *) a.
MonadIO m =>
IO a -> EventFoldT o p e m a
MonadIO
    , Monad (EventFoldT o p e m)
Monad (EventFoldT o p e m)
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> EventFoldT o p e m ())
-> MonadLogger (EventFoldT o p e m)
forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> EventFoldT o p e m ()
forall {o} {p} {e} {m :: * -> *}.
MonadLogger m =>
Monad (EventFoldT o p e m)
forall o p e (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> EventFoldT o p e m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> EventFoldT o p e m ()
$cmonadLoggerLog :: forall o p e (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> EventFoldT o p e m ()
MonadLogger
    , MonadIO (EventFoldT o p e m)
MonadLogger (EventFoldT o p e m)
EventFoldT
  o p e m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLogger (EventFoldT o p e m)
-> MonadIO (EventFoldT o p e m)
-> EventFoldT
     o p e m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> MonadLoggerIO (EventFoldT o p e m)
forall {o} {p} {e} {m :: * -> *}.
MonadLoggerIO m =>
MonadIO (EventFoldT o p e m)
forall {o} {p} {e} {m :: * -> *}.
MonadLoggerIO m =>
MonadLogger (EventFoldT o p e m)
forall o p e (m :: * -> *).
MonadLoggerIO m =>
EventFoldT
  o p e m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *).
MonadLogger m
-> MonadIO m
-> m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> MonadLoggerIO m
askLoggerIO :: EventFoldT
  o p e m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
$caskLoggerIO :: forall o p e (m :: * -> *).
MonadLoggerIO m =>
EventFoldT
  o p e m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLoggerIO
    , Monad (EventFoldT o p e m)
Monad (EventFoldT o p e m)
-> (forall e a. Exception e => e -> EventFoldT o p e m a)
-> MonadThrow (EventFoldT o p e m)
forall e a. Exception e => e -> EventFoldT o p e m a
forall {o} {p} {e} {m :: * -> *}.
MonadThrow m =>
Monad (EventFoldT o p e m)
forall o p e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> EventFoldT o p e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> EventFoldT o p e m a
$cthrowM :: forall o p e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> EventFoldT o p e m a
MonadThrow
    )
instance MonadTrans (EventFoldT o p e) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> EventFoldT o p e m a
lift = StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
forall o p e (m :: * -> *) a.
StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
EventFoldT (StateT (UpdateResult o p e) (ReaderT p m) a
 -> EventFoldT o p e m a)
-> (m a -> StateT (UpdateResult o p e) (ReaderT p m) a)
-> m a
-> EventFoldT o p e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT p m a -> StateT (UpdateResult o p e) (ReaderT p m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT p m a -> StateT (UpdateResult o p e) (ReaderT p m) a)
-> (m a -> ReaderT p m a)
-> m a
-> StateT (UpdateResult o p e) (ReaderT p m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT p m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Monad m) => MonadInspectEF o p e (EventFoldT o p e m) where
  efAsks :: forall a. (EventFold o p e -> a) -> EventFoldT o p e m a
efAsks EventFold o p e -> a
f = StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
forall o p e (m :: * -> *) a.
StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
EventFoldT (StateT (UpdateResult o p e) (ReaderT p m) a
 -> EventFoldT o p e m a)
-> StateT (UpdateResult o p e) (ReaderT p m) a
-> EventFoldT o p e m a
forall a b. (a -> b) -> a -> b
$ (UpdateResult o p e -> a)
-> StateT (UpdateResult o p e) (ReaderT p m) a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EventFold o p e -> a
f (EventFold o p e -> a)
-> (UpdateResult o p e -> EventFold o p e)
-> UpdateResult o p e
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdateResult o p e -> EventFold o p e
forall o p e. UpdateResult o p e -> EventFold o p e
urEventFold)
  efAsk :: EventFoldT o p e m (EventFold o p e)
efAsk = StateT (UpdateResult o p e) (ReaderT p m) (EventFold o p e)
-> EventFoldT o p e m (EventFold o p e)
forall o p e (m :: * -> *) a.
StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
EventFoldT (StateT (UpdateResult o p e) (ReaderT p m) (EventFold o p e)
 -> EventFoldT o p e m (EventFold o p e))
-> StateT (UpdateResult o p e) (ReaderT p m) (EventFold o p e)
-> EventFoldT o p e m (EventFold o p e)
forall a b. (a -> b) -> a -> b
$ (UpdateResult o p e -> EventFold o p e)
-> StateT (UpdateResult o p e) (ReaderT p m) (EventFold o p e)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets UpdateResult o p e -> EventFold o p e
forall o p e. UpdateResult o p e -> EventFold o p e
urEventFold

instance
    ( Eq (Output e)
    , Eq e
    , Eq o
    , Event p e
    , Monad m
    , Ord p
    )
  =>
    MonadUpdateEF o p e (EventFoldT o p e m)
  where
    event :: e -> EventFoldT o p e m (Output e, EventId p)
event e
e =
      (EventFold o p e
 -> p -> ((Output e, EventId p), UpdateResult o p e))
-> EventFoldT o p e m (Output e, EventId p)
forall o p e (m :: * -> *) a.
(Monad m, Ord p) =>
(EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF
        (\EventFold o p e
ef p
self ->
          let (Output e
o, EventId p
eid, UpdateResult o p e
ur) = p
-> e
-> EventFold o p e
-> (Output e, EventId p, UpdateResult o p e)
forall o p e.
(Event p e, Ord p) =>
p
-> e
-> EventFold o p e
-> (Output e, EventId p, UpdateResult o p e)
EF.event p
self e
e EventFold o p e
ef
          in ((Output e
o, EventId p
eid), UpdateResult o p e
ur)
        )

    fullMerge :: EventFold o p e
-> EventFoldT o p e m (Either (MergeError o p e) ())
fullMerge EventFold o p e
other =
      (EventFold o p e
 -> p -> (Either (MergeError o p e) (), UpdateResult o p e))
-> EventFoldT o p e m (Either (MergeError o p e) ())
forall o p e (m :: * -> *) a.
(Monad m, Ord p) =>
(EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF
        (\EventFold o p e
ef p
self ->
          case p
-> EventFold o p e
-> EventFold o p e
-> Either (MergeError o p e) (UpdateResult o p e)
forall e o p.
(Eq (Output e), Eq e, Eq o, Event p e, Ord p) =>
p
-> EventFold o p e
-> EventFold o p e
-> Either (MergeError o p e) (UpdateResult o p e)
EF.fullMerge p
self EventFold o p e
ef EventFold o p e
other of
            Left MergeError o p e
err -> (MergeError o p e -> Either (MergeError o p e) ()
forall a b. a -> Either a b
Left MergeError o p e
err, EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult EventFold o p e
ef Map (EventId p) (Output e)
forall a. Monoid a => a
mempty Bool
False)
            Right UpdateResult o p e
ur -> (() -> Either (MergeError o p e) ()
forall a b. b -> Either a b
Right (), UpdateResult o p e
ur)
        )

    diffMerge :: Diff o p e -> EventFoldT o p e m (Either (MergeError o p e) ())
diffMerge Diff o p e
diff =
      (EventFold o p e
 -> p -> (Either (MergeError o p e) (), UpdateResult o p e))
-> EventFoldT o p e m (Either (MergeError o p e) ())
forall o p e (m :: * -> *) a.
(Monad m, Ord p) =>
(EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF
        (\EventFold o p e
ef p
self ->
          case p
-> EventFold o p e
-> Diff o p e
-> Either (MergeError o p e) (UpdateResult o p e)
forall e o p.
(Eq (Output e), Eq e, Eq o, Event p e, Ord p) =>
p
-> EventFold o p e
-> Diff o p e
-> Either (MergeError o p e) (UpdateResult o p e)
EF.diffMerge p
self EventFold o p e
ef Diff o p e
diff of
            Left MergeError o p e
err -> (MergeError o p e -> Either (MergeError o p e) ()
forall a b. a -> Either a b
Left MergeError o p e
err, EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult EventFold o p e
ef Map (EventId p) (Output e)
forall a. Monoid a => a
mempty Bool
False)
            Right UpdateResult o p e
ur -> (() -> Either (MergeError o p e) ()
forall a b. b -> Either a b
Right (), UpdateResult o p e
ur)
        )

    participate :: p -> EventFoldT o p e m (EventId p)
participate p
participant =
      (EventFold o p e -> p -> (EventId p, UpdateResult o p e))
-> EventFoldT o p e m (EventId p)
forall o p e (m :: * -> *) a.
(Monad m, Ord p) =>
(EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF (\EventFold o p e
ef p
self -> p -> p -> EventFold o p e -> (EventId p, UpdateResult o p e)
forall o p e.
(Ord p, Event p e) =>
p -> p -> EventFold o p e -> (EventId p, UpdateResult o p e)
EF.participate p
self p
participant EventFold o p e
ef)

    disassociate :: p -> EventFoldT o p e m (EventId p)
disassociate p
participant =
      (EventFold o p e -> p -> (EventId p, UpdateResult o p e))
-> EventFoldT o p e m (EventId p)
forall o p e (m :: * -> *) a.
(Monad m, Ord p) =>
(EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF (\EventFold o p e
ef p
_self -> p -> EventFold o p e -> (EventId p, UpdateResult o p e)
forall o p e.
(Event p e, Ord p) =>
p -> EventFold o p e -> (EventId p, UpdateResult o p e)
EF.disassociate p
participant EventFold o p e
ef)

    getResult :: EventFoldT o p e m (UpdateResult o p e)
getResult = StateT (UpdateResult o p e) (ReaderT p m) (UpdateResult o p e)
-> EventFoldT o p e m (UpdateResult o p e)
forall o p e (m :: * -> *) a.
StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
EventFoldT StateT (UpdateResult o p e) (ReaderT p m) (UpdateResult o p e)
forall s (m :: * -> *). MonadState s m => m s
get


{- |
  EventFoldT helper to make sure we always do the right thing when
  updating an event.
-}
withEF
  :: forall o p e m a. (Monad m, Ord p)
  => (EventFold o p e -> p -> (a, UpdateResult o p e))
  -> EventFoldT o p e m a
withEF :: forall o p e (m :: * -> *) a.
(Monad m, Ord p) =>
(EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF EventFold o p e -> p -> (a, UpdateResult o p e)
f = StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
forall o p e (m :: * -> *) a.
StateT (UpdateResult o p e) (ReaderT p m) a -> EventFoldT o p e m a
EventFoldT (StateT (UpdateResult o p e) (ReaderT p m) a
 -> EventFoldT o p e m a)
-> StateT (UpdateResult o p e) (ReaderT p m) a
-> EventFoldT o p e m a
forall a b. (a -> b) -> a -> b
$
    (UpdateResult o p e -> (a, UpdateResult o p e))
-> StateT (UpdateResult o p e) (ReaderT p m) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((UpdateResult o p e -> (a, UpdateResult o p e))
 -> StateT (UpdateResult o p e) (ReaderT p m) a)
-> (p -> UpdateResult o p e -> (a, UpdateResult o p e))
-> p
-> StateT (UpdateResult o p e) (ReaderT p m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> UpdateResult o p e -> (a, UpdateResult o p e)
updateState (p -> StateT (UpdateResult o p e) (ReaderT p m) a)
-> StateT (UpdateResult o p e) (ReaderT p m) p
-> StateT (UpdateResult o p e) (ReaderT p m) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT (UpdateResult o p e) (ReaderT p m) p
forall r (m :: * -> *). MonadReader r m => m r
ask
  where
    updateState :: p -> UpdateResult o p e -> (a, UpdateResult o p e)
    updateState :: p -> UpdateResult o p e -> (a, UpdateResult o p e)
updateState p
self (UpdateResult EventFold o p e
ef Map (EventId p) (Output e)
outputs Bool
prop) =
      let
        (a
a, UpdateResult EventFold o p e
ef2 Map (EventId p) (Output e)
outputs2 Bool
prop2) =
          EventFold o p e -> p -> (a, UpdateResult o p e)
f EventFold o p e
ef p
self
        results :: UpdateResult o p e
        results :: UpdateResult o p e
results = EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult EventFold o p e
ef2 (Map (EventId p) (Output e)
outputs Map (EventId p) (Output e)
-> Map (EventId p) (Output e) -> Map (EventId p) (Output e)
forall a. Semigroup a => a -> a -> a
<> Map (EventId p) (Output e)
outputs2) (Bool
prop Bool -> Bool -> Bool
|| Bool
prop2)
      in
        (a
a, UpdateResult o p e
results)

runEventFoldT
  :: (Ord p)
  => p {- ^ The local participant. -}
  -> EventFold o p e {- ^ Initial event fold value.  -}
  -> EventFoldT o p e m a {- ^ The action to run.  -}
  -> m (a, UpdateResult o p e)
     {- ^
       Returns the result of the action, plus all the accumulated
       'UpdateResult's, which contain the new 'EventFold' value, all
       of the consistent outputs, and a flag indicating whether the new
       'EventFold' value should be propagated to the other participants.
     -}
runEventFoldT :: forall p o e (m :: * -> *) a.
Ord p =>
p
-> EventFold o p e
-> EventFoldT o p e m a
-> m (a, UpdateResult o p e)
runEventFoldT p
self EventFold o p e
ef =
  (ReaderT p m (a, UpdateResult o p e)
 -> p -> m (a, UpdateResult o p e))
-> p
-> ReaderT p m (a, UpdateResult o p e)
-> m (a, UpdateResult o p e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT p m (a, UpdateResult o p e)
-> p -> m (a, UpdateResult o p e)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT p
self
  (ReaderT p m (a, UpdateResult o p e) -> m (a, UpdateResult o p e))
-> (EventFoldT o p e m a -> ReaderT p m (a, UpdateResult o p e))
-> EventFoldT o p e m a
-> m (a, UpdateResult o p e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (UpdateResult o p e) (ReaderT p m) a
 -> UpdateResult o p e -> ReaderT p m (a, UpdateResult o p e))
-> UpdateResult o p e
-> StateT (UpdateResult o p e) (ReaderT p m) a
-> ReaderT p m (a, UpdateResult o p e)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (UpdateResult o p e) (ReaderT p m) a
-> UpdateResult o p e -> ReaderT p m (a, UpdateResult o p e)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult EventFold o p e
ef Map (EventId p) (Output e)
forall a. Monoid a => a
mempty Bool
False)
  (StateT (UpdateResult o p e) (ReaderT p m) a
 -> ReaderT p m (a, UpdateResult o p e))
-> (EventFoldT o p e m a
    -> StateT (UpdateResult o p e) (ReaderT p m) a)
-> EventFoldT o p e m a
-> ReaderT p m (a, UpdateResult o p e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFoldT o p e m a -> StateT (UpdateResult o p e) (ReaderT p m) a
forall o p e (m :: * -> *) a.
EventFoldT o p e m a -> StateT (UpdateResult o p e) (ReaderT p m) a
unEventFoldT