{-# 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 :: StateT GameState IO (Either (NonEmpty Text) TickNumber)
playUntilWin = do
  WinCondition
w <- Getting WinCondition GameState WinCondition
-> StateT GameState IO WinCondition
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting WinCondition GameState WinCondition
Lens' GameState WinCondition
winCondition
  [Text]
b <- (GameState -> [Text]) -> StateT GameState IO [Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GameState -> [Text]
badErrorsInLogs
  case [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Text]
b of
    Just NonEmpty Text
badErrs -> Either (NonEmpty Text) TickNumber
-> StateT GameState IO (Either (NonEmpty Text) TickNumber)
forall a. a -> StateT GameState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (NonEmpty Text) TickNumber
 -> StateT GameState IO (Either (NonEmpty Text) TickNumber))
-> Either (NonEmpty Text) TickNumber
-> StateT GameState IO (Either (NonEmpty Text) TickNumber)
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> Either (NonEmpty Text) TickNumber
forall a b. a -> Either a b
Left NonEmpty Text
badErrs
    Maybe (NonEmpty Text)
Nothing -> case WinCondition
w of
      WinConditions (Won Bool
_ TickNumber
ts) ObjectiveCompletion
_ -> Either (NonEmpty Text) TickNumber
-> StateT GameState IO (Either (NonEmpty Text) TickNumber)
forall a. a -> StateT GameState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (NonEmpty Text) TickNumber
 -> StateT GameState IO (Either (NonEmpty Text) TickNumber))
-> Either (NonEmpty Text) TickNumber
-> StateT GameState IO (Either (NonEmpty Text) TickNumber)
forall a b. (a -> b) -> a -> b
$ TickNumber -> Either (NonEmpty Text) TickNumber
forall a b. b -> Either a b
Right TickNumber
ts
      WinCondition
_ -> TimeIOC (StateT GameState IO) Bool -> StateT GameState IO Bool
forall (m :: * -> *) a. TimeIOC m a -> m a
runTimeIO TimeIOC (StateT GameState IO) Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasGameStepState sig m =>
m Bool
gameTick StateT GameState IO Bool
-> StateT GameState IO (Either (NonEmpty Text) TickNumber)
-> StateT GameState IO (Either (NonEmpty Text) TickNumber)
forall a b.
StateT GameState IO a
-> StateT GameState IO b -> StateT GameState IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT GameState IO (Either (NonEmpty Text) TickNumber)
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 :: GameState -> [Text]
badErrorsInLogs GameState
g =
  (Robot -> [Text]) -> IntMap Robot -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    (\Robot
r -> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isBad (Seq LogEntry -> [Text]
forall (t :: * -> *). Foldable t => t LogEntry -> [Text]
logToText (Seq LogEntry -> [Text]) -> Seq LogEntry -> [Text]
forall a b. (a -> b) -> a -> b
$ Robot
r Robot
-> Getting (Seq LogEntry) Robot (Seq LogEntry) -> Seq LogEntry
forall s a. s -> Getting a s a -> a
^. Getting (Seq LogEntry) Robot (Seq LogEntry)
Lens' Robot (Seq LogEntry)
robotLog))
    (GameState
g GameState
-> Getting (IntMap Robot) GameState (IntMap Robot) -> IntMap Robot
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (IntMap Robot) Robots)
-> GameState -> Const (IntMap Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (IntMap Robot) Robots)
 -> GameState -> Const (IntMap Robot) GameState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> Robots -> Const (IntMap Robot) Robots)
-> Getting (IntMap Robot) GameState (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> Robots -> Const (IntMap Robot) Robots
Lens' Robots (IntMap Robot)
robotMap)
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isBad (Seq LogEntry -> [Text]
forall (t :: * -> *). Foldable t => t LogEntry -> [Text]
logToText (Seq LogEntry -> [Text]) -> Seq LogEntry -> [Text]
forall a b. (a -> b) -> a -> b
$ GameState
g GameState
-> Getting (Seq LogEntry) GameState (Seq LogEntry) -> Seq LogEntry
forall s a. s -> Getting a s a -> a
^. (Messages -> Const (Seq LogEntry) Messages)
-> GameState -> Const (Seq LogEntry) GameState
Lens' GameState Messages
messageInfo ((Messages -> Const (Seq LogEntry) Messages)
 -> GameState -> Const (Seq LogEntry) GameState)
-> ((Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
    -> Messages -> Const (Seq LogEntry) Messages)
-> Getting (Seq LogEntry) GameState (Seq LogEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
-> Messages -> Const (Seq LogEntry) Messages
Lens' Messages (Seq LogEntry)
messageQueue)
 where
  isBad :: Text -> Bool
isBad Text
m = Text
"Fatal error:" Text -> Text -> Bool
`T.isInfixOf` Text
m Bool -> Bool -> Bool
|| Text
"swarm/issues" Text -> Text -> Bool
`T.isInfixOf` Text
m