{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wmissing-import-lists #-}
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, 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)
class MonadUpdateEF o p e m | m -> o p e where
event :: e -> m (Output e, EventId p)
fullMerge
:: EventFold o p e
-> m (Either (MergeError o p e) ())
diffMerge
:: Diff o p e
-> m (Either (MergeError o p e) ())
participate :: p -> m (EventId p)
disassociate :: p -> m (EventId p)
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
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)
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
-> EventFold o p e
-> EventFoldT o p e m a
-> m (a, UpdateResult o p e)
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 action :: EventFoldT o p e m a
action = 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
(EventFoldT o p e m a -> m (a, UpdateResult o p e))
-> EventFoldT o p e m a -> m (a, UpdateResult o p e)
forall a b. (a -> b) -> a -> b
$ EventFoldT o p e m a
action