-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Game-related state and utilities
--
-- Definition of the record holding all the game-related state, and various related
-- utility functions.
module Swarm.Game.State.Initialize (
  scenarioToGameState,
  pureScenarioToGameState,
) where

import Control.Arrow (Arrow ((&&&)))
import Control.Carrier.State.Lazy qualified as Fused
import Control.Effect.Lens (view)
import Control.Lens hiding (view)
import Data.Hashable (Hashable)
import Data.IntMap qualified as IM
import Data.List (partition)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (isNothing)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Tuple.Extra (dupe)
import Swarm.Game.CESK (finalValue, initMachine)
import Swarm.Game.Device (getCapabilitySet, getMap)
import Swarm.Game.Entity
import Swarm.Game.Land
import Swarm.Game.Recipe (
  catRecipeMap,
  inRecipeMap,
  outRecipeMap,
 )
import Swarm.Game.Recipe.Graph qualified as RG
import Swarm.Game.Robot
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Objective (initCompletion)
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.State
import Swarm.Game.State.Landscape (mkLandscape)
import Swarm.Game.State.Robot (setRobotInfo)
import Swarm.Game.State.Substate
import Swarm.Game.Step.Util (adaptGameState)
import Swarm.Game.World.Gen (Seed)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Syntax (allConst, erase)
import Swarm.Language.Types
import Swarm.Util (applyWhen, binTuples, (?))
import System.Clock qualified as Clock
import System.Random (mkStdGen)

-- | Create an initial game state corresponding to the given scenario.
scenarioToGameState ::
  ScenarioWith (Maybe ScenarioPath) ->
  ValidatedLaunchParams ->
  GameStateConfig ->
  IO GameState
scenarioToGameState :: ScenarioWith (Maybe ScenarioPath)
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState si :: ScenarioWith (Maybe ScenarioPath)
si@(ScenarioWith Scenario
scenario Maybe ScenarioPath
_) (LaunchParams (Identity Maybe Seed
userSeed) (Identity Maybe CodeToRun
toRun)) GameStateConfig
gsc = do
  Seed
theSeed <- Maybe Seed -> ScenarioLandscape -> IO Seed
arbitrateSeed Maybe Seed
userSeed (ScenarioLandscape -> IO Seed) -> ScenarioLandscape -> IO Seed
forall a b. (a -> b) -> a -> b
$ Scenario
scenario Scenario
-> Getting ScenarioLandscape Scenario ScenarioLandscape
-> ScenarioLandscape
forall s a. s -> Getting a s a -> a
^. Getting ScenarioLandscape Scenario ScenarioLandscape
Lens' Scenario ScenarioLandscape
scenarioLandscape
  TimeSpec
now <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
  GameState -> IO GameState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GameState -> IO GameState) -> GameState -> IO GameState
forall a b. (a -> b) -> a -> b
$ ScenarioWith (Maybe ScenarioPath)
-> Seed
-> TimeSpec
-> Maybe CodeToRun
-> GameStateConfig
-> GameState
pureScenarioToGameState ScenarioWith (Maybe ScenarioPath)
si Seed
theSeed TimeSpec
now Maybe CodeToRun
toRun GameStateConfig
gsc

pureScenarioToGameState ::
  ScenarioWith (Maybe ScenarioPath) ->
  Seed ->
  Clock.TimeSpec ->
  Maybe CodeToRun ->
  GameStateConfig ->
  GameState
pureScenarioToGameState :: ScenarioWith (Maybe ScenarioPath)
-> Seed
-> TimeSpec
-> Maybe CodeToRun
-> GameStateConfig
-> GameState
pureScenarioToGameState (ScenarioWith Scenario
scenario Maybe ScenarioPath
fp) Seed
theSeed TimeSpec
now Maybe CodeToRun
toRun GameStateConfig
gsc =
  GameState
preliminaryGameState
    GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((RecognitionState RecognizableStructureContent Entity
     -> Identity (RecognitionState RecognizableStructureContent Entity))
    -> Discovery -> Identity Discovery)
-> (RecognitionState RecognizableStructureContent Entity
    -> Identity (RecognitionState RecognizableStructureContent Entity))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognitionState RecognizableStructureContent Entity
 -> Identity (RecognitionState RecognizableStructureContent Entity))
-> Discovery -> Identity Discovery
Lens'
  Discovery (RecognitionState RecognizableStructureContent Entity)
structureRecognition ((RecognitionState RecognizableStructureContent Entity
  -> Identity (RecognitionState RecognizableStructureContent Entity))
 -> GameState -> Identity GameState)
-> RecognitionState RecognizableStructureContent Entity
-> GameState
-> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RecognitionState RecognizableStructureContent Entity
recognition
 where
  sLandscape :: ScenarioLandscape
sLandscape = Scenario
scenario Scenario
-> Getting ScenarioLandscape Scenario ScenarioLandscape
-> ScenarioLandscape
forall s a. s -> Getting a s a -> a
^. Getting ScenarioLandscape Scenario ScenarioLandscape
Lens' Scenario ScenarioLandscape
scenarioLandscape

  -- It may be possible at some point for the game seed to affect whether
  -- initially-placed structures remain intact, by way of random placements.
  -- Therefore we run this at 'GameState' initialization time, rather than
  -- 'Scenario' parse time.
  recognition :: RecognitionState RecognizableStructureContent Entity
recognition =
    Identity (RecognitionState RecognizableStructureContent Entity)
-> RecognitionState RecognizableStructureContent Entity
forall a. Identity a -> a
runIdentity
      (Identity (RecognitionState RecognizableStructureContent Entity)
 -> RecognitionState RecognizableStructureContent Entity)
-> (State
      GameState (RecognitionState RecognizableStructureContent Entity)
    -> Identity (RecognitionState RecognizableStructureContent Entity))
-> State
     GameState (RecognitionState RecognizableStructureContent Entity)
-> RecognitionState RecognizableStructureContent Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameState
-> StateC
     GameState
     Identity
     (RecognitionState RecognizableStructureContent Entity)
-> Identity (RecognitionState RecognizableStructureContent Entity)
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
Fused.evalState GameState
preliminaryGameState
      (StateC
   GameState
   Identity
   (RecognitionState RecognizableStructureContent Entity)
 -> Identity (RecognitionState RecognizableStructureContent Entity))
-> (State
      GameState (RecognitionState RecognizableStructureContent Entity)
    -> StateC
         GameState
         Identity
         (RecognitionState RecognizableStructureContent Entity))
-> State
     GameState (RecognitionState RecognizableStructureContent Entity)
-> Identity (RecognitionState RecognizableStructureContent Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State
  GameState (RecognitionState RecognizableStructureContent Entity)
-> StateC
     GameState
     Identity
     (RecognitionState RecognizableStructureContent Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
State GameState b -> m b
adaptGameState
      (State
   GameState (RecognitionState RecognizableStructureContent Entity)
 -> RecognitionState RecognizableStructureContent Entity)
-> State
     GameState (RecognitionState RecognizableStructureContent Entity)
-> RecognitionState RecognizableStructureContent Entity
forall a b. (a -> b) -> a -> b
$ GenericEntLocator (StateT GameState Identity) Entity
-> StaticStructureInfo RecognizableStructureContent Entity
-> State
     GameState (RecognitionState RecognizableStructureContent Entity)
forall (s :: * -> *) a b.
(Monad s, Hashable a, Eq b) =>
GenericEntLocator s a
-> StaticStructureInfo b a -> s (RecognitionState b a)
initializeRecognition GenericEntLocator (StateT GameState Identity) Entity
mtlEntityAt (ScenarioLandscape
sLandscape ScenarioLandscape
-> Getting
     (StaticStructureInfo RecognizableStructureContent Entity)
     ScenarioLandscape
     (StaticStructureInfo RecognizableStructureContent Entity)
-> StaticStructureInfo RecognizableStructureContent Entity
forall s a. s -> Getting a s a -> a
^. Getting
  (StaticStructureInfo RecognizableStructureContent Entity)
  ScenarioLandscape
  (StaticStructureInfo RecognizableStructureContent Entity)
Lens'
  ScenarioLandscape
  (StaticStructureInfo RecognizableStructureContent Entity)
scenarioStructures)

  gs :: GameState
gs = GameStateConfig -> GameState
initGameState GameStateConfig
gsc
  preliminaryGameState :: GameState
preliminaryGameState =
    GameState
gs
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Maybe ScenarioPath -> Identity (Maybe ScenarioPath))
-> GameState -> Identity GameState
Lens' GameState (Maybe ScenarioPath)
currentScenarioPath ((Maybe ScenarioPath -> Identity (Maybe ScenarioPath))
 -> GameState -> Identity GameState)
-> Maybe ScenarioPath -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ScenarioPath
fp
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> (Robots -> Robots) -> GameState -> GameState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Seed -> [Robot] -> Robots -> Robots
setRobotInfo Seed
baseID [Robot]
robotList'
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
creativeMode ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> Bool -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (WinCondition -> Identity WinCondition)
-> GameState -> Identity GameState
Lens' GameState WinCondition
winCondition ((WinCondition -> Identity WinCondition)
 -> GameState -> Identity GameState)
-> WinCondition -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WinCondition
theWinCondition
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Maybe TSyntax -> Identity (Maybe TSyntax))
-> GameState -> Identity GameState
Lens' GameState (Maybe TSyntax)
winSolution ((Maybe TSyntax -> Identity (Maybe TSyntax))
 -> GameState -> Identity GameState)
-> Maybe TSyntax -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario Scenario
-> Getting (Maybe TSyntax) Scenario (Maybe TSyntax)
-> Maybe TSyntax
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
-> Scenario -> Const (Maybe TSyntax) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
 -> Scenario -> Const (Maybe TSyntax) Scenario)
-> ((Maybe TSyntax -> Const (Maybe TSyntax) (Maybe TSyntax))
    -> ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
-> Getting (Maybe TSyntax) Scenario (Maybe TSyntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe TSyntax -> Const (Maybe TSyntax) (Maybe TSyntax))
-> ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation
Lens' ScenarioOperation (Maybe TSyntax)
scenarioSolution
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Notifications Const -> Identity (Notifications Const))
    -> Discovery -> Identity Discovery)
-> (Notifications Const -> Identity (Notifications Const))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications Const -> Identity (Notifications Const))
-> Discovery -> Identity Discovery
Lens' Discovery (Notifications Const)
availableCommands ((Notifications Const -> Identity (Notifications Const))
 -> GameState -> Identity GameState)
-> Notifications Const -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed -> Bool -> [Const] -> Notifications Const
forall a. Seed -> Bool -> [a] -> Notifications a
Notifications Seed
0 Bool
False [Const]
initialCommands
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Set Text -> Identity (Set Text))
    -> Discovery -> Identity Discovery)
-> (Set Text -> Identity (Set Text))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Identity (Set Text))
-> Discovery -> Identity Discovery
Lens' Discovery (Set Text)
knownEntities ((Set Text -> Identity (Set Text))
 -> GameState -> Identity GameState)
-> Set Text -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScenarioLandscape
sLandscape ScenarioLandscape
-> Getting (Set Text) ScenarioLandscape (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. Getting (Set Text) ScenarioLandscape (Set Text)
Lens' ScenarioLandscape (Set Text)
scenarioKnown
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Map Text (NonEmpty Text)
     -> Identity (Map Text (NonEmpty Text)))
    -> Discovery -> Identity Discovery)
-> (Map Text (NonEmpty Text)
    -> Identity (Map Text (NonEmpty Text)))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text (NonEmpty Text) -> Identity (Map Text (NonEmpty Text)))
-> Discovery -> Identity Discovery
Lens' Discovery (Map Text (NonEmpty Text))
tagMembers ((Map Text (NonEmpty Text) -> Identity (Map Text (NonEmpty Text)))
 -> GameState -> Identity GameState)
-> Map Text (NonEmpty Text) -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EntityMap -> Map Text (NonEmpty Text)
buildTagMap EntityMap
em
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Set Text -> Identity (Set Text))
    -> Discovery -> Identity Discovery)
-> (Set Text -> Identity (Set Text))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Identity (Set Text))
-> Discovery -> Identity Discovery
Lens' Discovery (Set Text)
craftableDevices ((Set Text -> Identity (Set Text))
 -> GameState -> Identity GameState)
-> Set Text -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set Text
craftable
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Randomness -> Identity Randomness)
-> GameState -> Identity GameState
Lens' GameState Randomness
randomness ((Randomness -> Identity Randomness)
 -> GameState -> Identity GameState)
-> ((Seed -> Identity Seed) -> Randomness -> Identity Randomness)
-> (Seed -> Identity Seed)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seed -> Identity Seed) -> Randomness -> Identity Randomness
Lens' Randomness Seed
seed ((Seed -> Identity Seed) -> GameState -> Identity GameState)
-> Seed -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed
theSeed
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Randomness -> Identity Randomness)
-> GameState -> Identity GameState
Lens' GameState Randomness
randomness ((Randomness -> Identity Randomness)
 -> GameState -> Identity GameState)
-> ((StdGen -> Identity StdGen)
    -> Randomness -> Identity Randomness)
-> (StdGen -> Identity StdGen)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StdGen -> Identity StdGen) -> Randomness -> Identity Randomness
Lens' Randomness StdGen
randGen ((StdGen -> Identity StdGen) -> GameState -> Identity GameState)
-> StdGen -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed -> StdGen
mkStdGen Seed
theSeed
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Recipes -> Identity Recipes) -> GameState -> Identity GameState
Lens' GameState Recipes
recipesInfo ((Recipes -> Identity Recipes) -> GameState -> Identity GameState)
-> (Recipes -> Recipes) -> GameState -> GameState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Recipes -> Recipes
modifyRecipesInfo
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Landscape -> Identity Landscape)
-> GameState -> Identity GameState
Lens' GameState Landscape
landscape ((Landscape -> Identity Landscape)
 -> GameState -> Identity GameState)
-> Landscape -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScenarioLandscape
-> NonEmpty SubworldDescription -> Seed -> Landscape
mkLandscape ScenarioLandscape
sLandscape NonEmpty SubworldDescription
worldTuples Seed
theSeed
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> ((Maybe Syntax -> Identity (Maybe Syntax))
    -> GameControls -> Identity GameControls)
-> (Maybe Syntax -> Identity (Maybe Syntax))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Syntax -> Identity (Maybe Syntax))
-> GameControls -> Identity GameControls
Lens' GameControls (Maybe Syntax)
initiallyRunCode ((Maybe Syntax -> Identity (Maybe Syntax))
 -> GameState -> Identity GameState)
-> Maybe Syntax -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (TSyntax -> Syntax
forall (t :: * -> *) ty. Functor t => t ty -> t ()
erase (TSyntax -> Syntax) -> Maybe TSyntax -> Maybe Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TSyntax
initialCodeToRun)
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> ((REPLStatus -> Identity REPLStatus)
    -> GameControls -> Identity GameControls)
-> (REPLStatus -> Identity REPLStatus)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLStatus -> Identity REPLStatus)
-> GameControls -> Identity GameControls
Lens' GameControls REPLStatus
replStatus ((REPLStatus -> Identity REPLStatus)
 -> GameState -> Identity GameState)
-> REPLStatus -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ case Bool
running of -- When the base starts out running a program, the REPL status must be set to working,
      -- otherwise the store of definition cells is not saved (see #333, #838)
        Bool
False -> Maybe (Polytype, Value) -> REPLStatus
REPLDone Maybe (Polytype, Value)
forall a. Maybe a
Nothing
        Bool
True -> Polytype -> Maybe Value -> REPLStatus
REPLWorking Polytype
PolyUnit Maybe Value
forall a. Maybe a
Nothing
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (TemporalState -> Identity TemporalState)
-> GameState -> Identity GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Identity TemporalState)
 -> GameState -> Identity GameState)
-> ((Seed -> Identity Seed)
    -> TemporalState -> Identity TemporalState)
-> (Seed -> Identity Seed)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seed -> Identity Seed) -> TemporalState -> Identity TemporalState
Lens' TemporalState Seed
robotStepsPerTick ((Seed -> Identity Seed) -> GameState -> Identity GameState)
-> Seed -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Scenario
scenario Scenario
-> Getting (Maybe Seed) Scenario (Maybe Seed) -> Maybe Seed
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const (Maybe Seed) ScenarioOperation)
-> Scenario -> Const (Maybe Seed) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Maybe Seed) ScenarioOperation)
 -> Scenario -> Const (Maybe Seed) Scenario)
-> ((Maybe Seed -> Const (Maybe Seed) (Maybe Seed))
    -> ScenarioOperation -> Const (Maybe Seed) ScenarioOperation)
-> Getting (Maybe Seed) Scenario (Maybe Seed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Seed -> Const (Maybe Seed) (Maybe Seed))
-> ScenarioOperation -> Const (Maybe Seed) ScenarioOperation
Lens' ScenarioOperation (Maybe Seed)
scenarioStepsPerTick) Maybe Seed -> Seed -> Seed
forall a. Maybe a -> a -> a
? Seed
defaultRobotStepsPerTick)

  robotList' :: [Robot]
robotList' = ((TimeSpec -> Identity TimeSpec) -> Robot -> Identity Robot
Lens' Robot TimeSpec
robotCreatedAt ((TimeSpec -> Identity TimeSpec) -> Robot -> Identity Robot)
-> TimeSpec -> Robot -> Robot
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
now) (Robot -> Robot) -> [Robot] -> [Robot]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robotList

  -- Get the names of all devices (i.e. entities that provide at least
  -- one capability) which can be recursively crafted from the
  -- starting inventory + entities available in the world
  craftable :: Set Text
craftable = (Entity -> Text) -> Set Entity -> Set Text
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (Getting Text Entity Text -> Entity -> Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName) (Set Entity -> Set Text)
-> (Set Entity -> Set Entity) -> Set Entity -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Bool) -> Set Entity -> Set Entity
forall a. (a -> Bool) -> Set a -> Set a
S.filter Entity -> Bool
isDevice (Set Entity -> Set Text) -> Set Entity -> Set Text
forall a b. (a -> b) -> a -> b
$ [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (RecipeGraph -> [Set Entity]
RG.levels RecipeGraph
recipeGraph)
   where
    recipeGraph :: RecipeGraph
recipeGraph = Scenario -> GameStateInputs -> RecipeGraph
RG.scenarioRecipeGraph Scenario
scenario (GameStateConfig -> GameStateInputs
initState GameStateConfig
gsc)
    isDevice :: Entity -> Bool
    isDevice :: Entity -> Bool
isDevice = Bool -> Bool
not (Bool -> Bool) -> (Entity -> Bool) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Capability (ExerciseCost Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Capability (ExerciseCost Text) -> Bool)
-> (Entity -> Map Capability (ExerciseCost Text)) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleEntityCapabilities Text -> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (SingleEntityCapabilities Text
 -> Map Capability (ExerciseCost Text))
-> (Entity -> SingleEntityCapabilities Text)
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (SingleEntityCapabilities Text)
  Entity
  (SingleEntityCapabilities Text)
-> Entity -> SingleEntityCapabilities Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting
  (SingleEntityCapabilities Text)
  Entity
  (SingleEntityCapabilities Text)
Lens' Entity (SingleEntityCapabilities Text)
entityCapabilities

  modifyRecipesInfo :: Recipes -> Recipes
modifyRecipesInfo Recipes
oldRecipesInfo =
    Recipes
oldRecipesInfo
      Recipes -> (Recipes -> Recipes) -> Recipes
forall a b. a -> (a -> b) -> b
& (IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
-> Recipes -> Identity Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesOut ((IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
 -> Recipes -> Identity Recipes)
-> (IntMap [Recipe Entity] -> IntMap [Recipe Entity])
-> Recipes
-> Recipes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Recipe Entity] -> IntMap [Recipe Entity])
-> IntMap [Recipe Entity] -> IntMap [Recipe Entity]
forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap
      Recipes -> (Recipes -> Recipes) -> Recipes
forall a b. a -> (a -> b) -> b
& (IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
-> Recipes -> Identity Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesIn ((IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
 -> Recipes -> Identity Recipes)
-> (IntMap [Recipe Entity] -> IntMap [Recipe Entity])
-> Recipes
-> Recipes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Recipe Entity] -> IntMap [Recipe Entity])
-> IntMap [Recipe Entity] -> IntMap [Recipe Entity]
forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap
      Recipes -> (Recipes -> Recipes) -> Recipes
forall a b. a -> (a -> b) -> b
& (IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
-> Recipes -> Identity Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesCat ((IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
 -> Recipes -> Identity Recipes)
-> (IntMap [Recipe Entity] -> IntMap [Recipe Entity])
-> Recipes
-> Recipes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Recipe Entity] -> IntMap [Recipe Entity])
-> IntMap [Recipe Entity] -> IntMap [Recipe Entity]
forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap

  TerrainEntityMaps TerrainMap
_ EntityMap
em = ScenarioLandscape
sLandscape ScenarioLandscape
-> Getting TerrainEntityMaps ScenarioLandscape TerrainEntityMaps
-> TerrainEntityMaps
forall s a. s -> Getting a s a -> a
^. Getting TerrainEntityMaps ScenarioLandscape TerrainEntityMaps
Lens' ScenarioLandscape TerrainEntityMaps
scenarioTerrainAndEntities
  baseID :: Seed
baseID = Seed
0
  ([Entity]
things, [Entity]
devices) = (Entity -> Bool) -> [Entity] -> ([Entity], [Entity])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Map Capability (ExerciseCost Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Capability (ExerciseCost Text) -> Bool)
-> (Entity -> Map Capability (ExerciseCost Text)) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleEntityCapabilities Text -> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (SingleEntityCapabilities Text
 -> Map Capability (ExerciseCost Text))
-> (Entity -> SingleEntityCapabilities Text)
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (SingleEntityCapabilities Text)
  Entity
  (SingleEntityCapabilities Text)
-> Entity -> SingleEntityCapabilities Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting
  (SingleEntityCapabilities Text)
  Entity
  (SingleEntityCapabilities Text)
Lens' Entity (SingleEntityCapabilities Text)
entityCapabilities) (Map Text Entity -> [Entity]
forall k a. Map k a -> [a]
M.elems (EntityMap -> Map Text Entity
entitiesByName EntityMap
em))

  robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = ScenarioLandscape -> NonEmpty SubworldDescription -> [TRobot]
forall a b.
ScenarioLandscape
-> NonEmpty (a, ([(Seed, TRobot)], b)) -> [TRobot]
genRobotTemplates ScenarioLandscape
sLandscape NonEmpty SubworldDescription
worldTuples

  initialCodeToRun :: Maybe TSyntax
initialCodeToRun = Getting TSyntax CodeToRun TSyntax -> CodeToRun -> TSyntax
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting TSyntax CodeToRun TSyntax
Lens' CodeToRun TSyntax
toRunSyntax (CodeToRun -> TSyntax) -> Maybe CodeToRun -> Maybe TSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun

  robotListRaw :: [Robot]
robotListRaw =
    (Seed -> TRobot -> Robot) -> [Seed] -> [TRobot] -> [Robot]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe CESK -> Seed -> TRobot -> Robot
instantiateRobot Maybe CESK
forall a. Maybe a
Nothing) [Seed
baseID ..] [TRobot]
robotsByBasePrecedence

  robotList :: [Robot]
robotList =
    [Robot]
robotListRaw
      -- If the  --run flag was used, use it to replace the CESK machine of the
      -- robot whose id is 0, i.e. the first robot listed in the scenario.
      -- Note that this *replaces* any program the base robot otherwise
      -- would have run (i.e. any program specified in the program: field
      -- of the scenario description).
      [Robot] -> ([Robot] -> [Robot]) -> [Robot]
forall a b. a -> (a -> b) -> b
& Index [Robot] -> Traversal' [Robot] (IxValue [Robot])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Seed
Index [Robot]
baseID
        ((Robot -> Identity Robot) -> [Robot] -> Identity [Robot])
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> [Robot]
-> Identity [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine
        ((CESK -> Identity CESK) -> [Robot] -> Identity [Robot])
-> (CESK -> CESK) -> [Robot] -> [Robot]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Maybe TSyntax
initialCodeToRun of
          Maybe TSyntax
Nothing -> CESK -> CESK
forall a. a -> a
id
          Just TSyntax
t -> CESK -> CESK -> CESK
forall a b. a -> b -> a
const (CESK -> CESK -> CESK) -> CESK -> CESK -> CESK
forall a b. (a -> b) -> a -> b
$ TSyntax -> CESK
initMachine TSyntax
t
      -- If we are in creative mode, give base all the things
      [Robot] -> ([Robot] -> [Robot]) -> [Robot]
forall a b. a -> (a -> b) -> b
& Index [Robot] -> Traversal' [Robot] (IxValue [Robot])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Seed
Index [Robot]
baseID
        ((Robot -> Identity Robot) -> [Robot] -> Identity [Robot])
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> [Robot]
-> Identity [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory
        ((Inventory -> Identity Inventory) -> [Robot] -> Identity [Robot])
-> (Inventory -> Inventory) -> [Robot] -> [Robot]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> (Inventory -> Inventory) -> Inventory -> Inventory
forall a. Bool -> (a -> a) -> a -> a
applyWhen
          (Scenario
scenario Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative)
          (Inventory -> Inventory -> Inventory
union ([(Seed, Entity)] -> Inventory
fromElems ((Entity -> (Seed, Entity)) -> [Entity] -> [(Seed, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (Seed
0,) [Entity]
things)))
      [Robot] -> ([Robot] -> [Robot]) -> [Robot]
forall a b. a -> (a -> b) -> b
& Index [Robot] -> Traversal' [Robot] (IxValue [Robot])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Seed
Index [Robot]
baseID
        ((Robot -> Identity Robot) -> [Robot] -> Identity [Robot])
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> [Robot]
-> Identity [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
equippedDevices
        ((Inventory -> Identity Inventory) -> [Robot] -> Identity [Robot])
-> (Inventory -> Inventory) -> [Robot] -> [Robot]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> (Inventory -> Inventory) -> Inventory -> Inventory
forall a. Bool -> (a -> a) -> a -> a
applyWhen
          (Scenario
scenario Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative)
          (Inventory -> Inventory -> Inventory
forall a b. a -> b -> a
const ([Entity] -> Inventory
fromList [Entity]
devices))

  running :: Bool
running = case [Robot]
robotList of
    [] -> Bool
False
    (Robot
base : [Robot]
_) -> Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing (CESK -> Maybe Value
finalValue (Robot
base Robot -> Getting CESK Robot CESK -> CESK
forall s a. s -> Getting a s a -> a
^. Getting CESK Robot CESK
Lens' Robot CESK
machine))

  -- Initial list of available commands = all commands enabled by
  -- devices in inventory or equipped; and commands that require no
  -- capability.
  allCapabilities :: Robot -> MultiEntityCapabilities Entity Text
allCapabilities Robot
r =
    Inventory -> MultiEntityCapabilities Entity Text
inventoryCapabilities (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices)
      MultiEntityCapabilities Entity Text
-> MultiEntityCapabilities Entity Text
-> MultiEntityCapabilities Entity Text
forall a. Semigroup a => a -> a -> a
<> Inventory -> MultiEntityCapabilities Entity Text
inventoryCapabilities (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory)
  initialCaps :: Set Capability
initialCaps = MultiEntityCapabilities Entity Text -> Set Capability
forall e. Capabilities e -> Set Capability
getCapabilitySet (MultiEntityCapabilities Entity Text -> Set Capability)
-> MultiEntityCapabilities Entity Text -> Set Capability
forall a b. (a -> b) -> a -> b
$ [MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text
forall a. Monoid a => [a] -> a
mconcat ([MultiEntityCapabilities Entity Text]
 -> MultiEntityCapabilities Entity Text)
-> [MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text
forall a b. (a -> b) -> a -> b
$ (Robot -> MultiEntityCapabilities Entity Text)
-> [Robot] -> [MultiEntityCapabilities Entity Text]
forall a b. (a -> b) -> [a] -> [b]
map Robot -> MultiEntityCapabilities Entity Text
allCapabilities [Robot]
robotList
  initialCommands :: [Const]
initialCommands =
    (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter
      (Bool -> (Capability -> Bool) -> Maybe Capability -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Capability -> Set Capability -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
initialCaps) (Maybe Capability -> Bool)
-> (Const -> Maybe Capability) -> Const -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Maybe Capability
constCaps)
      [Const]
allConst

  worldTuples :: NonEmpty SubworldDescription
worldTuples = ScenarioLandscape -> NonEmpty SubworldDescription
buildWorldTuples ScenarioLandscape
sLandscape

  theWinCondition :: WinCondition
theWinCondition =
    WinCondition
-> (NonEmpty Objective -> WinCondition)
-> Maybe (NonEmpty Objective)
-> WinCondition
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      WinCondition
NoWinCondition
      (WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions WinStatus
Ongoing (ObjectiveCompletion -> WinCondition)
-> (NonEmpty Objective -> ObjectiveCompletion)
-> NonEmpty Objective
-> WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Objective] -> ObjectiveCompletion
initCompletion ([Objective] -> ObjectiveCompletion)
-> (NonEmpty Objective -> [Objective])
-> NonEmpty Objective
-> ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Objective -> [Objective]
forall a. NonEmpty a -> [a]
NE.toList)
      ([Objective] -> Maybe (NonEmpty Objective)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Scenario
scenario Scenario -> Getting [Objective] Scenario [Objective] -> [Objective]
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Scenario -> Const [Objective] Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const [Objective] ScenarioOperation)
 -> Scenario -> Const [Objective] Scenario)
-> (([Objective] -> Const [Objective] [Objective])
    -> ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Getting [Objective] Scenario [Objective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Const [Objective] [Objective])
-> ScenarioOperation -> Const [Objective] ScenarioOperation
Lens' ScenarioOperation [Objective]
scenarioObjectives))

  addRecipesWith :: ([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f = (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) ([Recipe Entity] -> IntMap a
f ([Recipe Entity] -> IntMap a) -> [Recipe Entity] -> IntMap a
forall a b. (a -> b) -> a -> b
$ Scenario
scenario Scenario
-> Getting [Recipe Entity] Scenario [Recipe Entity]
-> [Recipe Entity]
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const [Recipe Entity] ScenarioOperation)
-> Scenario -> Const [Recipe Entity] Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const [Recipe Entity] ScenarioOperation)
 -> Scenario -> Const [Recipe Entity] Scenario)
-> (([Recipe Entity] -> Const [Recipe Entity] [Recipe Entity])
    -> ScenarioOperation -> Const [Recipe Entity] ScenarioOperation)
-> Getting [Recipe Entity] Scenario [Recipe Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Recipe Entity] -> Const [Recipe Entity] [Recipe Entity])
-> ScenarioOperation -> Const [Recipe Entity] ScenarioOperation
Lens' ScenarioOperation [Recipe Entity]
scenarioRecipes)

-- |
-- As part of initializing the recognizer, we also pre-populate the
-- list of "found" structures with those statically placed by the scenario definition.
-- Note that this bypasses the regular "online" recognition machinery;
-- we don't actually have to "search" for these structures since we are
-- explicitly given their location; we only need to validate that each
-- structure remains intact given other, potentially overlapping static placements.
initializeRecognition ::
  (Monad s, Hashable a, Eq b) =>
  GenericEntLocator s a ->
  StaticStructureInfo b a ->
  s (RecognitionState b a)
initializeRecognition :: forall (s :: * -> *) a b.
(Monad s, Hashable a, Eq b) =>
GenericEntLocator s a
-> StaticStructureInfo b a -> s (RecognitionState b a)
initializeRecognition GenericEntLocator s a
entLoader StaticStructureInfo b a
structInfo = do
  [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
foundIntact <- (FoundStructure b a
 -> s (FoundStructure b a, Maybe (StructureIntactnessFailure a)))
-> [FoundStructure b a]
-> s [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FoundStructure b a
-> s (FoundStructure b a, Maybe (StructureIntactnessFailure a))
forall {b}.
FoundStructure b a
-> s (FoundStructure b a, Maybe (StructureIntactnessFailure a))
checkIntactness [FoundStructure b a]
allPlaced

  let fs :: FoundRegistry b a
fs = [FoundStructure b a] -> FoundRegistry b a
forall a b.
(Eq a, Eq b) =>
[FoundStructure b a] -> FoundRegistry b a
populateStaticFoundStructures ([FoundStructure b a] -> FoundRegistry b a)
-> ([(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
    -> [FoundStructure b a])
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
-> FoundRegistry b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FoundStructure b a, Maybe (StructureIntactnessFailure a))
 -> FoundStructure b a)
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
-> [FoundStructure b a]
forall a b. (a -> b) -> [a] -> [b]
map (FoundStructure b a, Maybe (StructureIntactnessFailure a))
-> FoundStructure b a
forall a b. (a, b) -> a
fst ([(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
 -> [FoundStructure b a])
-> ([(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
    -> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))])
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
-> [FoundStructure b a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FoundStructure b a, Maybe (StructureIntactnessFailure a))
 -> Bool)
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (StructureIntactnessFailure a) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (StructureIntactnessFailure a) -> Bool)
-> ((FoundStructure b a, Maybe (StructureIntactnessFailure a))
    -> Maybe (StructureIntactnessFailure a))
-> (FoundStructure b a, Maybe (StructureIntactnessFailure a))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundStructure b a, Maybe (StructureIntactnessFailure a))
-> Maybe (StructureIntactnessFailure a)
forall a b. (a, b) -> b
snd) ([(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
 -> FoundRegistry b a)
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
-> FoundRegistry b a
forall a b. (a -> b) -> a -> b
$ [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
foundIntact
  RecognitionState b a -> s (RecognitionState b a)
forall a. a -> s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecognitionState b a -> s (RecognitionState b a))
-> RecognitionState b a -> s (RecognitionState b a)
forall a b. (a -> b) -> a -> b
$
    FoundRegistry b a -> [SearchLog a] -> RecognitionState b a
forall b a.
FoundRegistry b a -> [SearchLog a] -> RecognitionState b a
RecognitionState
      FoundRegistry b a
fs
      [[IntactPlacementLog a] -> SearchLog a
forall e. [IntactPlacementLog e] -> SearchLog e
IntactStaticPlacement ([IntactPlacementLog a] -> SearchLog a)
-> [IntactPlacementLog a] -> SearchLog a
forall a b. (a -> b) -> a -> b
$ ((FoundStructure b a, Maybe (StructureIntactnessFailure a))
 -> IntactPlacementLog a)
-> [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
-> [IntactPlacementLog a]
forall a b. (a -> b) -> [a] -> [b]
map (FoundStructure b a, Maybe (StructureIntactnessFailure a))
-> IntactPlacementLog a
forall {b} {a} {e}.
(PositionedStructure (StructureWithGrid b a),
 Maybe (StructureIntactnessFailure e))
-> IntactPlacementLog e
mkLogEntry [(FoundStructure b a, Maybe (StructureIntactnessFailure a))]
foundIntact]
 where
  checkIntactness :: FoundStructure b a
-> s (FoundStructure b a, Maybe (StructureIntactnessFailure a))
checkIntactness = (FoundStructure b a -> s (Maybe (StructureIntactnessFailure a)))
-> (FoundStructure b a, FoundStructure b a)
-> s (FoundStructure b a, Maybe (StructureIntactnessFailure a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (FoundStructure b a, a) -> f (FoundStructure b a, b)
traverse (FoundRegistry b a
-> GenericEntLocator s a
-> FoundStructure b a
-> s (Maybe (StructureIntactnessFailure a))
forall (s :: * -> *) a b.
(Monad s, Hashable a) =>
FoundRegistry b a
-> GenericEntLocator s a
-> FoundStructure b a
-> s (Maybe (StructureIntactnessFailure a))
ensureStructureIntact FoundRegistry b a
forall b a. FoundRegistry b a
emptyFoundStructures GenericEntLocator s a
entLoader) ((FoundStructure b a, FoundStructure b a)
 -> s (FoundStructure b a, Maybe (StructureIntactnessFailure a)))
-> (FoundStructure b a -> (FoundStructure b a, FoundStructure b a))
-> FoundStructure b a
-> s (FoundStructure b a, Maybe (StructureIntactnessFailure a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundStructure b a -> (FoundStructure b a, FoundStructure b a)
forall a. a -> (a, a)
dupe

  allPlaced :: [FoundStructure b a]
allPlaced = StaticStructureInfo b a -> [FoundStructure b a]
forall b a. StaticStructureInfo b a -> [FoundStructure b a]
lookupStaticPlacements StaticStructureInfo b a
structInfo
  mkLogEntry :: (PositionedStructure (StructureWithGrid b a),
 Maybe (StructureIntactnessFailure e))
-> IntactPlacementLog e
mkLogEntry (PositionedStructure (StructureWithGrid b a)
x, Maybe (StructureIntactnessFailure e)
intact) =
    Maybe (StructureIntactnessFailure e)
-> PositionedStructure OrientedStructure -> IntactPlacementLog e
forall e.
Maybe (StructureIntactnessFailure e)
-> PositionedStructure OrientedStructure -> IntactPlacementLog e
IntactPlacementLog
      Maybe (StructureIntactnessFailure e)
intact
      (PositionedStructure OrientedStructure -> IntactPlacementLog e)
-> PositionedStructure OrientedStructure -> IntactPlacementLog e
forall a b. (a -> b) -> a -> b
$ Cosmic Location
-> OrientedStructure -> PositionedStructure OrientedStructure
forall s. Cosmic Location -> s -> PositionedStructure s
PositionedStructure (PositionedStructure (StructureWithGrid b a) -> Cosmic Location
forall s. PositionedStructure s -> Cosmic Location
upperLeftCorner PositionedStructure (StructureWithGrid b a)
x) ((StructureWithGrid b a -> OrientedStructure
forall b a. StructureWithGrid b a -> OrientedStructure
distillLabel (StructureWithGrid b a -> OrientedStructure)
-> (PositionedStructure (StructureWithGrid b a)
    -> StructureWithGrid b a)
-> PositionedStructure (StructureWithGrid b a)
-> OrientedStructure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedStructure (StructureWithGrid b a)
-> StructureWithGrid b a
forall s. PositionedStructure s -> s
structureWithGrid) PositionedStructure (StructureWithGrid b a)
x)

buildTagMap :: EntityMap -> Map Text (NonEmpty EntityName)
buildTagMap :: EntityMap -> Map Text (NonEmpty Text)
buildTagMap EntityMap
em =
  [(Text, Text)] -> Map Text (NonEmpty Text)
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples [(Text, Text)]
expanded
 where
  expanded :: [(Text, Text)]
expanded = ((Text, Set Text) -> [(Text, Text)])
-> [(Text, Set Text)] -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
k, Set Text
vs) -> [(Text
v, Text
k) | Text
v <- Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
vs]) [(Text, Set Text)]
tagsByEntity
  tagsByEntity :: [(Text, Set Text)]
tagsByEntity = (Entity -> (Text, Set Text)) -> [Entity] -> [(Text, Set Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Entity Text -> Entity -> Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName (Entity -> Text)
-> (Entity -> Set Text) -> Entity -> (Text, Set Text)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (Set Text) Entity (Set Text) -> Entity -> Set Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting (Set Text) Entity (Set Text)
Lens' Entity (Set Text)
entityTags) ([Entity] -> [(Text, Set Text)]) -> [Entity] -> [(Text, Set Text)]
forall a b. (a -> b) -> a -> b
$ EntityMap -> [Entity]
entityDefinitionOrder EntityMap
em