module Control.OperationalTransformation.Properties
( prop_compose_apply
, prop_transform_apply
, prop_transform_compose
, prop_transform_compose_compat_l
, prop_transform_compose_compat_r
) where
import Control.OperationalTransformation
import Test.QuickCheck hiding (Result, reason)
import Test.QuickCheck.Property
import Control.Applicative ((<$>), (<*>))
(==?) :: (Eq a, Show a) => a -> a -> Result
a ==? b | a == b = succeeded
| otherwise = failed { reason = "expected " ++ show a ++ " to be " ++ show b }
eitherProperty :: (Either String a) -> (a -> Property) -> Property
eitherProperty (Left err) _ = property $ failed { reason = err }
eitherProperty (Right res) prop = prop res
prop_compose_apply :: (OTSystem doc op, OTComposableOperation op, Arbitrary doc, Show doc, Eq doc)
=> (doc -> Gen op) -> Property
prop_compose_apply genOperation = property $ do
doc <- arbitrary
a <- genOperation doc
return $ eitherProperty (apply a doc) $ \doc' -> property $ do
b <- genOperation doc'
return $ eitherProperty ((,) <$> apply b doc' <*> compose a b) $ \(doc'', ab) ->
property $ Right doc'' ==? apply ab doc
prop_transform_apply :: (OTSystem doc op, Arbitrary doc, Show doc, Eq doc)
=> (doc -> Gen op)
-> Property
prop_transform_apply genOperation = property $ do
doc <- arbitrary
a <- genOperation doc
b <- genOperation doc
let res1 = (,,) <$> apply a doc <*> apply b doc <*> transform a b
return $ eitherProperty res1 $ \(doca, docb, (a', b')) ->
let res2 = (,) <$> apply b' doca <*> apply a' docb
in eitherProperty res2 $ \(docab', docba') ->
property $ docab' ==? docba'
prop_transform_compose :: (OTSystem doc op, OTComposableOperation op, Arbitrary doc, Show op, Eq op)
=> (doc -> Gen op)
-> Property
prop_transform_compose genOperation = property $ do
doc <- arbitrary
a <- genOperation doc
b <- genOperation doc
return $ eitherProperty (transform a b) $ \(a', b') ->
eitherProperty ((,) <$> compose a b' <*> compose b a') $ \(ab', ba') ->
property $ ab' ==? ba'
prop_transform_compose_compat_l :: (OTSystem doc op, OTComposableOperation op, Arbitrary doc, Show op, Eq op)
=> (doc -> Gen op)
-> Property
prop_transform_compose_compat_l genOperation = property $ do
doc <- arbitrary
a <- genOperation doc
c <- genOperation doc
return $ eitherProperty (apply a doc) $ \(doc') -> property $ do
b <- genOperation doc'
let res = (,) <$> (snd <$> (compose a b >>= flip transform c))
<*> (snd <$> (transform a c >>= transform b . snd))
return $ eitherProperty res $ \(c'_1, c'_2) ->
property $ c'_1 ==? c'_2
prop_transform_compose_compat_r :: (OTSystem doc op, OTComposableOperation op, Arbitrary doc, Show op, Eq op)
=> (doc -> Gen op)
-> Property
prop_transform_compose_compat_r genOperation = property $ do
doc <- arbitrary
a <- genOperation doc
c <- genOperation doc
return $ eitherProperty (apply a doc) $ \(doc') -> property $ do
b <- genOperation doc'
let res = (,) <$> (fst <$> (compose a b >>= transform c))
<*> (fst <$> (transform c a >>= flip transform b . fst))
return $ eitherProperty res $ \(c'_1, c'_2) -> property $ c'_1 ==? c'_2