{-# 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 #-}

{- | Description: Garbage collected event folding CRDT. -}
module Data.CRDT.EventFold (
  -- * Overview
  {- |
    This module provides a CRDT data structure that collects and applies
    operations (called "events") that mutate an underlying data structure.

    It is "Garbage Collected" in the sense that the number of operations
    accumulated in the structure will not grow unbounded, assuming that
    participants manage to sync their data once in a while. The size of
    the data (as measured by the number of operations we have to store)
    is allowed to shrink.

    In addition to mutating the underlying data, each operation can
    also produce an output that can be obtained by the client. The
    output can be either totally consistent across all replicas (which
    is slower), or it can be returned immediately and possibly reflect
    an inconsistent state.
  -}

  -- ** Garbage Collection
  {- |
    Unlike many traditional CRDTs which always grow and never shrink,
    'EventFold' has a mechanism for determining what consensus
    has been reached by all of the participants, which allows us to
    "garbage collect" events that achieved total consensus. Perhaps more
    importantly, this allows us to produce the totally consistent output
    for events for which total consensus has been achieved.

    But there are trade offs. The big downside is that participation in the
    distributed replication of the 'EventFold' must be strictly managed.

    - The process of participating itself involves registering with an
      existing participant, using 'participate'. You can't just send the
      data off to some other computer and expect that now that computer
      is participating in the CRDT. It isn't.
    - Participants can not "restore from backup". Once they have
      incorporated data received from other participants or generated
      new data themselves, and that data has been transmitted to any
      other participant, they are committed to using that result going
      forward. Doing anything that looks like "restoring from an older
      version" would destroy the idea that participants have reached
      consensus on anything, and the results would be undefined and
      almost certainly completely wrong. This library is written with
      some limited capability to detect this situation, but it is not
      always possible to detect it all cases. Many times you will just
      end up with undefined behavior.
  -}

  -- ** A Belabored Analogy
  {- |
    The 'EventFold' name derives from a loose analogy to folding over
    a list of events using plain old 'foldl'. The component parts of
    'foldl' are:

    - A binary operator, analogous to 'apply'.

    - An accumulator value, analogous to 'infimumValue'.

    - A list of values to fold over, loosely analogous to "the list of
      all future calls to 'event'".

    - A return value.  There is no real analogy for the "return value".
      Similarly to how you never actually obtain a return value if you
      try to 'foldl' over an infinite list, 'EventFold's are meant to be
      long-lived objects that accommodate an infinite number of calls
      to 'event'. What you can do is inspect the current value of the
      accumulator using 'infimumValue', or the "projected" value of
      the accumulator using 'projectedValue' (where "projected" means
      "taking into account all of the currently known calls to 'event'
      that have not yet been folded into the accumulator, and which may
      yet turn out to to have other events inserted into the middle or
      beginning of the list").

    The 'EventFold' value itself can be thought of as an intermediate,
    replicated, current state of the fold of an infinite list of events
    that has not yet been fully generated.  So you can, for instance,
    check the current accumulator value.

    In a little more detail, consider the type signature of 'foldl'
    (for lists).

    > foldl
    >   :: (b -> a -> b) -- Analogous to 'apply', where 'a' is your 'Event'
    >                    -- instance, and 'b' is 'State a'.
    >
    >   -> b             -- Loosely analogous to 'infimumValue' where
    >                    -- progressive applications are accumulated.
    >
    >   -> [a]           -- Analogous to all outstanding or future calls to
    >                    -- 'event'.
    >
    >   -> b             
  -}
  -- * Basic API
  -- ** Creating new CRDTs
  new,

  -- ** Adding new events
  event,

  -- ** Coordinating replica updates
  {- |
    Functions in this section are used to help merge foreign copies of
    the CRDT, and transmit our own copy. (This library does not provide
    any kind of transport support, except that all the relevant types
    have 'Binary' instances. Actually arranging for these things to get
    shipped across a wire is left to the user.)

    In principal, the only function you need is 'fullMerge'. Everything
    else in this section is an optimization.  You can ship the full
    'EventFold' value to a remote participant and it can incorporate
    any changes using 'fullMerge', and vice versa. You can receive an
    'EventFold' value from another participant and incorporate its
    changes locally using 'fullMerge'.

    However, if your underlying data structure is large, it may be more
    efficient to just ship a sort of diff containing the information
    that the local participant thinks the remote participant might be
    missing. That is what 'events' and 'diffMerge' are for.
  -}
  fullMerge,
  UpdateResult(..),
  events,
  diffMerge,
  MergeError(..),

  -- ** Participation
  participate,
  disassociate,

  -- ** Defining your state and events
  Event(..),
  EventResult(..),

  -- * Inspecting the 'EventFold'
  isBlockedOnError,
  projectedValue,
  infimumValue,
  infimumId,
  infimumParticipants,
  allParticipants,
  projParticipants,
  origin,
  divergent,

  -- * Underlying Types
  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)


{- |
  This type is a
  <https://en.wikipedia.org/wiki/Conflict-free_replicated_data_type CRDT>
  into which participants can add 'Event's that are folded into a
  base 'State'. You can also think of the "events" as operations that
  mutate the base state, and the point of this CRDT is to coordinate
  the application of the operations across all participants so that
  they are applied consistently even if the operations themselves are
  not commutative, idempotent, or monotonic.

  Variables are:

  - @o@ - Origin
  - @p@ - Participant
  - @e@ - Event

  The "Origin" is a value that is more or less meant to identify the
  "thing" being replicated, and in particular identify the historical
  lineage of the 'EventFold'. The idea is that it is meaningless to
  try and merge two 'EventFold's that do not share a common history
  (identified by the origin value) and doing so is a programming error. It
  is only used to try and check for this type of programming error and
  throw an exception if it happens instead of producing undefined (and
  difficult to detect) behavior.
-}
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)


{- |
  `Infimum` is the infimum, or greatest lower bound, of the possible
  values of @s@.
-}
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


{- |
  `EventId` is a monotonically increasing, totally ordered identification
  value which allows us to lend the attribute of monotonicity to event
  application operations which would not naturally be monotonic.
-}
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 around 'DW.Word256' to supply typeclass instances. -}
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)))


{- |
  This is the exception type for illegal merges. These errors indicate
  serious programming bugs.
-}
data MergeError o p e
  = DifferentOrigins o o
    {- ^
      The 'EventFold's do not have the same origin. It makes no sense
      to merge 'EventFold's that have different origins because they
      do not share a common history.
    -}
  | DiffTooNew (EventFold o p e) (Diff o p e)
    {- ^
      The `Diff`'s infimum is greater than any event known to 'EventFold'
      into which it is being merged. This should be impossible and
      indicates that either the local 'EventFold' has rolled back an
      event that it had previously acknowledged, or else the source of
      the 'Diff' moved the infimum forward without a full acknowledgement
      from all participants. Both of these conditions should be regarded
      as serious bugs.
    -}
  | DiffTooSparse (EventFold o p e) (Diff o p e)
    {- ^
      The 'Diff' assumes we know about events that we do not in fact know
      about. This is only possible if we rolled back our copy of the state
      somehow and "forgot" about state that we had previous acknowledged,
      or else some other participant erroneously acknowledged some events
      on our behalf.
    -}
  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)


{- | `Delta` is how we represent mutations to the event fold state. -}
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)


{- |
  Instances of this class define the particular "events" being "folded"
  over in a distributed fashion. In addition to the event type itself,
  there are a couple of type families which define the 'State' into which
  folded events are accumulated, and the 'Output' which application of
  a particular event can generate.

  TL;DR: This is how users define their own custom operations.
-}
class Event e where
  type Output e
  type State e
  {- | Apply an event to a state value. **This function MUST be total!!!** -}
  apply :: e -> State e -> EventResult e
{- | The most trivial event type. -}
instance Event () where
  type Output () = ()
  type State () = ()
  apply :: () -> State () -> EventResult ()
apply () () = Output () -> State () -> EventResult ()
forall e. Output e -> State e -> EventResult e
Pure () ()
{- | The union of two event types. -}
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)


{- |
  The result of applying an event.

  Morally speaking, events are always pure functions. However, mundane
  issues like finite memory constraints and finite execution time can
  cause referentially opaque behavior. In a normal Haskell program, this
  usually leads to a crash or an exception, and the crash or exception
  can itself, in a way, be thought of as being referentially transparent,
  because there is no way for it to both happen and, simultaneously,
  not happen.

  However, in our case we are replicating computations across many
  different pieces of hardware, so there most definitely is a way
  for these aberrant system failures to both happen and not happen
  simultaneously. What happens if the computation of the event runs out
  of memory on one machine, but not on another?

  There exists a strategy for dealing with these problems: if the
  computation of an event experiences a failure on every participant, then
  the event is pushed into the infimum as a failure (i.e. a no-op), but if
  any single participant successfully computes the event then all other
  participants can (somehow) request a "Full Merge" from the successful
  participant. The Full Merge will include the infimum __value__ computed
  by the successful participant, which will include the successful
  application of the problematic event. The error participants can thus
  bypass computation of the problem event altogether, and can simply
  overwrite their infimum with the infimum provided by the Full Merge.

  Doing a full merge can be much more expensive than doing a simple
  'Diff' merge, because it requires transmitting the full value of the
  'EventFold' instead of just the outstanding operations.

  This type represents how computation of the event finished; with either a
  pure result, or some kind of system error.

  TL;DR:

  In general 'SystemError' is probably only ever useful for when your
  event type somehow executes untrusted code (for instance when your event
  type is a Turing-complete DSL that allows users to submit their own
  custom-programmed "events") and you want to limit the resources that
  can be consumed by such untrusted code.  It is much less useful when
  you are encoding some well defined business logic directly in Haskell.
-}
data EventResult e
  = SystemError (Output e)
  | Pure (Output e) (State e)


{- |
  Construct a new 'EventFold' with the given origin and initial
  participant.
-}
new
  :: (Default (State e), Ord p)
  => o {- ^ The "origin", identifying the historical lineage of this CRDT. -}
  -> p {- ^ The initial participant. -}
  -> 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
      }


{- |
  Get the outstanding events that need to be propagated to a particular
  participant.
-}
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
    {- |
      Don't send the event data to participants which have already
      acknowledged it, saving network and cpu resources.
    -}
    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
      )


{- | A package containing events that can be merged into an event fold. -}
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)


{- |
  Like 'fullMerge', but merge a remote 'Diff' instead of a full remote
  'EventFold'.
-}
diffMerge
  :: ( Eq (Output e)
     , Eq e
     , Eq o
     , Event e
     , Ord p
     )
  => p {- ^ The "local" participant doing the merge. -}
  -> EventFold o p e {- ^ The local copy of the 'EventFold'. -}
  -> Diff o p e {- ^ The 'Diff' provided by the remote participant. -}
  -> 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)


{- |
  Monotonically merge the information in two 'EventFold's.  The resulting
  'EventFold' may have a higher infimum value, but it will never have a
  lower one (where "higher" and "lower" are measured by 'infimumId' value,
  not the value of the underlying data structure). Only 'EventFold's
  that originated from the same 'new' call can be merged. If the origins
  are mismatched, or if there is some other programming error detected,
  then an error will be returned.

  Returns the new 'EventFold' value, along with the output for all of
  the events that can now be considered "fully consistent".
-}
fullMerge
  :: ( Eq (Output e)
     , Eq e
     , Eq o
     , Event e
     , Ord p
     )
  => p {- ^ The "local" participant doing the merge. -}
  -> EventFold o p e {- ^ The local copy of the 'EventFold'. -}
  -> EventFold o p e {- ^ The remote copy of the 'Eventfold'. -}
  -> 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)
        )


{- |
  The result updating the 'EventFold', which contains:

  - The new 'EventFold' value,
  - The outputs of events that have reached the infimum as a result of
    the update (i.e. "totally consistent outputs"),
  - And a flag indicating whether the other participants need to hear
    about the changes.
-}
data UpdateResult o p e =
    UpdateResult {
             UpdateResult o p e -> EventFold o p e
urEventFold :: EventFold o p e,
                            {- ^ The new 'EventFold' value -}
               UpdateResult o p e -> Map (EventId p) (Output e)
urOutputs :: Map (EventId p) (Output e),
                            {- ^
                              Any consistent outputs resulting from
                              the update.
                            -}
      UpdateResult o p e -> Bool
urNeedsPropagation :: Bool
                            {- ^
                              'True' if any new information was added to
                              the 'EventFold' which might need propagating
                              to other participants.
                            -}
    }


{- |
  Record the fact that the participant acknowledges the information
  contained in the 'EventFold'. The implication is that the participant
  __must__ base all future operations on the result of this function.

  Returns the new 'EventFold' value, along with the output for all of
  the events that can now be considered "fully consistent".
-}
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 =
    {-
      First do a normal reduction, then do a special acknowledgement of the
      reduction error, if any.
    -}
    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)


{- | Acknowledge the reduction error, if one exists. -}
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
      }


{- |
  Allow a participant to join in the distributed nature of the
  'EventFold'. Return the 'EventId' at which the participation is
  recorded, and the resulting 'EventFold'. The purpose of returning the
  'EventId' is so that you can use it to tell when the participation
  event has reached the infimum. See also: 'infimumId'
-}
participate :: forall o p e. (Ord p, Event e)
  => p {- ^ The local participant. -}
  -> p {- ^ The participant being added. -}
  -> 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,
          {- 
            By definition, we have added some new information that
            needs propagating.
          -}
          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


{- |
  Indicate that a participant is removing itself from participating in
  the distributed 'EventFold'.
-}
disassociate :: forall o p e. (Event e, Ord p)
  => p {- ^ The peer removing itself from participation. -}
  -> 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,
          {- 
            By definition, we have added some new information that
            needs propagating.
          -}
          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


{- |
  Introduce a change to the EventFold on behalf of the participant.
  Return the new 'EventFold', along with the projected output of the
  event, along with an 'EventId' which can be used to get the fully
  consistent event output at a later time.
-}
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 =
            {-
              An event is, by definition, adding information to the 'EventFold',
              and the only time we might not need to propagate this this
              information is if the local participant is the only participant.
            -}
            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
        }
    )


{- | Return the current projected value of the 'EventFold'. -}
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


{- | Return the current infimum value of the 'EventFold'. -}
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


{- | Return the 'EventId' of the infimum value. -}
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


{- |
  Gets the known participants at the infimum.
-}
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


{- |
  Get all known participants. This includes participants that are
  projected for removal.
-}
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


{- |
  Get all the projected participants. This does not include participants that
  are projected for removal.
-}
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


{- |
  Returns the participants that we think might be diverging. In
  this context, a participant is "diverging" if there is an event
  that the participant has not acknowledged but we are expecting it
  to acknowledge. Along with the participant, return the last known
  `EventId` which that participant has acknowledged.
-}
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
      )


{- | Return the origin value of the 'EventFold'. -}
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


{- |
  This helper function is responsible for figuring out if the 'EventFold'
  has enough information to derive a new infimum value. In other words,
  this is where garbage collection happens.
-}
reduce
  :: forall o p e f.
     ( Event e
     , Monad f
     , Ord p
     )
  => EventId p
     {- ^
       The infimum 'EventId' as known by some node in the cluster. "Some
       node" can be different than "this node" in the case where another
       node advanced the infimum before we did (because it knew about our
       acknowledgement, but we didn't know about its acknowledgement)
       and sent us an 'Diff' with this value of the infimum. In this
       case, this infimum value acts as a universal acknowledgement of
       all events coming before it.
     -}
  -> 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 -> {- The event is obsolete. Ignore it. -}
            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 -> {- This is a renegade event. Ignore it. -}
            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
              {- |
                Join events must be acknowledged by the joining
                participant before moving into the infimum.
              -}
              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
    {- | Unwrap the events from their monad. -}
    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_
      ]

    {- | Figure out which nodes have upcoming unjoins. -}
    unjoins
      :: EventId p
         {- ^
           The even under consideration, unjoins only after which we
           are interested.
         -}
      -> 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

    {- | The static map of unjoins. -}
    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
        ]

    {- |
      Renegade events are events that originate from a non-participating
      peer.  This might happen in a network partition situation, where
      the cluster ejected a peer that later reappears on the network,
      broadcasting updates.
    -}
    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)


{- |
  A utility function that constructs the next `EventId` on behalf of
  a participant.
-}
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


{- |
  Return 'True' if progress on the 'EventFold' is blocked on a
  'SystemError'.

  The implication here is that if the local copy is blocked on a
  'SystemError', it needs to somehow arrange for remote copies to send
  full 'EventFold's, not just 'Diff's. A 'diffMerge' is not sufficient
  to get past the block. Only a 'fullMerge' will suffice.
  
  If your system is not using 'SystemError' or else not using 'Diff's,
  then you don't ever need to worry about this function.
-}
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