about summary refs log tree commit diff
path: root/users/glittershark/xanthous/test/Xanthous
diff options
context:
space:
mode:
authorGriffin Smith <grfn@gws.fyi>2020-07-04T00·32-0400
committerglittershark <grfn@gws.fyi>2020-07-04T15·30+0000
commit9b8d3185fe6cee9231ed20a1dbf0240d0c459a39 (patch)
tree29b8f78a81500043df1fa8ca289bdb2a35dc68ff /users/glittershark/xanthous/test/Xanthous
parent4455f28e426f49c2e3b8ef08961e5073a11a5b4f (diff)
refactor(xan): Switch to V2 over tuples most places r/1207
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>
Diffstat (limited to 'users/glittershark/xanthous/test/Xanthous')
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs23
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs41
2 files changed, 39 insertions, 25 deletions
diff --git a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
index c82c385987b5..cdfadc06f505 100644
--- a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
+++ b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
@@ -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
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
index ff99d1073840..61e589280362 100644
--- a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
+++ b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
@@ -2,10 +2,13 @@ module Xanthous.Util.GraphicsSpec (main, test) where
 --------------------------------------------------------------------------------
 import Test.Prelude hiding (head)
 --------------------------------------------------------------------------------
+import Data.List (nub, head)
+import Data.Set (isSubsetOf)
+import Linear.V2
+--------------------------------------------------------------------------------
 import Xanthous.Util.Graphics
 import Xanthous.Util
-import Data.List (head)
-import Data.Set (isSubsetOf)
+import Xanthous.Orphans ()
 --------------------------------------------------------------------------------
 
 main :: IO ()
@@ -23,24 +26,28 @@ test = testGroup "Xanthous.Util.Graphics"
         | 2 |   | x |   | x |
         | 3 |   |   | x |   |
       -}
-      $ (sort . unique @[] @[_]) (circle @Int (2, 2) 1)
-      @?= [ (1, 2)
-          , (2, 1), (2, 3)
-          , (3, 2)
+      $ (sort . unique @[] @[_]) (circle @Int (V2 2 2) 1)
+      @?= [ V2 1 2
+          , V2 2 1, V2 2 3
+          , V2 3 2
           ]
     , testCase "radius 12, origin 0"
-      $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12)
-      @?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2)
-          , (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7)
-          , (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10)
-          , (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12)
-          , (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12)
-          , (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11)
-          , (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7)
-          , (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1)
-          , (12,0), (12,1),(12,2),(12,3),(12,4)
+      $   (sort . nub) (circle @Int 0 12)
+      @?= (sort . nub)
+          [ V2 (-12) (-4), V2 (-12) (-3), V2 (-12) (-2), V2 (-12) (-1)
+          , V2 (-12) 0, V2 (-12) 1, V2 (-12) 2, V2 (-12) 3, V2 (-12) 4
+          , V2 (-11) (-6), V2 (-11) (-5), V2 (-11) 5, V2 (-11) 6, V2 (-10) (-7)
+          , V2 (-10) 7, V2 (-9) (-9), V2 (-9) (-8), V2 (-9) 8, V2 (-9) 9
+          , V2 (-8) (-9), V2 (-8) 9, V2 (-7) (-10), V2 (-7) 10, V2 (-6) (-11)
+          , V2 (-6) 11, V2 (-5) (-11), V2 (-5) 11, V2 (-4) (-12), V2 (-4) 12
+          , V2 (-3) (-12), V2 (-3) 12, V2 (-2) (-12), V2 (-2) 12, V2 (-1) (-12)
+          , V2 (-1) 12, V2 0 (-12), V2 0 12, V2 1 (-12), V2 1 12, V2 2 (-12)
+          , V2 2 12, V2 3 (-12), V2 3 12, V2 4 (-12), V2 4 12, V2 5 (-11)
+          , V2 5 11, V2 6 (-11), V2 6 11, V2 7 (-10), V2 7 10, V2 8 (-9), V2 8 9
+          , V2 9 (-9), V2 9 (-8), V2 9 8, V2 9 9, V2 10 (-7), V2 10 7
+          , V2 11 (-6), V2 11 (-5), V2 11 5, V2 11 6, V2 12 (-4), V2 12 (-3)
+          , V2 12 (-2), V2 12 (-1), V2 12 0, V2 12 1, V2 12 2, V2 12 3, V2 12 4
           ]
-
     ]
   , testGroup "filledCircle"
     [ testProperty "is a superset of circle" $ \center radius ->