refactor to remove swarm-tournament dep from swarm-integration (#…

…1809)

The only reason the `swarm-integration` test had `swarm-tournament` as a dependency was because of a few validation functions in `Swarm.Web.Tournament.Validate`.  However, this seemed to me like a strange place for those validation functions to live, since they had nothing to do with running a tournament in particular, and it meant that running the integration tests required having postgresql installed even though no databases are used in the integration tests at all.

This PR moves those validation functions to two more generic places: the first function to extract text from a sequence of log messages now lives in `Swarm.Log`, and the other two functions to check for bad errors and run a `GameState` to completion now live in a new module `Swarm.Game.Step.Validate`.

src/swarm-engine/Swarm/Game/Step/Validate.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+-- Description: Validation of gameplay.
+--
+-- Facilities for running a game state until completion, checking for
+-- any errors encountered.  This is not used for normal gameplay but
+-- can be used by /e.g./ integration tests.
+module Swarm.Game.Step.Validate where
+
+import Control.Lens (use, (^.))
+import Control.Monad.State (StateT, gets)
+import Data.List.NonEmpty qualified as NE
+import Data.Text qualified as T
+import Swarm.Effect.Time (runTimeIO)
+import Swarm.Game.Robot.Concrete (robotLog)
+import Swarm.Game.State (GameState, messageInfo, robotInfo, winCondition)
+import Swarm.Game.State.Robot (robotMap)
+import Swarm.Game.State.Substate (WinCondition (..), WinStatus (..), messageQueue)
+import Swarm.Game.Step (gameTick)
+import Swarm.Game.Tick (TickNumber)
+import Swarm.Log (logToText)
+
+-- | Keep stepping a 'GameState' until completion, returning the
+--   number of ticks taken if successful, or any bad error messages
+--   encountered.
+playUntilWin :: StateT GameState IO (Either (NE.NonEmpty T.Text) TickNumber)
+playUntilWin = do
+  w <- use winCondition
+  b <- gets badErrorsInLogs
+  case NE.nonEmpty b of
+    Just badErrs -> return $ Left badErrs
+    Nothing -> case w of
+      WinConditions (Won _ ts) _ -> return $ Right ts
+      _ -> runTimeIO gameTick >> playUntilWin
+
+-- | Extract any bad error messages from robot logs or the global
+--   message queue, where "bad" errors are either fatal errors or
+--   ones referring to issues in the issue tracker.
+badErrorsInLogs :: GameState -> [T.Text]
+badErrorsInLogs g =
+  concatMap
+    (\r -> filter isBad (logToText $ r ^. robotLog))
+    (g ^. robotInfo . robotMap)
+    <> filter isBad (logToText $ g ^. messageInfo . messageQueue)
+ where
+  isBad m = "Fatal error:" `T.isInfixOf` m || "swarm/issues" `T.isInfixOf` m

src/swarm-engine/Swarm/Log.hs

@@ -7,6 +7,7 @@
 -- A data type to represent log messages, both for robot logs and
 -- the system log.
 module Swarm.Log (
+  -- * Log entries
   Severity (..),
   RobotLogSource (..),
   LogSource (..),
@@ -16,10 +17,14 @@ module Swarm.Log (
   leSeverity,
   leName,
   leText,
+
+  -- * Utilities
+  logToText,
 ) where
 
-import Control.Lens (makeLenses)
+import Control.Lens (makeLenses, view)
 import Data.Aeson (FromJSON, ToJSON)
+import Data.Foldable (toList)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Swarm.Game.Location (Location)
@@ -68,3 +73,7 @@ data LogEntry = LogEntry
   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
 
 makeLenses ''LogEntry
+
+-- | Extract the text from a container of log entries.
+logToText :: Foldable t => t LogEntry -> [Text]
+logToText = map (view leText) . toList

src/swarm-tournament/Swarm/Web/Tournament/Validate.hs

@@ -13,41 +13,29 @@ import Control.Carrier.Throw.Either (runThrow)
 import Control.Lens
 import Control.Monad (unless)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.State (StateT, evalStateT, gets)
+import Control.Monad.State (evalStateT)
 import Control.Monad.Trans.Except
 import Data.ByteString.Lazy qualified as LBS
 import Data.Either.Extra (maybeToEither)
-import Data.Foldable (Foldable (toList))
-import Data.List.NonEmpty qualified as NE
 import Data.Sequence (Seq)
 import Data.Text qualified as T
 import Data.Text.Encoding (decodeUtf8')
 import Data.Yaml (decodeEither', parseEither)
 import Servant.Multipart
-import Swarm.Effect (runTimeIO)
 import Swarm.Game.CESK (emptyStore, initMachine)
 import Swarm.Game.Failure (SystemFailure)
-import Swarm.Game.Robot.Concrete (machine, robotContext, robotLog)
+import Swarm.Game.Robot.Concrete (machine, robotContext)
 import Swarm.Game.Robot.Context (defReqs)
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Scoring.CodeSize (codeMetricsFromSyntax)
 import Swarm.Game.Scenario.Status (emptyLaunchParams)
 import Swarm.Game.State
-import Swarm.Game.State.Robot (robotMap)
 import Swarm.Game.State.Runtime (initGameStateConfig, initScenarioInputs)
-import Swarm.Game.State.Substate (
-  WinCondition (WinConditions),
-  WinStatus (Won),
-  initState,
-  messageQueue,
-  seed,
- )
-import Swarm.Game.Step (gameTick)
-import Swarm.Game.Tick (TickNumber)
+import Swarm.Game.State.Substate (initState, seed)
+import Swarm.Game.Step.Validate (playUntilWin)
 import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Module (Module (..))
 import Swarm.Language.Pipeline (ProcessedTerm (..), processTermEither)
-import Swarm.Log
 import Swarm.Util.Yaml
 import Swarm.Web.Tournament.Database.Query
 import Swarm.Web.Tournament.Type
@@ -231,27 +219,3 @@ verifySolution (SolutionTimeout timeoutSeconds) sol gs = do
       -- hopefully, eventually, go away).
       & baseRobot . robotContext . defReqs <>~ reqCtx
       & baseRobot . machine .~ initMachine sol Ctx.empty emptyStore
-
--- ** Utils shared with integration tests
-
-playUntilWin :: StateT GameState IO (Either (NE.NonEmpty T.Text) TickNumber)
-playUntilWin = do
-  w <- use winCondition
-  b <- gets badErrorsInLogs
-  case NE.nonEmpty b of
-    Just badErrs -> return $ Left badErrs
-    Nothing -> case w of
-      WinConditions (Won _ ts) _ -> return $ Right ts
-      _ -> runTimeIO gameTick >> playUntilWin
-
-badErrorsInLogs :: GameState -> [T.Text]
-badErrorsInLogs g =
-  concatMap
-    (\r -> filter isBad (seqToTexts $ r ^. robotLog))
-    (g ^. robotInfo . robotMap)
-    <> filter isBad (seqToTexts $ g ^. messageInfo . messageQueue)
- where
-  isBad m = "Fatal error:" `T.isInfixOf` m || "swarm/issues" `T.isInfixOf` m
-
-seqToTexts :: Seq LogEntry -> [T.Text]
-seqToTexts = map (view leText) . toList

swarm.cabal

@@ -337,6 +337,7 @@ library swarm-engine
     Swarm.Game.Step.Util
     Swarm.Game.Step.Util.Command
     Swarm.Game.Step.Util.Inspect
+    Swarm.Game.Step.Validate
     Swarm.Game.Tick
     Swarm.Game.Value
     Swarm.Log
@@ -657,6 +658,7 @@ library
     Swarm.Game.Step.Util,
     Swarm.Game.Step.Util.Command,
     Swarm.Game.Step.Util.Inspect,
+    Swarm.Game.Step.Validate,
     Swarm.Game.Terrain,
     Swarm.Game.Tick,
     Swarm.Game.Universe,
@@ -935,10 +937,7 @@ test-suite swarm-integration
     witch,
     yaml,
 
-  build-depends:
-    swarm,
-    swarm:swarm-tournament,
-
+  build-depends: swarm
   hs-source-dirs: test/integration
   default-language: Haskell2010
   ghc-options: -threaded

test/integration/Main.hs

@@ -64,6 +64,7 @@ import Swarm.Game.State.Substate (
   ticks,
  )
 import Swarm.Game.Step.Path.Type
+import Swarm.Game.Step.Validate (badErrorsInLogs, playUntilWin)
 import Swarm.Game.Tick (getTickNumber)
 import Swarm.Language.Context qualified as Ctx
 import Swarm.Language.Pipeline (ProcessedTerm (..), processTerm)
@@ -80,7 +81,6 @@ import Swarm.TUI.Model.UI (UIState)
 import Swarm.Util (acquireAllWithExt)
 import Swarm.Util.RingBuffer qualified as RB
 import Swarm.Util.Yaml (decodeFileEitherE)
-import Swarm.Web.Tournament.Validate
 import System.FilePath.Posix (splitDirectories)
 import System.Timeout (timeout)
 import Test.Tasty (TestTree, defaultMain, testGroup)
@@ -325,8 +325,8 @@ testScenarioSolutions rs ui =
         , testSolution Default "Testing/955-heading"
         , testSolution' Default "Testing/397-wrong-missing" CheckForBadErrors $ \g -> do
             let msgs =
-                  (g ^. messageInfo . messageQueue . to seqToTexts)
-                    <> (g ^.. robotInfo . robotMap . traverse . robotLog . to seqToTexts . traverse)
+                  (g ^. messageInfo . messageQueue . to logToText)
+                    <> (g ^.. robotInfo . robotMap . traverse . robotLog . to logToText . traverse)
 
             assertBool "Should be some messages" (not (null msgs))
             assertBool "Error messages should not mention treads" $