implement updateLattice

2 files changed, 39 insertions, 0 deletions

diff --git a/test/LatticeTest.hs b/test/LatticeTest.hs
new file mode 100644
index 0000000..a7d67d8
--- /dev/null
+++ b/test/LatticeTest.hs
@@ -0,0 +1,37 @@
+module LatticeTest (suite) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+import Lattice 
+
+suite :: TestTree
+suite = testGroup "lattice tests" $
+  [ latticeGrowth
+  ]
+
+
+data GrowKind = Empty | Plant deriving (Show, Enum, Eq)
+data GrowFlags = None deriving (Show, Eq)
+
+
+latticeGrowth :: TestTree
+latticeGrowth = testCase "growth update rule" $
+  let
+    plant = LatticeCell Plant None
+    empty = LatticeCell Empty None
+    lattice = [[ empty, empty, plant ]]
+    rules =
+      [ 
+        -- empty
+        \l x y -> 
+          if kind ((l !! y) !! (x+1)) == Plant
+          then LatticeCell Plant None
+          else LatticeCell Empty None
+        -- plant
+        , \_ _ _ -> LatticeCell Plant None
+      ] :: [LatticeRule GrowKind GrowFlags]
+    lattice' = updateLattice lattice rules
+    lattice'' = updateLattice lattice' rules
+  in do
+    lattice' @?= [[ empty, plant, plant ]]
+    lattice'' @?= [[ plant, plant, plant ]]
diff --git a/test/Main.hs b/test/Main.hs
index 907bbdd..24666a6 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -4,9 +4,11 @@ import Test.Tasty
 
 import qualified MindTest
 import qualified GenomeTest
+import qualified LatticeTest
 
 main :: IO ()
 main = defaultMain $ testGroup "all tests" $
   [ MindTest.suite
   , GenomeTest.suite
+  , LatticeTest.suite
   ]