Made tests use generic types; they don't yet all pass like this

diff --git a/testsrc/TestInfrastructure.hs b/testsrc/TestInfrastructure.hs
index 40531b1d1c5283adc90e7ddfd73138ab3ce1264c..45d0f0a18d43733855e04d6f9337c1ad5807a8cf 100644 (file)
--- a/testsrc/TestInfrastructure.hs
+++ b/testsrc/TestInfrastructure.hs
@@ -36,13 +36,13 @@ expected @=? actual =
 keysToMap :: Ord k => [k] -> Map.Map k ()
 keysToMap = foldl (\map k -> Map.insert k () map) Map.empty
 
-emptymap :: (Eq k, Ord k) => Map.Map k ()
+emptymap :: (Eq k, Ord k, Show v) => Map.Map k v
 emptymap = Map.empty
 
-instance (Arbitrary k, Eq k, Ord k) => Arbitrary (Map.Map k ()) where
+instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (Map.Map k v) where
     arbitrary = 
         do items <- arbitrary
-           return $ keysToMap items
+           return $ Map.fromList items
     coarbitrary = coarbitrary . Map.keys
 
 -- Modified from HUnit

diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs
index e78334e099c919576e21b5117d36368cb3e88f95..2d57ac123896a4d7b6f5c2472053c47f5cd8b3f8 100644 (file)
--- a/testsrc/runtests.hs
+++ b/testsrc/runtests.hs
@@ -47,65 +47,67 @@ prop_delAllFromMaster inp =
         in (expectedResMaster, []) @=? 
            (sort resMaster, resChild)
            
-prop_addFromMaster :: SyncCollection Int () -> Result
+prop_addFromMaster :: SyncCollection Int Float -> Result
 prop_addFromMaster inp =
     let (resMaster, resChild) = syncBiDir inp emptymap emptymap
-        expectedResChild = sort . map (\k -> CopyItem k ()) . Map.keys $ inp
+        expectedResChild = sort . map (\(k, v) -> CopyItem k v) . Map.toList $ inp
         in ([], expectedResChild) @=? 
            (resMaster, sort resChild)
 
-prop_allChangesToChild :: SyncCollection Int () -> SyncCollection Int () -> Result
+-- FIXME: prop_addFromChild
+
+prop_allChangesToChild :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 prop_allChangesToChild master child =
     let (resMaster, resChild) = syncBiDir master child child
         expectedResChild = sort $
-            (map (\k -> CopyItem k ()) . Map.keys . Map.difference master $ child) ++
+            (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ child) ++
             (map DeleteItem . Map.keys . Map.difference child $ master)
         in ([], expectedResChild) @=?
            (resMaster, sort resChild)
 
-prop_allChangesToMaster :: SyncCollection Int () -> SyncCollection Int () -> Result
+prop_allChangesToMaster :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 prop_allChangesToMaster master child =
     let (resMaster, resChild) = syncBiDir master child master
         expectedResMaster = sort $
-            (map (\k -> CopyItem k ()) . Map.keys . Map.difference child $ master) ++
+            (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ master) ++
             (map DeleteItem . Map.keys . Map.difference master $ child)
         in (expectedResMaster, []) @=?
            (sort resMaster, resChild)
 
-prop_allChanges :: SyncCollection Int () -> SyncCollection Int () -> SyncCollection Int () -> Result
+prop_allChanges :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
 prop_allChanges master child lastchild =
     let (resMaster, resChild) = syncBiDir master child lastchild
         expectedResMaster = sort $
-            (map (\k -> CopyItem k ()) . Map.keys . Map.difference child $ Map.union master lastchild) ++
+            (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)
         expectedResChild = sort $
-            (map (\k -> CopyItem k ()) . Map.keys . Map.difference master $ Map.union child lastchild) ++
+            (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)
     in (expectedResMaster, expectedResChild) @=?
        (sort resMaster, sort resChild)
 
 {- | Basic validation that unaryApplyChanges works -}
-prop_unaryApplyChanges :: SyncCollection Int () -> [(Bool, Int)] -> Result
+prop_unaryApplyChanges :: SyncCollection Int Float -> [(Bool, Int, Float)] -> 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
         -- commands.
-        commands = map toCommand . nubBy (\x y -> snd x == snd y) $ randcommands
-        toCommand (True, x) = CopyItem x ()
-        toCommand (False, x) = DeleteItem x
+        commands = map toCommand . nubBy (\(x1, y1, z1) (x2, y2, z2) -> y1 == y2) $ randcommands
+        toCommand (True, x, v) = CopyItem x v
+        toCommand (False, x, _) = DeleteItem x
 
         addedKeys = catMaybes . map (\x -> case x of CopyItem y _ -> Just y; _ -> Nothing) $ commands
         deletedKeys = catMaybes . map (\x -> case x of DeleteItem y -> Just y; _ -> Nothing) $ commands
         
-        collection' = Map.difference collection (keysToMap deletedKeys)
+        collection' = Map.difference collection (foldl (\m k -> Map.insert k 3.14 m) emptymap deletedKeys)
         expectedCollection = 
-            Map.union collection' (keysToMap addedKeys)
+            Map.union collection' (foldl (\m k -> Map.insert k 3.14 m) emptymap deletedKeys)
         in (sort . Map.keys $ expectedCollection) @=?
            (sort . Map.keys $ unaryApplyChanges collection commands)
 
 {- | Should validate both that unaryApplyChanges works, and that it is
 an identify -}
-prop_unaryApplyChangesId :: SyncCollection Int () -> SyncCollection Int () -> Result
+prop_unaryApplyChangesId :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 prop_unaryApplyChangesId master child =
     let (resMaster, resChild) = syncBiDir master child child
         newMaster = unaryApplyChanges master resMaster
@@ -115,14 +117,14 @@ prop_unaryApplyChangesId master child =
         in (True, sort (Map.keys master), sort (Map.keys master)) @=?
            (newMasterKeys == newChildKeys, newMasterKeys, newChildKeys)
 
-prop_unaryApplyChanges3 :: SyncCollection Int () -> SyncCollection Int () -> SyncCollection Int () -> Result
+prop_unaryApplyChanges3 :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> 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 () -> SyncCollection Int () -> Result
+prop_diffCollection :: SyncCollection Int Float -> SyncCollection Int Float -> Result
 prop_diffCollection coll1 coll2 = 
     let commands = diffCollection coll1 coll2
         newcoll2 = unaryApplyChanges coll1 commands