Add 'users/glittershark/xanthous/' from commit '53b56744f4335c038724a1bcffc27a7eb8cf6a6d' r/978

git-subtree-dir: users/glittershark/xanthous
git-subtree-mainline: 91f53f02d8479303910abfd3f3690d3ef27e6c4b
git-subtree-split: 53b56744f4335c038724a1bcffc27a7eb8cf6a6d

1 files changed, 77 insertions, 0 deletions

diff --git a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
new file mode 100644
index 000000000000..c82c385987b5
--- /dev/null
+++ b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
@@ -0,0 +1,77 @@
+{-# 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 "numAliveNeighborsM"
+    [ 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 "numAliveNeighbors"
+    [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
+      \(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 numAliveNeighbors arr loc === 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
+      ]
+  ]