{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}


{-# OPTIONS_GHC -Wno-name-shadowing #-}

{- | crdt-event-fold package tests. -}
module Main (
  main,
) where


import Data.CRDT.EventFold (Event(Output, State, apply),
  EventResult(Pure), UpdateResult(urEventFold, urNeedsPropagation,
  urOutputs), EventFold, acknowledge, bottomEid, diffMerge, disassociate,
  divergent, event, events, fullMerge, infimumValue, new, participate)
import Data.Maybe (fromJust)
import Test.Hspec (describe, hspec, it, shouldBe, shouldNotBe)
import qualified Data.Map as Map


data Ops
  = Inc
  | Dec
  deriving stock (Eq, Show)

instance Event Char Ops where
  type State Ops = Int
  type Output Ops = Int
  apply Inc state = Pure state (succ state)
  apply Dec state = Pure state (pred state)


main :: IO ()
main = hspec $ do
  describe "EventFold" $
    it "works in a specific contrived scenario" $ do
      {- New crdt with the participant 'a'.  -}
      let a = new 0 'a' :: EventFold Int Char Ops
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = BottomEid, participants = fromList \"a\", stateValue = 0}, psEvents = fromList []}}"
      infimumValue a `shouldBe` 0

      {- 'b' starts participating.  -}
      let (_eid, r) = participate 'a' 'b' a
      let a = urEventFold r
      let b = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = BottomEid, participants = fromList \"a\", stateValue = 0}, psEvents = fromList [(Eid 0 'a',(Identity (Join 'b'),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = BottomEid, participants = fromList \"a\", stateValue = 0}, psEvents = fromList [(Eid 0 'a',(Identity (Join 'b'),fromList \"a\"))]}}"

      let r = acknowledge 'b' b
      let b = urEventFold r
      let Right r = diffMerge 'a' a (fromJust (events 'a' b))
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList []}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList []}}"

      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList []"
      show (divergent b) `shouldBe` "fromList []"

      {- 'a' decrements. -}
      let (o, _, r) = event 'a' Dec a
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'a',(Identity (EventD Dec),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList []}}"
      o `shouldBe` 0
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 0 'a')]"
      show (divergent b) `shouldBe` "fromList []"

      {- 'a' decrements again.  -}
      let (o, _, r) = event 'a' Dec a
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'a',(Identity (EventD Dec),fromList \"a\")),(Eid 2 'a',(Identity (EventD Dec),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList []}}"
      o `shouldBe` negate 1
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 0 'a')]"
      show (divergent b) `shouldBe` "fromList []"

      {- 'b' decrements.  -}
      let (o, _, r) = event 'b' Dec b
      let b = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'a',(Identity (EventD Dec),fromList \"a\")),(Eid 2 'a',(Identity (EventD Dec),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'b',(Identity (EventD Dec),fromList \"b\"))]}}"
      o `shouldBe` 0
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 0 'a')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 0 'a')]"

      {- | 'b' sends update to 'a'.  -}
      let Right r = diffMerge 'a' a (fromJust (events 'a' b))
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'a',(Identity (EventD Dec),fromList \"a\")),(Eid 1 'b',(Identity (EventD Dec),fromList \"ab\")),(Eid 2 'a',(Identity (EventD Dec),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'b',(Identity (EventD Dec),fromList \"b\"))]}}"
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 1 'b')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 0 'a')]"

      {- | 'a' sends update to 'b'.  -}
      let Right r = diffMerge 'b' b (fromJust (events 'b' a))
      let b = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 0 'a', participants = fromList \"ab\", stateValue = 0}, psEvents = fromList [(Eid 1 'a',(Identity (EventD Dec),fromList \"a\")),(Eid 1 'b',(Identity (EventD Dec),fromList \"ab\")),(Eid 2 'a',(Identity (EventD Dec),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList []}}"
      show (urOutputs r) `shouldBe` "fromList [(Eid 1 'a',0),(Eid 1 'b',-1),(Eid 2 'a',-2)]"
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 1 'b')]"
      show (divergent b) `shouldBe` "fromList []"

      {- | 'b' sends update to 'a'.  -}
      let Right r = diffMerge 'a' a (fromJust (events 'a' b))
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList []}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList []}}"
      show (urOutputs r) `shouldBe` "fromList [(Eid 1 'a',0),(Eid 1 'b',-1),(Eid 2 'a',-2)]"
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList []"
      show (divergent b) `shouldBe` "fromList []"
      show a `shouldBe` show b

      {- | 'b' sends update to 'a' (again).  -}
      let Right r = diffMerge 'a' a (fromJust (events 'a' b))
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList []}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList []}}"
      show (urOutputs r) `shouldBe` "fromList []"
      urNeedsPropagation r `shouldBe` False
      show (divergent a) `shouldBe` "fromList []"
      show (divergent b) `shouldBe` "fromList []"
      show a `shouldBe` show b
      
      {- 'a' increments. -}
      let (o, _, r) = event 'a' Inc a
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList []}}"
      o `shouldBe` negate 3
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 2 'a')]"
      show (divergent b) `shouldBe` "fromList []"

      {- 'b' increments. -}
      let (o, _, r) = event 'b' Inc b
      let b = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'b',(Identity (EventD Inc),fromList \"b\"))]}}"
      o `shouldBe` negate 3
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 2 'a')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 2 'a')]"

      {- 'c' joins on 'a' -}
      let (_eid, r) = participate 'a' 'c' a
      let a = urEventFold r
      let r = acknowledge 'c' a
      let a = urEventFold r
      let c = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'b',(Identity (EventD Inc),fromList \"b\"))]}}"
      show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      a `shouldBe` c
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 2 'a')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 2 'a')]"
      show (divergent c) `shouldBe` "fromList [('b',Eid 2 'a')]"

      {- 'a' increments. -}
      let (o, _, r) = event 'a' Inc a
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'b',(Identity (EventD Inc),fromList \"b\"))]}}"
      show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      o `shouldBe` negate 2
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 2 'a'),('c',Eid 4 'a')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 2 'a')]"
      show (divergent c) `shouldBe` "fromList [('b',Eid 2 'a')]"

      {- 'b' increments. -}
      let (o, _, r) = event 'b' Inc b
      let b = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'b',(Identity (EventD Inc),fromList \"b\")),(Eid 4 'b',(Identity (EventD Inc),fromList \"b\"))]}}"
      show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      o `shouldBe` negate 2
      urOutputs r `shouldBe` mempty
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 2 'a'),('c',Eid 4 'a')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 2 'a')]"
      show (divergent c) `shouldBe` "fromList [('b',Eid 2 'a')]"

      {- | 'b' sends update to 'a'.  -}
      let Right r = diffMerge 'a' a (fromJust (events 'a' b))
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 3 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\")),(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'b',(Identity (EventD Inc),fromList \"b\")),(Eid 4 'b',(Identity (EventD Inc),fromList \"b\"))]}}"
      show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      show (urOutputs r) `shouldBe` "fromList []"
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 4 'b'),('c',Eid 4 'a')]"
      show (divergent b) `shouldBe` "fromList [('a',Eid 2 'a')]"
      show (divergent c) `shouldBe` "fromList [('b',Eid 2 'a')]"

      do {- A world where c leaves.  -}
        let (_eid, r) = disassociate 'c' c
        show (urEventFold r) `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\")),(Eid 5 'c',(Identity (UnJoin 'c'),fromList \"c\"))]}}"

      {- | 'a' sends update to 'b'.  -}
      let Right r = diffMerge 'b' b (fromJust (events 'b' a))
      let b = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 3 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\")),(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"a\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
      show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      show (urOutputs r) `shouldBe` "fromList [(Eid 3 'a',-3),(Eid 3 'b',-2)]"
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('b',Eid 4 'b'),('c',Eid 4 'a')]"
      show (divergent b) `shouldBe` "fromList [('c',Eid 4 'a')]"
      show (divergent c) `shouldBe` "fromList [('b',Eid 2 'a')]"

      {- | 'b' sends update to 'a'.  -}
      let Right r = diffMerge 'a' a (fromJust (events 'a' b))
      let a = urEventFold r
      show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
      show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
      show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 2 'a', participants = fromList \"ab\", stateValue = -3}, psEvents = fromList [(Eid 3 'a',(Identity (EventD Inc),fromList \"ac\")),(Eid 4 'a',(Identity (Join 'c'),fromList \"ac\"))]}}"
      show (urOutputs r) `shouldBe` "fromList [(Eid 3 'a',-3),(Eid 3 'b',-2)]"
      urNeedsPropagation r `shouldBe` True
      show (divergent a) `shouldBe` "fromList [('c',Eid 4 'a')]"
      show (divergent b) `shouldBe` "fromList [('c',Eid 4 'a')]"
      show (divergent c) `shouldBe` "fromList [('b',Eid 2 'a')]"
      show a `shouldBe` show b
      infimumValue a `shouldBe` negate 1

      do {-
           World 1, b erroneously sends an update to c using diffMerge,
           dropping (Eid 3 'a') (because b's Diff infimum is (Eid 4 'a')).
         -}
        {- 
          TODO I think we can detect this condition and throw an exception
          instead of just doing the wrong thing.
        -}
        {- | 'b' sends update to 'c'.  -}
        let Right r = diffMerge 'c' c (fromJust (events 'c' b))
        let c = urEventFold r
        show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
        show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
        show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 0}, psEvents = fromList []}}"
        show (urOutputs r) `shouldBe` "fromList [(Eid 3 'a',-3),(Eid 4 'b',-2),(Eid 5 'a',-1)]"
        urNeedsPropagation r `shouldBe` True
        show (divergent a) `shouldBe` "fromList [('c',Eid 4 'a')]"
        show (divergent b) `shouldBe` "fromList [('c',Eid 4 'a')]"
        show (divergent c) `shouldBe` "fromList []"

        {- | 'c' sends update to 'a'.  -}
        let Right r = diffMerge 'a' a (fromJust (events 'a' c))
        let a = urEventFold r
        show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
        show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 0}, psEvents = fromList []}}"
        show (urOutputs r) `shouldBe` "fromList [(Eid 4 'b',-1),(Eid 5 'a',0)]"
        urNeedsPropagation r `shouldBe` True
        show (divergent a) `shouldBe` "fromList []"
        show (divergent b) `shouldBe` "fromList [('c',Eid 4 'a')]"
        show (divergent c) `shouldBe` "fromList []"

        {- | 'a' sends update to 'b'.  -}
        let Right r = diffMerge 'b' b (fromJust (events 'b' a))
        let b = urEventFold r
        show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 0}, psEvents = fromList []}}"
        show (urOutputs r) `shouldBe` "fromList [(Eid 4 'b',-1),(Eid 5 'a',0)]"
        urNeedsPropagation r `shouldBe` True
        show (divergent a) `shouldBe` "fromList []"
        show (divergent b) `shouldBe` "fromList []"
        show (divergent c) `shouldBe` "fromList []"
        show a `shouldBe` show b
        show a `shouldNotBe` show c

      do {- World 2, b does the right thing and updates c using fullMerge.  -}
        {- | 'b' sends update to 'c'.  -}
        let Right r = fullMerge 'c' c b
        let c = urEventFold r
        show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
        show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
        show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show (urOutputs r) `shouldBe` "fromList [(Eid 4 'b',-1),(Eid 5 'a',0)]"
        urNeedsPropagation r `shouldBe` True
        show (divergent a) `shouldBe` "fromList [('c',Eid 4 'a')]"
        show (divergent b) `shouldBe` "fromList [('c',Eid 4 'a')]"
        show (divergent c) `shouldBe` "fromList []"

        {- | 'c' sends update to 'a'.  -}
        let Right r = diffMerge 'a' a (fromJust (events 'a' c))
        let a = urEventFold r
        show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 4 'a', participants = fromList \"abc\", stateValue = -1}, psEvents = fromList [(Eid 4 'b',(Identity (EventD Inc),fromList \"ab\")),(Eid 5 'a',(Identity (EventD Inc),fromList \"ab\"))]}}"
        show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show (urOutputs r) `shouldBe` "fromList [(Eid 4 'b',-1),(Eid 5 'a',0)]"
        urNeedsPropagation r `shouldBe` True
        show (divergent a) `shouldBe` "fromList []"
        show (divergent b) `shouldBe` "fromList [('c',Eid 4 'a')]"
        show (divergent c) `shouldBe` "fromList []"

        {- | 'a' sends update to 'b'.  -}
        let Right r = diffMerge 'b' b (fromJust (events 'b' a))
        let b = urEventFold r
        show a `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show b `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show c `shouldBe` "EventFold {unEventFold = EventFoldF {psOrigin = 0, psInfimum = Infimum {eventId = Eid 5 'a', participants = fromList \"abc\", stateValue = 1}, psEvents = fromList []}}"
        show (urOutputs r) `shouldBe` "fromList [(Eid 4 'b',-1),(Eid 5 'a',0)]"
        urNeedsPropagation r `shouldBe` True
        show (divergent a) `shouldBe` "fromList []"
        show (divergent b) `shouldBe` "fromList []"
        show (divergent c) `shouldBe` "fromList []"
        show a `shouldBe` show b
        show a `shouldBe` show c

  describe "divergent" $ do
    it "marks an unacked join as divergent" $ do
      let
        a = new 0 'a' :: EventFold Int Char Ops
        b = urEventFold . snd . participate 'a' 'b' $ a
      divergent b `shouldBe` Map.fromList [('b', bottomEid)]
    it "does not mark an acked join as divergent" $ do
      let
        a = new 0 'a' :: EventFold Int Char Ops
        b = urEventFold . snd . participate 'a' 'b' $ a
        c = urEventFold . snd . participate 'a' 'c' $ b
        d = urEventFold . acknowledge 'c' $ c
      divergent d `shouldBe` Map.fromList [('b', bottomEid)]

  describe "events" $ do
    it "balks on infimum invalidity" $ do
      let
        b =
          let
            a = new 0 'a' :: EventFold Int Char Ops
          in
            urEventFold . snd . participate 'a' 'b' $ a
      events 'b' b `shouldBe` Nothing
      (const () <$> events 'a' b) `shouldBe` Just ()
    it "balkes on unjoin/join invalidity" $ do
      let
        d =
          let
            a = new 0 'a' :: EventFold Int Char Ops
            b = urEventFold . snd . participate 'a' 'b' $ a
            c = urEventFold . snd . disassociate 'b' $ b
          in
            urEventFold . snd . participate 'a' 'b' $ c
      events 'b' d `shouldBe` Nothing
      (const () <$> events 'a' d) `shouldBe` Just ()
    it "succeeds in the usual case" $ do
      let
        c =
          let
            a = new 0 'a' :: EventFold Int Char Ops
            b = urEventFold . snd . participate 'a' 'b' $ a
          in
            urEventFold . acknowledge 'b' $ b
      (const () <$> events 'a' c) `shouldBe` Just ()
      (const () <$> events 'b' c) `shouldBe` Just ()