{-# 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,
  initTemporalState,
  gameStep,
  runStatus,
  ticks,
  robotStepsPerTick,
  paused,

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

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

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

  -- *** Discovery
  Discovery,
  initDiscovery,
  allDiscoveredEntities,
  availableRecipes,
  availableCommands,
  knownEntities,
  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 (..), StructureCells)
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (RecognizerAutomatons (..))
import Swarm.Game.State.Config
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Game.World.Gen (Seed)
import Swarm.Language.Syntax (Const, TSyntax)
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, Int -> REPLStatus -> ShowS
[REPLStatus] -> ShowS
REPLStatus -> String
(Int -> REPLStatus -> ShowS)
-> (REPLStatus -> String)
-> ([REPLStatus] -> ShowS)
-> Show REPLStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> REPLStatus -> ShowS
showsPrec :: Int -> REPLStatus -> ShowS
$cshow :: REPLStatus -> String
show :: REPLStatus -> String
$cshowList :: [REPLStatus] -> ShowS
showList :: [REPLStatus] -> ShowS
Show, (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, Maybe REPLStatus
Value -> Parser [REPLStatus]
Value -> Parser REPLStatus
(Value -> Parser REPLStatus)
-> (Value -> Parser [REPLStatus])
-> Maybe REPLStatus
-> FromJSON REPLStatus
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser REPLStatus
parseJSON :: Value -> Parser REPLStatus
$cparseJSONList :: Value -> Parser [REPLStatus]
parseJSONList :: Value -> Parser [REPLStatus]
$comittedField :: Maybe REPLStatus
omittedField :: Maybe REPLStatus
FromJSON, [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 (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 TemporalState = TemporalState
  { TemporalState -> Step
_gameStep :: Step
  , TemporalState -> RunStatus
_runStatus :: RunStatus
  , TemporalState -> TickNumber
_ticks :: TickNumber
  , TemporalState -> Int
_robotStepsPerTick :: Int
  }

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

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

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 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 TSyntax)

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 -> Map GameplayAchievement Attainment
_gameAchievements :: Map GameplayAchievement Attainment
  , Discovery -> StructureRecognizer StructureCells Entity
_structureRecognition :: StructureRecognizer StructureCells 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)

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

-- | Recognizer for robot-constructed structures
structureRecognition :: Lens' Discovery (StructureRecognizer StructureCells 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 :: TemporalState
initTemporalState :: TemporalState
initTemporalState =
  TemporalState
    { _gameStep :: Step
_gameStep = Step
WorldTick
    , _runStatus :: RunStatus
_runStatus = RunStatus
Running
    , _ticks :: TickNumber
_ticks = Int64 -> TickNumber
TickNumber Int64
0
    , _robotStepsPerTick :: Int
_robotStepsPerTick = Int
defaultRobotStepsPerTick
    }

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
    , _inputHandler :: Maybe (EntityName, Value)
_inputHandler = Maybe (EntityName, Value)
forall a. Maybe a
Nothing
    , _initiallyRunCode :: Maybe TSyntax
_initiallyRunCode = Maybe TSyntax
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
    , -- 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 :: StructureRecognizer StructureCells Entity
_structureRecognition = RecognizerAutomatons StructureCells Entity
-> FoundRegistry StructureCells Entity
-> [SearchLog Entity]
-> StructureRecognizer StructureCells Entity
forall b a.
RecognizerAutomatons b a
-> FoundRegistry b a -> [SearchLog a] -> StructureRecognizer b a
StructureRecognizer (Map EntityName (StructureInfo StructureCells Entity)
-> HashMap
     Entity
     (AutomatonInfo
        Entity
        (AtomicKeySymbol Entity)
        (StructureSearcher StructureCells Entity))
-> RecognizerAutomatons StructureCells Entity
forall b a.
Map EntityName (StructureInfo b a)
-> HashMap
     a (AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a))
-> RecognizerAutomatons b a
RecognizerAutomatons Map EntityName (StructureInfo StructureCells Entity)
forall a. Monoid a => a
mempty HashMap
  Entity
  (AutomatonInfo
     Entity
     (AtomicKeySymbol Entity)
     (StructureSearcher StructureCells Entity))
forall a. Monoid a => a
mempty) FoundRegistry StructureCells 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