{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wmissing-deriving-strategies #-}
module Data.CRDT.EventFold (
new,
event,
fullMerge,
acknowledge,
events,
mergeMaybe,
mergeEither,
MergeError(..),
participate,
disassociate,
Event(..),
EventResult(..),
isBlockedOnError,
projectedValue,
infimumValue,
infimumId,
infimumParticipants,
allParticipants,
projParticipants,
origin,
divergent,
EventFoldF,
EventFold,
EventId,
EventPack,
) 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 = EventFold {
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)
type EventFold o p e = EventFoldF o p e Identity
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
| EventPackTooNew (EventFold o p e) (EventPack o p e)
| EventPackTooSparse (EventFold o p e) (EventPack 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 =
EventFold :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFold {
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 -> EventPack o p e
events :: p -> EventFold o p e -> EventPack o p e
events peer :: p
peer ps :: EventFold o p e
ps =
EventPack :: forall o p e.
Map (EventId p) (Maybe (Delta p e), Set p)
-> o -> EventId p -> EventPack o p e
EventPack {
epEvents :: Map (EventId p) (Maybe (Delta p e), Set p)
epEvents = (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
<$> EventFold o p e -> 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
ps,
epOrigin :: o
epOrigin = EventFold o p e -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin EventFold o p e
ps,
epInfimum :: EventId p
epInfimum = Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (EventFold o p e -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFold o p e
ps)
}
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 EventPack o p e = EventPack {
EventPack o p e -> Map (EventId p) (Maybe (Delta p e), Set p)
epEvents :: Map (EventId p) (Maybe (Delta p e), Set p),
EventPack o p e -> o
epOrigin :: o,
EventPack o p e -> EventId p
epInfimum :: EventId p
}
deriving stock ((forall x. EventPack o p e -> Rep (EventPack o p e) x)
-> (forall x. Rep (EventPack o p e) x -> EventPack o p e)
-> Generic (EventPack o p e)
forall x. Rep (EventPack o p e) x -> EventPack o p e
forall x. EventPack o p e -> Rep (EventPack 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 (EventPack o p e) x -> EventPack o p e
forall o p e x. EventPack o p e -> Rep (EventPack o p e) x
$cto :: forall o p e x. Rep (EventPack o p e) x -> EventPack o p e
$cfrom :: forall o p e x. EventPack o p e -> Rep (EventPack o p e) x
Generic)
deriving stock instance (
Show o, Show p, Show e, Show (Output e)
) =>
Show (EventPack o p e)
instance (
Binary o, Binary p, Binary e, Binary (Output e)
) =>
Binary (EventPack o p e)
mergeMaybe :: (Eq o, Event e, Ord p)
=> EventFold o p e
-> EventPack o p e
-> Maybe (EventFold o p e, Map (EventId p) (Output e))
mergeMaybe :: EventFold o p e
-> EventPack o p e
-> Maybe (EventFold o p e, Map (EventId p) (Output e))
mergeMaybe ps :: EventFold o p e
ps es :: EventPack o p e
es = (MergeError o p e
-> Maybe (EventFold o p e, Map (EventId p) (Output e)))
-> ((EventFold o p e, Map (EventId p) (Output e))
-> Maybe (EventFold o p e, Map (EventId p) (Output e)))
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
-> Maybe (EventFold o p e, Map (EventId p) (Output e))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (EventFold o p e, Map (EventId p) (Output e))
-> MergeError o p e
-> Maybe (EventFold o p e, Map (EventId p) (Output e))
forall a b. a -> b -> a
const Maybe (EventFold o p e, Map (EventId p) (Output e))
forall a. Maybe a
Nothing) (EventFold o p e, Map (EventId p) (Output e))
-> Maybe (EventFold o p e, Map (EventId p) (Output e))
forall a. a -> Maybe a
Just (EventFold o p e
-> EventPack o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
forall o e p.
(Eq o, Event e, Ord p) =>
EventFold o p e
-> EventPack o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
mergeEither EventFold o p e
ps EventPack o p e
es)
mergeEither :: (Eq o, Event e, Ord p)
=> EventFold o p e
-> EventPack o p e
-> Either
(MergeError o p e)
(EventFold o p e, Map (EventId p) (Output e))
mergeEither :: EventFold o p e
-> EventPack o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
mergeEither EventFold {psOrigin :: forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin = o
o1} EventPack {epOrigin :: forall o p e. EventPack o p e -> o
epOrigin = 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) (EventFold o p e, Map (EventId p) (Output 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)
mergeEither ps :: EventFold o p e
ps pak :: EventPack o p e
pak | Bool
tooNew =
MergeError o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
forall a b. a -> Either a b
Left (EventFold o p e -> EventPack o p e -> MergeError o p e
forall o p e.
EventFold o p e -> EventPack o p e -> MergeError o p e
EventPackTooNew EventFold o p e
ps EventPack 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
. EventFold o p e -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum (EventFold o p e -> EventId p) -> EventFold o p e -> EventId p
forall a b. (a -> b) -> a -> b
$ EventFold o p e
ps)
(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
. EventFold o p e -> 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 -> EventId p) -> EventFold o p e -> EventId p
forall a b. (a -> b) -> a -> b
$ EventFold o p e
ps
tooNew :: Bool
tooNew :: Bool
tooNew = EventId p
maxState EventId p -> EventId p -> Bool
forall a. Ord a => a -> a -> Bool
< EventPack o p e -> EventId p
forall o p e. EventPack o p e -> EventId p
epInfimum EventPack o p e
pak
mergeEither orig :: EventFold o p e
orig@(EventFold o :: o
o infimum :: Infimum (State e) p
infimum d1 :: Map (EventId p) (Identity (Delta p e), Set p)
d1) ep :: EventPack o p e
ep@(EventPack d2 :: Map (EventId p) (Maybe (Delta p e), Set p)
d2 _ i2 :: EventId p
i2) =
case
EventId p
-> EventFoldF o p e Maybe
-> Maybe (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce
EventId p
i2
EventFold :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFold {
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) (EventFold o p e, Map (EventId p) (Output e))
forall a b. a -> Either a b
Left (EventFold o p e -> EventPack o p e -> MergeError o p e
forall o p e.
EventFold o p e -> EventPack o p e -> MergeError o p e
EventPackTooSparse EventFold o p e
orig EventPack o p e
ep)
Just ps -> (EventFold o p e, Map (EventId p) (Output e))
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
forall a b. b -> Either a b
Right (EventFold o p e, Map (EventId p) (Output e))
ps
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 o, Event e, Ord p)
=> EventFold o p e
-> EventFold o p e
-> Either (MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
fullMerge :: EventFold o p e
-> EventFold o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
fullMerge ps :: EventFold o p e
ps (EventFold o2 :: o
o2 i2 :: Infimum (State e) p
i2 d2 :: Map (EventId p) (Identity (Delta p e), Set p)
d2) =
EventFold o p e
-> EventPack o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
forall o e p.
(Eq o, Event e, Ord p) =>
EventFold o p e
-> EventPack o p e
-> Either
(MergeError o p e) (EventFold o p e, Map (EventId p) (Output e))
mergeEither
EventFold o p e
ps {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 (EventFold o p e -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFold o p e
ps) Infimum (State e) p
i2}
EventPack :: forall o p e.
Map (EventId p) (Maybe (Delta p e), Set p)
-> o -> EventId p -> EventPack o p e
EventPack {
epOrigin :: o
epOrigin = o
o2,
epEvents :: Map (EventId p) (Maybe (Delta p e), Set p)
epEvents = (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,
epInfimum :: EventId p
epInfimum = Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId Infimum (State e) p
i2
}
acknowledge :: (Event e, Ord p)
=> p
-> EventFold o p e
-> (EventFold o p e, Map (EventId p) (Output e))
acknowledge :: p
-> EventFold o p e -> (EventFold o p e, Map (EventId p) (Output e))
acknowledge p :: p
p ps :: EventFold o p e
ps =
let
(ps2 :: EventFold o p e
ps2, outputs :: Map (EventId p) (Output e)
outputs) =
Identity (EventFold o p e, Map (EventId p) (Output e))
-> (EventFold o p e, Map (EventId p) (Output e))
forall a. Identity a -> a
runIdentity (Identity (EventFold o p e, Map (EventId p) (Output e))
-> (EventFold o p e, Map (EventId p) (Output e)))
-> Identity (EventFold o p e, Map (EventId p) (Output e))
-> (EventFold o p e, Map (EventId p) (Output e))
forall a b. (a -> b) -> a -> b
$
EventId p
-> EventFold o p e
-> Identity (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce
(Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (EventFold o p e -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFold o p e
ps))
EventFold o p e
ps {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 (EventFold o p e -> 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
ps)}
(ps3 :: EventFold o p e
ps3, outputs2 :: Map (EventId p) (Output e)
outputs2) = p
-> EventFold o p e -> (EventFold o p e, Map (EventId p) (Output e))
forall e p o.
(Event e, Ord p) =>
p
-> EventFold o p e -> (EventFold o p e, Map (EventId p) (Output e))
ackErr p
p EventFold o p e
ps2
in
(EventFold o p e
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
-> EventFold o p e
-> (EventFold o p e, Map (EventId p) (Output e))
ackErr :: p
-> EventFold o p e -> (EventFold o p e, Map (EventId p) (Output e))
ackErr p :: p
p ps :: EventFold o p e
ps =
Identity (EventFold o p e, Map (EventId p) (Output e))
-> (EventFold o p e, Map (EventId p) (Output e))
forall a. Identity a -> a
runIdentity (Identity (EventFold o p e, Map (EventId p) (Output e))
-> (EventFold o p e, Map (EventId p) (Output e)))
-> Identity (EventFold o p e, Map (EventId p) (Output e))
-> (EventFold o p e, Map (EventId p) (Output e))
forall a b. (a -> b) -> a -> b
$
EventId p
-> EventFold o p e
-> Identity (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce
(Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (EventFold o p e -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum EventFold o p e
ps))
EventFold o p e
ps {
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 (EventFold o p e -> 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
ps) 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
_ -> EventFold o p e -> 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
ps
}
participate :: (Ord p)
=> p
-> p
-> EventFold o p e
-> (EventId p, EventFold o p e)
participate :: p -> p -> EventFold o p e -> (EventId p, EventFold o p e)
participate self :: p
self peer :: p
peer ps :: EventFold o p e
ps@EventFold {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
eid :: EventId p
eid = p -> EventFold o p e -> EventId p
forall p o e (f :: * -> *).
Ord p =>
p -> EventFoldF o p e f -> EventId p
nextId p
self EventFold o p e
ps
in
(
EventId p
eid,
EventFold o p e
ps {
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)
Map (EventId p) (Identity (Delta p e), Set p)
psEvents
}
)
disassociate :: (Ord p)
=> p
-> p
-> EventFold o p e
-> EventFold o p e
disassociate :: p -> p -> EventFold o p e -> EventFold o p e
disassociate self :: p
self peer :: p
peer ps :: EventFold o p e
ps@EventFold {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} =
EventFold o p e
ps {
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
(p -> EventFold o p e -> EventId p
forall p o e (f :: * -> *).
Ord p =>
p -> EventFoldF o p e f -> EventId p
nextId p
self EventFold o p e
ps)
(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)
Map (EventId p) (Identity (Delta p e), Set p)
psEvents
}
event :: (Ord p, Event e)
=> p
-> e
-> EventFold o p e
-> (Output e, EventId p, EventFold o p e)
event :: p -> e -> EventFold o p e -> (Output e, EventId p, EventFold o p e)
event p :: p
p e :: e
e ps :: EventFold o p e
ps@EventFold {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
eid :: EventId p
eid = p -> EventFold o p e -> EventId p
forall p o e (f :: * -> *).
Ord p =>
p -> EventFoldF o p e f -> EventId p
nextId p
p EventFold o p e
ps
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
ps) of
Pure output :: Output e
output _ -> Output e
output
SystemError output :: Output e
output -> Output e
output,
EventId p
eid,
EventFold o p e
ps {
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)
Map (EventId p) (Identity (Delta p e), Set p)
psEvents
}
)
projectedValue :: (Event e) => EventFold o p e -> State e
projectedValue :: EventFold o p e -> State e
projectedValue EventFold {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 :: EventFoldF o p e f -> State e
infimumValue :: EventFoldF o p e f -> State e
infimumValue EventFold {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 :: EventFoldF o p e f -> EventId p
infimumId :: EventFoldF o p e f -> EventId p
infimumId = Infimum (State e) p -> EventId p
forall s p. Infimum s p -> EventId p
eventId (Infimum (State e) p -> EventId p)
-> (EventFoldF o p e f -> Infimum (State e) p)
-> EventFoldF o p e f
-> EventId p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventFoldF o p e f -> Infimum (State e) p
forall o p e (f :: * -> *).
EventFoldF o p e f -> Infimum (State e) p
psInfimum
infimumParticipants :: EventFoldF o p e f -> Set p
infimumParticipants :: EventFoldF o p e f -> Set p
infimumParticipants EventFold {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 {
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 {
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 {
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 :: EventFoldF o p e f -> o
origin :: EventFoldF o p e f -> o
origin = EventFoldF o p e f -> o
forall o p e (f :: * -> *). EventFoldF o p e f -> o
psOrigin
reduce
:: forall o p e f.
( Event e
, Monad f
, Ord p
)
=> EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce :: EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce
infState :: EventId p
infState
ps :: EventFoldF o p e f
ps@EventFold {
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 ->
(EventFold o p e, Map (EventId p) (Output e))
-> f (EventFold o p e, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFold :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFold {
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
ps,
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
ps,
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 (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ps {
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 (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ps {
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 (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ps {
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 (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ps {
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 :: EventFold o p e
ps2, outputs :: Map (EventId p) (Output e)
outputs) <-
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ps {
psInfimum :: Infimum (State e) p
psInfimum = Infimum (State e) p
infimum {
eventId :: EventId p
eventId = EventId p
eid
}
}
(EventFold o p e, Map (EventId p) (Output e))
-> f (EventFold o p e, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventFold o p e
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
(EventFold o p e, Map (EventId p) (Output e))
-> f (EventFold o p e, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFold :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFold {
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
ps,
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
ps,
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
(EventFold o p e, Map (EventId p) (Output e))
-> f (EventFold o p e, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFold :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFold {
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
ps,
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 :: EventFold o p e
ps2, outputs :: Map (EventId p) (Output e)
outputs) <-
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
forall o p e (f :: * -> *).
(Event e, Monad f, Ord p) =>
EventId p
-> EventFoldF o p e f
-> f (EventFold o p e, Map (EventId p) (Output e))
reduce EventId p
infState EventFoldF o p e f
ps {
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
}
(EventFold o p e, Map (EventId p) (Output e))
-> f (EventFold o p e, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EventFold o p e
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
(EventFold o p e, Map (EventId p) (Output e))
-> f (EventFold o p e, Map (EventId p) (Output e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(
EventFold :: forall o p e (f :: * -> *).
o
-> Infimum (State e) p
-> Map (EventId p) (f (Delta p e), Set p)
-> EventFoldF o p e f
EventFold {
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
ps,
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
ps,
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 EventFold {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 ps :: EventFold o p e
ps =
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 (EventFold o p e -> 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
ps) of
Just ((Identity (Error _ _), _), _) -> Bool
True
_ -> Bool
False