{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Subrecord definitions that belong to 'Swarm.Game.State.GameState'
module Swarm.Game.State.Substate (
  GameStateConfig (..),
  REPLStatus (..),
  WinStatus (..),
  WinCondition (..),
  ObjectiveCompletion,
  _NoWinCondition,
  _WinConditions,
  Announcement (..),
  RunStatus (..),
  Step (..),
  SingleStep (..),

  -- ** GameState fields

  -- *** Randomness state
  Randomness,
  initRandomness,
  seed,
  randGen,

  -- *** Temporal state
  TemporalState,
  PauseOnObjective (..),
  initTemporalState,
  gameStep,
  runStatus,
  ticks,
  robotStepsPerTick,
  paused,
  pauseOnObjective,

  -- *** Recipes
  Recipes,
  initRecipeMaps,
  recipesOut,
  recipesIn,
  recipesCat,

  -- *** Messages
  Messages,
  initMessages,
  messageQueue,
  lastSeenMessageTime,
  announcementQueue,

  -- *** Controls
  GameControls,
  initGameControls,
  initiallyRunCode,
  replStatus,
  replNextValueIndex,
  replListener,
  inputHandler,

  -- *** Discovery
  Discovery,
  initDiscovery,
  allDiscoveredEntities,
  availableRecipes,
  availableCommands,
  knownEntities,
  craftableDevices,
  gameAchievements,
  structureRecognition,
  tagMembers,

  -- ** Notifications
  Notifications (..),
  notificationsCount,
  notificationsShouldAlert,
  notificationsContent,

  -- ** Utilities
  defaultRobotStepsPerTick,
  replActiveType,
  replWorking,
  toggleRunStatus,
) where

import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Data.Aeson (FromJSON, ToJSON)
import Data.IntMap (IntMap)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Set qualified as S
import Data.Text (Text)
import GHC.Generics (Generic)
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Entity
import Swarm.Game.Recipe (
  Recipe,
  catRecipeMap,
  inRecipeMap,
  outRecipeMap,
 )
import Swarm.Game.Robot
import Swarm.Game.Scenario (GameStateInputs (..), RecognizableStructureContent)
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures)
import Swarm.Game.State.Config
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Game.World.Gen (Seed)
import Swarm.Language.Syntax (Const, Syntax)
import Swarm.Language.Types (Polytype)
import Swarm.Language.Value (Value)
import Swarm.Log
import Swarm.Util.Lens (makeLensesNoSigs)
import System.Random (StdGen, mkStdGen)

-- * Subsidiary data types

-- | A data type to represent the current status of the REPL.
data REPLStatus
  = -- | The REPL is not doing anything actively at the moment.
    --   We persist the last value and its type though.
    REPLDone (Maybe (Polytype, Value))
  | -- | A command entered at the REPL is currently being run.  The
    --   'Polytype' represents the type of the expression that was
    --   entered.  The @Maybe Value@ starts out as 'Nothing' and gets
    --   filled in with a result once the command completes.
    REPLWorking Polytype (Maybe Value)
  deriving (REPLStatus -> REPLStatus -> Bool
(REPLStatus -> REPLStatus -> Bool)
-> (REPLStatus -> REPLStatus -> Bool) -> Eq REPLStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: REPLStatus -> REPLStatus -> Bool
== :: REPLStatus -> REPLStatus -> Bool
$c/= :: REPLStatus -> REPLStatus -> Bool
/= :: REPLStatus -> REPLStatus -> Bool
Eq, (forall x. REPLStatus -> Rep REPLStatus x)
-> (forall x. Rep REPLStatus x -> REPLStatus) -> Generic REPLStatus
forall x. Rep REPLStatus x -> REPLStatus
forall x. REPLStatus -> Rep REPLStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. REPLStatus -> Rep REPLStatus x
from :: forall x. REPLStatus -> Rep REPLStatus x
$cto :: forall x. Rep REPLStatus x -> REPLStatus
to :: forall x. Rep REPLStatus x -> REPLStatus
Generic, [REPLStatus] -> Value
[REPLStatus] -> Encoding
REPLStatus -> Bool
REPLStatus -> Value
REPLStatus -> Encoding
(REPLStatus -> Value)
-> (REPLStatus -> Encoding)
-> ([REPLStatus] -> Value)
-> ([REPLStatus] -> Encoding)
-> (REPLStatus -> Bool)
-> ToJSON REPLStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: REPLStatus -> Value
toJSON :: REPLStatus -> Value
$ctoEncoding :: REPLStatus -> Encoding
toEncoding :: REPLStatus -> Encoding
$ctoJSONList :: [REPLStatus] -> Value
toJSONList :: [REPLStatus] -> Value
$ctoEncodingList :: [REPLStatus] -> Encoding
toEncodingList :: [REPLStatus] -> Encoding
$comitField :: REPLStatus -> Bool
omitField :: REPLStatus -> Bool
ToJSON)

data WinStatus
  = -- | There are one or more objectives remaining that the player
    -- has not yet accomplished.
    Ongoing
  | -- | The player has won.
    -- The boolean indicates whether they have
    -- already been congratulated.
    Won Bool TickNumber
  | -- | The player has completed certain "goals" that preclude
    -- (via negative prerequisites) the completion of all of the
    -- required goals.
    -- The boolean indicates whether they have
    -- already been informed.
    Unwinnable Bool
  deriving (WinStatus -> WinStatus -> Bool
(WinStatus -> WinStatus -> Bool)
-> (WinStatus -> WinStatus -> Bool) -> Eq WinStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WinStatus -> WinStatus -> Bool
== :: WinStatus -> WinStatus -> Bool
$c/= :: WinStatus -> WinStatus -> Bool
/= :: WinStatus -> WinStatus -> Bool
Eq, Int -> WinStatus -> ShowS
[WinStatus] -> ShowS
WinStatus -> String
(Int -> WinStatus -> ShowS)
-> (WinStatus -> String)
-> ([WinStatus] -> ShowS)
-> Show WinStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WinStatus -> ShowS
showsPrec :: Int -> WinStatus -> ShowS
$cshow :: WinStatus -> String
show :: WinStatus -> String
$cshowList :: [WinStatus] -> ShowS
showList :: [WinStatus] -> ShowS
Show, (forall x. WinStatus -> Rep WinStatus x)
-> (forall x. Rep WinStatus x -> WinStatus) -> Generic WinStatus
forall x. Rep WinStatus x -> WinStatus
forall x. WinStatus -> Rep WinStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WinStatus -> Rep WinStatus x
from :: forall x. WinStatus -> Rep WinStatus x
$cto :: forall x. Rep WinStatus x -> WinStatus
to :: forall x. Rep WinStatus x -> WinStatus
Generic, Maybe WinStatus
Value -> Parser [WinStatus]
Value -> Parser WinStatus
(Value -> Parser WinStatus)
-> (Value -> Parser [WinStatus])
-> Maybe WinStatus
-> FromJSON WinStatus
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WinStatus
parseJSON :: Value -> Parser WinStatus
$cparseJSONList :: Value -> Parser [WinStatus]
parseJSONList :: Value -> Parser [WinStatus]
$comittedField :: Maybe WinStatus
omittedField :: Maybe WinStatus
FromJSON, [WinStatus] -> Value
[WinStatus] -> Encoding
WinStatus -> Bool
WinStatus -> Value
WinStatus -> Encoding
(WinStatus -> Value)
-> (WinStatus -> Encoding)
-> ([WinStatus] -> Value)
-> ([WinStatus] -> Encoding)
-> (WinStatus -> Bool)
-> ToJSON WinStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WinStatus -> Value
toJSON :: WinStatus -> Value
$ctoEncoding :: WinStatus -> Encoding
toEncoding :: WinStatus -> Encoding
$ctoJSONList :: [WinStatus] -> Value
toJSONList :: [WinStatus] -> Value
$ctoEncodingList :: [WinStatus] -> Encoding
toEncodingList :: [WinStatus] -> Encoding
$comitField :: WinStatus -> Bool
omitField :: WinStatus -> Bool
ToJSON)

data WinCondition
  = -- | There is no winning condition.
    NoWinCondition
  | -- | NOTE: It is possible to continue to achieve "optional" objectives
    -- even after the game has been won (or deemed unwinnable).
    WinConditions WinStatus ObjectiveCompletion
  deriving (Int -> WinCondition -> ShowS
[WinCondition] -> ShowS
WinCondition -> String
(Int -> WinCondition -> ShowS)
-> (WinCondition -> String)
-> ([WinCondition] -> ShowS)
-> Show WinCondition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WinCondition -> ShowS
showsPrec :: Int -> WinCondition -> ShowS
$cshow :: WinCondition -> String
show :: WinCondition -> String
$cshowList :: [WinCondition] -> ShowS
showList :: [WinCondition] -> ShowS
Show, (forall x. WinCondition -> Rep WinCondition x)
-> (forall x. Rep WinCondition x -> WinCondition)
-> Generic WinCondition
forall x. Rep WinCondition x -> WinCondition
forall x. WinCondition -> Rep WinCondition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WinCondition -> Rep WinCondition x
from :: forall x. WinCondition -> Rep WinCondition x
$cto :: forall x. Rep WinCondition x -> WinCondition
to :: forall x. Rep WinCondition x -> WinCondition
Generic, Maybe WinCondition
Value -> Parser [WinCondition]
Value -> Parser WinCondition
(Value -> Parser WinCondition)
-> (Value -> Parser [WinCondition])
-> Maybe WinCondition
-> FromJSON WinCondition
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser WinCondition
parseJSON :: Value -> Parser WinCondition
$cparseJSONList :: Value -> Parser [WinCondition]
parseJSONList :: Value -> Parser [WinCondition]
$comittedField :: Maybe WinCondition
omittedField :: Maybe WinCondition
FromJSON, [WinCondition] -> Value
[WinCondition] -> Encoding
WinCondition -> Bool
WinCondition -> Value
WinCondition -> Encoding
(WinCondition -> Value)
-> (WinCondition -> Encoding)
-> ([WinCondition] -> Value)
-> ([WinCondition] -> Encoding)
-> (WinCondition -> Bool)
-> ToJSON WinCondition
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: WinCondition -> Value
toJSON :: WinCondition -> Value
$ctoEncoding :: WinCondition -> Encoding
toEncoding :: WinCondition -> Encoding
$ctoJSONList :: [WinCondition] -> Value
toJSONList :: [WinCondition] -> Value
$ctoEncodingList :: [WinCondition] -> Encoding
toEncodingList :: [WinCondition] -> Encoding
$comitField :: WinCondition -> Bool
omitField :: WinCondition -> Bool
ToJSON)

makePrisms ''WinCondition

instance ToSample WinCondition where
  toSamples :: Proxy WinCondition -> [(EntityName, WinCondition)]
toSamples Proxy WinCondition
_ =
    [WinCondition] -> [(EntityName, WinCondition)]
forall a. [a] -> [(EntityName, a)]
SD.samples
      [ WinCondition
NoWinCondition
      -- TODO: #1552 add simple objective sample
      ]

-- | A data type to keep track of the pause mode.
data RunStatus
  = -- | The game is running.
    Running
  | -- | The user paused the game, and it should stay pause after visiting the help.
    ManualPause
  | -- | The game got paused while visiting the help,
    --   and it should unpause after returning back to the game.
    AutoPause
  deriving (RunStatus -> RunStatus -> Bool
(RunStatus -> RunStatus -> Bool)
-> (RunStatus -> RunStatus -> Bool) -> Eq RunStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunStatus -> RunStatus -> Bool
== :: RunStatus -> RunStatus -> Bool
$c/= :: RunStatus -> RunStatus -> Bool
/= :: RunStatus -> RunStatus -> Bool
Eq, Int -> RunStatus -> ShowS
[RunStatus] -> ShowS
RunStatus -> String
(Int -> RunStatus -> ShowS)
-> (RunStatus -> String)
-> ([RunStatus] -> ShowS)
-> Show RunStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStatus -> ShowS
showsPrec :: Int -> RunStatus -> ShowS
$cshow :: RunStatus -> String
show :: RunStatus -> String
$cshowList :: [RunStatus] -> ShowS
showList :: [RunStatus] -> ShowS
Show, (forall x. RunStatus -> Rep RunStatus x)
-> (forall x. Rep RunStatus x -> RunStatus) -> Generic RunStatus
forall x. Rep RunStatus x -> RunStatus
forall x. RunStatus -> Rep RunStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunStatus -> Rep RunStatus x
from :: forall x. RunStatus -> Rep RunStatus x
$cto :: forall x. Rep RunStatus x -> RunStatus
to :: forall x. Rep RunStatus x -> RunStatus
Generic, Maybe RunStatus
Value -> Parser [RunStatus]
Value -> Parser RunStatus
(Value -> Parser RunStatus)
-> (Value -> Parser [RunStatus])
-> Maybe RunStatus
-> FromJSON RunStatus
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunStatus
parseJSON :: Value -> Parser RunStatus
$cparseJSONList :: Value -> Parser [RunStatus]
parseJSONList :: Value -> Parser [RunStatus]
$comittedField :: Maybe RunStatus
omittedField :: Maybe RunStatus
FromJSON, [RunStatus] -> Value
[RunStatus] -> Encoding
RunStatus -> Bool
RunStatus -> Value
RunStatus -> Encoding
(RunStatus -> Value)
-> (RunStatus -> Encoding)
-> ([RunStatus] -> Value)
-> ([RunStatus] -> Encoding)
-> (RunStatus -> Bool)
-> ToJSON RunStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RunStatus -> Value
toJSON :: RunStatus -> Value
$ctoEncoding :: RunStatus -> Encoding
toEncoding :: RunStatus -> Encoding
$ctoJSONList :: [RunStatus] -> Value
toJSONList :: [RunStatus] -> Value
$ctoEncodingList :: [RunStatus] -> Encoding
toEncodingList :: [RunStatus] -> Encoding
$comitField :: RunStatus -> Bool
omitField :: RunStatus -> Bool
ToJSON)

-- | Switch (auto or manually) paused game to running and running to manually paused.
--
--   Note that this function is not safe to use in the app directly, because the UI
--   also tracks time between ticks---use 'Swarm.TUI.Controller.safeTogglePause' instead.
toggleRunStatus :: RunStatus -> RunStatus
toggleRunStatus :: RunStatus -> RunStatus
toggleRunStatus RunStatus
s = if RunStatus
s RunStatus -> RunStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RunStatus
Running then RunStatus
ManualPause else RunStatus
Running

-- | A data type to keep track of some kind of log or sequence, with
--   an index to remember which ones are "new", which ones have
--   "already been seen", and whether the user has yet been notified
--   of the fact that there are unseen notifications.
data Notifications a = Notifications
  { forall a. Notifications a -> Int
_notificationsCount :: Int
  , forall a. Notifications a -> Bool
_notificationsShouldAlert :: Bool
  , forall a. Notifications a -> [a]
_notificationsContent :: [a]
  }
  deriving (Notifications a -> Notifications a -> Bool
(Notifications a -> Notifications a -> Bool)
-> (Notifications a -> Notifications a -> Bool)
-> Eq (Notifications a)
forall a. Eq a => Notifications a -> Notifications a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Notifications a -> Notifications a -> Bool
== :: Notifications a -> Notifications a -> Bool
$c/= :: forall a. Eq a => Notifications a -> Notifications a -> Bool
/= :: Notifications a -> Notifications a -> Bool
Eq, Int -> Notifications a -> ShowS
[Notifications a] -> ShowS
Notifications a -> String
(Int -> Notifications a -> ShowS)
-> (Notifications a -> String)
-> ([Notifications a] -> ShowS)
-> Show (Notifications a)
forall a. Show a => Int -> Notifications a -> ShowS
forall a. Show a => [Notifications a] -> ShowS
forall a. Show a => Notifications a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Notifications a -> ShowS
showsPrec :: Int -> Notifications a -> ShowS
$cshow :: forall a. Show a => Notifications a -> String
show :: Notifications a -> String
$cshowList :: forall a. Show a => [Notifications a] -> ShowS
showList :: [Notifications a] -> ShowS
Show, (forall x. Notifications a -> Rep (Notifications a) x)
-> (forall x. Rep (Notifications a) x -> Notifications a)
-> Generic (Notifications a)
forall x. Rep (Notifications a) x -> Notifications a
forall x. Notifications a -> Rep (Notifications a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Notifications a) x -> Notifications a
forall a x. Notifications a -> Rep (Notifications a) x
$cfrom :: forall a x. Notifications a -> Rep (Notifications a) x
from :: forall x. Notifications a -> Rep (Notifications a) x
$cto :: forall a x. Rep (Notifications a) x -> Notifications a
to :: forall x. Rep (Notifications a) x -> Notifications a
Generic, Maybe (Notifications a)
Value -> Parser [Notifications a]
Value -> Parser (Notifications a)
(Value -> Parser (Notifications a))
-> (Value -> Parser [Notifications a])
-> Maybe (Notifications a)
-> FromJSON (Notifications a)
forall a. FromJSON a => Maybe (Notifications a)
forall a. FromJSON a => Value -> Parser [Notifications a]
forall a. FromJSON a => Value -> Parser (Notifications a)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Notifications a)
parseJSON :: Value -> Parser (Notifications a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Notifications a]
parseJSONList :: Value -> Parser [Notifications a]
$comittedField :: forall a. FromJSON a => Maybe (Notifications a)
omittedField :: Maybe (Notifications a)
FromJSON, [Notifications a] -> Value
[Notifications a] -> Encoding
Notifications a -> Bool
Notifications a -> Value
Notifications a -> Encoding
(Notifications a -> Value)
-> (Notifications a -> Encoding)
-> ([Notifications a] -> Value)
-> ([Notifications a] -> Encoding)
-> (Notifications a -> Bool)
-> ToJSON (Notifications a)
forall a. ToJSON a => [Notifications a] -> Value
forall a. ToJSON a => [Notifications a] -> Encoding
forall a. ToJSON a => Notifications a -> Bool
forall a. ToJSON a => Notifications a -> Value
forall a. ToJSON a => Notifications a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => Notifications a -> Value
toJSON :: Notifications a -> Value
$ctoEncoding :: forall a. ToJSON a => Notifications a -> Encoding
toEncoding :: Notifications a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [Notifications a] -> Value
toJSONList :: [Notifications a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [Notifications a] -> Encoding
toEncodingList :: [Notifications a] -> Encoding
$comitField :: forall a. ToJSON a => Notifications a -> Bool
omitField :: Notifications a -> Bool
ToJSON)

instance Semigroup (Notifications a) where
  Notifications Int
count1 Bool
alert1 [a]
xs1 <> :: Notifications a -> Notifications a -> Notifications a
<> Notifications Int
count2 Bool
alert2 [a]
xs2 = Int -> Bool -> [a] -> Notifications a
forall a. Int -> Bool -> [a] -> Notifications a
Notifications (Int
count1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count2) (Bool
alert1 Bool -> Bool -> Bool
|| Bool
alert2) ([a]
xs1 [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
xs2)

instance Monoid (Notifications a) where
  mempty :: Notifications a
mempty = Int -> Bool -> [a] -> Notifications a
forall a. Int -> Bool -> [a] -> Notifications a
Notifications Int
0 Bool
False []

makeLenses ''Notifications

data Recipes = Recipes
  { Recipes -> IntMap [Recipe Entity]
_recipesOut :: IntMap [Recipe Entity]
  , Recipes -> IntMap [Recipe Entity]
_recipesIn :: IntMap [Recipe Entity]
  , Recipes -> IntMap [Recipe Entity]
_recipesCat :: IntMap [Recipe Entity]
  }

makeLensesNoSigs ''Recipes

-- | All recipes the game knows about, indexed by outputs.
recipesOut :: Lens' Recipes (IntMap [Recipe Entity])

-- | All recipes the game knows about, indexed by inputs.
recipesIn :: Lens' Recipes (IntMap [Recipe Entity])

-- | All recipes the game knows about, indexed by requirement/catalyst.
recipesCat :: Lens' Recipes (IntMap [Recipe Entity])

data Messages = Messages
  { Messages -> Seq LogEntry
_messageQueue :: Seq LogEntry
  , Messages -> TickNumber
_lastSeenMessageTime :: TickNumber
  , Messages -> Seq Announcement
_announcementQueue :: Seq Announcement
  }

makeLensesNoSigs ''Messages

-- | A queue of global messages.
--
-- Note that we put the newest entry to the right.
messageQueue :: Lens' Messages (Seq LogEntry)

-- | Last time message queue has been viewed (used for notification).
lastSeenMessageTime :: Lens' Messages TickNumber

-- | A queue of global announcements.
-- Note that this is distinct from the 'messageQueue',
-- which is for messages emitted by robots.
--
-- Note that we put the newest entry to the right.
announcementQueue :: Lens' Messages (Seq Announcement)

-- | Type for remembering which robots will be run next in a robot step mode.
--
-- Once some robots have run, we need to store 'RID' to know which ones should go next.
-- At 'SBefore' no robots were run yet, so it is safe to transition to and from 'WorldTick'.
--
-- @
--                     tick
--     ┌────────────────────────────────────┐
--     │                                    │
--     │               step                 │
--     │              ┌────┐                │
--     ▼              ▼    │                │
-- ┌───────┐ step  ┌───────┴───┐ step  ┌────┴─────┐
-- │SBefore├──────►│SSingle RID├──────►│SAfter RID│
-- └──┬────┘       └───────────┘       └────┬─────┘
--    │ ▲ player        ▲                   │
--    ▼ │ switch        └───────────────────┘
-- ┌────┴────┐             view RID > oldRID
-- │WorldTick│
-- └─────────┘
-- @
data SingleStep
  = -- | Run the robots from the beginning until the focused robot (noninclusive).
    SBefore
  | -- | Run a single step of the focused robot.
    SSingle RID
  | -- | Run robots after the (previously) focused robot and finish the tick.
    SAfter RID

-- | Game step mode - we use the single step mode when debugging robot 'CESK' machine.
data Step = WorldTick | RobotStep SingleStep

data PauseOnObjective = PauseOnWin | PauseOnAnyObjective
  deriving (PauseOnObjective -> PauseOnObjective -> Bool
(PauseOnObjective -> PauseOnObjective -> Bool)
-> (PauseOnObjective -> PauseOnObjective -> Bool)
-> Eq PauseOnObjective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PauseOnObjective -> PauseOnObjective -> Bool
== :: PauseOnObjective -> PauseOnObjective -> Bool
$c/= :: PauseOnObjective -> PauseOnObjective -> Bool
/= :: PauseOnObjective -> PauseOnObjective -> Bool
Eq, Eq PauseOnObjective
Eq PauseOnObjective =>
(PauseOnObjective -> PauseOnObjective -> Ordering)
-> (PauseOnObjective -> PauseOnObjective -> Bool)
-> (PauseOnObjective -> PauseOnObjective -> Bool)
-> (PauseOnObjective -> PauseOnObjective -> Bool)
-> (PauseOnObjective -> PauseOnObjective -> Bool)
-> (PauseOnObjective -> PauseOnObjective -> PauseOnObjective)
-> (PauseOnObjective -> PauseOnObjective -> PauseOnObjective)
-> Ord PauseOnObjective
PauseOnObjective -> PauseOnObjective -> Bool
PauseOnObjective -> PauseOnObjective -> Ordering
PauseOnObjective -> PauseOnObjective -> PauseOnObjective
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PauseOnObjective -> PauseOnObjective -> Ordering
compare :: PauseOnObjective -> PauseOnObjective -> Ordering
$c< :: PauseOnObjective -> PauseOnObjective -> Bool
< :: PauseOnObjective -> PauseOnObjective -> Bool
$c<= :: PauseOnObjective -> PauseOnObjective -> Bool
<= :: PauseOnObjective -> PauseOnObjective -> Bool
$c> :: PauseOnObjective -> PauseOnObjective -> Bool
> :: PauseOnObjective -> PauseOnObjective -> Bool
$c>= :: PauseOnObjective -> PauseOnObjective -> Bool
>= :: PauseOnObjective -> PauseOnObjective -> Bool
$cmax :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective
max :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective
$cmin :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective
min :: PauseOnObjective -> PauseOnObjective -> PauseOnObjective
Ord, Int -> PauseOnObjective -> ShowS
[PauseOnObjective] -> ShowS
PauseOnObjective -> String
(Int -> PauseOnObjective -> ShowS)
-> (PauseOnObjective -> String)
-> ([PauseOnObjective] -> ShowS)
-> Show PauseOnObjective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PauseOnObjective -> ShowS
showsPrec :: Int -> PauseOnObjective -> ShowS
$cshow :: PauseOnObjective -> String
show :: PauseOnObjective -> String
$cshowList :: [PauseOnObjective] -> ShowS
showList :: [PauseOnObjective] -> ShowS
Show, Int -> PauseOnObjective
PauseOnObjective -> Int
PauseOnObjective -> [PauseOnObjective]
PauseOnObjective -> PauseOnObjective
PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
PauseOnObjective
-> PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
(PauseOnObjective -> PauseOnObjective)
-> (PauseOnObjective -> PauseOnObjective)
-> (Int -> PauseOnObjective)
-> (PauseOnObjective -> Int)
-> (PauseOnObjective -> [PauseOnObjective])
-> (PauseOnObjective -> PauseOnObjective -> [PauseOnObjective])
-> (PauseOnObjective -> PauseOnObjective -> [PauseOnObjective])
-> (PauseOnObjective
    -> PauseOnObjective -> PauseOnObjective -> [PauseOnObjective])
-> Enum PauseOnObjective
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PauseOnObjective -> PauseOnObjective
succ :: PauseOnObjective -> PauseOnObjective
$cpred :: PauseOnObjective -> PauseOnObjective
pred :: PauseOnObjective -> PauseOnObjective
$ctoEnum :: Int -> PauseOnObjective
toEnum :: Int -> PauseOnObjective
$cfromEnum :: PauseOnObjective -> Int
fromEnum :: PauseOnObjective -> Int
$cenumFrom :: PauseOnObjective -> [PauseOnObjective]
enumFrom :: PauseOnObjective -> [PauseOnObjective]
$cenumFromThen :: PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
enumFromThen :: PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
$cenumFromTo :: PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
enumFromTo :: PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
$cenumFromThenTo :: PauseOnObjective
-> PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
enumFromThenTo :: PauseOnObjective
-> PauseOnObjective -> PauseOnObjective -> [PauseOnObjective]
Enum, PauseOnObjective
PauseOnObjective -> PauseOnObjective -> Bounded PauseOnObjective
forall a. a -> a -> Bounded a
$cminBound :: PauseOnObjective
minBound :: PauseOnObjective
$cmaxBound :: PauseOnObjective
maxBound :: PauseOnObjective
Bounded)

data TemporalState = TemporalState
  { TemporalState -> Step
_gameStep :: Step
  , TemporalState -> RunStatus
_runStatus :: RunStatus
  , TemporalState -> TickNumber
_ticks :: TickNumber
  , TemporalState -> Int
_robotStepsPerTick :: Int
  , TemporalState -> PauseOnObjective
_pauseOnObjective :: PauseOnObjective
  }

makeLensesNoSigs ''TemporalState

-- | How to step the game: 'WorldTick' or 'RobotStep' for debugging the 'CESK' machine.
gameStep :: Lens' TemporalState Step

-- | The current 'RunStatus'.
runStatus :: Lens' TemporalState RunStatus

-- | Whether the game is currently paused.
paused :: Getter TemporalState Bool
paused :: Getter TemporalState Bool
paused = (TemporalState -> Bool)
-> (Bool -> f Bool) -> TemporalState -> f TemporalState
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\TemporalState
s -> TemporalState
s TemporalState
-> Getting RunStatus TemporalState RunStatus -> RunStatus
forall s a. s -> Getting a s a -> a
^. Getting RunStatus TemporalState RunStatus
Lens' TemporalState RunStatus
runStatus RunStatus -> RunStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= RunStatus
Running)

-- | The number of ticks elapsed since the game started.
ticks :: Lens' TemporalState TickNumber

-- | The maximum number of CESK machine steps a robot may take during
--   a single tick.
robotStepsPerTick :: Lens' TemporalState Int

-- | Whether to pause the game after an objective is completed.
pauseOnObjective :: Lens' TemporalState PauseOnObjective

data GameControls = GameControls
  { GameControls -> REPLStatus
_replStatus :: REPLStatus
  , GameControls -> Integer
_replNextValueIndex :: Integer
  , GameControls -> EntityName -> IO ()
_replListener :: Text -> IO ()
  , GameControls -> Maybe (EntityName, Value)
_inputHandler :: Maybe (Text, Value)
  , GameControls -> Maybe Syntax
_initiallyRunCode :: Maybe Syntax
  }

makeLensesNoSigs ''GameControls

-- | The current status of the REPL.
replStatus :: Lens' GameControls REPLStatus

-- | The index of the next @it{index}@ value
replNextValueIndex :: Lens' GameControls Integer

-- | The action to be run after transitioning to REPLDone.
--   This is used to tell Web API the result of run command.
replListener :: Lens' GameControls (Text -> IO ())

-- | The currently installed input handler and hint text.
inputHandler :: Lens' GameControls (Maybe (Text, Value))

-- | Code that is run upon scenario start, before any
-- REPL interaction.
initiallyRunCode :: Lens' GameControls (Maybe Syntax)

data Discovery = Discovery
  { Discovery -> Inventory
_allDiscoveredEntities :: Inventory
  , Discovery -> Notifications (Recipe Entity)
_availableRecipes :: Notifications (Recipe Entity)
  , Discovery -> Notifications Const
_availableCommands :: Notifications Const
  , Discovery -> Set EntityName
_knownEntities :: S.Set EntityName
  , Discovery -> Set EntityName
_craftableDevices :: S.Set EntityName
  , Discovery -> Map GameplayAchievement Attainment
_gameAchievements :: Map GameplayAchievement Attainment
  , Discovery -> RecognitionState RecognizableStructureContent Entity
_structureRecognition :: RecognitionState RecognizableStructureContent Entity
  , Discovery -> Map EntityName (NonEmpty EntityName)
_tagMembers :: Map Text (NonEmpty EntityName)
  }

makeLensesNoSigs ''Discovery

-- | The list of entities that have been discovered.
allDiscoveredEntities :: Lens' Discovery Inventory

-- | The list of available recipes.
availableRecipes :: Lens' Discovery (Notifications (Recipe Entity))

-- | The list of available commands.
availableCommands :: Lens' Discovery (Notifications Const)

-- | The names of entities that should be considered \"known\", that is,
--   robots know what they are without having to scan them.
knownEntities :: Lens' Discovery (S.Set EntityName)

-- | The set of all entities that can be crafted in the current
--   scenario.
craftableDevices :: Lens' Discovery (S.Set EntityName)

-- | Map of in-game achievements that were obtained
gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)

-- | Recognizer for robot-constructed structures
structureRecognition :: Lens' Discovery (RecognitionState RecognizableStructureContent Entity)

-- | Map from tags to entities that possess that tag
tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName))

data Randomness = Randomness
  { Randomness -> Int
_seed :: Seed
  , Randomness -> StdGen
_randGen :: StdGen
  }

makeLensesNoSigs ''Randomness

-- | The initial seed that was used for the random number generator,
--   and world generation.
seed :: Lens' Randomness Seed

-- | Pseudorandom generator initialized at start.
randGen :: Lens' Randomness StdGen

-- * Utilities

-- | Whether the repl is currently working.
replWorking :: Getter GameControls Bool
replWorking :: Getter GameControls Bool
replWorking = (GameControls -> Bool)
-> (Bool -> f Bool) -> GameControls -> f GameControls
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\GameControls
s -> REPLStatus -> Bool
matchesWorking (REPLStatus -> Bool) -> REPLStatus -> Bool
forall a b. (a -> b) -> a -> b
$ GameControls
s GameControls
-> Getting REPLStatus GameControls REPLStatus -> REPLStatus
forall s a. s -> Getting a s a -> a
^. Getting REPLStatus GameControls REPLStatus
Lens' GameControls REPLStatus
replStatus)
 where
  matchesWorking :: REPLStatus -> Bool
matchesWorking REPLDone {} = Bool
False
  matchesWorking REPLWorking {} = Bool
True

-- | Either the type of the command being executed, or of the last command
replActiveType :: Getter REPLStatus (Maybe Polytype)
replActiveType :: Getter REPLStatus (Maybe Polytype)
replActiveType = (REPLStatus -> Maybe Polytype)
-> (Maybe Polytype -> f (Maybe Polytype))
-> REPLStatus
-> f REPLStatus
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to REPLStatus -> Maybe Polytype
getter
 where
  getter :: REPLStatus -> Maybe Polytype
getter (REPLDone (Just (Polytype
typ, Value
_))) = Polytype -> Maybe Polytype
forall a. a -> Maybe a
Just Polytype
typ
  getter (REPLWorking Polytype
typ Maybe Value
_) = Polytype -> Maybe Polytype
forall a. a -> Maybe a
Just Polytype
typ
  getter REPLStatus
_ = Maybe Polytype
forall a. Maybe a
Nothing

-- | By default, robots may make a maximum of 100 CESK machine steps
--   during one game tick.
defaultRobotStepsPerTick :: Int
defaultRobotStepsPerTick :: Int
defaultRobotStepsPerTick = Int
100

-- * Record initialization

initTemporalState :: Bool -> TemporalState
initTemporalState :: Bool -> TemporalState
initTemporalState Bool
pausedAtStart =
  TemporalState
    { _gameStep :: Step
_gameStep = Step
WorldTick
    , _runStatus :: RunStatus
_runStatus = if Bool
pausedAtStart then RunStatus
ManualPause else RunStatus
Running
    , _ticks :: TickNumber
_ticks = Int64 -> TickNumber
TickNumber Int64
0
    , _robotStepsPerTick :: Int
_robotStepsPerTick = Int
defaultRobotStepsPerTick
    , _pauseOnObjective :: PauseOnObjective
_pauseOnObjective = PauseOnObjective
PauseOnAnyObjective
    }

initGameControls :: GameControls
initGameControls :: GameControls
initGameControls =
  GameControls
    { _replStatus :: REPLStatus
_replStatus = Maybe (Polytype, Value) -> REPLStatus
REPLDone Maybe (Polytype, Value)
forall a. Maybe a
Nothing
    , _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
    , _replListener :: EntityName -> IO ()
_replListener = IO () -> EntityName -> IO ()
forall a b. a -> b -> a
const (IO () -> EntityName -> IO ()) -> IO () -> EntityName -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , _inputHandler :: Maybe (EntityName, Value)
_inputHandler = Maybe (EntityName, Value)
forall a. Maybe a
Nothing
    , _initiallyRunCode :: Maybe Syntax
_initiallyRunCode = Maybe Syntax
forall a. Maybe a
Nothing
    }

initMessages :: Messages
initMessages :: Messages
initMessages =
  Messages
    { _messageQueue :: Seq LogEntry
_messageQueue = Seq LogEntry
forall s. AsEmpty s => s
Empty
    , _lastSeenMessageTime :: TickNumber
_lastSeenMessageTime = Int64 -> TickNumber
TickNumber (-Int64
1)
    , _announcementQueue :: Seq Announcement
_announcementQueue = Seq Announcement
forall a. Monoid a => a
mempty
    }

initDiscovery :: Discovery
initDiscovery :: Discovery
initDiscovery =
  Discovery
    { _availableRecipes :: Notifications (Recipe Entity)
_availableRecipes = Notifications (Recipe Entity)
forall a. Monoid a => a
mempty
    , _availableCommands :: Notifications Const
_availableCommands = Notifications Const
forall a. Monoid a => a
mempty
    , _allDiscoveredEntities :: Inventory
_allDiscoveredEntities = Inventory
empty
    , _knownEntities :: Set EntityName
_knownEntities = Set EntityName
forall a. Monoid a => a
mempty
    , _craftableDevices :: Set EntityName
_craftableDevices = Set EntityName
forall a. Monoid a => a
mempty
    , -- This does not need to be initialized with anything,
      -- since the master list of achievements is stored in UIState
      _gameAchievements :: Map GameplayAchievement Attainment
_gameAchievements = Map GameplayAchievement Attainment
forall a. Monoid a => a
mempty
    , _structureRecognition :: RecognitionState RecognizableStructureContent Entity
_structureRecognition = FoundRegistry RecognizableStructureContent Entity
-> [SearchLog Entity]
-> RecognitionState RecognizableStructureContent Entity
forall b a.
FoundRegistry b a -> [SearchLog a] -> RecognitionState b a
RecognitionState FoundRegistry RecognizableStructureContent Entity
forall b a. FoundRegistry b a
emptyFoundStructures []
    , _tagMembers :: Map EntityName (NonEmpty EntityName)
_tagMembers = Map EntityName (NonEmpty EntityName)
forall a. Monoid a => a
mempty
    }

initRandomness :: Randomness
initRandomness :: Randomness
initRandomness =
  Randomness
    { _seed :: Int
_seed = Int
0
    , _randGen :: StdGen
_randGen = Int -> StdGen
mkStdGen Int
0
    }

initRecipeMaps :: GameStateConfig -> Recipes
initRecipeMaps :: GameStateConfig -> Recipes
initRecipeMaps GameStateConfig
gsc =
  Recipes
    { _recipesOut :: IntMap [Recipe Entity]
_recipesOut = [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap [Recipe Entity]
recipeList
    , _recipesIn :: IntMap [Recipe Entity]
_recipesIn = [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap [Recipe Entity]
recipeList
    , _recipesCat :: IntMap [Recipe Entity]
_recipesCat = [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap [Recipe Entity]
recipeList
    }
 where
  recipeList :: [Recipe Entity]
recipeList = GameStateInputs -> [Recipe Entity]
gsiRecipes (GameStateInputs -> [Recipe Entity])
-> GameStateInputs -> [Recipe Entity]
forall a b. (a -> b) -> a -> b
$ GameStateConfig -> GameStateInputs
initState GameStateConfig
gsc