maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

chore(users): grfn -> aspen

Browse source 
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9
Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809
Autosubmit: aspen <root@gws.fyi>
Reviewed-by: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
Reviewed-by: lukegb <lukegb@tvl.fyi>
This commit is contained in:
Aspen Smith 2024-02-11 22:00:40 -05:00 • committed by clbot
parent 0ba476a426
commit 82ecd61f5c
478 changed files with 75 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

127
users/aspen/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs Normal file
View file

@ -0,0 +1,127 @@
{-# LANGUAGE PackageImports #-}
--------------------------------------------------------------------------------
module Xanthous.Generators.Level.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, array)
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 Linear.V2
--------------------------------------------------------------------------------
import Xanthous.Util
import Xanthous.Data (width, height)
--------------------------------------------------------------------------------
import Xanthous.Generators.Level.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, V2 (dims ^. width) (dims ^. height))
]
, testGroup "numAliveNeighborsM"
[ testProperty "maxes out at 8"
$ \(GenArray (arr :: Array (V2 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
, testCase "on the outer x edge" $
let act :: forall s. ST s Word
act = do
cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word)
(V2 0 0, V2 2 2)
[ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True)
, (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
, (V2 0 2, True), (V2 1 2, True), (V2 2 2, True)
]
numAliveNeighborsM cells (V2 0 1)
res = runST act
in res @?= 7
, testCase "on the outer y edge" $
let act :: forall s. ST s Word
act = do
cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word)
(V2 0 0, V2 2 2)
[ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True)
, (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
, (V2 0 2, True), (V2 1 2, True), (V2 2 2, True)
]
numAliveNeighborsM cells (V2 1 0)
res = runST act
in res @?= 6
]
, testGroup "numAliveNeighbors"
[ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
\(GenArray (arr :: Array (V2 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
, testCase "on the outer x edge" $
let cells =
array @Array @Bool @(V2 Word)
(V2 0 0, V2 2 2)
[ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True)
, (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
, (V2 0 2, True), (V2 1 2, True), (V2 2 2, True)
]
in numAliveNeighbors cells (V2 0 1) @?= 7
, testCase "on the outer y edge" $
let cells =
array @Array @Bool @(V2 Word)
(V2 0 0, V2 2 2)
[ (V2 0 0, True), (V2 1 0, True), (V2 2 0, True)
, (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
, (V2 0 2, True), (V2 1 2, True), (V2 2 2, True)
]
in numAliveNeighbors cells (V2 1 0) @?= 6
]
, 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
]
]