about summary refs log tree commit diff
path: root/test/Xanthous
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-07T18·49-0400
committerGriffin Smith <root@gws.fyi>2019-09-07T18·52-0400
commitf03ad6bbd60b6ccdd329fc6740bcea2b554980dd (patch)
treeeba7d803e5468ae12edf133acf21a2e227ef1f6c /test/Xanthous
parent73a52e531d940858f0ac334d8b2ccda479ea7b5e (diff)
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.
Diffstat (limited to 'test/Xanthous')
-rw-r--r--test/Xanthous/Generators/UtilSpec.hs66
1 files changed, 66 insertions, 0 deletions
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
+      ]
+  ]