import Data.List
import Data.Maybe(catMaybes)
import System.IO(stderr)
+import Data.Word
import Data.Syncable
import TestInfrastructure
in (expectedResMaster, []) @=?
(sort resMaster, resChild)
-prop_addFromMaster :: SyncCollection Int Float -> Result
+prop_addFromMaster :: SyncCollection Int Word8 -> Result
prop_addFromMaster inp =
let (resMaster, resChild) = syncBiDir inp emptymap emptymap
expectedResChild = sort . map (\(k, v) -> CopyItem k v) . Map.toList $ inp
-- FIXME: prop_addFromChild
-prop_allChangesToChild :: SyncCollection Int Float -> SyncCollection Int Float -> Result
+prop_allChangesToChild :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
prop_allChangesToChild master child =
let (resMaster, resChild) = syncBiDir master child child
expectedResChild = sort $
(map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ child) ++
- (map DeleteItem . Map.keys . Map.difference child $ master)
+ (map DeleteItem . Map.keys . Map.difference child $ master) ++
+ (map (pairToFunc ModifyContent) changeList)
+ changeList = foldl changefunc [] (Map.toList child)
+ changefunc accum (k, v) =
+ case Map.lookup k master of
+ Nothing -> accum
+ Just x -> if x /= v
+ then (k, x) : accum
+ else accum
in ([], expectedResChild) @=?
- (resMaster, sort resChild)
+ (sort resMaster, sort resChild)
-prop_allChangesToMaster :: SyncCollection Int Float -> SyncCollection Int Float -> Result
+prop_allChangesToMaster :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
prop_allChangesToMaster master child =
let (resMaster, resChild) = syncBiDir master child master
expectedResMaster = sort $
- (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ master) ++
- (map DeleteItem . Map.keys . Map.difference master $ child)
+ (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ master) ++
+ (map DeleteItem . Map.keys . Map.difference master $ child) ++
+ (map (pairToFunc ModifyContent) changeList)
+ changeList = foldl changefunc [] (Map.toList child)
+ changefunc accum (k, v) =
+ case Map.lookup k master of
+ Nothing -> accum
+ Just x -> if x /= v
+ then (k, v) : accum
+ else accum
in (expectedResMaster, []) @=?
(sort resMaster, resChild)
-prop_allChanges :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
+-- FIXME: test findModified
+
+prop_allChanges :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
prop_allChanges master child lastchild =
let (resMaster, resChild) = syncBiDir master child lastchild
+
+ masterMods = catMaybes . map procKV $ (Map.toList master)
+ where procKV (k, m) =
+ case (Map.lookup k child, Map.lookup k lastchild) of
+ (Just c, Just lc) ->
+ if c == lc -- child didn't change
+ then Nothing
+ else if c == m -- child and master changed
+ then Nothing
+ else Just (k, c) -- child changed, master didn't
+ (Nothing, Just lc) -> Nothing -- deleted on child
+ (Just c, Nothing) -> -- New on both c and m
+ if c == m -- Added the same
+ then Nothing
+ else Just (k, c) -- Added but differ
+ (Nothing, Nothing) -> Nothing -- New to master only
+
+ childMods = catMaybes . map procKV $ (Map.toList child)
+ where procKV (k, c) =
+ case (Map.lookup k master, Map.lookup k lastchild) of
+ (Just m, Just lc) ->
+ if lc == c
+ then if c == m
+ then Nothing
+ else Just (k, m)
+ else Nothing
+ (Nothing, Just lc) -> -- deleted; nothing to see here
+ Nothing
+ (Just m, Nothing) -> -- New on both; child takes precedence
+ Nothing
+ (Nothing, Nothing) -> Nothing -- New to child only
+
expectedResMaster = sort $
- (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ Map.union master lastchild) ++
- (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child)
+ (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
+ (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
+ (map (pairToFunc ModifyContent) masterMods)
+
expectedResChild = sort $
- (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ Map.union child lastchild) ++
- (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master)
+ (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
+ (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
+ (map (pairToFunc ModifyContent) childMods)
+
in (expectedResMaster, expectedResChild) @=?
(sort resMaster, sort resChild)
{- | Basic validation that unaryApplyChanges works -}
-prop_unaryApplyChanges :: SyncCollection Int Float -> [(Bool, Int, Float)] -> Result
+prop_unaryApplyChanges :: SyncCollection Int Word8 -> [(Bool, Int, Word8)] -> Result
prop_unaryApplyChanges collection randcommands =
let -- We use nubBy to make sure we don't get input that has reference
-- to the same key more than once. We then convert True/False to
{- | Should validate both that unaryApplyChanges works, and that it is
an identify -}
-prop_unaryApplyChangesId :: SyncCollection Int Float -> SyncCollection Int Float -> Result
+prop_unaryApplyChangesId :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
prop_unaryApplyChangesId master child =
let (resMaster, resChild) = syncBiDir master child child
newMaster = unaryApplyChanges master resMaster
in (True, sort (Map.keys master), sort (Map.keys master)) @=?
(newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
-prop_unaryApplyChanges3 :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
+prop_unaryApplyChanges3 :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
prop_unaryApplyChanges3 master child lastChild =
let (resMaster, resChild) = syncBiDir master child lastChild
newMaster = unaryApplyChanges master resMaster
newChild = unaryApplyChanges child resChild
in newMaster @=? newChild
-prop_diffCollection :: SyncCollection Int Float -> SyncCollection Int Float -> Result
+prop_diffCollection :: SyncCollection Int Word8 -> SyncCollection Int Word8 -> Result
prop_diffCollection coll1 coll2 =
let commands = diffCollection coll1 coll2
newcoll2 = unaryApplyChanges coll1 commands
in coll2 @=? newcoll2
-allt = [qctest "Empty" prop_empty,
- qctest "Del all from child" prop_delAllFromChild,
- qctest "Del all from master" prop_delAllFromMaster,
- qctest "Add from master" prop_addFromMaster,
- qctest "All changes to child" prop_allChangesToChild,
- qctest "All changes to master" prop_allChangesToMaster,
- qctest "All changes" prop_allChanges,
- qctest "unaryApplyChanges" prop_unaryApplyChanges,
- qctest "unaryApplyChangesId" prop_unaryApplyChangesId,
- qctest "unaryApplyChanges3" prop_unaryApplyChanges3,
- qctest "diffCollection" prop_diffCollection
+q :: Testable a => String -> a -> HU.Test
+q = qccheck (defaultConfig {configMaxTest = 250})
+
+allt = [q "Empty" prop_empty,
+ q "Del all from child" prop_delAllFromChild,
+ q "Del all from master" prop_delAllFromMaster,
+ q "Add from master" prop_addFromMaster,
+ q "All changes to child" prop_allChangesToChild,
+ q "All changes to master" prop_allChangesToMaster,
+ q "All changes" prop_allChanges,
+ q "unaryApplyChanges" prop_unaryApplyChanges,
+ q "unaryApplyChangesId" prop_unaryApplyChangesId,
+ q "unaryApplyChanges3" prop_unaryApplyChanges3,
+ q "diffCollection" prop_diffCollection
]
testh = HU.runTestTT $ HU.TestList allt