diff --git a/test/unit/Main.hs b/test/unit/Main.hs index e03caccb6..8d1f0a656 100644 --- a/test/unit/Main.hs +++ b/test/unit/Main.hs @@ -45,12 +45,18 @@ import Witch (from) main :: IO () main = do - defaultMain statelessTests + ms <- runExceptT classicGame0 + case ms of + Left err -> assertFailure (from err) + Right s -> defaultMain (tests s) --- ms <- runExceptT classicGame0 --- case ms of --- Left err -> assertFailure (from err) --- Right s -> defaultMain (stateDependentTests s) +tests :: AppState -> TestTree +tests s = + testGroup + "Tests" + [ statelessTests + , stateDependentTests s + ] -- | Initializing an 'AppState' entails -- loading challenge scenarios, etc. from diff --git a/test/unit/TestOverlay.hs b/test/unit/TestOverlay.hs index 42297d08b..c02f14f85 100644 --- a/test/unit/TestOverlay.hs +++ b/test/unit/TestOverlay.hs @@ -20,7 +20,7 @@ import Test.Tasty import Test.Tasty.HUnit debugRenderGrid :: Bool -debugRenderGrid = True +debugRenderGrid = False -- * Example grids @@ -45,12 +45,8 @@ testOverlay = "Overlay" [ testGroup "Empty grids, base grid at origin" - [ mkOriginTestCase "Southward" (Location 3 2) (Location 0 2) - , -- Overlay is to the west and south of the base. - -- Therefore, the origin of the combined grid must - -- be adjusted eastward to match its original position - -- in the base layer. - mkOriginTestCase "Eastward" (Location (-7) (-1)) (Location (-7) 0) + [ mkOriginTestCase "Northward" (Location 3 2) (Location 0 2) + , mkOriginTestCase "Westward" (Location (-7) (-1)) (Location (-7) 0) ] , testGroup "Overlay sequences" @@ -85,29 +81,21 @@ testOverlay = (Location 0 2) ] , testGroup - "Nonzero local origin" - [ mkOverlaySequenceOriginTest - "positive first south of second" - [ place (Location 2 0) "sibling1" (Location 0 0) twoByTwoGrid - ] - (Location 2 0) + "Merge sizes" + [ testMergedSize + "merge an offset 1x1 atop a 0x0 base" + (mkNamedStructure "baseLayer" (Location 0 0) [[]]) + (mkNamedStructure "sibling1" (Location (-1) 1) oneByOneGrid) + (AreaDimensions 1 1) + , testMergedSize + "merge a 2x2 atop a 1x1 with an offset" + (mkNamedStructure "sibling1" (Location (-1) 1) oneByOneGrid) + (mkNamedStructure "sibling2" (Location 0 0) twoByTwoGrid) + (AreaDimensions 3 3) ] , testGroup "Northwesterly offset of first sibling" - [ -- testMergedSize - -- "test merged size" - -- (placeUnshifted "baseLayer" (Location 0 0) [[]]) - -- (placeUnshifted "sibling1" (Location (-1) 1) oneByOneGrid) - -- (AreaDimensions 1 1) - - -- , testMergedSize - -- "test merged size" - -- (place (Location 1 (-1)) "sibling1" (Location (-1) 1) oneByOneGrid) - -- (placeUnshifted "sibling2" (Location 0 0) twoByTwoGrid) - -- (AreaDimensions 3 3) - -- , - - mkOverlaySequenceOriginTest + [ mkOverlaySequenceOriginTest "positive first south of second" [ placeUnshifted "sibling1" (Location (-1) 1) oneByOneGrid , placeUnshifted "sibling2" (Location 0 0) twoByTwoGrid @@ -120,11 +108,11 @@ testOverlay = -- * Test construction testMergedSize :: String -> - Placed (Maybe Int) -> - Placed (Maybe Int) -> + NamedStructure (Maybe Int) -> + NamedStructure (Maybe Int) -> AreaDimensions -> TestTree -testMergedSize testLabel (Placed _ ns1) (Placed _ ns2) expectedArea = +testMergedSize testLabel ns1 ns2 expectedArea = testCase testLabel $ do assertEqual "Merged area is wrong" expectedArea mergedSize where @@ -171,7 +159,6 @@ mkOverlaySequenceTest f testLabel overlays expectedBaseLoc = baseArea = PositionedGrid (Location 0 0) (EmptyGrid :: Grid (Maybe Int)) eitherResultGrid = getGridFromMergedStructure <$> eitherResult - eitherResult = foldLayer mempty @@ -201,12 +188,22 @@ place :: Placed (Maybe a) place localOrigin theName placementOffset g = Placed (Placement sName (Pose placementOffset defaultOrientation)) $ - NamedArea sName mempty mempty s + mkNamedStructure theName localOrigin g + where + sName = StructureName theName + +mkNamedStructure :: + Text -> + Location -> + [[a]] -> + NamedArea (PStructure (Maybe a)) +mkNamedStructure theName pos g = + NamedArea sName mempty mempty s where sName = StructureName theName s = Structure - (PositionedGrid localOrigin $ Just <$> mkGrid g) + (PositionedGrid pos $ Just <$> mkGrid g) mempty mempty mempty