crdt-8.0: test/RGA.hs

{-# OPTIONS_GHC -Wno-missing-signatures #-}

{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

module RGA where

import           Control.Monad.State.Strict (execStateT, runStateT)
import           Data.Maybe (isJust)
import qualified Data.Vector as Vector
import           Test.QuickCheck (conjoin, counterexample, (===))

import           CRDT.Cm (apply, initial, makeAndApplyOp, makeOp)
import           CRDT.Cm.RGA (RGA (OpAddAfter), RgaIntent (AddAfter),
                              fromString, load, toString)
import           CRDT.LamportClock (LamportTime (LamportTime), Pid (Pid),
                                    advance)
import           CRDT.LamportClock.Simulation (ProcessSim, runLamportClockSim,
                                               runProcessSim)

import           Laws (cmrdtLaw)
import           Util (pattern (:-), expectRightK)

prop_makeOp =
    isJust
        (makeOp @(RGA Char) (AddAfter Nothing 'a') (initial @(RGA Char))
        :: Maybe (ProcessSim (RGA Char)))

prop_makeAndApplyOp = conjoin
    [ counterexample "result3"  $ result3  === Right (op3, payload3)
    , counterexample "result2"  $ result2  === Right (op2, payload2)
    , counterexample "result1"  $ result1  === Right (op1, payload1)
    , counterexample "result12" $ result12 === payload12
    , counterexample "results=" $ result21 === result12
    ]
  where
    time1 = LamportTime 4 $ Pid 1
    time2 = LamportTime 4 $ Pid 2
    time3 = LamportTime 3 $ Pid 3
    op1 = OpAddAfter Nothing '1' time1
    op2 = OpAddAfter Nothing '2' time2
    op3 = OpAddAfter Nothing '3' time3
    payload3 = load $ Vector.singleton (time3 :- Just '3')
    payload1 = load $ Vector.fromList [time1 :- Just '1', time3 :- Just '3']
    payload2 = load $ Vector.fromList [time2 :- Just '2', time3 :- Just '3']
    payload12 = load $ Vector.fromList
        [time2 :- Just '2', time1 :- Just '1', time3 :- Just '3']
    result3 =
        runLamportClockSim .
        runProcessSim (Pid 3) .
        (`runStateT` initial @(RGA Char)) $ do
            advance 2
            makeAndApplyOp @(RGA Char) (AddAfter Nothing '3')
    result2 =
        runLamportClockSim . runProcessSim (Pid 2) . (`runStateT` payload3) $ do
            advance 1
            makeAndApplyOp @(RGA Char) (AddAfter Nothing '2')
    result1 =
        runLamportClockSim . runProcessSim (Pid 1) . (`runStateT` payload3) $
            makeAndApplyOp @(RGA Char) (AddAfter Nothing '1')
    result12 = apply op2 payload1
    result21 = apply op1 payload2

prop_fromString s pid =
    result ===
    Right (load $ Vector.fromList
        [LamportTime t pid :- Just c | t <- [1..] | c <- s])
  where
    result =
        runLamportClockSim .
        runProcessSim pid .
        (`execStateT` initial @(RGA Char)) $
        fromString s

prop_fromString_toString s pid =
    expectRightK result $ \s' -> toString s' === s
  where
    result =
        runLamportClockSim .
        runProcessSim pid .
        (`execStateT` initial @(RGA Char)) $
        fromString s

prop_Cm = cmrdtLaw @(RGA Char)