{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}
module Data.CRDT.EventFold (
new,
event,
fullMerge,
UpdateResult(..),
events,
diffMerge,
MergeError(..),
participate,
disassociate,
Event(..),
EventResult(..),
isBlockedOnError,
projectedValue,
infimumValue,
infimumId,
infimumParticipants,
allParticipants,
projParticipants,
origin,
divergent,
EventFold,
EventId,
Diff,
) where
import Data.Bifunctor (first)
import Data.Binary (Binary(get, put))
import Data.Default.Class (Default(def))
import Data.DoubleWord (Word128(Word128), Word256(Word256))
import Data.Functor.Identity (Identity(Identity), runIdentity)
import Data.Map (Map, keys, toAscList, toDescList, unionWith)
import Data.Maybe (catMaybes)
import Data.Set ((\\), Set, member, union)
import Data.Word (Word64)
import GHC.Generics (Generic)
import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as Map.Merge
import qualified Data.Set as Set
data EventFoldF o p e f = EventFoldF {
EventFoldF o p e f -> o
psOrigin :: o,
EventFoldF o p e f -> Infimum (State e) p
psInfimum :: Infimum (State e) p,
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents :: Map (EventId p) (f (Delta p e), Set p)
} deriving stock ((forall x. EventFoldF o p e f -> Rep (EventFoldF o p e f) x)
-> (forall x. Rep (EventFoldF o p e f) x -> EventFoldF o p e f)
-> Generic (EventFoldF o p e f)
forall x. Rep (EventFoldF o p e f) x -> EventFoldF o p e f
forall x. EventFoldF o p e f -> Rep (EventFoldF o p e f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall o p e (f :: * -> *) x.
Rep (EventFoldF o p e f) x -> EventFoldF o p e f
forall o p e (f :: * -> *) x.
EventFoldF o p e f -> Rep (EventFoldF o p e f) x
$cto :: forall o p e (f :: * -> *) x.
Rep (EventFoldF o p e f) x -> EventFoldF o p e f
$cfrom :: forall o p e (f :: * -> *) x.
EventFoldF o p e f -> Rep (EventFoldF o p e f) x
Generic)
deriving stock instance
( Eq (f (Delta p e))
, Eq (Output e)
, Eq o
, Eq p
, Eq e
)
=>
Eq (EventFoldF o p e f)
instance
(
Binary (f (Delta p e)),
Binary o,
Binary p,
Binary e,
Binary (State e),
Binary (Output e)
)
=>
Binary (EventFoldF o p e f)
deriving stock instance
( Show (f (Delta p e))
, Show o
, Show p
, Show (State e)
)
=> Show (EventFoldF o p e f)
newtype EventFold o p e = EventFold { EventFold o p e -> EventFoldF o p e Identity
unEventFold :: EventFoldF o p e Identity}
deriving stock instance
(Show o, Show p, Show e, Show (Output e), Show (State e))
=>
Show (EventFold o p e)
deriving newtype instance
(Binary o, Binary p, Binary e, Binary (Output e), Binary (State e))
=>
Binary (EventFold o p e)
deriving newtype instance
(Eq o, Eq p, Eq e, Eq (Output e))
=>
Eq (EventFold o p e)
data Infimum s p = Infimum {
Infimum s p -> EventId p
eventId :: EventId p,
Infimum s p -> Set p
participants :: Set p,
Infimum s p -> s
stateValue :: s
} deriving stock ((forall x. Infimum s p -> Rep (Infimum s p) x)
-> (forall x. Rep (Infimum s p) x -> Infimum s p)
-> Generic (Infimum s p)
forall x. Rep (Infimum s p) x -> Infimum s p
forall x. Infimum s p -> Rep (Infimum s p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s p x. Rep (Infimum s p) x -> Infimum s p
forall s p x. Infimum s p -> Rep (Infimum s p) x
$cto :: forall s p x. Rep (Infimum s p) x -> Infimum s p
$cfrom :: forall s p x. Infimum s p -> Rep (Infimum s p) x
Generic, Int -> Infimum s p -> ShowS
[Infimum s p] -> ShowS
Infimum s p -> String
(Int -> Infimum s p -> ShowS)
-> (Infimum s p -> String)
-> ([Infimum s p] -> ShowS)
-> Show (Infimum s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s p. (Show p, Show s) => Int -> Infimum s p -> ShowS
forall s p. (Show p, Show s) => [Infimum s p] -> ShowS
forall s p. (Show p, Show s) => Infimum s p -> String
showList :: [Infimum s p] -> ShowS
$cshowList :: forall s p. (Show p, Show s) => [Infimum s p] -> ShowS
show :: Infimum s p -> String
$cshow :: forall s p. (Show p, Show s) => Infimum s p -> String
showsPrec :: Int -> Infimum s p -> ShowS
$cshowsPrec :: forall s p. (Show p, Show s) => Int -> Infimum s p -> ShowS
Show)
instance (Binary s, Binary p) => Binary (Infimum s p)
instance (Eq p) => Eq (Infimum s p) where
Infimum s1 :: EventId p
s1 _ _ == :: Infimum s p -> Infimum s p -> Bool
== Infimum s2 :: EventId p
s2 _ _ = EventId p
s1 EventId p -> EventId p -> Bool
forall a. Eq a => a -> a -> Bool
== EventId p
s2
instance (Ord p) => Ord (Infimum s p) where
compare :: Infimum s p -> Infimum s p -> Ordering
compare (Infimum s1 :: EventId p
s1 _ _) (Infimum s2 :: EventId p
s2 _ _) = EventId p -> EventId p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare EventId p
s1 EventId p
s2
data EventId p
= BottomEid
| Eid Word256 p
deriving stock ((forall x. EventId p -> Rep (EventId p) x)
-> (forall x. Rep (EventId p) x -> EventId p)
-> Generic (EventId p)
forall x. Rep (EventId p) x -> EventId p
forall x. EventId p -> Rep (EventId p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (EventId p) x -> EventId p
forall p x. EventId p -> Rep (EventId p) x
$cto :: forall p x. Rep (EventId p) x -> EventId p
$cfrom :: forall p x. EventId p -> Rep (EventId p) x
Generic, EventId p -> EventId p -> Bool
(EventId p -> EventId p -> Bool)
-> (EventId p -> EventId p -> Bool) -> Eq (EventId p)
forall p. Eq p => EventId p -> EventId p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventId p -> EventId p -> Bool
$c/= :: forall p. Eq p => EventId p -> EventId p -> Bool
== :: EventId p -> EventId p -> Bool
$c== :: forall p. Eq p => EventId p -> EventId p -> Bool
Eq, Eq (EventId p)
Eq (EventId p) =>
(EventId p -> EventId p -> Ordering)
-> (EventId p -> EventId p -> Bool)
-> (EventId p -> EventId p -> Bool)
-> (EventId p -> EventId p -> Bool)
-> (EventId p -> EventId p -> Bool)
-> (EventId p -> EventId p -> EventId p)
-> (EventId p -> EventId p -> EventId p)
-> Ord (EventId p)
EventId p -> EventId p -> Bool
EventId p -> EventId p -> Ordering
EventId p -> EventId p -> EventId p
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall p. Ord p => Eq (EventId p)
forall p. Ord p => EventId p -> EventId p -> Bool
forall p. Ord p => EventId p -> EventId p -> Ordering
forall p. Ord p => EventId p -> EventId p -> EventId p
min :: EventId p -> EventId p -> EventId p
$cmin :: forall p. Ord p => EventId p -> EventId p -> EventId p
max :: EventId p -> EventId p -> EventId p
$cmax :: forall p. Ord p => EventId p -> EventId p -> EventId p
>= :: EventId p -> EventId p -> Bool
$c>= :: forall p. Ord p => EventId p -> EventId p -> Bool
> :: EventId p -> EventId p -> Bool
$c> :: forall p. Ord p => EventId p -> EventId p -> Bool
<= :: EventId p -> EventId p -> Bool
$c<= :: forall p. Ord p => EventId p -> EventId p -> Bool
< :: EventId p -> EventId p -> Bool
$c< :: forall p. Ord p => EventId p -> EventId p -> Bool
compare :: EventId p -> EventId p -> Ordering
$ccompare :: forall p. Ord p => EventId p -> EventId p -> Ordering
$cp1Ord :: forall p. Ord p => Eq (EventId p)
Ord, Int -> EventId p -> ShowS
[EventId p] -> ShowS
EventId p -> String
(Int -> EventId p -> ShowS)
-> (EventId p -> String)
-> ([EventId p] -> ShowS)
-> Show (EventId p)
forall p. Show p => Int -> EventId p -> ShowS
forall p. Show p => [EventId p] -> ShowS
forall p. Show p => EventId p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventId p] -> ShowS
$cshowList :: forall p. Show p => [EventId p] -> ShowS
show :: EventId p -> String
$cshow :: forall p. Show p => EventId p -> String
showsPrec :: Int -> EventId p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> EventId p -> ShowS
Show)
instance (Binary p) => Binary (EventId p) where
put :: EventId p -> Put
put = Maybe (Word64, Word64, Word64, Word64, p) -> Put
forall t. Binary t => t -> Put
put (Maybe (Word64, Word64, Word64, Word64, p) -> Put)
-> (EventId p -> Maybe (Word64, Word64, Word64, Word64, p))
-> EventId p
-> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId p -> Maybe (Word64, Word64, Word64, Word64, p)
toMaybe
where
toMaybe :: EventId p -> Maybe (Word64, Word64, Word64, Word64, p)
toMaybe :: EventId p -> Maybe (Word64, Word64, Word64, Word64, p)
toMaybe BottomEid =
Maybe (Word64, Word64, Word64, Word64, p)
forall a. Maybe a
Nothing
toMaybe (Eid (Word256 (Word128 a :: Word64
a b :: Word64
b) (Word128 c :: Word64
c d :: Word64
d)) p :: p
p) =
(Word64, Word64, Word64, Word64, p)
-> Maybe (Word64, Word64, Word64, Word64, p)
forall a. a -> Maybe a
Just (Word64
a, Word64
b, Word64
c, Word64
d, p
p)
get :: Get (EventId p)
get = do
Maybe (Word64, Word64, Word64, Word64, p)
theThing <- Get (Maybe (Word64, Word64, Word64, Word64, p))
forall t. Binary t => Get t
get
EventId p -> Get (EventId p)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventId p -> Get (EventId p)) -> EventId p -> Get (EventId p)
forall a b. (a -> b) -> a -> b
$ case Maybe (Word64, Word64, Word64, Word64, p)
theThing of
Nothing -> EventId p
forall p. EventId p
BottomEid
Just (a :: Word64
a, b :: Word64
b, c :: Word64
c, d :: Word64
d, p :: p
p) -> Word256 -> p -> EventId p
forall p. Word256 -> p -> EventId p
Eid (Word128 -> Word128 -> Word256
Word256 (Word64 -> Word64 -> Word128
Word128 Word64
a Word64
b) (Word64 -> Word64 -> Word128
Word128 Word64
c Word64
d)) p
p
instance Default (EventId p) where
def :: EventId p
def = EventId p
forall p. EventId p
BottomEid
data MergeError o p e
= DifferentOrigins o o
| DiffTooNew (EventFold o p e) (Diff o p e)
| DiffTooSparse (EventFold o p e) (Diff o p e)
deriving stock instance
( Show (Output e)
, Show o
, Show p
, Show e
, Show (State e)
)
=>
Show (MergeError o p e)
data Delta p e
= Join p
| UnJoin p
| Event e
| Error (Output e) (Set p)
deriving stock ((forall x. Delta p e -> Rep (Delta p e) x)
-> (forall x. Rep (Delta p e) x -> Delta p e)
-> Generic (Delta p e)
forall x. Rep (Delta p e) x -> Delta p e
forall x. Delta p e -> Rep (Delta p e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p e x. Rep (Delta p e) x -> Delta p e
forall p e x. Delta p e -> Rep (Delta p e) x
$cto :: forall p e x. Rep (Delta p e) x -> Delta p e
$cfrom :: forall p e x. Delta p e -> Rep (Delta p e) x
Generic)
deriving stock instance (Eq p, Eq e, Eq (Output e)) => Eq (Delta p e)
deriving stock instance (Show p, Show e, Show (Output e)) => Show (Delta p e)
instance (Binary p, Binary e, Binary (Output e)) => Binary (Delta p e)
class Event e where
type Output e
type State e
apply :: e -> State e -> EventResult e
instance Event () where
type Output () = ()
type State () = ()
apply :: () -> State () -> EventResult ()
apply () () = Output () -> State () -> EventResult ()
forall e. Output e -> State e -> EventResult e
Pure () ()
instance (Event a, Event b) => Event (Either a b) where
type Output (Either a b) = Either (Output a) (Output b)
type State (Either a b) = (State a, State b)
apply :: Either a b -> State (Either a b) -> EventResult (Either a b)
apply (Left e :: a
e) (a, b) =
case a -> State a -> EventResult a
forall e. Event e => e -> State e -> EventResult e
apply a
e State a
a of
SystemError o :: Output a
o -> Output (Either a b) -> EventResult (Either a b)
forall e. Output e -> EventResult e
SystemError (Output a -> Either (Output a) (Output b)
forall a b. a -> Either a b
Left Output a
o)
Pure o :: Output a
o s :: State a
s -> Output (Either a b)
-> State (Either a b) -> EventResult (Either a b)
forall e. Output e -> State e -> EventResult e
Pure (Output a -> Either (Output a) (Output b)
forall a b. a -> Either a b
Left Output a
o) (State a
s, State b
b)
apply (Right e :: b
e) (a, b) =
case b -> State b -> EventResult b
forall e. Event e => e -> State e -> EventResult e
apply b
e State b
b of
SystemError o :: Output b
o -> Output (Either a b) -> EventResult (Either a b)
forall e. Output e -> EventResult e
SystemError (Output b -> Either (Output a) (Output b)
forall a b. b -> Either a b
Right Output b
o)
Pure o :: Output b
o s :: State b
s -> Output (Either a b)
-> State (Either a b) -> EventResult (Either a b)
forall e. Output e -> State e -> EventResult e
Pure (Output b -> Either (Output a) (Output b)
forall a b. b -> Either a b
Right Output b
o) (State a
a, State b
s)
data EventResult e
= SystemError (Output e)
| Pure (Output e) (State e)
new
:: (Default (State e), Ord p)
=> o
-> p
-> EventFold o p e
new :: o -> p -> EventFold o p e
new o :: o
o participant :: p
participant =
EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold
EventFoldF :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFoldF {
psOrigin :: o
psOrigin = o
o,
psInfimum :: Infimum (State e) p
psInfimum = Infimum :: forall s p. EventId p -> Set p -> s -> Infimum s p
Infimum {
eventId :: EventId p
eventId = EventId p
forall a. Default a => a
def,
participants :: Set p
participants = p -> Set p
forall a. a -> Set a
Set.singleton p
participant,
stateValue :: State e
stateValue = State e
forall a. Default a => a
def
},
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents = Map (EventId p) (Identity (Delta p e), Set p)
forall a. Monoid a => a
mempty
}
events :: (Ord p) => p -> EventFold o p e -> Diff o p e
events :: p -> EventFold o p e -> Diff o p e
events peer :: p
peer (EventFold ef :: EventFoldF o p e Identity
ef) =
Diff :: forall o p e.
Map (EventId p) (Maybe (Delta p e), Set p)
-> o -> EventId p -> Diff o p e
Diff {
diffEvents :: Map (EventId p) (Maybe (Delta p e), Set p)
diffEvents = (Identity (Delta p e), Set p) -> (Maybe (Delta p e), Set p)
omitAcknowledged ((Identity (Delta p e), Set p) -> (Maybe (Delta p e), Set p))
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Maybe (Delta p e), Set p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef,
diffOrigin :: o
diffOrigin = EventFoldF o p e Identity -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin EventFoldF o p e Identity
ef,
diffInfimum :: EventId p
diffInfimum = Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (EventFoldF o p e Identity -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e Identity
ef)
}
where
omitAcknowledged :: (Identity (Delta p e), Set p) -> (Maybe (Delta p e), Set p)
omitAcknowledged (d :: Identity (Delta p e)
d, acks :: Set p
acks) =
(
case (Identity (Delta p e)
d, p
peer p -> Set p -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set p
acks) of
(Identity Error {}, _) -> Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just (Identity (Delta p e) -> Delta p e
forall a. Identity a -> a
runIdentity Identity (Delta p e)
d)
(_, False) -> Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just (Identity (Delta p e) -> Delta p e
forall a. Identity a -> a
runIdentity Identity (Delta p e)
d)
_ -> Maybe (Delta p e)
forall a. Maybe a
Nothing,
Set p
acks
)
data Diff o p e = Diff {
Diff o p e -> Map (EventId p) (Maybe (Delta p e), Set p)
diffEvents :: Map (EventId p) (Maybe (Delta p e), Set p),
Diff o p e -> o
diffOrigin :: o,
Diff o p e -> EventId p
diffInfimum :: EventId p
}
deriving stock ((forall x. Diff o p e -> Rep (Diff o p e) x)
-> (forall x. Rep (Diff o p e) x -> Diff o p e)
-> Generic (Diff o p e)
forall x. Rep (Diff o p e) x -> Diff o p e
forall x. Diff o p e -> Rep (Diff o p e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall o p e x. Rep (Diff o p e) x -> Diff o p e
forall o p e x. Diff o p e -> Rep (Diff o p e) x
$cto :: forall o p e x. Rep (Diff o p e) x -> Diff o p e
$cfrom :: forall o p e x. Diff o p e -> Rep (Diff o p e) x
Generic)
deriving stock instance (
Show o, Show p, Show e, Show (Output e)
) =>
Show (Diff o p e)
instance (
Binary o, Binary p, Binary e, Binary (Output e)
) =>
Binary (Diff o p e)
diffMerge
:: ( 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)
diffMerge :: p
-> EventFold o p e
-> Diff o p e
-> Either (MergeError o p e) (UpdateResult o p e)
diffMerge
_
(EventFold EventFoldF {psOrigin :: forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin = o
o1})
Diff {diffOrigin :: forall o p e. Diff o p e -> o
diffOrigin = o
o2}
| o
o1 o -> o -> Bool
forall a. Eq a => a -> a -> Bool
/= o
o2 =
MergeError o p e -> Either (MergeError o p e) (UpdateResult o p e)
forall a b. a -> Either a b
Left (o -> o -> MergeError o p e
forall o p e. o -> o -> MergeError o p e
DifferentOrigins o
o1 o
o2)
diffMerge _ ef :: EventFold o p e
ef pak :: Diff o p e
pak | Bool
tooNew =
MergeError o p e -> Either (MergeError o p e) (UpdateResult o p e)
forall a b. a -> Either a b
Left (EventFold o p e -> Diff o p e -> MergeError o p e
forall o p e. EventFold o p e -> Diff o p e -> MergeError o p e
DiffTooNew EventFold o p e
ef Diff o p e
pak)
where
maxState :: EventId p
maxState =
Set (EventId p) -> EventId p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
(Set (EventId p) -> EventId p)
-> (EventFold o p e -> Set (EventId p))
-> EventFold o p e
-> EventId p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventId p -> Set (EventId p) -> Set (EventId p)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (Infimum (State e) p -> EventId p)
-> (EventFold o p e -> Infimum (State e) p)
-> EventFold o p e
-> EventId p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFoldF o p e Identity -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum (EventFoldF o p e Identity -> Infimum (State e) p)
-> (EventFold o p e -> EventFoldF o p e Identity)
-> EventFold o p e
-> Infimum (State e) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold (EventFold o p e -> EventId p) -> EventFold o p e -> EventId p
forall a b. (a -> b) -> a -> b
$ EventFold o p e
ef)
(Set (EventId p) -> Set (EventId p))
-> (EventFold o p e -> Set (EventId p))
-> EventFold o p e
-> Set (EventId p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (EventId p) (Identity (Delta p e), Set p) -> Set (EventId p)
forall k a. Map k a -> Set k
Map.keysSet
(Map (EventId p) (Identity (Delta p e), Set p) -> Set (EventId p))
-> (EventFold o p e
-> Map (EventId p) (Identity (Delta p e), Set p))
-> EventFold o p e
-> Set (EventId p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents
(EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p))
-> (EventFold o p e -> EventFoldF o p e Identity)
-> EventFold o p e
-> Map (EventId p) (Identity (Delta p e), Set p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold
(EventFold o p e -> EventId p) -> EventFold o p e -> EventId p
forall a b. (a -> b) -> a -> b
$ EventFold o p e
ef
tooNew :: Bool
tooNew :: Bool
tooNew = EventId p
maxState EventId p -> EventId p -> Bool
forall a. Ord a => a -> a -> Bool
< Diff o p e -> EventId p
forall o p e. Diff o p e -> EventId p
diffInfimum Diff o p e
pak
diffMerge
participant :: p
participant
orig :: EventFold o p e
orig@(EventFold (EventFoldF o :: o
o infimum :: Infimum (State e) p
infimum d1 :: Map (EventId p) (Identity (Delta p e), Set p)
d1))
ep :: Diff o p e
ep@(Diff d2 :: Map (EventId p) (Maybe (Delta p e), Set p)
d2 _ i2 :: EventId p
i2)
=
case
EventId p
-> EventFoldF o p e Maybe
-> Maybe (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce
EventId p
i2
EventFoldF :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFoldF {
psOrigin :: o
psOrigin = o
o,
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum,
psEvents :: Map (EventId p) (Maybe (Delta p e), Set p)
psEvents =
SimpleWhenMissing
(EventId p) (Delta p e, Set p) (Maybe (Delta p e), Set p)
-> SimpleWhenMissing
(EventId p) (Maybe (Delta p e), Set p) (Maybe (Delta p e), Set p)
-> SimpleWhenMatched
(EventId p)
(Delta p e, Set p)
(Maybe (Delta p e), Set p)
(Maybe (Delta p e), Set p)
-> Map (EventId p) (Delta p e, Set p)
-> Map (EventId p) (Maybe (Delta p e), Set p)
-> Map (EventId p) (Maybe (Delta p e), Set p)
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.Merge.merge
((EventId p -> (Delta p e, Set p) -> (Maybe (Delta p e), Set p))
-> SimpleWhenMissing
(EventId p) (Delta p e, Set p) (Maybe (Delta p e), Set p)
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.Merge.mapMissing (((Delta p e, Set p) -> (Maybe (Delta p e), Set p))
-> EventId p -> (Delta p e, Set p) -> (Maybe (Delta p e), Set p)
forall a b. a -> b -> a
const ((Delta p e -> Maybe (Delta p e))
-> (Delta p e, Set p) -> (Maybe (Delta p e), Set p)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just)))
SimpleWhenMissing
(EventId p) (Maybe (Delta p e), Set p) (Maybe (Delta p e), Set p)
forall (f :: * -> *) k x. Applicative f => WhenMissing f k x x
Map.Merge.preserveMissing
((EventId p
-> (Delta p e, Set p)
-> (Maybe (Delta p e), Set p)
-> (Maybe (Delta p e), Set p))
-> SimpleWhenMatched
(EventId p)
(Delta p e, Set p)
(Maybe (Delta p e), Set p)
(Maybe (Delta p e), Set p)
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.Merge.zipWithMatched (((Delta p e, Set p)
-> (Maybe (Delta p e), Set p) -> (Maybe (Delta p e), Set p))
-> EventId p
-> (Delta p e, Set p)
-> (Maybe (Delta p e), Set p)
-> (Maybe (Delta p e), Set p)
forall a b. a -> b -> a
const (Delta p e, Set p)
-> (Maybe (Delta p e), Set p) -> (Maybe (Delta p e), Set p)
forall p e.
Ord p =>
(Delta p e, Set p)
-> (Maybe (Delta p e), Set p) -> (Maybe (Delta p e), Set p)
mergeAcks))
((Identity (Delta p e) -> Delta p e)
-> (Identity (Delta p e), Set p) -> (Delta p e, Set p)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Identity (Delta p e) -> Delta p e
forall a. Identity a -> a
runIdentity ((Identity (Delta p e), Set p) -> (Delta p e, Set p))
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Delta p e, Set p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (EventId p) (Identity (Delta p e), Set p)
d1)
Map (EventId p) (Maybe (Delta p e), Set p)
d2
}
of
Nothing -> MergeError o p e -> Either (MergeError o p e) (UpdateResult o p e)
forall a b. a -> Either a b
Left (EventFold o p e -> Diff o p e -> MergeError o p e
forall o p e. EventFold o p e -> Diff o p e -> MergeError o p e
DiffTooSparse EventFold o p e
orig Diff o p e
ep)
Just (ef1, outputs1) ->
let (ef2 :: EventFoldF o p e Identity
ef2, outputs2 :: Map (EventId p) (Output e)
outputs2) = p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge p
participant EventFoldF o p e Identity
ef1
in
UpdateResult o p e
-> Either (MergeError o p e) (UpdateResult o p e)
forall a b. b -> Either a b
Right (
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
(EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold EventFoldF o p e Identity
ef2)
(Map (EventId p) (Output e)
-> Map (EventId p) (Output e) -> Map (EventId p) (Output e)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (EventId p) (Output e)
outputs1 Map (EventId p) (Output e)
outputs2)
(
EventId p
i2 EventId p -> EventId p -> Bool
forall a. Eq a => a -> a -> Bool
/= Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId Infimum (State e) p
infimum
Bool -> Bool -> Bool
|| Bool -> Bool
not (Map (EventId p) (Maybe (Delta p e), Set p) -> Bool
forall k a. Map k a -> Bool
Map.null Map (EventId p) (Maybe (Delta p e), Set p)
d2)
Bool -> Bool -> Bool
|| EventFoldF o p e Identity
ef2 EventFoldF o p e Identity -> EventFoldF o p e Identity -> Bool
forall a. Eq a => a -> a -> Bool
/= EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold EventFold o p e
orig
)
)
where
mergeAcks :: (Ord p)
=> (Delta p e, Set p)
-> (Maybe (Delta p e), Set p)
-> (Maybe (Delta p e), Set p)
mergeAcks :: (Delta p e, Set p)
-> (Maybe (Delta p e), Set p) -> (Maybe (Delta p e), Set p)
mergeAcks
(Error output :: Output e
output eacks1 :: Set p
eacks1, acks1 :: Set p
acks1)
(Just (Error _ eacks2 :: Set p
eacks2), acks2 :: Set p
acks2)
=
(Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just (Output e -> Set p -> Delta p e
forall p e. Output e -> Set p -> Delta p e
Error Output e
output (Set p
eacks1 Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
`union` Set p
eacks2)), Set p
acks1 Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
`union` Set p
acks2)
mergeAcks
(Error {}, acks1 :: Set p
acks1)
(d :: Maybe (Delta p e)
d, acks2 :: Set p
acks2)
=
(Maybe (Delta p e)
d, Set p
acks1 Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
`union` Set p
acks2)
mergeAcks
(d :: Delta p e
d, acks1 :: Set p
acks1)
(Just _, acks2 :: Set p
acks2)
=
(Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just Delta p e
d, Set p
acks1 Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
`union` Set p
acks2)
mergeAcks
(d :: Delta p e
d, acks1 :: Set p
acks1)
(Nothing, acks2 :: Set p
acks2)
=
(Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just Delta p e
d, Set p
acks1 Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
`union` Set p
acks2)
fullMerge
:: ( 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)
fullMerge :: p
-> EventFold o p e
-> EventFold o p e
-> Either (MergeError o p e) (UpdateResult o p e)
fullMerge participant :: p
participant (EventFold left :: EventFoldF o p e Identity
left) (EventFold right :: EventFoldF o p e Identity
right@(EventFoldF o2 :: o
o2 i2 :: Infimum (State e) p
i2 d2 :: Map (EventId p) (Identity (Delta p e), Set p)
d2)) =
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)
diffMerge
p
participant
(
EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold
EventFoldF o p e Identity
left {
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p -> Infimum (State e) p -> Infimum (State e) p
forall a. Ord a => a -> a -> a
max (EventFoldF o p e Identity -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e Identity
left) Infimum (State e) p
i2
}
)
Diff :: forall o p e.
Map (EventId p) (Maybe (Delta p e), Set p)
-> o -> EventId p -> Diff o p e
Diff {
diffOrigin :: o
diffOrigin = o
o2,
diffEvents :: Map (EventId p) (Maybe (Delta p e), Set p)
diffEvents = (Identity (Delta p e) -> Maybe (Delta p e))
-> (Identity (Delta p e), Set p) -> (Maybe (Delta p e), Set p)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Delta p e -> Maybe (Delta p e)
forall a. a -> Maybe a
Just (Delta p e -> Maybe (Delta p e))
-> (Identity (Delta p e) -> Delta p e)
-> Identity (Delta p e)
-> Maybe (Delta p e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Delta p e) -> Delta p e
forall a. Identity a -> a
runIdentity) ((Identity (Delta p e), Set p) -> (Maybe (Delta p e), Set p))
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Maybe (Delta p e), Set p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (EventId p) (Identity (Delta p e), Set p)
d2,
diffInfimum :: EventId p
diffInfimum = Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId Infimum (State e) p
i2
}
of
Left err :: MergeError o p e
err -> MergeError o p e -> Either (MergeError o p e) (UpdateResult o p e)
forall a b. a -> Either a b
Left MergeError o p e
err
Right (UpdateResult ef :: EventFold o p e
ef outputs :: Map (EventId p) (Output e)
outputs _prop :: Bool
_prop) ->
let (ef2 :: EventFoldF o p e Identity
ef2, outputs2 :: Map (EventId p) (Output e)
outputs2) = p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge p
participant (EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold EventFold o p e
ef)
in
UpdateResult o p e
-> Either (MergeError o p e) (UpdateResult o p e)
forall a b. b -> Either a b
Right (
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
(EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold EventFoldF o p e Identity
ef2)
(Map (EventId p) (Output e)
-> Map (EventId p) (Output e) -> Map (EventId p) (Output e)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (EventId p) (Output e)
outputs Map (EventId p) (Output e)
outputs2)
(EventFoldF o p e Identity
ef2 EventFoldF o p e Identity -> EventFoldF o p e Identity -> Bool
forall a. Eq a => a -> a -> Bool
/= EventFoldF o p e Identity
left Bool -> Bool -> Bool
|| EventFoldF o p e Identity
ef2 EventFoldF o p e Identity -> EventFoldF o p e Identity -> Bool
forall a. Eq a => a -> a -> Bool
/= EventFoldF o p e Identity
right)
)
data UpdateResult o p e =
UpdateResult {
UpdateResult o p e -> EventFold o p e
urEventFold :: EventFold o p e,
UpdateResult o p e -> Map (EventId p) (Output e)
urOutputs :: Map (EventId p) (Output e),
UpdateResult o p e -> Bool
urNeedsPropagation :: Bool
}
acknowledge :: (Event e, Ord p)
=> p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge :: p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge p :: p
p ef :: EventFoldF o p e Identity
ef =
let
(ps2 :: EventFoldF o p e Identity
ps2, outputs :: Map (EventId p) (Output e)
outputs) =
Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall a. Identity a -> a
runIdentity (Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
-> (EventFoldF o p e Identity, Map (EventId p) (Output e)))
-> Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall a b. (a -> b) -> a -> b
$
EventId p
-> EventFoldF o p e Identity
-> Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce
(Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (EventFoldF o p e Identity -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e Identity
ef))
EventFoldF o p e Identity
ef {psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents = ((Identity (Delta p e), Set p) -> (Identity (Delta p e), Set p))
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identity (Delta p e), Set p) -> (Identity (Delta p e), Set p)
ackOne (EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef)}
(ps3 :: EventFoldF o p e Identity
ps3, outputs2 :: Map (EventId p) (Output e)
outputs2) = p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
ackErr p
p EventFoldF o p e Identity
ps2
in
(EventFoldF o p e Identity
ps3, 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)
where
ackOne :: (Identity (Delta p e), Set p) -> (Identity (Delta p e), Set p)
ackOne (e :: Identity (Delta p e)
e, acks :: Set p
acks) = (Identity (Delta p e)
e, p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.insert p
p Set p
acks)
ackErr :: (Event e, Ord p)
=> p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
ackErr :: p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
ackErr p :: p
p ef :: EventFoldF o p e Identity
ef =
Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall a. Identity a -> a
runIdentity (Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
-> (EventFoldF o p e Identity, Map (EventId p) (Output e)))
-> Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall a b. (a -> b) -> a -> b
$
EventId p
-> EventFoldF o p e Identity
-> Identity (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce
(Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (EventFoldF o p e Identity -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e Identity
ef))
EventFoldF o p e Identity
ef {
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents =
case Map (EventId p) (Identity (Delta p e), Set p)
-> Maybe
((EventId p, (Identity (Delta p e), Set p)),
Map (EventId p) (Identity (Delta p e), Set p))
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey (EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef) of
Just ((eid :: EventId p
eid, (Identity (Error o :: Output e
o eacks :: Set p
eacks), acks :: Set p
acks)), deltas :: Map (EventId p) (Identity (Delta p e), Set p)
deltas) ->
EventId p
-> (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
EventId p
eid
(Delta p e -> Identity (Delta p e)
forall a. a -> Identity a
Identity (Output e -> Set p -> Delta p e
forall p e. Output e -> Set p -> Delta p e
Error Output e
o (p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.insert p
p Set p
eacks)), Set p
acks)
Map (EventId p) (Identity (Delta p e), Set p)
deltas
_ -> EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef
}
participate :: forall o p e. (Ord p, Event e)
=> p
-> p
-> EventFold o p e
-> (EventId p, UpdateResult o p e)
participate :: p -> p -> EventFold o p e -> (EventId p, UpdateResult o p e)
participate self :: p
self peer :: p
peer (EventFold ef :: EventFoldF o p e Identity
ef) =
(
EventId p
eid,
let
(ef2 :: EventFoldF o p e Identity
ef2, outputs1 :: Map (EventId p) (Output e)
outputs1) =
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge
p
self
EventFoldF o p e Identity
ef {
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents =
EventId p
-> (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
EventId p
eid
(Delta p e -> Identity (Delta p e)
forall a. a -> Identity a
Identity (p -> Delta p e
forall p e. p -> Delta p e
Join p
peer), Set p
forall a. Monoid a => a
mempty)
(EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef)
}
(ef3 :: EventFoldF o p e Identity
ef3, outputs2 :: Map (EventId p) (Output e)
outputs2) = p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge p
peer EventFoldF o p e Identity
ef2
in
UpdateResult :: forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult {
urEventFold :: EventFold o p e
urEventFold = EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold EventFoldF o p e Identity
ef3,
urOutputs :: Map (EventId p) (Output e)
urOutputs = Map (EventId p) (Output e)
-> Map (EventId p) (Output e) -> Map (EventId p) (Output e)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (EventId p) (Output e)
outputs1 Map (EventId p) (Output e)
outputs2,
urNeedsPropagation :: Bool
urNeedsPropagation = Bool
True
}
)
where
eid :: EventId p
eid :: EventId p
eid = p -> EventFoldF o p e Identity -> EventId p
forall p o e (f :: * -> *).
Ord p =>
p -> EventFoldF o p e f -> EventId p
nextId p
self EventFoldF o p e Identity
ef
disassociate :: forall o p e. (Event e, Ord p)
=> p
-> EventFold o p e
-> (EventId p, UpdateResult o p e)
disassociate :: p -> EventFold o p e -> (EventId p, UpdateResult o p e)
disassociate peer :: p
peer (EventFold ef :: EventFoldF o p e Identity
ef) =
let
(ef2 :: EventFoldF o p e Identity
ef2, outputs :: Map (EventId p) (Output e)
outputs) =
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge
p
peer
EventFoldF o p e Identity
ef {
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents =
EventId p
-> (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
EventId p
eid
(Delta p e -> Identity (Delta p e)
forall a. a -> Identity a
Identity (p -> Delta p e
forall p e. p -> Delta p e
UnJoin p
peer), Set p
forall a. Monoid a => a
mempty)
(EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef)
}
in
(
EventId p
eid,
UpdateResult :: forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult {
urEventFold :: EventFold o p e
urEventFold = EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold EventFoldF o p e Identity
ef2,
urOutputs :: Map (EventId p) (Output e)
urOutputs = Map (EventId p) (Output e)
outputs,
urNeedsPropagation :: Bool
urNeedsPropagation = Bool
True
}
)
where
eid :: EventId p
eid :: EventId p
eid = p -> EventFoldF o p e Identity -> EventId p
forall p o e (f :: * -> *).
Ord p =>
p -> EventFoldF o p e f -> EventId p
nextId p
peer EventFoldF o p e Identity
ef
event :: (Ord p, Event e)
=> p
-> e
-> EventFold o p e
-> (Output e, EventId p, UpdateResult o p e)
event :: p
-> e
-> EventFold o p e
-> (Output e, EventId p, UpdateResult o p e)
event p :: p
p e :: e
e ef :: EventFold o p e
ef =
let
eid :: EventId p
eid = p -> EventFoldF o p e Identity -> EventId p
forall p o e (f :: * -> *).
Ord p =>
p -> EventFoldF o p e f -> EventId p
nextId p
p (EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold EventFold o p e
ef)
in
(
case e -> State e -> EventResult e
forall e. Event e => e -> State e -> EventResult e
apply e
e (EventFold o p e -> State e
forall e o p. Event e => EventFold o p e -> State e
projectedValue EventFold o p e
ef) of
Pure output :: Output e
output _ -> Output e
output
SystemError output :: Output e
output -> Output e
output,
EventId p
eid,
let
(ef2 :: EventFoldF o p e Identity
ef2, outputs :: Map (EventId p) (Output e)
outputs) =
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFoldF o p e Identity
-> (EventFoldF o p e Identity, Map (EventId p) (Output e))
acknowledge
p
p
(
(EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold EventFold o p e
ef) {
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents =
EventId p
-> (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
EventId p
eid
(Delta p e -> Identity (Delta p e)
forall a. a -> Identity a
Identity (e -> Delta p e
forall p e. e -> Delta p e
Event e
e), Set p
forall a. Monoid a => a
mempty)
(EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents (EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold EventFold o p e
ef))
}
)
in
UpdateResult :: forall o p e.
EventFold o p e
-> Map (EventId p) (Output e) -> Bool -> UpdateResult o p e
UpdateResult {
urEventFold :: EventFold o p e
urEventFold = EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold EventFoldF o p e Identity
ef2,
urOutputs :: Map (EventId p) (Output e)
urOutputs = Map (EventId p) (Output e)
outputs,
urNeedsPropagation :: Bool
urNeedsPropagation =
EventFold o p e -> Set p
forall p o e. Ord p => EventFold o p e -> Set p
allParticipants (EventFoldF o p e Identity -> EventFold o p e
forall o p e. EventFoldF o p e Identity -> EventFold o p e
EventFold EventFoldF o p e Identity
ef2) Set p -> Set p -> Bool
forall a. Eq a => a -> a -> Bool
/= p -> Set p
forall a. a -> Set a
Set.singleton p
p
}
)
projectedValue :: (Event e) => EventFold o p e -> State e
projectedValue :: EventFold o p e -> State e
projectedValue
(
EventFold
EventFoldF {
psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {State e
stateValue :: State e
stateValue :: forall s p. Infimum s p -> s
stateValue},
Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents
}
)
=
(e -> State e -> State e) -> State e -> [e] -> State e
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\ e :: e
e s :: State e
s ->
case e -> State e -> EventResult e
forall e. Event e => e -> State e -> EventResult e
apply e
e State e
s of
Pure _ newState :: State e
newState -> State e
newState
SystemError _ -> State e
s
)
State e
stateValue
[e]
changes
where
changes :: [e]
changes = ((EventId p, (Identity (Delta p e), Set p)) -> [e])
-> [(EventId p, (Identity (Delta p e), Set p))] -> [e]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (EventId p, (Identity (Delta p e), Set p)) -> [e]
forall p e. (EventId p, (Identity (Delta p e), Set p)) -> [e]
getDelta (Map (EventId p) (Identity (Delta p e), Set p)
-> [(EventId p, (Identity (Delta p e), Set p))]
forall k a. Map k a -> [(k, a)]
toDescList Map (EventId p) (Identity (Delta p e), Set p)
psEvents)
getDelta :: (EventId p, (Identity (Delta p e), Set p)) -> [e]
getDelta :: (EventId p, (Identity (Delta p e), Set p)) -> [e]
getDelta (_, (Identity (Event e :: e
e), _)) = [e
e]
getDelta _ = [e]
forall a. Monoid a => a
mempty
infimumValue :: EventFold o p e -> State e
infimumValue :: EventFold o p e -> State e
infimumValue (EventFold EventFoldF {psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {State e
stateValue :: State e
stateValue :: forall s p. Infimum s p -> s
stateValue}}) =
State e
stateValue
infimumId :: EventFold o p e -> EventId p
infimumId :: EventFold o p e -> EventId p
infimumId = Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (Infimum (State e) p -> EventId p)
-> (EventFold o p e -> Infimum (State e) p)
-> EventFold o p e
-> EventId p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFoldF o p e Identity -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum (EventFoldF o p e Identity -> Infimum (State e) p)
-> (EventFold o p e -> EventFoldF o p e Identity)
-> EventFold o p e
-> Infimum (State e) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold
infimumParticipants :: EventFold o p e -> Set p
infimumParticipants :: EventFold o p e -> Set p
infimumParticipants
(
EventFold
EventFoldF {
psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {Set p
participants :: Set p
participants :: forall s p. Infimum s p -> Set p
participants}
}
)
=
Set p
participants
allParticipants :: (Ord p) => EventFold o p e -> Set p
allParticipants :: EventFold o p e -> Set p
allParticipants
(
EventFold
EventFoldF {
psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {Set p
participants :: Set p
participants :: forall s p. Infimum s p -> Set p
participants},
Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents
}
)
=
((EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p)
-> Set p -> [(EventId p, (Identity (Delta p e), Set p))] -> Set p
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p
forall p e.
Ord p =>
(EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p
updateParticipants Set p
participants (Map (EventId p) (Identity (Delta p e), Set p)
-> [(EventId p, (Identity (Delta p e), Set p))]
forall k a. Map k a -> [(k, a)]
toDescList Map (EventId p) (Identity (Delta p e), Set p)
psEvents)
where
updateParticipants :: (Ord p)
=> (EventId p, (Identity (Delta p e), Set p))
-> Set p
-> Set p
updateParticipants :: (EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p
updateParticipants (_, (Identity (Join p :: p
p), _)) = p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.insert p
p
updateParticipants _ = Set p -> Set p
forall a. a -> a
id
projParticipants :: (Ord p) => EventFold o p e -> Set p
projParticipants :: EventFold o p e -> Set p
projParticipants
(
EventFold
EventFoldF {
psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {Set p
participants :: Set p
participants :: forall s p. Infimum s p -> Set p
participants},
Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents
}
)
=
((EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p)
-> Set p -> [(EventId p, (Identity (Delta p e), Set p))] -> Set p
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p
forall p e.
Ord p =>
(EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p
updateParticipants Set p
participants (Map (EventId p) (Identity (Delta p e), Set p)
-> [(EventId p, (Identity (Delta p e), Set p))]
forall k a. Map k a -> [(k, a)]
toDescList Map (EventId p) (Identity (Delta p e), Set p)
psEvents)
where
updateParticipants :: (Ord p)
=> (EventId p, (Identity (Delta p e), Set p))
-> Set p
-> Set p
updateParticipants :: (EventId p, (Identity (Delta p e), Set p)) -> Set p -> Set p
updateParticipants (_, (Identity (Join p :: p
p), _)) = p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.insert p
p
updateParticipants (_, (Identity (UnJoin p :: p
p), _)) = p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.delete p
p
updateParticipants _ = Set p -> Set p
forall a. a -> a
id
divergent :: forall o p e. (Ord p) => EventFold o p e -> Map p (EventId p)
divergent :: EventFold o p e -> Map p (EventId p)
divergent
(
EventFold
EventFoldF {
psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {Set p
participants :: Set p
participants :: forall s p. Infimum s p -> Set p
participants, EventId p
eventId :: EventId p
eventId :: forall s p. Infimum s p -> EventId p
eventId},
Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents
}
)
=
let (byParticipant :: Map p (EventId p)
byParticipant, maxEid :: EventId p
maxEid) = (Map p (EventId p), EventId p)
eidByParticipant
in (EventId p -> Bool) -> Map p (EventId p) -> Map p (EventId p)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (EventId p -> EventId p -> Bool
forall a. Ord a => a -> a -> Bool
< EventId p
maxEid) Map p (EventId p)
byParticipant
where
eidByParticipant :: (Map p (EventId p), EventId p)
eidByParticipant :: (Map p (EventId p), EventId p)
eidByParticipant =
((EventId p, Delta p e, Set p)
-> (Map p (EventId p), EventId p)
-> (Map p (EventId p), EventId p))
-> (Map p (EventId p), EventId p)
-> [(EventId p, Delta p e, Set p)]
-> (Map p (EventId p), EventId p)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(EventId p, Delta p e, Set p)
-> (Map p (EventId p), EventId p) -> (Map p (EventId p), EventId p)
accum
([(p, EventId p)] -> Map p (EventId p)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(p
p, EventId p
eventId) | p
p <- Set p -> [p]
forall a. Set a -> [a]
Set.toList Set p
participants], EventId p
eventId)
(
let flatten :: (a, (Identity b, c)) -> (a, b, c)
flatten (a :: a
a, (Identity b :: b
b, c :: c
c)) = (a
a, b
b, c
c)
in ((EventId p, (Identity (Delta p e), Set p))
-> (EventId p, Delta p e, Set p)
forall a b c. (a, (Identity b, c)) -> (a, b, c)
flatten ((EventId p, (Identity (Delta p e), Set p))
-> (EventId p, Delta p e, Set p))
-> [(EventId p, (Identity (Delta p e), Set p))]
-> [(EventId p, Delta p e, Set p)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (EventId p) (Identity (Delta p e), Set p)
-> [(EventId p, (Identity (Delta p e), Set p))]
forall k a. Map k a -> [(k, a)]
toAscList Map (EventId p) (Identity (Delta p e), Set p)
psEvents)
)
accum
:: (EventId p, Delta p e, Set p)
-> (Map p (EventId p), EventId p)
-> (Map p (EventId p), EventId p)
accum :: (EventId p, Delta p e, Set p)
-> (Map p (EventId p), EventId p) -> (Map p (EventId p), EventId p)
accum (eid :: EventId p
eid, Join p :: p
p, acks :: Set p
acks) (acc :: Map p (EventId p)
acc, maxEid :: EventId p
maxEid) =
(
(EventId p -> EventId p -> EventId p)
-> Map p (EventId p) -> Map p (EventId p) -> Map p (EventId p)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith
EventId p -> EventId p -> EventId p
forall a. Ord a => a -> a -> a
max
(p -> EventId p -> Map p (EventId p) -> Map p (EventId p)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert p
p EventId p
eid Map p (EventId p)
acc)
([(p, EventId p)] -> Map p (EventId p)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(p
a, EventId p
eid) | p
a <- Set p -> [p]
forall a. Set a -> [a]
Set.toList Set p
acks]),
EventId p -> EventId p -> EventId p
forall a. Ord a => a -> a -> a
max EventId p
maxEid EventId p
eid
)
accum (eid :: EventId p
eid, _, acks :: Set p
acks) (acc :: Map p (EventId p)
acc, maxEid :: EventId p
maxEid) =
(
(EventId p -> EventId p -> EventId p)
-> Map p (EventId p) -> Map p (EventId p) -> Map p (EventId p)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith
EventId p -> EventId p -> EventId p
forall a. Ord a => a -> a -> a
max
Map p (EventId p)
acc
([(p, EventId p)] -> Map p (EventId p)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(p
a, EventId p
eid) | p
a <- Set p -> [p]
forall a. Set a -> [a]
Set.toList Set p
acks]),
EventId p -> EventId p -> EventId p
forall a. Ord a => a -> a -> a
max EventId p
maxEid EventId p
eid
)
origin :: EventFold o p e -> o
origin :: EventFold o p e -> o
origin = EventFoldF o p e Identity -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin (EventFoldF o p e Identity -> o)
-> (EventFold o p e -> EventFoldF o p e Identity)
-> EventFold o p e
-> o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFold o p e -> EventFoldF o p e Identity
forall o p e. EventFold o p e -> EventFoldF o p e Identity
unEventFold
reduce
:: forall o p e f.
( Event e
, Monad f
, Ord p
)
=> EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce :: EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce
infState :: EventId p
infState
ef :: EventFoldF o p e f
ef@EventFoldF {
psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = infimum :: Infimum (State e) p
infimum@Infimum {Set p
participants :: Set p
participants :: forall s p. Infimum s p -> Set p
participants, State e
stateValue :: State e
stateValue :: forall s p. Infimum s p -> s
stateValue},
Map (EventId p) (f (Delta p e), Set p)
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents
}
=
case Map (EventId p) (f (Delta p e), Set p)
-> Maybe
((EventId p, (f (Delta p e), Set p)),
Map (EventId p) (f (Delta p e), Set p))
forall k a. Map k a -> Maybe ((k, a), Map k a)
Map.minViewWithKey Map (EventId p) (f (Delta p e), Set p)
psEvents of
Nothing ->
(EventFoldF o p e Identity, Map (EventId p) (Output e))
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFoldF :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFoldF {
psOrigin :: o
psOrigin = EventFoldF o p e f -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin EventFoldF o p e f
ef,
psInfimum :: Infimum (State e) p
psInfimum = EventFoldF o p e f -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e f
ef,
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents = Map (EventId p) (Identity (Delta p e), Set p)
forall a. Monoid a => a
mempty
},
Map (EventId p) (Output e)
forall a. Monoid a => a
mempty
)
Just ((eid :: EventId p
eid, (getUpdate :: f (Delta p e)
getUpdate, acks :: Set p
acks)), newDeltas :: Map (EventId p) (f (Delta p e), Set p)
newDeltas)
| EventId p
eid EventId p -> EventId p -> Bool
forall a. Ord a => a -> a -> Bool
<= Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId Infimum (State e) p
infimum ->
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ef {
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents = Map (EventId p) (f (Delta p e), Set p)
newDeltas
}
| EventId p -> Bool
isRenegade EventId p
eid ->
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ef {
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents = Map (EventId p) (f (Delta p e), Set p)
newDeltas
}
| Bool
otherwise -> do
Set p
implicitAcks <- EventId p -> f (Set p)
unjoins EventId p
eid
Delta p e
update <- f (Delta p e)
getUpdate
let
joining :: Set p
joining =
case Delta p e
update of
Join p :: p
p -> p -> Set p
forall a. a -> Set a
Set.singleton p
p
_ -> Set p
forall a. Monoid a => a
mempty
if
Set p -> Bool
forall a. Set a -> Bool
Set.null (((Set p
participants Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
`union` Set p
joining) Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
\\ Set p
acks) Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
\\ Set p
implicitAcks)
Bool -> Bool -> Bool
|| EventId p
eid EventId p -> EventId p -> Bool
forall a. Ord a => a -> a -> Bool
<= EventId p
infState
then
case Delta p e
update of
Join p :: p
p ->
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ef {
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum {
eventId :: EventId p
eventId = EventId p
eid,
participants :: Set p
participants = p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.insert p
p Set p
participants
},
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents = Map (EventId p) (f (Delta p e), Set p)
newDeltas
}
UnJoin p :: p
p ->
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ef {
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum {
eventId :: EventId p
eventId = EventId p
eid,
participants :: Set p
participants = p -> Set p -> Set p
forall a. Ord a => a -> Set a -> Set a
Set.delete p
p Set p
participants
},
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents = Map (EventId p) (f (Delta p e), Set p)
newDeltas
}
Error output :: Output e
output eacks :: Set p
eacks
| Set p -> Bool
forall a. Set a -> Bool
Set.null (Set p
participants Set p -> Set p -> Set p
forall a. Ord a => Set a -> Set a -> Set a
\\ Set p
eacks) -> do
(ps2 :: EventFoldF o p e Identity
ps2, outputs :: Map (EventId p) (Output e)
outputs) <-
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ef {
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum {
eventId :: EventId p
eventId = EventId p
eid
}
}
(EventFoldF o p e Identity, Map (EventId p) (Output e))
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventFoldF o p e Identity
ps2, EventId p
-> Output e
-> Map (EventId p) (Output e)
-> Map (EventId p) (Output e)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EventId p
eid Output e
output Map (EventId p) (Output e)
outputs)
| Bool
otherwise -> do
Map (EventId p) (Identity (Delta p e), Set p)
events_ <- Map (EventId p) (f (Delta p e), Set p)
-> f (Map (EventId p) (Identity (Delta p e), Set p))
runEvents Map (EventId p) (f (Delta p e), Set p)
psEvents
(EventFoldF o p e Identity, Map (EventId p) (Output e))
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFoldF :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFoldF {
psOrigin :: o
psOrigin = EventFoldF o p e f -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin EventFoldF o p e f
ef,
psInfimum :: Infimum (State e) p
psInfimum = EventFoldF o p e f -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e f
ef,
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents = Map (EventId p) (Identity (Delta p e), Set p)
events_
},
Map (EventId p) (Output e)
forall a. Monoid a => a
mempty
)
Event e :: e
e ->
case e -> State e -> EventResult e
forall e. Event e => e -> State e -> EventResult e
apply e
e State e
stateValue of
SystemError output :: Output e
output -> do
Map (EventId p) (Identity (Delta p e), Set p)
events_ <- Map (EventId p) (f (Delta p e), Set p)
-> f (Map (EventId p) (Identity (Delta p e), Set p))
runEvents Map (EventId p) (f (Delta p e), Set p)
newDeltas
(EventFoldF o p e Identity, Map (EventId p) (Output e))
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFoldF :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFoldF {
psOrigin :: o
psOrigin = EventFoldF o p e f -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin EventFoldF o p e f
ef,
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum,
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents =
EventId p
-> (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
-> Map (EventId p) (Identity (Delta p e), Set p)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
EventId p
eid
(Delta p e -> Identity (Delta p e)
forall a. a -> Identity a
Identity (Output e -> Set p -> Delta p e
forall p e. Output e -> Set p -> Delta p e
Error Output e
output Set p
forall a. Monoid a => a
mempty), Set p
acks)
Map (EventId p) (Identity (Delta p e), Set p)
events_
},
Map (EventId p) (Output e)
forall a. Monoid a => a
mempty
)
Pure output :: Output e
output newState :: State e
newState -> do
(ps2 :: EventFoldF o p e Identity
ps2, outputs :: Map (EventId p) (Output e)
outputs) <-
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ef {
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum {
eventId :: EventId p
eventId = EventId p
eid,
stateValue :: State e
stateValue = State e
newState
},
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents = Map (EventId p) (f (Delta p e), Set p)
newDeltas
}
(EventFoldF o p e Identity, Map (EventId p) (Output e))
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventFoldF o p e Identity
ps2, EventId p
-> Output e
-> Map (EventId p) (Output e)
-> Map (EventId p) (Output e)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EventId p
eid Output e
output Map (EventId p) (Output e)
outputs)
else do
Map (EventId p) (Identity (Delta p e), Set p)
events_ <- Map (EventId p) (f (Delta p e), Set p)
-> f (Map (EventId p) (Identity (Delta p e), Set p))
runEvents Map (EventId p) (f (Delta p e), Set p)
psEvents
(EventFoldF o p e Identity, Map (EventId p) (Output e))
-> f (EventFoldF o p e Identity, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFoldF :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFoldF {
psOrigin :: o
psOrigin = EventFoldF o p e f -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin EventFoldF o p e f
ef,
psInfimum :: Infimum (State e) p
psInfimum = EventFoldF o p e f -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFoldF o p e f
ef,
psEvents :: Map (EventId p) (Identity (Delta p e), Set p)
psEvents = Map (EventId p) (Identity (Delta p e), Set p)
events_
},
Map (EventId p) (Output e)
forall a. Monoid a => a
mempty
)
where
runEvents
:: Map (EventId p) (f (Delta p e), Set p)
-> f (Map (EventId p) (Identity (Delta p e), Set p))
runEvents :: Map (EventId p) (f (Delta p e), Set p)
-> f (Map (EventId p) (Identity (Delta p e), Set p))
runEvents events_ :: Map (EventId p) (f (Delta p e), Set p)
events_ =
[(EventId p, (Identity (Delta p e), Set p))]
-> Map (EventId p) (Identity (Delta p e), Set p)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(EventId p, (Identity (Delta p e), Set p))]
-> Map (EventId p) (Identity (Delta p e), Set p))
-> f [(EventId p, (Identity (Delta p e), Set p))]
-> f (Map (EventId p) (Identity (Delta p e), Set p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (EventId p, (Identity (Delta p e), Set p))]
-> f [(EventId p, (Identity (Delta p e), Set p))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [
do
Delta p e
d <- f (Delta p e)
fd
(EventId p, (Identity (Delta p e), Set p))
-> f (EventId p, (Identity (Delta p e), Set p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventId p
eid, (Delta p e -> Identity (Delta p e)
forall a. a -> Identity a
Identity Delta p e
d, Set p
acks))
| (eid :: EventId p
eid, (fd :: f (Delta p e)
fd, acks :: Set p
acks)) <- Map (EventId p) (f (Delta p e), Set p)
-> [(EventId p, (f (Delta p e), Set p))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (EventId p) (f (Delta p e), Set p)
events_
]
unjoins
:: EventId p
-> f (Set p)
unjoins :: EventId p -> f (Set p)
unjoins eid :: EventId p
eid =
[p] -> Set p
forall a. Ord a => [a] -> Set a
Set.fromList
([p] -> Set p)
-> (Map (EventId p) p -> [p]) -> Map (EventId p) p -> Set p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (EventId p) p -> [p]
forall k a. Map k a -> [a]
Map.elems
(Map (EventId p) p -> [p])
-> (Map (EventId p) p -> Map (EventId p) p)
-> Map (EventId p) p
-> [p]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventId p -> p -> Bool) -> Map (EventId p) p -> Map (EventId p) p
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\k :: EventId p
k _ -> EventId p
eid EventId p -> EventId p -> Bool
forall a. Ord a => a -> a -> Bool
<= EventId p
k)
(Map (EventId p) p -> Set p) -> f (Map (EventId p) p) -> f (Set p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Map (EventId p) p)
unjoinMap
unjoinMap :: f (Map (EventId p) p)
unjoinMap :: f (Map (EventId p) p)
unjoinMap =
[(EventId p, p)] -> Map (EventId p) p
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(EventId p, p)] -> Map (EventId p) p)
-> ([Maybe (EventId p, p)] -> [(EventId p, p)])
-> [Maybe (EventId p, p)]
-> Map (EventId p) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (EventId p, p)] -> [(EventId p, p)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (EventId p, p)] -> Map (EventId p) p)
-> f [Maybe (EventId p, p)] -> f (Map (EventId p) p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (Maybe (EventId p, p))] -> f [Maybe (EventId p, p)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [
f (Delta p e)
update f (Delta p e)
-> (Delta p e -> f (Maybe (EventId p, p)))
-> f (Maybe (EventId p, p))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
UnJoin p :: p
p -> Maybe (EventId p, p) -> f (Maybe (EventId p, p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((EventId p, p) -> Maybe (EventId p, p)
forall a. a -> Maybe a
Just (EventId p
eid, p
p))
_ -> Maybe (EventId p, p) -> f (Maybe (EventId p, p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EventId p, p)
forall a. Maybe a
Nothing
| (eid :: EventId p
eid, (update :: f (Delta p e)
update, _acks :: Set p
_acks)) <- Map (EventId p) (f (Delta p e), Set p)
-> [(EventId p, (f (Delta p e), Set p))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (EventId p) (f (Delta p e), Set p)
psEvents
]
isRenegade :: EventId p -> Bool
isRenegade BottomEid = Bool
False
isRenegade (Eid _ p :: p
p) = Bool -> Bool
not (p
p p -> Set p -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set p
participants)
nextId :: (Ord p) => p -> EventFoldF o p e f -> EventId p
nextId :: p -> EventFoldF o p e f -> EventId p
nextId p :: p
p EventFoldF {psInfimum :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum = Infimum {EventId p
eventId :: EventId p
eventId :: forall s p. Infimum s p -> EventId p
eventId}, Map (EventId p) (f (Delta p e), Set p)
psEvents :: Map (EventId p) (f (Delta p e), Set p)
psEvents :: forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents} =
case [EventId p] -> EventId p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (EventId p
eventIdEventId p -> [EventId p] -> [EventId p]
forall a. a -> [a] -> [a]
:Map (EventId p) (f (Delta p e), Set p) -> [EventId p]
forall k a. Map k a -> [k]
keys Map (EventId p) (f (Delta p e), Set p)
psEvents) of
BottomEid -> Word256 -> p -> EventId p
forall p. Word256 -> p -> EventId p
Eid 0 p
p
Eid ord :: Word256
ord _ -> Word256 -> p -> EventId p
forall p. Word256 -> p -> EventId p
Eid (Word256 -> Word256
forall a. Enum a => a -> a
succ Word256
ord) p
p
isBlockedOnError :: EventFold o p e -> Bool
isBlockedOnError :: EventFold o p e -> Bool
isBlockedOnError (EventFold ef :: EventFoldF o p e Identity
ef) =
case Map (EventId p) (Identity (Delta p e), Set p)
-> Maybe
((Identity (Delta p e), Set p),
Map (EventId p) (Identity (Delta p e), Set p))
forall k a. Map k a -> Maybe (a, Map k a)
Map.minView (EventFoldF o p e Identity
-> Map (EventId p) (Identity (Delta p e), Set p)
forall o p e (f :: * -> *).
EventFoldF o p e f -> Map (EventId p) (f (Delta p e), Set p)
psEvents EventFoldF o p e Identity
ef) of
Just ((Identity (Error _ _), _), _) -> Bool
True
_ -> Bool
False