diff --git a/swarm.cabal b/swarm.cabal index 2cb027dbf..9976547e7 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -439,6 +439,7 @@ test-suite swarm-unit TestInventory TestModel TestPedagogy + TestRecipeCoverage TestNotification TestLanguagePipeline TestOrdering @@ -451,6 +452,7 @@ test-suite swarm-unit build-depends: tasty >= 0.10 && < 1.6, tasty-hunit >= 0.10 && < 0.11, + tasty-expected-failure >= 0.12 && < 0.13, tasty-quickcheck >= 0.10 && < 0.11, QuickCheck >= 2.14 && < 2.15, -- Imports shared with the library don't need bounds diff --git a/test/unit/Main.hs b/test/unit/Main.hs index 3792558b2..2ecdc43b9 100644 --- a/test/unit/Main.hs +++ b/test/unit/Main.hs @@ -37,6 +37,7 @@ import TestNotification (testNotification) import TestOrdering (testOrdering) import TestPedagogy (testPedagogy) import TestPretty (testPrettyConst) +import TestRecipeCoverage (testDeviceRecipeCoverage) import TestScoring (testHighScores) import Witch (from) @@ -55,6 +56,7 @@ tests s = , testPrettyConst , testBoolExpr , testCommands + , testDeviceRecipeCoverage (s ^. runtimeState) , testHighScores , testEval (s ^. gameState) , testModel diff --git a/test/unit/TestRecipeCoverage.hs b/test/unit/TestRecipeCoverage.hs new file mode 100644 index 000000000..a66253529 --- /dev/null +++ b/test/unit/TestRecipeCoverage.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- Ensure recipe coverage for all entities that +-- grant capabilities (aka "devices"). +module TestRecipeCoverage where + +import Control.Lens ((^.)) +import Data.Map qualified as M +import Data.Set qualified as Set +import Data.Text qualified as T +import Swarm.Game.Entity (EntityMap (entitiesByCap), entityName) +import Swarm.Game.Recipe (recipeOutputs) +import Swarm.TUI.Model (RuntimeState, stdEntityMap, stdRecipes) +import Swarm.Util (commaList, quote) +import Test.Tasty +import Test.Tasty.ExpectedFailure (expectFailBecause) +import Test.Tasty.HUnit + +testDeviceRecipeCoverage :: RuntimeState -> TestTree +testDeviceRecipeCoverage rs = + testGroup + "Recipe coverage" + [ expectFailBecause "Need to come up with more recipes" checkCoverage + ] + where + checkCoverage :: TestTree + checkCoverage = + testCase + "Ensure all devices have recipes (#1268)" + $ assertBool errMessage + $ null nonCoveredEntities + where + errMessage = + T.unpack $ + T.unwords + [ "Missing recipes for:" + , commaList $ map quote $ Set.toList nonCoveredEntities + ] + + -- Only include entities that grant a capability: + entityNames = Set.fromList . map (^. entityName) . concat . M.elems . entitiesByCap $ rs ^. stdEntityMap + + getOutputsForRecipe r = map ((^. entityName) . snd) $ r ^. recipeOutputs + recipeOutputEntities = Set.fromList . concatMap getOutputsForRecipe $ rs ^. stdRecipes + nonCoveredEntities = Set.difference entityNames recipeOutputEntities