Add cellular-automata cave generator

Add a cellular-automata-based cave level generator, plus an
optparse-applicative-based CLI for invoking level generators in general.

2 files changed, 70 insertions, 2 deletions

diff --git a/test/Spec.hs b/test/Spec.hs
index 7ae9b40d267e..dd4212c2eb70 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,10 +1,11 @@
 import Test.Prelude
-import qualified Xanthous.DataSpec
 import qualified Xanthous.Data.EntityMapSpec
+import qualified Xanthous.DataSpec
+import qualified Xanthous.Entities.RawsSpec
 import qualified Xanthous.GameSpec
+import qualified Xanthous.Generators.UtilSpec
 import qualified Xanthous.MessageSpec
 import qualified Xanthous.OrphansSpec
-import qualified Xanthous.Entities.RawsSpec
 
 main :: IO ()
 main = defaultMain test
@@ -14,6 +15,7 @@ test = testGroup "Xanthous"
   [ Xanthous.Data.EntityMapSpec.test
   , Xanthous.Entities.RawsSpec.test
   , Xanthous.GameSpec.test
+  , Xanthous.Generators.UtilSpec.test
   , Xanthous.MessageSpec.test
   , Xanthous.OrphansSpec.test
   , Xanthous.DataSpec.test
diff --git a/test/Xanthous/Generators/UtilSpec.hs b/test/Xanthous/Generators/UtilSpec.hs
new file mode 100644
index 000000000000..a1c2f79d6042
--- /dev/null
+++ b/test/Xanthous/Generators/UtilSpec.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE PackageImports #-}
+
+module Xanthous.Generators.UtilSpec (main, test) where
+
+import Test.Prelude
+import System.Random (mkStdGen)
+import Control.Monad.Random (runRandT)
+import Data.Array.ST (STUArray, runSTUArray, thaw)
+import Data.Array.IArray (bounds)
+import Data.Array.MArray (newArray, readArray, writeArray)
+import Data.Array (Array, range, listArray, Ix)
+import Control.Monad.ST (ST, runST)
+import "checkers" Test.QuickCheck.Instances.Array ()
+
+import Xanthous.Util
+import Xanthous.Data (width, height)
+import Xanthous.Generators.Util
+
+main :: IO ()
+main = defaultMain test
+
+newtype GenArray a b = GenArray (Array a b)
+  deriving stock (Show, Eq)
+
+instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray a b) where
+  arbitrary = GenArray <$> do
+    (mkElem :: a -> b) <- arbitrary
+    minDims <- arbitrary
+    maxDims <- arbitrary
+    let bnds = (minDims, maxDims)
+    pure $ listArray bnds $ mkElem <$> range bnds
+
+test :: TestTree
+test = testGroup "Xanthous.Generators.Util"
+  [ testGroup "randInitialize"
+    [ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance ->
+        let gen = mkStdGen seed
+            res = runSTUArray
+                $ fmap fst
+                $ flip runRandT gen
+                $ randInitialize dims aliveChance
+        in bounds res === ((0, 0), (dims ^. width, dims ^. height))
+    ]
+  , testGroup "numAliveNeighbors"
+    [ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc ->
+        let
+          act :: forall s. ST s Word
+          act = do
+            mArr <- thaw @_ @_ @_ @(STUArray s) arr
+            numAliveNeighborsM mArr loc
+          res = runST act
+        in counterexample (show res) $ between 0 8 res
+    ]
+  , testGroup "cloneMArray"
+      [ testCase "clones the array" $ runST $
+          let
+            go :: forall s. ST s Assertion
+            go = do
+              arr <- newArray @(STUArray s) (0 :: Int, 5) (1 :: Int)
+              arr' <- cloneMArray @_ @(STUArray s) arr
+              writeArray arr' 0 1234
+              x <- readArray arr 0
+              pure $ x @?= 1
+          in go
+      ]
+  ]