{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-name-shadowing -Wno-incomplete-uni-patterns #-}
{- | 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, allParticipants, bottomEid,
diffMerge, disassociate, divergent, event, events, fullMerge,
infimumParticipants, infimumValue, new, participate, projParticipants)
import Data.Maybe (fromJust)
import Prelude (Bool(False, True), Either(Right), Enum(pred, succ),
Maybe(Just, Nothing), Monoid(mempty), Num(negate), Show(show), ($),
(.), (<$>), Char, Eq, IO, Int, const, snd)
import Test.Hspec (describe, hspec, it, shouldBe)
import qualified Data.Map as Map
import qualified Data.Set as Set
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 {psOrigin = 0, psInfimum = Infimum {eventId = BottomEid, participants = fromList \"a\", stateValue = 0}, psEvents = fromList [], psUnjoins = 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, urEventFold -> 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\"))]}}"
(allParticipants r, projParticipants r, infimumParticipants r) `shouldBe` (Set.fromList "abc", Set.fromList "ab", Set.fromList "ab")
{- | '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 "false-renegade" $ do
{-
This tests for the bug where UnJoin may not work because we
falsely believe that the UnJoin event is a renegade when it gets
reduced in the same batch as its own Join.
-}
let
a = new 0 'a' :: EventFold Int Char Ops
b = urEventFold . snd . participate 'a' 'b' $ a
c = urEventFold . snd . disassociate 'b' $ b
projParticipants c `shouldBe` Set.fromList "a"
it "balks 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 ()