{-# LANGUAGE DeriveAnyClass #-}
{-# 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 #-}
{-# OPTIONS_GHC -Wmissing-import-lists #-}
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.Aeson (FromJSON(parseJSON), ToJSON(toEncoding, toJSON),
FromJSONKey, ToJSONKey)
import Data.Bifunctor (first)
import Data.Binary (Binary(get, put))
import Data.Default.Class (Default(def))
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 GHC.Generics (Generic)
import qualified Data.DoubleWord as DW
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 anyclass instance (ToJSON o, ToJSON p, ToJSON (State e), ToJSON (f (Delta p e))) => ToJSON (EventFoldF o p e f)
deriving anyclass instance (Ord p, FromJSON o, FromJSON p, FromJSON (f (Delta p e)), FromJSON (State e)) => FromJSON (EventFoldF o p e f)
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 newtype instance (ToJSON o, ToJSON p, ToJSON e, ToJSON (Output e), ToJSON (State e)) => ToJSON (EventFold o p e)
deriving newtype instance (Ord p, FromJSON o, FromJSON p, FromJSON e, FromJSON (Output e), FromJSON (State e)) => FromJSON (EventFold o p e)
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)
deriving anyclass ([Infimum s p] -> Encoding
[Infimum s p] -> Value
Infimum s p -> Encoding
Infimum s p -> Value
(Infimum s p -> Value)
-> (Infimum s p -> Encoding)
-> ([Infimum s p] -> Value)
-> ([Infimum s p] -> Encoding)
-> ToJSON (Infimum s p)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall s p. (ToJSON s, ToJSON p) => [Infimum s p] -> Encoding
forall s p. (ToJSON s, ToJSON p) => [Infimum s p] -> Value
forall s p. (ToJSON s, ToJSON p) => Infimum s p -> Encoding
forall s p. (ToJSON s, ToJSON p) => Infimum s p -> Value
toEncodingList :: [Infimum s p] -> Encoding
$ctoEncodingList :: forall s p. (ToJSON s, ToJSON p) => [Infimum s p] -> Encoding
toJSONList :: [Infimum s p] -> Value
$ctoJSONList :: forall s p. (ToJSON s, ToJSON p) => [Infimum s p] -> Value
toEncoding :: Infimum s p -> Encoding
$ctoEncoding :: forall s p. (ToJSON s, ToJSON p) => Infimum s p -> Encoding
toJSON :: Infimum s p -> Value
$ctoJSON :: forall s p. (ToJSON s, ToJSON p) => Infimum s p -> Value
ToJSON, Value -> Parser [Infimum s p]
Value -> Parser (Infimum s p)
(Value -> Parser (Infimum s p))
-> (Value -> Parser [Infimum s p]) -> FromJSON (Infimum s p)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall s p.
(Ord p, FromJSON p, FromJSON s) =>
Value -> Parser [Infimum s p]
forall s p.
(Ord p, FromJSON p, FromJSON s) =>
Value -> Parser (Infimum s p)
parseJSONList :: Value -> Parser [Infimum s p]
$cparseJSONList :: forall s p.
(Ord p, FromJSON p, FromJSON s) =>
Value -> Parser [Infimum s p]
parseJSON :: Value -> Parser (Infimum s p)
$cparseJSON :: forall s p.
(Ord p, FromJSON p, FromJSON s) =>
Value -> Parser (Infimum s p)
FromJSON)
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)
deriving anyclass ([EventId p] -> Encoding
[EventId p] -> Value
EventId p -> Encoding
EventId p -> Value
(EventId p -> Value)
-> (EventId p -> Encoding)
-> ([EventId p] -> Value)
-> ([EventId p] -> Encoding)
-> ToJSON (EventId p)
forall p. ToJSON p => [EventId p] -> Encoding
forall p. ToJSON p => [EventId p] -> Value
forall p. ToJSON p => EventId p -> Encoding
forall p. ToJSON p => EventId p -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EventId p] -> Encoding
$ctoEncodingList :: forall p. ToJSON p => [EventId p] -> Encoding
toJSONList :: [EventId p] -> Value
$ctoJSONList :: forall p. ToJSON p => [EventId p] -> Value
toEncoding :: EventId p -> Encoding
$ctoEncoding :: forall p. ToJSON p => EventId p -> Encoding
toJSON :: EventId p -> Value
$ctoJSON :: forall p. ToJSON p => EventId p -> Value
ToJSON, Value -> Parser [EventId p]
Value -> Parser (EventId p)
(Value -> Parser (EventId p))
-> (Value -> Parser [EventId p]) -> FromJSON (EventId p)
forall p. FromJSON p => Value -> Parser [EventId p]
forall p. FromJSON p => Value -> Parser (EventId p)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EventId p]
$cparseJSONList :: forall p. FromJSON p => Value -> Parser [EventId p]
parseJSON :: Value -> Parser (EventId p)
$cparseJSON :: forall p. FromJSON p => Value -> Parser (EventId p)
FromJSON, ToJSONKeyFunction [EventId p]
ToJSONKeyFunction (EventId p)
ToJSONKeyFunction (EventId p)
-> ToJSONKeyFunction [EventId p] -> ToJSONKey (EventId p)
forall p. ToJSON p => ToJSONKeyFunction [EventId p]
forall p. ToJSON p => ToJSONKeyFunction (EventId p)
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [EventId p]
$ctoJSONKeyList :: forall p. ToJSON p => ToJSONKeyFunction [EventId p]
toJSONKey :: ToJSONKeyFunction (EventId p)
$ctoJSONKey :: forall p. ToJSON p => ToJSONKeyFunction (EventId p)
ToJSONKey, FromJSONKeyFunction [EventId p]
FromJSONKeyFunction (EventId p)
FromJSONKeyFunction (EventId p)
-> FromJSONKeyFunction [EventId p] -> FromJSONKey (EventId p)
forall p. FromJSON p => FromJSONKeyFunction [EventId p]
forall p. FromJSON p => FromJSONKeyFunction (EventId p)
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [EventId p]
$cfromJSONKeyList :: forall p. FromJSON p => FromJSONKeyFunction [EventId p]
fromJSONKey :: FromJSONKeyFunction (EventId p)
$cfromJSONKey :: forall p. FromJSON p => FromJSONKeyFunction (EventId p)
FromJSONKey, Get (EventId p)
[EventId p] -> Put
EventId p -> Put
(EventId p -> Put)
-> Get (EventId p) -> ([EventId p] -> Put) -> Binary (EventId p)
forall p. Binary p => Get (EventId p)
forall p. Binary p => [EventId p] -> Put
forall p. Binary p => EventId p -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [EventId p] -> Put
$cputList :: forall p. Binary p => [EventId p] -> Put
get :: Get (EventId p)
$cget :: forall p. Binary p => Get (EventId p)
put :: EventId p -> Put
$cput :: forall p. Binary p => EventId p -> Put
Binary)
instance Default (EventId p) where
def :: EventId p
def = EventId p
forall p. EventId p
BottomEid
newtype Word256 = Word256 {
Word256 -> Word256
unWord256 :: DW.Word256
}
deriving stock ((forall x. Word256 -> Rep Word256 x)
-> (forall x. Rep Word256 x -> Word256) -> Generic Word256
forall x. Rep Word256 x -> Word256
forall x. Word256 -> Rep Word256 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Word256 x -> Word256
$cfrom :: forall x. Word256 -> Rep Word256 x
Generic)
deriving newtype (Word256 -> Word256 -> Bool
(Word256 -> Word256 -> Bool)
-> (Word256 -> Word256 -> Bool) -> Eq Word256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word256 -> Word256 -> Bool
$c/= :: Word256 -> Word256 -> Bool
== :: Word256 -> Word256 -> Bool
$c== :: Word256 -> Word256 -> Bool
Eq, Eq Word256
Eq Word256 =>
(Word256 -> Word256 -> Ordering)
-> (Word256 -> Word256 -> Bool)
-> (Word256 -> Word256 -> Bool)
-> (Word256 -> Word256 -> Bool)
-> (Word256 -> Word256 -> Bool)
-> (Word256 -> Word256 -> Word256)
-> (Word256 -> Word256 -> Word256)
-> Ord Word256
Word256 -> Word256 -> Bool
Word256 -> Word256 -> Ordering
Word256 -> Word256 -> Word256
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
min :: Word256 -> Word256 -> Word256
$cmin :: Word256 -> Word256 -> Word256
max :: Word256 -> Word256 -> Word256
$cmax :: Word256 -> Word256 -> Word256
>= :: Word256 -> Word256 -> Bool
$c>= :: Word256 -> Word256 -> Bool
> :: Word256 -> Word256 -> Bool
$c> :: Word256 -> Word256 -> Bool
<= :: Word256 -> Word256 -> Bool
$c<= :: Word256 -> Word256 -> Bool
< :: Word256 -> Word256 -> Bool
$c< :: Word256 -> Word256 -> Bool
compare :: Word256 -> Word256 -> Ordering
$ccompare :: Word256 -> Word256 -> Ordering
$cp1Ord :: Eq Word256
Ord, Int -> Word256 -> ShowS
[Word256] -> ShowS
Word256 -> String
(Int -> Word256 -> ShowS)
-> (Word256 -> String) -> ([Word256] -> ShowS) -> Show Word256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word256] -> ShowS
$cshowList :: [Word256] -> ShowS
show :: Word256 -> String
$cshow :: Word256 -> String
showsPrec :: Int -> Word256 -> ShowS
$cshowsPrec :: Int -> Word256 -> ShowS
Show, Int -> Word256
Word256 -> Int
Word256 -> [Word256]
Word256 -> Word256
Word256 -> Word256 -> [Word256]
Word256 -> Word256 -> Word256 -> [Word256]
(Word256 -> Word256)
-> (Word256 -> Word256)
-> (Int -> Word256)
-> (Word256 -> Int)
-> (Word256 -> [Word256])
-> (Word256 -> Word256 -> [Word256])
-> (Word256 -> Word256 -> [Word256])
-> (Word256 -> Word256 -> Word256 -> [Word256])
-> Enum Word256
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Word256 -> Word256 -> Word256 -> [Word256]
$cenumFromThenTo :: Word256 -> Word256 -> Word256 -> [Word256]
enumFromTo :: Word256 -> Word256 -> [Word256]
$cenumFromTo :: Word256 -> Word256 -> [Word256]
enumFromThen :: Word256 -> Word256 -> [Word256]
$cenumFromThen :: Word256 -> Word256 -> [Word256]
enumFrom :: Word256 -> [Word256]
$cenumFrom :: Word256 -> [Word256]
fromEnum :: Word256 -> Int
$cfromEnum :: Word256 -> Int
toEnum :: Int -> Word256
$ctoEnum :: Int -> Word256
pred :: Word256 -> Word256
$cpred :: Word256 -> Word256
succ :: Word256 -> Word256
$csucc :: Word256 -> Word256
Enum, Integer -> Word256
Word256 -> Word256
Word256 -> Word256 -> Word256
(Word256 -> Word256 -> Word256)
-> (Word256 -> Word256 -> Word256)
-> (Word256 -> Word256 -> Word256)
-> (Word256 -> Word256)
-> (Word256 -> Word256)
-> (Word256 -> Word256)
-> (Integer -> Word256)
-> Num Word256
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Word256
$cfromInteger :: Integer -> Word256
signum :: Word256 -> Word256
$csignum :: Word256 -> Word256
abs :: Word256 -> Word256
$cabs :: Word256 -> Word256
negate :: Word256 -> Word256
$cnegate :: Word256 -> Word256
* :: Word256 -> Word256 -> Word256
$c* :: Word256 -> Word256 -> Word256
- :: Word256 -> Word256 -> Word256
$c- :: Word256 -> Word256 -> Word256
+ :: Word256 -> Word256 -> Word256
$c+ :: Word256 -> Word256 -> Word256
Num)
instance FromJSON Word256 where
parseJSON :: Value -> Parser Word256
parseJSON v :: Value
v = do
(a :: Word64
a, b :: Word64
b, c :: Word64
c, d :: Word64
d) <- Value -> Parser (Word64, Word64, Word64, Word64)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Word256 -> Parser Word256
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word256 -> Word256
Word256 (Word128 -> Word128 -> Word256
DW.Word256 (Word64 -> Word64 -> Word128
DW.Word128 Word64
a Word64
b) (Word64 -> Word64 -> Word128
DW.Word128 Word64
c Word64
d)))
instance ToJSON Word256 where
toJSON :: Word256 -> Value
toJSON (Word256 (DW.Word256 (DW.Word128 a :: Word64
a b :: Word64
b) (DW.Word128 c :: Word64
c d :: Word64
d))) =
(Word64, Word64, Word64, Word64) -> Value
forall a. ToJSON a => a -> Value
toJSON (Word64
a, Word64
b, Word64
c, Word64
d)
toEncoding :: Word256 -> Encoding
toEncoding (Word256 (DW.Word256 (DW.Word128 a :: Word64
a b :: Word64
b) (DW.Word128 c :: Word64
c d :: Word64
d))) =
(Word64, Word64, Word64, Word64) -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Word64
a, Word64
b, Word64
c, Word64
d)
instance Binary Word256 where
put :: Word256 -> Put
put (Word256 (DW.Word256 (DW.Word128 a :: Word64
a b :: Word64
b) (DW.Word128 c :: Word64
c d :: Word64
d))) =
(Word64, Word64, Word64, Word64) -> Put
forall t. Binary t => t -> Put
put (Word64
a, Word64
b, Word64
c, Word64
d)
get :: Get Word256
get = do
(a :: Word64
a, b :: Word64
b, c :: Word64
c, d :: Word64
d) <- Get (Word64, Word64, Word64, Word64)
forall t. Binary t => Get t
get
Word256 -> Get Word256
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word256 -> Word256
Word256 (Word128 -> Word128 -> Word256
DW.Word256 (Word64 -> Word64 -> Word128
DW.Word128 Word64
a Word64
b) (Word64 -> Word64 -> Word128
DW.Word128 Word64
c Word64
d)))
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 ((forall x. MergeError o p e -> Rep (MergeError o p e) x)
-> (forall x. Rep (MergeError o p e) x -> MergeError o p e)
-> Generic (MergeError o p e)
forall x. Rep (MergeError o p e) x -> MergeError o p e
forall x. MergeError o p e -> Rep (MergeError 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 (MergeError o p e) x -> MergeError o p e
forall o p e x. MergeError o p e -> Rep (MergeError o p e) x
$cto :: forall o p e x. Rep (MergeError o p e) x -> MergeError o p e
$cfrom :: forall o p e x. MergeError o p e -> Rep (MergeError o p e) x
Generic)
deriving anyclass instance (Ord p, FromJSON o, FromJSON p, FromJSON e, FromJSON (State e), FromJSON (Output e)) => FromJSON (MergeError o p e)
deriving anyclass instance (ToJSON o, ToJSON p, ToJSON e, ToJSON (Output e), ToJSON (State e)) => ToJSON (MergeError 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 anyclass instance (ToJSON p, ToJSON e, ToJSON (Output e)) => ToJSON (Delta p e)
deriving anyclass instance (Ord p, FromJSON p, FromJSON e, FromJSON (Output e)) => (FromJSON (Delta p e))
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 anyclass instance (ToJSON o, ToJSON p, ToJSON e, ToJSON (Output e)) => ToJSON (Diff o p e)
deriving anyclass instance (Ord p, FromJSON o, FromJSON p, FromJSON e, FromJSON (Output e)) => FromJSON (Diff o p e)
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