crdt-3.0: test/LWW.hs

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

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module LWW
    ( genUniquelyTimedLWW
    , prop_Cm
    , prop_assign
    , prop_merge_with_former
    , test_Cv
    ) where

import           Control.Monad.State.Strict (StateT, lift)
import           Data.Semigroup ((<>))
import           Data.Set (Set)
import qualified Data.Set as Set
import           Test.QuickCheck (Arbitrary, Gen, arbitrary, (===))

import           CRDT.LamportClock (LamportTime, runLamportClock, runProcess)
import           CRDT.LWW (LWW (LWW), assign, initial, query)

import           Laws (cmrdtLaw, cvrdtLaws)
import           QCUtil (genUnique)

prop_Cm = cmrdtLaw @(LWW Char)

test_Cv = cvrdtLaws @(LWW Char) $ Just (genUniquelyTimedLWW, Set.empty)

prop_assign pid1 pid2 (formerValue :: Char) latterValue = runLamportClock $ do
    state1 <- runProcess pid1 $ initial formerValue
    state2 <- runProcess pid2 $ assign latterValue state1
    pure $ query state2 === latterValue

prop_merge_with_former pid1 pid2 (formerValue :: Char) latterValue =
    runLamportClock $ do
        state1 <- runProcess pid1 $ initial formerValue
        state2 <- runProcess pid2 $ assign latterValue state1
        pure $ query (state1 <> state2) === latterValue

-- | Generate specified number of 'LWW' with unique timestamps
genUniquelyTimedLWW :: Arbitrary a => StateT (Set LamportTime) Gen (LWW a)
genUniquelyTimedLWW = LWW <$> lift arbitrary <*> genUnique