implement Combinable for LatticePropList

3 files changed, 37 insertions, 67 deletions

diff --git a/test/AgentTest.hs b/test/AgentTest.hs
new file mode 100644
index 0000000..c89d28a
--- /dev/null
+++ b/test/AgentTest.hs
@@ -0,0 +1,10 @@
+module AgentTest (suite) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Agent
+
+suite :: TestTree
+suite = testGroup "agent tests" $
+  [
+  ]
diff --git a/test/ProposalTest.hs b/test/ProposalTest.hs
new file mode 100644
index 0000000..1b78c69
--- /dev/null
+++ b/test/ProposalTest.hs
@@ -0,0 +1,10 @@
+module ProposalTest (suite) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Proposal 
+
+suite :: TestTree
+suite = testGroup "proposal tests" $
+  [
+  ]
diff --git a/test/WorldTypesTest.hs b/test/WorldTypesTest.hs
index f1822fc..5a45418 100644
--- a/test/WorldTypesTest.hs
+++ b/test/WorldTypesTest.hs
@@ -4,8 +4,7 @@ module WorldTypesTest (suite) where
 import Test.Tasty
 import Test.Tasty.HUnit
 import World.Types
-  ( Merge (..)
-  , Compatible (..)
+  ( Combinable (..)
   , Pos
   , LatticeProposal (..)
   , LatticePropList (..)
@@ -19,73 +18,24 @@ suite = testGroup "world types tests" $
   [ latticePropTests
   ]
 
-newtype MockMerge = MockMerge Int deriving (Show, Eq)
-instance Merge MockMerge where
-  mergable (MockMerge x) (MockMerge y) = x == y
-  merge x _ = x
-  merge _ _ = error "incompatible merge!"
 
 latticePropTests :: TestTree
 latticePropTests = testGroup "lattice proposal tests" $
-  [ testCase "lattice proposals correctly detect mergability" $
-    do
-      -- disjoint positions
-      True @=? compatible 
-        (LatticeProposal (0, 0) Nothing Nothing Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 1) Nothing Nothing Nothing)
-      True @=? compatible
-        (LatticeProposal (1, 0) (Just 4) (Just 5) Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) (Just 5) (Just 5) Nothing)
-      -- merge from
-      True @=? mergable
-        (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) (Just 4) Nothing Nothing)
-      True @=? mergable
-        (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing Nothing Nothing)
-      False @=? mergable
-        (LatticeProposal (0, 0) (Just 4) Nothing Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) (Just 5) Nothing Nothing)
-      -- merge to
-      True @=? mergable
-        (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing (Just 4) Nothing)
-      True @=? mergable
-        (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing Nothing Nothing)
-      False @=? mergable
-        (LatticeProposal (0, 0) Nothing (Just 4) Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing (Just 2) Nothing)
-      -- merge flags
-      True @=? mergable
-        (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing Nothing Nothing)
-      True @=? mergable
-        (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4))
-      False @=? mergable
-        (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 5))
-
-
-  , testCase "merge lattice proposals" $
-    do
-      LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4) @?= merge
-        (LatticeProposal (0, 0) Nothing Nothing Nothing :: LatticeProposal Int MockMerge)
-        (LatticeProposal (0, 0) Nothing Nothing (Just $ MockMerge 4))
-      LatticeProposal (0, 0) (Just 2) (Just 4) (Just $ MockMerge 4) @?= merge
-        (LatticeProposal (0, 0) (Just 2) Nothing Nothing)
-        (LatticeProposal (0, 0) Nothing (Just 4) (Just $ MockMerge 4))
-
-  , testCase "merge lattice proposal lists" $
+  [ testCase "combine LatticePropList with identity" $
+    let 
+      propList :: LatticePropList (Maybe Int) (Maybe Int)
+      propList = LatticePropList
+        [ LatticeProposal (0, 0) (Just 0) (Just 0) (Just 0)
+        , LatticeProposal (0, 1) Nothing (Just 0) (Just 0)
+        , LatticeProposal (1, 1) (Just 0) Nothing Nothing
+        ]
+    in combine identity propList @?= propList
+  , testCase "conditionally combine proposal lists" $
     let
-      a = LatticeProposal (0, 0) Nothing  (Just 2) (Just $ MockMerge 4) :: LatticeProposal Int MockMerge
-      b = LatticeProposal (1, 0) Nothing  (Just 2) (Just $ MockMerge 4) :: LatticeProposal Int MockMerge
-      c = LatticeProposal (0, 0) (Just 3) (Just 2) (Just $ MockMerge 4) :: LatticeProposal Int MockMerge
-      d = LatticeProposal (0, 0) (Just 3) (Just 2) (Just $ MockMerge 5) :: LatticeProposal Int MockMerge
-    in do
-      (LatticePropList [a, b]) @=? merge (LatticePropList [a])    (LatticePropList [b])
-      (LatticePropList [c, b]) @=? merge (LatticePropList [a])    (LatticePropList [b, c])
-      (LatticePropList [c])    @=? merge (LatticePropList [a, b]) (LatticePropList [c, d])
-      (LatticePropList [b, d]) @=? merge (LatticePropList [b])    (LatticePropList [d])
+      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
+      a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing ]
+      a' :: [LatticeProposal (Maybe Int) (Maybe Int)]
+      a' = [ LatticeProposal(0, 0) (Just 4) Nothing Nothing ]
+    in
+      combinable (LatticePropList a) (LatticePropList a') @?= False
   ]