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

---
 src/World/Types.hs | 35 +++++++++++++++++++++++++++++++++--
 1 file changed, 33 insertions(+), 2 deletions(-)

(limited to 'src')

diff --git a/src/World/Types.hs b/src/World/Types.hs
index 32e4df6..cf66dd9 100644
--- a/src/World/Types.hs
+++ b/src/World/Types.hs
@@ -4,10 +4,14 @@ module World.Types
   , LatticeProposal (..)
   , LatticePropList (..)
   , AgentProposal (..)
+  , AgentPropList (..)
   , Proposal (..)
   ) where
 
 
+import Data.Maybe
+
+
 class Combinable a where
   -- the "identity" element of the class is combinable with all others
   -- and (naturally) results in those others when combined
@@ -64,10 +68,37 @@ instance (Combinable a, Combinable b) => Combinable (LatticePropList a b) where
 
 -- agent proposals
 data AgentProposal a = AgentProposal
-  { id :: Int
-  , agentPos :: Pos
+  { agentId :: Int
+  , agentPos :: Maybe Pos
   , agentFlags :: a
   }
   deriving (Show, Eq)
+newtype AgentPropList a = AgentPropList [AgentProposal a] deriving (Show, Eq)
+
+instance (Combinable a) => Combinable (AgentPropList a) where
+  identity = AgentPropList []
+
+  combinable (AgentPropList xs) (AgentPropList ys) =
+    let
+      pairIsCombinable (x, y) =
+        if (agentId x) == (agentId y)
+          -- same agent
+          then if 
+            combinable (agentPos x) (agentPos y) && 
+            combinable (agentFlags x) (agentFlags y)
+            then True else False
+          -- different agents
+          else if 
+            (isJust $ agentPos x) && 
+            (isJust $ agentPos y) &&
+            (fromJust $ agentPos x) == (fromJust $ agentPos y)
+            then False -- agents moving to the same location
+            else True -- c:
+      pairs = [ (x, y) | x <- xs, y <- ys ]
+    in
+      all pairIsCombinable pairs
+
+  combine (AgentPropList xs) (AgentPropList ys) = AgentPropList $ xs ++ ys
+
 
 newtype Proposal a b c = Proposal ([LatticeProposal a b], [AgentProposal c]) deriving (Show, Eq)
-- 
cgit v1.2.1