crdt-7.0: test/RGA.hs

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

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

module RGA where

import           Control.Monad.State.Strict (get)
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 (initial @(RGA Char)) $
        runProcessSim (Pid 3) $ do
            advance 2
            (,) <$> makeAndApplyOp @(RGA Char) (AddAfter Nothing '3')
                <*> get
    result2 = runLamportClockSim payload3 $ runProcessSim (Pid 2) $ do
        advance 1
        (,) <$> makeAndApplyOp @(RGA Char) (AddAfter Nothing '2')
            <*> get
    result1 = runLamportClockSim payload3 $ runProcessSim (Pid 1) $
        (,) <$> makeAndApplyOp @(RGA Char) (AddAfter Nothing '1')
            <*> get
    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 (initial @(RGA Char)) $
        runProcessSim pid $ do
            _ <- fromString s
            get

prop_fromString_toString s pid =
    expectRightK result $ \s' -> toString s' === s
  where
    result = runLamportClockSim (initial @(RGA Char)) $ runProcessSim pid $ do
        _ <- fromString s
        get

prop_Cm = cmrdtLaw @(RGA Char)