summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/World/.Types.hs.swobin0 -> 12288 bytes
-rw-r--r--src/World/Types.hs61
2 files changed, 61 insertions, 0 deletions
diff --git a/src/World/.Types.hs.swo b/src/World/.Types.hs.swo
new file mode 100644
index 0000000..527fc99
--- /dev/null
+++ b/src/World/.Types.hs.swo
Binary files 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