refactor(xan): Switch to V2 over tuples most places

These are generally rather nicer to work due to some typeclass instances,
and integrate better with other ecosystems for things like linear
algebra etc.

Change-Id: I546c8da7b17234648f3d612b28741c1fded25447
Reviewed-on: https://cl.tvl.fyi/c/depot/+/910
Tested-by: BuildkiteCI
Reviewed-by: glittershark <grfn@gws.fyi>
This commit is contained in:
Griffin Smith 2020-07-03 20:32:36 -04:00 committed by glittershark
parent 4455f28e42
commit 9b8d3185fe
12 changed files with 172 additions and 143 deletions

View file

@ -1,7 +1,7 @@
{-# LANGUAGE PackageImports #-}
--------------------------------------------------------------------------------
module Xanthous.Generators.UtilSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
import System.Random (mkStdGen)
import Control.Monad.Random (runRandT)
@ -11,18 +11,23 @@ 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.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
instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b)
=> Arbitrary (GenArray a b) where
arbitrary = GenArray <$> do
(mkElem :: a -> b) <- arbitrary
minDims <- arbitrary
@ -33,16 +38,18 @@ instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b) => Arbitrary (GenArray
test :: TestTree
test = testGroup "Xanthous.Generators.Util"
[ testGroup "randInitialize"
[ testProperty "returns an array of the correct dimensions" $ \dims seed aliveChance ->
[ 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))
in bounds res === (0, V2 (dims ^. width) (dims ^. height))
]
, testGroup "numAliveNeighborsM"
[ testProperty "maxes out at 8" $ \(GenArray (arr :: Array (Word, Word) Bool)) loc ->
[ testProperty "maxes out at 8"
$ \(GenArray (arr :: Array (V2 Word) Bool)) loc ->
let
act :: forall s. ST s Word
act = do
@ -53,7 +60,7 @@ test = testGroup "Xanthous.Generators.Util"
]
, testGroup "numAliveNeighbors"
[ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
\(GenArray (arr :: Array (Word, Word) Bool)) loc ->
\(GenArray (arr :: Array (V2 Word) Bool)) loc ->
let
act :: forall s. ST s Word
act = do