{-# 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.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 f :: 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 {
    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)
a -> EventFoldT o p e m a
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)
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m b
EventFoldT o p e m a
-> EventFoldT o p e m b -> EventFoldT o p e m a
EventFoldT o p e m (a -> b)
-> EventFoldT o p e m a -> EventFoldT o p e m b
(a -> b -> c)
-> EventFoldT o p e m a
-> EventFoldT o p e m b
-> EventFoldT o p e m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> EventFoldT o p e m a
$cpure :: forall o p e (m :: * -> *) a. Monad m => a -> EventFoldT o p e m a
$cp1Applicative :: forall o p e (m :: * -> *). Monad m => Functor (EventFoldT o p e m)
Applicative
    , a -> EventFoldT o p e m b -> EventFoldT o p e m a
(a -> b) -> EventFoldT o p e m a -> EventFoldT o p e m b
(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
<$ :: 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 :: (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)
a -> EventFoldT o p e m a
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)
EventFoldT o p e m a
-> (a -> EventFoldT o p e m b) -> EventFoldT o p e m 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
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 :: a -> EventFoldT o p e m a
$creturn :: forall o p e (m :: * -> *) a. Monad m => a -> EventFoldT o p e m a
>> :: 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
>>= :: 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
$cp1Monad :: forall o p e (m :: * -> *).
Monad m =>
Applicative (EventFoldT o p e m)
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)
IO a -> EventFoldT o p e m a
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 :: 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
$cp1MonadIO :: forall o p e (m :: * -> *). MonadIO m => Monad (EventFoldT o p e m)
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)
Loc -> LogSource -> LogLevel -> msg -> 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 :: 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 ()
$cp1MonadLogger :: forall o p e (m :: * -> *).
MonadLogger m =>
Monad (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 ())
$cp2MonadLoggerIO :: forall o p e (m :: * -> *).
MonadLoggerIO m =>
MonadIO (EventFoldT o p e m)
$cp1MonadLoggerIO :: forall o p e (m :: * -> *).
MonadLoggerIO m =>
MonadLogger (EventFoldT o p e m)
MonadLoggerIO
    )
instance MonadTrans (EventFoldT o p e) where
  lift :: 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 :: (EventFold o p e -> a) -> EventFoldT o p e m a
efAsks f :: 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 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
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
        (\ef :: EventFold o p e
ef self :: p
self ->
          let (o :: Output e
o, eid :: EventId p
eid, ur :: UpdateResult o p e
ur) = p
-> e
-> EventFold o p e
-> (Output e, EventId p, UpdateResult o p e)
forall p e o.
(Ord p, Event e) =>
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 other :: 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
        (\ef :: EventFold o p e
ef self :: 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 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 err :: 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 ur :: 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 :: 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
        (\ef :: EventFold o p e
ef self :: 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 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 err :: 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 ur :: 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 participant :: 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 (\ef :: EventFold o p e
ef self :: p
self -> p -> p -> EventFold o p e -> (EventId p, UpdateResult o p e)
forall o p e.
(Ord p, Event 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 participant :: 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 (\ef :: EventFold o p e
ef _self :: p
_self -> p -> EventFold o p e -> (EventId p, UpdateResult o p e)
forall o p e.
(Event 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 :: (EventFold o p e -> p -> (a, UpdateResult o p e))
-> EventFoldT o p e m a
withEF f :: 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 self :: p
self (UpdateResult ef :: EventFold o p e
ef outputs :: Map (EventId p) (Output e)
outputs prop :: Bool
prop) =
      let
        (a :: a
a, UpdateResult ef2 :: EventFold o p e
ef2 outputs2 :: Map (EventId p) (Output e)
outputs2 prop2 :: 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 :: p
-> EventFold o p e
-> EventFoldT o p e m a
-> m (a, UpdateResult o p e)
runEventFoldT self :: p
self ef :: EventFold o p e
ef = do
  (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