From 1a3814b5ead29e1bbfb2ccfa56b2b2bb76c71994 Mon Sep 17 00:00:00 2001
From: sanine <sanine.not@pm.me>
Date: Mon, 4 Dec 2023 11:44:09 -0600
Subject: implement Combinable for AgentPropList

---
 test/WorldTypesTest.hs | 96 ++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 94 insertions(+), 2 deletions(-)

(limited to 'test')

diff --git a/test/WorldTypesTest.hs b/test/WorldTypesTest.hs
index 5a45418..e151fed 100644
--- a/test/WorldTypesTest.hs
+++ b/test/WorldTypesTest.hs
@@ -9,6 +9,7 @@ import World.Types
   , LatticeProposal (..)
   , LatticePropList (..)
   , AgentProposal (..)
+  , AgentPropList (..)
   , Proposal (..)
   )
 
@@ -16,6 +17,7 @@ import World.Types
 suite :: TestTree
 suite = testGroup "world types tests" $
   [ latticePropTests
+  , agentPropTests
   ]
 
 
@@ -30,12 +32,102 @@ latticePropTests = testGroup "lattice proposal tests" $
         , LatticeProposal (1, 1) (Just 0) Nothing Nothing
         ]
     in combine identity propList @?= propList
-  , testCase "conditionally combine proposal lists" $
+  , testCase "incompatible proposal lists are not combinable" $
     let
       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 ]
+      a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ]
     in
       combinable (LatticePropList a) (LatticePropList a') @?= False
+  , testCase "compatible proposal lists are combinable" $
+    let
+      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 0) (Just 4) (Just 2) ]
+    in
+      combinable (LatticePropList a) (LatticePropList a') @?= True
+  , testCase "otherwise incompatible proposal lists are still compatible for different cells" $
+    let
+      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
+      a = [ LatticeProposal (0, 1) (Just 0) Nothing Nothing ]
+      a' :: [LatticeProposal (Maybe Int) (Maybe Int)]
+      a' = [ LatticeProposal (0, 0) (Just 4) Nothing Nothing ]
+    in
+      combinable (LatticePropList a) (LatticePropList a') @?= True 
+  , testCase "a single incompatible proposal results in overall incompatibility" $
+    let
+      a :: [LatticeProposal (Maybe Int) (Maybe Int)]
+      a = [ LatticeProposal (0, 0) (Just 0) Nothing Nothing 
+          , LatticeProposal (0, 1) (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
+  ]
+
+
+agentPropTests :: TestTree
+agentPropTests = testGroup "lattice proposal tests" $
+  [ testCase "combine AgentPropList with identity" $
+    let 
+      propList :: AgentPropList (Maybe Int)
+      propList = AgentPropList
+        [ AgentProposal 0 (Just (0, 0)) (Just 0)
+        , AgentProposal 0 (Just (0, 1)) Nothing
+        , AgentProposal 0 (Just (1, 1)) Nothing
+        ]
+    in combine identity propList @?= propList
+  , testCase "incompatible proposal lists are not combinable" $
+    let
+      a :: [AgentProposal (Maybe Int)]
+      a = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
+      a' :: [AgentProposal (Maybe Int)]
+      a' = [ AgentProposal 0 (Just (0, 0)) (Just 4) ]
+    in
+      combinable (AgentPropList a) (AgentPropList a') @?= False
+  , testCase "compatible proposal lists are combinable" $
+    let
+      a :: [AgentProposal (Maybe Int)]
+      a = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
+      a' :: [AgentProposal (Maybe Int) ]
+      a' = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
+    in
+      combinable (AgentPropList a) (AgentPropList a') @?= True
+  , testCase "trying to move an agent to two different locations is incompatible" $
+    let
+      a :: [AgentProposal (Maybe Int)]
+      a = [ AgentProposal 0 (Just (0, 1)) (Just 0) ]
+      a' :: [AgentProposal (Maybe Int)]
+      a' = [ AgentProposal 0 (Just (0, 0)) (Just 0) ]
+    in
+      combinable (AgentPropList a) (AgentPropList a') @?= False
+  , testCase "a single incompatible proposal results in overall incompatibility" $
+    let
+      a :: [AgentProposal (Maybe Int)]
+      a = [ AgentProposal 0 (Just (0, 0)) (Just 0) 
+          , AgentProposal 0 (Just (0, 1)) (Just 0) 
+          ]
+      a' :: [AgentProposal (Maybe Int)]
+      a' = [ AgentProposal 0 (Just (0, 0)) (Just 4) ]
+    in
+      combinable (AgentPropList a) (AgentPropList a') @?= False
+  , testCase "two updates moving different agents to the same location are incompatible" $
+    let
+      a :: [AgentProposal (Maybe Int)]
+      a = [ AgentProposal 0 (Just (0, 0)) Nothing ]
+      a' :: [AgentProposal (Maybe Int)]
+      a' = [ AgentProposal 1 (Just (0, 0)) Nothing ]
+    in
+      combinable (AgentPropList a) (AgentPropList a') @?= False
+   , testCase "two updates moving the same agent to the same location are compatible" $
+    let
+      a :: [AgentProposal (Maybe Int)]
+      a = [ AgentProposal 0 (Just (0, 0)) Nothing ]
+      a' :: [AgentProposal (Maybe Int)]
+      a' = [ AgentProposal 0 (Just (0, 0)) Nothing ]
+    in
+      combinable (AgentPropList a) (AgentPropList a') @?= True
   ]
-- 
cgit v1.2.1