From bf40a269daef0517e2d0fc5961e043ece6ff4837 Mon Sep 17 00:00:00 2001
From: sanine <sanine.not@pm.me>
Date: Thu, 30 Nov 2023 13:54:44 -0600
Subject: begin adding world types

---
 src/World/.Types.hs.swo | Bin 0 -> 12288 bytes
 src/World/Types.hs      |  61 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 61 insertions(+)
 create mode 100644 src/World/.Types.hs.swo
 create mode 100644 src/World/Types.hs

(limited to 'src')

diff --git a/src/World/.Types.hs.swo b/src/World/.Types.hs.swo
new file mode 100644
index 0000000..527fc99
Binary files /dev/null and b/src/World/.Types.hs.swo differ
diff --git a/src/World/Types.hs b/src/World/Types.hs
new file mode 100644
index 0000000..c7f77ce
--- /dev/null
+++ b/src/World/Types.hs
@@ -0,0 +1,61 @@
+module World.Types
+  ( Merge (..)
+  , Pos
+  , LatticeProposal (..)
+  , AgentProposal (..)
+  , Proposal (..)
+  ) where
+
+
+class Merge a where
+  mergeCompatible :: a -> a -> Bool
+  merge :: a -> a -> a
+
+instance (Merge a) => Merge (Maybe a) where
+  mergeCompatible (Just x) (Just y) = mergeCompatible x y
+  mergeCompatible _ _ = True
+  merge (Just x) (Just y) = Just $ merge x y
+  merge Nothing (Just y) = Just $ y
+  merge (Just x) (Nothing) = Just $ x
+  merge Nothing Nothing = Nothing
+
+class (Eq a) => MergeEq a where
+  mergeEqCompatible :: a -> a -> Bool
+  mergeEq :: a -> a -> a
+
+instance (Eq a) => MergeEq (Maybe a) where
+  mergeEqCompatible (Just x) (Just y) = x == y
+  mergeEqCompatible _ _ = True
+  mergeEq (Just x) (Just _) = Just $ x
+  mergeEq Nothing (Just y) = Just $ y
+  mergeEq (Just x) (Nothing) = Just $ x
+  mergeEq Nothing Nothing = Nothing
+
+type Pos = (Int, Int)
+
+data LatticeProposal a b = LatticeProposal
+  { cellPos :: Pos
+  , from :: Maybe a
+  , to :: Maybe a
+  , cellFlags :: Maybe b
+  }
+  deriving (Show, Eq)
+
+data AgentProposal a = AgentProposal
+  { id :: Int
+  , agentPos :: Pos
+  , agentFlags :: a
+  }
+  deriving (Show, Eq)
+
+newtype Proposal a b c = Proposal ([LatticeProposal a b], [AgentProposal c]) deriving (Show, Eq)
+
+
+instance (Eq a, Merge b) => Merge (LatticeProposal a b) where
+  mergeCompatible x y =
+    if (cellPos x /= cellPos y) then True else
+      if mergeEqCompatible (from x) (from y)
+        && mergeEqCompatible (to x) (to y)
+        && mergeCompatible (cellFlags x) (cellFlags y)
+      then True
+      else False
-- 
cgit v1.2.1