{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Robot command logic
--
-- Implementation of robot commands
module Swarm.Game.Step.Const where

import Control.Arrow ((&&&))
import Control.Carrier.State.Lazy
import Control.Effect.Error
import Control.Effect.Lens
import Control.Effect.Lift
import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
import Control.Monad (filterM, forM, forM_, guard, msum, unless, when)
import Data.Bifunctor (second)
import Data.Bool (bool)
import Data.Char (chr, ord)
import Data.Either (partitionEithers, rights)
import Data.Foldable (asum, for_, traverse_)
import Data.Foldable.Extra (findM, firstJustM)
import Data.Function (on)
import Data.Functor (void)
import Data.Int (Int32)
import Data.IntMap qualified as IM
import Data.IntSet qualified as IS
import Data.List (find, sortOn)
import Data.List qualified as L
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Map.NonEmpty qualified as NEM
import Data.Map.Strict qualified as MS
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
import Data.MonoidMap qualified as MM
import Data.Ord (Down (Down))
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Tuple (swap)
import Linear (V2 (..), perp, zero)
import Swarm.Effect as Effect (Time, getNow)
import Swarm.Failure
import Swarm.Game.Achievement.Definitions
import Swarm.Game.CESK
import Swarm.Game.Display
import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
import Swarm.Game.Entity qualified as E
import Swarm.Game.Exception
import Swarm.Game.Land
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity
import Swarm.Game.Robot.Concrete
import Swarm.Game.Robot.Walk (emptyExceptions)
import Swarm.Game.Scenario (RecognizableStructureContent)
import Swarm.Game.Scenario.Topography.Area (getNEGridDimensions, rectHeight)
import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
import Swarm.Game.Scenario.Topography.Navigation.Util
import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..))
import Swarm.Game.Scenario.Topography.Structure.Named (StructureName (..))
import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Substate
import Swarm.Game.Step.Arithmetic
import Swarm.Game.Step.Combustion qualified as Combustion
import Swarm.Game.Step.Flood
import Swarm.Game.Step.Path.Finding
import Swarm.Game.Step.Path.Type
import Swarm.Game.Step.Path.Walkability
import Swarm.Game.Step.RobotStepState
import Swarm.Game.Step.Util
import Swarm.Game.Step.Util.Command
import Swarm.Game.Step.Util.Inspect
import Swarm.Game.Terrain (TerrainType)
import Swarm.Game.Tick
import Swarm.Game.Universe
import Swarm.Game.Value
import Swarm.Language.Capability
import Swarm.Language.Key (parseKeyComboFull)
import Swarm.Language.Parser.Value (readValue)
import Swarm.Language.Pipeline
import Swarm.Language.Requirements qualified as R
import Swarm.Language.Syntax
import Swarm.Language.Syntax.Direction
import Swarm.Language.Text.Markdown qualified as Markdown
import Swarm.Language.Value
import Swarm.Log
import Swarm.Pretty (prettyText)
import Swarm.ResourceLoading (getDataFileNameSafe)
import Swarm.Util hiding (both)
import Swarm.Util.Effect (throwToMaybe)
import Swarm.Util.Lens (inherit)
import Text.Megaparsec (runParser)
import Witch (From (from), into)
import Prelude hiding (lookup)

-- | How to handle failure, for example when moving into liquid or
--   attempting to move to a blocked location
data RobotFailure = ThrowExn | Destroy | IgnoreFail

-- | How to handle different types of failure when moving/teleporting
--   to a location.
type MoveFailureHandler = MoveFailureMode -> RobotFailure

-- | Whether to remove the entity in the world inside the 'doGrab' function
-- or leave it to be done by other code.
data GrabRemoval = DeferRemoval | PerformRemoval
  deriving (GrabRemoval -> GrabRemoval -> Bool
(GrabRemoval -> GrabRemoval -> Bool)
-> (GrabRemoval -> GrabRemoval -> Bool) -> Eq GrabRemoval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GrabRemoval -> GrabRemoval -> Bool
== :: GrabRemoval -> GrabRemoval -> Bool
$c/= :: GrabRemoval -> GrabRemoval -> Bool
/= :: GrabRemoval -> GrabRemoval -> Bool
Eq)

-- | Interpret the execution (or evaluation) of a constant application
--   to some values.
execConst ::
  (HasRobotStepState sig m, Has Effect.Time sig m, Has (Lift IO) sig m) =>
  -- | Need to pass this function as an argument to avoid module import cycle
  -- The supplied function invokes 'runCESK', which lives in "Swarm.Game.Step".
  (Store -> Robot -> Value -> m Value) ->
  Const ->
  [Value] ->
  Store ->
  Cont ->
  m CESK
execConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m, Has (Lift IO) sig m) =>
(Store -> Robot -> Value -> m Value)
-> Const -> [Value] -> Store -> Cont -> m CESK
execConst Store -> Robot -> Value -> m Value
runChildProg Const
c [Value]
vs Store
s Cont
k = do
  -- First, ensure the robot is capable of executing/evaluating this constant.
  Const -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
 Has (Throw Exn) sig m) =>
Const -> m ()
ensureCanExecute Const
c

  -- Increment command count regardless of success
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Const -> Bool
isTangible Const
c) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (ActivityCounts -> Identity ActivityCounts)
-> Robot -> Identity Robot
Lens' Robot ActivityCounts
activityCounts ((ActivityCounts -> Identity ActivityCounts)
 -> Robot -> Identity Robot)
-> ((Int -> Identity Int)
    -> ActivityCounts -> Identity ActivityCounts)
-> (Int -> Identity Int)
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> ActivityCounts -> Identity ActivityCounts
Lens' ActivityCounts Int
tangibleCommandCount ((Int -> Identity Int) -> Robot -> Identity Robot) -> Int -> m ()
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State s) sig m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
1

  (ActivityCounts -> Identity ActivityCounts)
-> Robot -> Identity Robot
Lens' Robot ActivityCounts
activityCounts ((ActivityCounts -> Identity ActivityCounts)
 -> Robot -> Identity Robot)
-> ((Map Const Int -> Identity (Map Const Int))
    -> ActivityCounts -> Identity ActivityCounts)
-> (Map Const Int -> Identity (Map Const Int))
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Const Int -> Identity (Map Const Int))
-> ActivityCounts -> Identity ActivityCounts
Lens' ActivityCounts (Map Const Int)
commandsHistogram ((Map Const Int -> Identity (Map Const Int))
 -> Robot -> Identity Robot)
-> (Map Const Int -> Map Const Int) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Int -> Int -> Int)
-> Const -> Int -> Map Const Int -> Map Const Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
MS.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Const
c Int
1

  -- Now proceed to actually carry out the operation.
  case Const
c of
    Const
Noop -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
    Const
Pure -> case [Value]
vs of
      [Value
v] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Wait -> case [Value]
vs of
      [VInt Integer
d] -> do
        TickNumber
time <- Getting TickNumber GameState TickNumber -> m TickNumber
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting TickNumber GameState TickNumber -> m TickNumber)
-> Getting TickNumber GameState TickNumber -> m TickNumber
forall a b. (a -> b) -> a -> b
$ (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
        m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m ()
purgeFarAwayWatches
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ TickNumber -> CESK -> CESK
Waiting (Int -> TickNumber -> TickNumber
addTicks (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d) TickNumber
time) (() -> CESK
forall a. Valuable a => a -> CESK
mkReturn ())
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Selfdestruct -> do
      (Bool -> Maybe GameplayAchievement) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Bool -> Maybe GameplayAchievement) -> m ()
destroyIfNotBase ((Bool -> Maybe GameplayAchievement) -> m ())
-> (Bool -> Maybe GameplayAchievement) -> m ()
forall a b. (a -> b) -> a -> b
$ \case Bool
False -> GameplayAchievement -> Maybe GameplayAchievement
forall a. a -> Maybe a
Just GameplayAchievement
AttemptSelfDestructBase; Bool
_ -> Maybe GameplayAchievement
forall a. Maybe a
Nothing
      m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
    Const
Move -> do
      Maybe Heading
orientation <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
      Heading -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Heading -> m CESK
moveInDirection (Heading -> m CESK) -> Heading -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Heading
orientation Maybe Heading -> Heading -> Heading
forall a. Maybe a -> a -> a
? Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
    Const
Backup -> do
      Maybe Heading
orientation <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
      Heading -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Heading -> m CESK
moveInDirection (Heading -> m CESK) -> Heading -> m CESK
forall a b. (a -> b) -> a -> b
$ Direction -> Heading -> Heading
applyTurn (RelativeDir -> Direction
DRelative (RelativeDir -> Direction) -> RelativeDir -> Direction
forall a b. (a -> b) -> a -> b
$ PlanarRelativeDir -> RelativeDir
DPlanar PlanarRelativeDir
DBack) (Heading -> Heading) -> Heading -> Heading
forall a b. (a -> b) -> a -> b
$ Maybe Heading
orientation Maybe Heading -> Heading -> Heading
forall a. Maybe a -> a -> a
? Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
    Const
Volume -> case [Value]
vs of
      [VInt Integer
limit] -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
limit Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
globalMaxVolume) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m ()) -> Exn -> m ()
forall a b. (a -> b) -> a -> b
$
            Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed
              Const
Volume
              ( [Text] -> Text
T.unwords
                  [ Text
"Can only measure up to"
                  , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
globalMaxVolume
                  , Text
"cells."
                  ]
              )
              Maybe GameplayAchievement
forall a. Maybe a
Nothing

        Cosmic Location
robotLoc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Maybe Int
maybeResult <- Cosmic Location -> Int -> m (Maybe Int)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Int -> m (Maybe Int)
floodFill Cosmic Location
robotLoc (Int -> m (Maybe Int)) -> Int -> m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
limit
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Int -> CESK
forall a. Valuable a => a -> CESK
mkReturn Maybe Int
maybeResult
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Path -> case [Value]
vs of
      [VInj Bool
hasLimit Value
limitVal, VInj Bool
findEntity Value
goalVal] -> do
        Maybe Integer
maybeLimit <-
          if Bool
hasLimit
            then case Value
limitVal of
              VInt Integer
d -> Maybe Integer -> m (Maybe Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer -> m (Maybe Integer))
-> Maybe Integer -> m (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
d
              Value
_ -> m (Maybe Integer)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
            else Maybe Integer -> m (Maybe Integer)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
        PathfindingTarget
goal <-
          if Bool
findEntity
            then case Value
goalVal of
              VText Text
eName -> PathfindingTarget -> m PathfindingTarget
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PathfindingTarget -> m PathfindingTarget)
-> PathfindingTarget -> m PathfindingTarget
forall a b. (a -> b) -> a -> b
$ Text -> PathfindingTarget
EntityTarget Text
eName
              Value
_ -> m PathfindingTarget
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
            else case Value
goalVal of
              VPair (VInt Integer
x) (VInt Integer
y) ->
                PathfindingTarget -> m PathfindingTarget
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PathfindingTarget -> m PathfindingTarget)
-> PathfindingTarget -> m PathfindingTarget
forall a b. (a -> b) -> a -> b
$
                  Location -> PathfindingTarget
LocationTarget (Location -> PathfindingTarget) -> Location -> PathfindingTarget
forall a b. (a -> b) -> a -> b
$
                    Int32 -> Int32 -> Location
Location (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
              Value
_ -> m PathfindingTarget
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
        Cosmic Location
robotLoc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Maybe (Direction, Int)
result <- PathfindingParameters (Cosmic Location)
-> m (Maybe (Direction, Int))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
PathfindingParameters (Cosmic Location)
-> m (Maybe (Direction, Int))
pathCommand (PathfindingParameters (Cosmic Location)
 -> m (Maybe (Direction, Int)))
-> PathfindingParameters (Cosmic Location)
-> m (Maybe (Direction, Int))
forall a b. (a -> b) -> a -> b
$ Maybe Integer
-> Cosmic Location
-> PathfindingTarget
-> PathfindingParameters (Cosmic Location)
forall a.
Maybe Integer -> a -> PathfindingTarget -> PathfindingParameters a
PathfindingParameters Maybe Integer
maybeLimit Cosmic Location
robotLoc PathfindingTarget
goal
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe (Direction, Int) -> CESK
forall a. Valuable a => a -> CESK
mkReturn Maybe (Direction, Int)
result
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Push -> do
      -- Figure out where we're going
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      Maybe Heading
orientation <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
      let applyHeading :: Cosmic Location -> Cosmic Location
applyHeading = (Cosmic Location -> Heading -> Cosmic Location
`offsetBy` (Maybe Heading
orientation Maybe Heading -> Heading -> Heading
forall a. Maybe a -> a -> a
? Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero))
          nextLoc :: Cosmic Location
nextLoc = Cosmic Location -> Cosmic Location
applyHeading Cosmic Location
loc
          placementLoc :: Cosmic Location
placementLoc = Cosmic Location -> Cosmic Location
applyHeading Cosmic Location
nextLoc

      -- If unobstructed, the robot will move even if
      -- there is nothing to push.
      Maybe Entity
maybeCurrentE <- Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
nextLoc
      Maybe Entity -> (Entity -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Entity
maybeCurrentE ((Entity -> m ()) -> m ()) -> (Entity -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Entity
e -> do
        -- Make sure there's nothing already occupying the destination
        Bool
nothingHere <- Maybe Entity -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
placementLoc
        Bool
nothingHere Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"Something is in the way!"]

        let verbed :: Text
verbed = GrabbingCmd -> Text
verbedGrabbingCmd GrabbingCmd
Push'
        -- Ensure it can be pushed.
        Bool
omni <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
        (Bool
omni Bool -> Bool -> Bool
|| Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Pushable Bool -> Bool -> Bool
|| Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Pickable Bool -> Bool -> Bool
&& Bool -> Bool
not (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Liquid))
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"The", Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName, Text
"here can't be", Text
verbed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

        -- Place the entity and remove it from previous loc
        Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
nextLoc (Maybe Entity -> Maybe Entity -> Maybe Entity
forall a b. a -> b -> a
const Maybe Entity
forall a. Maybe a
Nothing)
        Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
placementLoc (Maybe Entity -> Maybe Entity -> Maybe Entity
forall a b. a -> b -> a
const (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e))

      Cosmic Location -> Cosmic Location -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
loc Cosmic Location
nextLoc
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
    Const
Stride -> case [Value]
vs of
      [VInt Integer
d] -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxStrideRange) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m ()) -> Exn -> m ()
forall a b. (a -> b) -> a -> b
$
            Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed
              Const
Stride
              ( [Text] -> Text
T.unwords
                  [ Text
"Can only stride up to"
                  , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
maxStrideRange
                  , Text
"units."
                  ]
              )
              Maybe GameplayAchievement
forall a. Maybe a
Nothing

        -- Figure out where we're going
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Maybe Heading
orientation <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
        let heading :: Heading
heading = Maybe Heading
orientation Maybe Heading -> Heading -> Heading
forall a. Maybe a -> a -> a
? Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero

        -- Excludes the base location.
        let locsInDirection :: [Cosmic Location]
            locsInDirection :: [Cosmic Location]
locsInDirection =
              Int -> [Cosmic Location] -> [Cosmic Location]
forall a. Int -> [a] -> [a]
take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d) Int
maxStrideRange) ([Cosmic Location] -> [Cosmic Location])
-> [Cosmic Location] -> [Cosmic Location]
forall a b. (a -> b) -> a -> b
$
                Int -> [Cosmic Location] -> [Cosmic Location]
forall a. Int -> [a] -> [a]
drop Int
1 ([Cosmic Location] -> [Cosmic Location])
-> [Cosmic Location] -> [Cosmic Location]
forall a b. (a -> b) -> a -> b
$
                  (Cosmic Location -> Cosmic Location)
-> Cosmic Location -> [Cosmic Location]
forall a. (a -> a) -> a -> [a]
iterate (Cosmic Location -> Heading -> Cosmic Location
`offsetBy` Heading
heading) Cosmic Location
loc

        [Maybe MoveFailureMode]
failureMaybes <- (Cosmic Location -> m (Maybe MoveFailureMode))
-> [Cosmic Location] -> m [Maybe MoveFailureMode]
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 Cosmic Location -> m (Maybe MoveFailureMode)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureMode)
checkMoveFailure [Cosmic Location]
locsInDirection
        let maybeFirstFailure :: Maybe MoveFailureMode
maybeFirstFailure = [Maybe MoveFailureMode] -> Maybe MoveFailureMode
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe MoveFailureMode]
failureMaybes

        Maybe MoveFailureMode -> MoveFailureHandler -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureMode -> MoveFailureHandler -> m ()
applyMoveFailureEffect Maybe MoveFailureMode
maybeFirstFailure (MoveFailureHandler -> m ()) -> MoveFailureHandler -> m ()
forall a b. (a -> b) -> a -> b
$ \case
          PathBlockedBy Maybe Entity
_ -> RobotFailure
ThrowExn
          PathLiquid Entity
_ -> RobotFailure
Destroy

        let maybeLastLoc :: Maybe (Cosmic Location)
maybeLastLoc = do
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe MoveFailureMode -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe MoveFailureMode
maybeFirstFailure
              [Cosmic Location] -> Maybe (Cosmic Location)
forall a. [a] -> Maybe a
listToMaybe ([Cosmic Location] -> Maybe (Cosmic Location))
-> [Cosmic Location] -> Maybe (Cosmic Location)
forall a b. (a -> b) -> a -> b
$ [Cosmic Location] -> [Cosmic Location]
forall a. [a] -> [a]
reverse [Cosmic Location]
locsInDirection

        Maybe (Cosmic Location) -> (Cosmic Location -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Cosmic Location)
maybeLastLoc ((Cosmic Location -> m ()) -> m ())
-> (Cosmic Location -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> Cosmic Location -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
loc

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Teleport -> case [Value]
vs of
      [VRobot Int
rid, VPair (VInt Integer
x) (VInt Integer
y)] -> do
        Int -> (Cosmic Location -> Cosmic Location) -> m CESK
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Algebra sig m, Member (Throw Exn) sig, Member (Lift IO) sig,
 Member (State Robot) sig, Member (State GameState) sig) =>
Int -> (Cosmic Location -> Cosmic Location) -> m CESK
doTeleport Int
rid (Int32 -> Int32 -> Location
Location (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y) Location -> Cosmic Location -> Cosmic Location
forall a b. a -> Cosmic b -> Cosmic a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Warp -> case [Value]
vs of
      [VRobot Int
rid, VPair (VText Text
swName) (VPair (VInt Integer
x) (VInt Integer
y))] -> do
        Int -> (Cosmic Location -> Cosmic Location) -> m CESK
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Algebra sig m, Member (Throw Exn) sig, Member (Lift IO) sig,
 Member (State Robot) sig, Member (State GameState) sig) =>
Int -> (Cosmic Location -> Cosmic Location) -> m CESK
doTeleport Int
rid ((Cosmic Location -> Cosmic Location) -> m CESK)
-> (Location -> Cosmic Location -> Cosmic Location)
-> Location
-> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Cosmic Location -> Cosmic Location
forall a b. a -> b -> a
const (Cosmic Location -> Cosmic Location -> Cosmic Location)
-> (Location -> Cosmic Location)
-> Location
-> Cosmic Location
-> Cosmic Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubworldName -> Location -> Cosmic Location
forall a. SubworldName -> a -> Cosmic a
Cosmic (Text -> SubworldName
SubworldName Text
swName) (Location -> m CESK) -> Location -> m CESK
forall a b. (a -> b) -> a -> b
$
          Int32 -> Int32 -> Location
Location (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Grab -> Entity -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Entity -> CESK) -> m Entity -> m CESK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrabbingCmd -> GrabRemoval -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
GrabbingCmd -> GrabRemoval -> m Entity
doGrab GrabbingCmd
Grab' GrabRemoval
PerformRemoval
    Const
Harvest -> Entity -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Entity -> CESK) -> m Entity -> m CESK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GrabbingCmd -> GrabRemoval -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
GrabbingCmd -> GrabRemoval -> m Entity
doGrab GrabbingCmd
Harvest' GrabRemoval
PerformRemoval
    Const
Sow -> case [Value]
vs of
      [VText Text
name] -> do
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation

        -- Make sure there's nothing already here
        Bool
nothingHere <- Maybe Entity -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
        Bool
nothingHere Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"There is already an entity here."]

        -- Make sure the robot has the thing in its inventory
        Entity
e <- Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name

        (TerrainType
terrainHere, Maybe Entity
_) <- Cosmic Location -> m (TerrainType, Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (TerrainType, Maybe Entity)
contentAt Cosmic Location
loc
        TerrainType -> Cosmic Location -> Entity -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
TerrainType -> Cosmic Location -> Entity -> m ()
doPlantSeed TerrainType
terrainHere Cosmic Location
loc Entity
e

        -- Remove it from the inventory
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
e

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Ignite -> case [Value]
vs of
      [VDir Direction
d] -> do
        Const -> Direction -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
Const -> Direction -> m ()
Combustion.igniteCommand Const
c Direction
d
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Swap -> case [Value]
vs of
      [VText Text
name] -> do
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        -- Make sure the robot has the thing in its inventory
        Entity
e <- Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name
        -- Grab without removing from the world
        Entity
newE <- GrabbingCmd -> GrabRemoval -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
GrabbingCmd -> GrabRemoval -> m Entity
doGrab GrabbingCmd
Swap' GrabRemoval
DeferRemoval

        -- Place the entity and remove it from the inventory
        Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (Maybe Entity -> Maybe Entity -> Maybe Entity
forall a b. a -> b -> a
const (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e))
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
e

        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entity
e Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity
newE) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot GameplayAchievement
SwapSame

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Entity -> CESK
forall a. Valuable a => a -> CESK
mkReturn Entity
newE
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Turn -> case [Value]
vs of
      [VDir Direction
d] -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Direction -> Bool
isCardinal Direction
d) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Capability -> Term -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
 Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
COrient (Direction -> Term
forall ty. Direction -> Term' ty
TDir Direction
d)
        (Maybe Heading -> Identity (Maybe Heading))
-> Robot -> Identity Robot
Lens' Robot (Maybe Heading)
robotOrientation ((Maybe Heading -> Identity (Maybe Heading))
 -> Robot -> Identity Robot)
-> ((Heading -> Identity Heading)
    -> Maybe Heading -> Identity (Maybe Heading))
-> (Heading -> Identity Heading)
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Heading -> Identity Heading)
-> Maybe Heading -> Identity (Maybe Heading)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Heading -> Identity Heading) -> Robot -> Identity Robot)
-> (Heading -> Heading) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Direction -> Heading -> Heading
applyTurn Direction
d
        m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw

        Inventory
inst <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Direction
d Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== RelativeDir -> Direction
DRelative RelativeDir
DDown Bool -> Bool -> Bool
&& Text -> Inventory -> Int
countByName Text
"compass" Inventory
inst Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot GameplayAchievement
GetDisoriented

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Place -> case [Value]
vs of
      [VText Text
name] -> do
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation

        -- Make sure there's nothing already here
        Bool
nothingHere <- Maybe Entity -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
        Bool
nothingHere Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"There is already an entity here."]

        -- Make sure the robot has the thing in its inventory
        Entity
e <- Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name

        -- Place the entity (if it is not evanescent) and remove it from the inventory
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (EntityProperty
Evanescent EntityProperty -> Set EntityProperty -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` (Entity
e Entity
-> Getting (Set EntityProperty) Entity (Set EntityProperty)
-> Set EntityProperty
forall s a. s -> Getting a s a -> a
^. Getting (Set EntityProperty) Entity (Set EntityProperty)
Lens' Entity (Set EntityProperty)
entityProperties)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (Maybe Entity -> Maybe Entity -> Maybe Entity
forall a b. a -> b -> a
const (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e))
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
e

        m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Ping -> case [Value]
vs of
      [VRobot Int
otherID] -> do
        Maybe Robot
maybeOtherRobot <- Int -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID Int
otherID
        Robot
selfRobot <- m Robot
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Heading -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Maybe Heading -> CESK) -> Maybe Heading -> CESK
forall a b. (a -> b) -> a -> b
$ Robot -> Maybe Robot -> Maybe Heading
displacementVector Robot
selfRobot Maybe Robot
maybeOtherRobot
       where
        displacementVector :: Robot -> Maybe Robot -> Maybe (V2 Int32)
        displacementVector :: Robot -> Maybe Robot -> Maybe Heading
displacementVector Robot
selfRobot Maybe Robot
maybeOtherRobot = do
          Robot
otherRobot <- Maybe Robot
maybeOtherRobot
          let dist :: DistanceMeasure Double
dist = ((Location -> Location -> Double)
-> Cosmic Location -> Cosmic Location -> DistanceMeasure Double
forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Double
euclidean (Cosmic Location -> Cosmic Location -> DistanceMeasure Double)
-> (Robot -> Cosmic Location)
-> Robot
-> Robot
-> DistanceMeasure Double
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting (Cosmic Location) Robot (Cosmic Location)
-> Robot -> Cosmic Location
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation) Robot
selfRobot Robot
otherRobot
              (Double
_minRange, Double
maxRange) = Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange (Robot -> Maybe Robot
forall a. a -> Maybe a
Just Robot
selfRobot) (Robot -> Maybe Robot
forall a. a -> Maybe a
Just Robot
otherRobot)
          Double
d <- DistanceMeasure Double -> Maybe Double
forall b. DistanceMeasure b -> Maybe b
getFiniteDistance DistanceMeasure Double
dist
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Double
d Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
maxRange
          Robot -> Cosmic Location -> Maybe Heading
orientationBasedRelativePosition Robot
selfRobot (Cosmic Location -> Maybe Heading)
-> Cosmic Location -> Maybe Heading
forall a b. (a -> b) -> a -> b
$ Getting (Cosmic Location) Robot (Cosmic Location)
-> Robot -> Cosmic Location
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation Robot
otherRobot
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Give -> case [Value]
vs of
      [VRobot Int
otherID, VText Text
itemName] -> do
        -- Make sure the other robot exists and is close
        Robot
_other <- Int -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> m Robot
getRobotWithinTouch Int
otherID

        Entity
item <- Text -> Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
"give"

        -- Giving something to ourself should be a no-op.  We need
        -- this as a special case since it will not work to modify
        -- ourselves in the robotMap --- after performing a tick we
        -- return a modified Robot which gets put back in the
        -- robotMap, overwriting any changes to this robot made
        -- directly in the robotMap during the tick.
        Int
myID <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
        Int
focusedID <- Getting Int GameState Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting Int GameState Int -> m Int)
-> Getting Int GameState Int -> m Int
forall a b. (a -> b) -> a -> b
$ (Robots -> Const Int Robots) -> GameState -> Const Int GameState
Lens' GameState Robots
robotInfo ((Robots -> Const Int Robots) -> GameState -> Const Int GameState)
-> ((Int -> Const Int Int) -> Robots -> Const Int Robots)
-> Getting Int GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Robots -> Const Int Robots
Getter Robots Int
focusedRobotID
        if Int
otherID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
myID
          then do
            -- Make the exchange
            (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((Inventory -> Identity Inventory) -> Robots -> Identity Robots)
-> (Inventory -> Identity Inventory)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Inventory -> Identity Inventory)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Inventory -> Identity Inventory)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
otherID ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Inventory -> Identity Inventory)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (Inventory -> Identity Inventory)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory)
 -> GameState -> Identity GameState)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
item
            (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
item

            -- Flag the UI for a redraw if we are currently showing either robot's inventory
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
focusedID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
myID Bool -> Bool -> Bool
|| Int
focusedID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
otherID) m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
          else GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot GameplayAchievement
GaveToSelf

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Equip -> case [Value]
vs of
      [VText Text
itemName] -> do
        Entity
item <- Text -> Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
"equip"
        Int
myID <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
        Int
focusedID <- Getting Int GameState Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting Int GameState Int -> m Int)
-> Getting Int GameState Int -> m Int
forall a b. (a -> b) -> a -> b
$ (Robots -> Const Int Robots) -> GameState -> Const Int GameState
Lens' GameState Robots
robotInfo ((Robots -> Const Int Robots) -> GameState -> Const Int GameState)
-> ((Int -> Const Int Int) -> Robots -> Const Int Robots)
-> Getting Int GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Robots -> Const Int Robots
Getter Robots Int
focusedRobotID
        -- Don't do anything if the robot already has the device.
        Bool
already <- Getting Bool Robot Bool -> m Bool
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use ((Inventory -> Const Bool Inventory) -> Robot -> Const Bool Robot
Lens' Robot Inventory
equippedDevices ((Inventory -> Const Bool Inventory) -> Robot -> Const Bool Robot)
-> ((Bool -> Const Bool Bool) -> Inventory -> Const Bool Inventory)
-> Getting Bool Robot Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Bool)
-> (Bool -> Const Bool Bool) -> Inventory -> Const Bool Inventory
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Inventory -> Entity -> Bool
`E.contains` Entity
item))
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
already (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
equippedDevices ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
item
          (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
item

          -- Check whether we should bestow the 'EquippedAllDevices' achievement
          Maybe ScenarioPath
curScenario <- Getting (Maybe ScenarioPath) GameState (Maybe ScenarioPath)
-> m (Maybe ScenarioPath)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe ScenarioPath) GameState (Maybe ScenarioPath)
Lens' GameState (Maybe ScenarioPath)
currentScenarioPath
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ScenarioPath
curScenario Maybe ScenarioPath -> Maybe ScenarioPath -> Bool
forall a. Eq a => a -> a -> Bool
== ScenarioPath -> Maybe ScenarioPath
forall a. a -> Maybe a
Just ScenarioPath
"classic.yaml") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Set Text
equipped <- [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text)
-> (Inventory -> [Text]) -> Inventory -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Text) -> [Entity] -> [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])
-> (Inventory -> [Entity]) -> Inventory -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [Entity]
nonzeroEntities (Inventory -> Set Text) -> m Inventory -> m (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
            Set Text
equippable <- Getting (Set Text) GameState (Set Text) -> m (Set Text)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting (Set Text) GameState (Set Text) -> m (Set Text))
-> Getting (Set Text) GameState (Set Text) -> m (Set Text)
forall a b. (a -> b) -> a -> b
$ (Discovery -> Const (Set Text) Discovery)
-> GameState -> Const (Set Text) GameState
Lens' GameState Discovery
discovery ((Discovery -> Const (Set Text) Discovery)
 -> GameState -> Const (Set Text) GameState)
-> ((Set Text -> Const (Set Text) (Set Text))
    -> Discovery -> Const (Set Text) Discovery)
-> Getting (Set Text) GameState (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Const (Set Text) (Set Text))
-> Discovery -> Const (Set Text) Discovery
Lens' Discovery (Set Text)
craftableDevices
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set Text
equippable Set Text -> Set Text -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set Text
equipped) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot GameplayAchievement
EquippedAllDevices

          -- Flag the UI for a redraw if we are currently showing our inventory
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
focusedID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
myID) m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Unequip -> case [Value]
vs of
      [VText Text
itemName] -> do
        Entity
item <- Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
ensureEquipped Text
itemName
        Int
myID <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID

        -- Speculatively unequip the item
        Int
focusedID <- Getting Int GameState Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting Int GameState Int -> m Int)
-> Getting Int GameState Int -> m Int
forall a b. (a -> b) -> a -> b
$ (Robots -> Const Int Robots) -> GameState -> Const Int GameState
Lens' GameState Robots
robotInfo ((Robots -> Const Int Robots) -> GameState -> Const Int GameState)
-> ((Int -> Const Int Int) -> Robots -> Const Int Robots)
-> Getting Int GameState Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Robots -> Const Int Robots
Getter Robots Int
focusedRobotID
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
equippedDevices ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
item
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
item

        -- Now check whether being on the current cell would still be
        -- allowed.
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Maybe MoveFailureMode
mfail <- Cosmic Location -> m (Maybe MoveFailureMode)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureMode)
checkMoveFailure Cosmic Location
loc
        Maybe MoveFailureMode -> (MoveFailureMode -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe MoveFailureMode
mfail \case
          PathBlockedBy Maybe Entity
_ -> do
            -- If unequipping the device would somehow result in the
            -- path being blocked, don't allow it; re-equip the device
            -- and throw an exception.
            (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
item
            (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
equippedDevices ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
item
            Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m ()) -> ([Text] -> Exn) -> [Text] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> [Text] -> Exn
cmdExn Const
Unequip ([Text] -> m ()) -> [Text] -> m ()
forall a b. (a -> b) -> a -> b
$
              [Text
"You can't unequip the", Entity
item Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName, Text
"right now!"]
          PathLiquid Entity
_ -> do
            -- Unequipping a device that gives the Float capability in
            -- the middle of liquid results in drowning, EVEN for
            -- base!  This is currently the only (known) way to get
            -- the `DestroyedBase` achievement.
            (Bool -> Identity Bool) -> Robot -> Identity Robot
Lens' Robot Bool
selfDestruct ((Bool -> Identity Bool) -> Robot -> Identity Robot)
-> Bool -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
myID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot GameplayAchievement
DestroyedBase

        -- Flag the UI for a redraw if we are currently showing our inventory
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
focusedID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
myID) m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Make -> case [Value]
vs of
      [VText Text
name] -> do
        Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
        Inventory
ins <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
        EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
        Entity
e <-
          Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em
            Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"I've never heard of", Text -> Text
indefiniteQ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

        IntMap [Recipe Entity]
outRs <- Getting (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
-> m (IntMap [Recipe Entity])
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
 -> m (IntMap [Recipe Entity]))
-> Getting
     (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
-> m (IntMap [Recipe Entity])
forall a b. (a -> b) -> a -> b
$ (Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> GameState -> Const (IntMap [Recipe Entity]) GameState
Lens' GameState Recipes
recipesInfo ((Recipes -> Const (IntMap [Recipe Entity]) Recipes)
 -> GameState -> Const (IntMap [Recipe Entity]) GameState)
-> ((IntMap [Recipe Entity]
     -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
    -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> Getting
     (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesOut

        Bool
creative <- Getting Bool GameState Bool -> m Bool
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
        let create :: [Text] -> [Text]
create [Text]
l = [Text]
l [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"You can use 'create \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"' instead." | Bool
creative]

        -- Only consider recipes where the number of things we are trying to make
        -- is greater in the outputs than in the inputs.  This prevents us from doing
        -- silly things like making copper pipes when the user says "make furnace".
        let recipes :: [Recipe Entity]
recipes = (Recipe Entity -> Bool) -> [Recipe Entity] -> [Recipe Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter Recipe Entity -> Bool
increase (IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor IntMap [Recipe Entity]
outRs Entity
e)
            increase :: Recipe Entity -> Bool
increase Recipe Entity
r = IngredientList Entity -> Int
forall {b} {t :: * -> *}. (Num b, Foldable t) => t (b, Entity) -> b
countIn (Recipe Entity
r Recipe Entity
-> Getting
     (IngredientList Entity) (Recipe Entity) (IngredientList Entity)
-> IngredientList Entity
forall s a. s -> Getting a s a -> a
^. Getting
  (IngredientList Entity) (Recipe Entity) (IngredientList Entity)
forall e (f :: * -> *).
Functor f =>
(IngredientList e -> f (IngredientList e))
-> Recipe e -> f (Recipe e)
recipeOutputs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> IngredientList Entity -> Int
forall {b} {t :: * -> *}. (Num b, Foldable t) => t (b, Entity) -> b
countIn (Recipe Entity
r Recipe Entity
-> Getting
     (IngredientList Entity) (Recipe Entity) (IngredientList Entity)
-> IngredientList Entity
forall s a. s -> Getting a s a -> a
^. Getting
  (IngredientList Entity) (Recipe Entity) (IngredientList Entity)
forall e (f :: * -> *).
Functor f =>
(IngredientList e -> f (IngredientList e))
-> Recipe e -> f (Recipe e)
recipeInputs)
            countIn :: t (b, Entity) -> b
countIn t (b, Entity)
xs = b -> ((b, Entity) -> b) -> Maybe (b, Entity) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
0 (b, Entity) -> b
forall a b. (a, b) -> a
fst (((b, Entity) -> Bool) -> t (b, Entity) -> Maybe (b, Entity)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Entity -> Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity
e) (Entity -> Bool) -> ((b, Entity) -> Entity) -> (b, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, Entity) -> Entity
forall a b. (a, b) -> b
snd) t (b, Entity)
xs)
        Bool -> Bool
not ([Recipe Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Recipe Entity]
recipes)
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text] -> [Text]
create [Text
"There is no known recipe for making", Text -> Text
indefinite Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

        let displayMissingCount :: a -> MissingType -> target
displayMissingCount a
mc = \case
              MissingType
MissingInput -> String -> target
forall source target. From source target => source -> target
from (a -> String
forall a. Show a => a -> String
show a
mc)
              MissingType
MissingCatalyst -> target
"not equipped"
            displayMissingIngredient :: MissingIngredient -> Text
displayMissingIngredient (MissingIngredient MissingType
mk Int
mc Entity
me) =
              Text
"  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Entity
me Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> MissingType -> Text
forall {target} {a}.
(From String target, Show a, IsString target) =>
a -> MissingType -> target
displayMissingCount Int
mc MissingType
mk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
            displayMissingIngredients :: [[MissingIngredient]] -> [Text]
displayMissingIngredients [[MissingIngredient]]
xs = [Text] -> [[Text]] -> [Text]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Text
"OR"] ((MissingIngredient -> Text) -> [MissingIngredient] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map MissingIngredient -> Text
displayMissingIngredient ([MissingIngredient] -> [Text])
-> [[MissingIngredient]] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[MissingIngredient]]
xs)

        -- Try recipes and make a weighted random choice among the
        -- ones we have ingredients for.
        let ([[MissingIngredient]]
badRecipes, [(Inventory, IngredientList Entity, Recipe Entity)]
goodRecipes) = [Either
   [MissingIngredient]
   (Inventory, IngredientList Entity, Recipe Entity)]
-> ([[MissingIngredient]],
    [(Inventory, IngredientList Entity, Recipe Entity)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either
    [MissingIngredient]
    (Inventory, IngredientList Entity, Recipe Entity)]
 -> ([[MissingIngredient]],
     [(Inventory, IngredientList Entity, Recipe Entity)]))
-> ([Recipe Entity]
    -> [Either
          [MissingIngredient]
          (Inventory, IngredientList Entity, Recipe Entity)])
-> [Recipe Entity]
-> ([[MissingIngredient]],
    [(Inventory, IngredientList Entity, Recipe Entity)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recipe Entity
 -> Either
      [MissingIngredient]
      (Inventory, IngredientList Entity, Recipe Entity))
-> [Recipe Entity]
-> [Either
      [MissingIngredient]
      (Inventory, IngredientList Entity, Recipe Entity)]
forall a b. (a -> b) -> [a] -> [b]
map ((Inventory, Inventory)
-> Recipe Entity
-> Either
     [MissingIngredient]
     (Inventory, IngredientList Entity, Recipe Entity)
make (Inventory
inv, Inventory
ins)) ([Recipe Entity]
 -> ([[MissingIngredient]],
     [(Inventory, IngredientList Entity, Recipe Entity)]))
-> [Recipe Entity]
-> ([[MissingIngredient]],
    [(Inventory, IngredientList Entity, Recipe Entity)])
forall a b. (a -> b) -> a -> b
$ [Recipe Entity]
recipes
        Maybe (Inventory, IngredientList Entity, Recipe Entity)
chosenRecipe <- ((Inventory, IngredientList Entity, Recipe Entity) -> Integer)
-> [(Inventory, IngredientList Entity, Recipe Entity)]
-> m (Maybe (Inventory, IngredientList Entity, Recipe Entity))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice ((Inventory, IngredientList Entity, Recipe Entity)
-> Getting
     Integer (Inventory, IngredientList Entity, Recipe Entity) Integer
-> Integer
forall s a. s -> Getting a s a -> a
^. (Recipe Entity -> Const Integer (Recipe Entity))
-> (Inventory, IngredientList Entity, Recipe Entity)
-> Const Integer (Inventory, IngredientList Entity, Recipe Entity)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (Inventory, IngredientList Entity, Recipe Entity)
  (Inventory, IngredientList Entity, Recipe Entity)
  (Recipe Entity)
  (Recipe Entity)
_3 ((Recipe Entity -> Const Integer (Recipe Entity))
 -> (Inventory, IngredientList Entity, Recipe Entity)
 -> Const Integer (Inventory, IngredientList Entity, Recipe Entity))
-> ((Integer -> Const Integer Integer)
    -> Recipe Entity -> Const Integer (Recipe Entity))
-> Getting
     Integer (Inventory, IngredientList Entity, Recipe Entity) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Const Integer Integer)
-> Recipe Entity -> Const Integer (Recipe Entity)
forall e (f :: * -> *).
Functor f =>
(Integer -> f Integer) -> Recipe e -> f (Recipe e)
recipeWeight) [(Inventory, IngredientList Entity, Recipe Entity)]
goodRecipes
        (Inventory
invTaken, IngredientList Entity
changeInv, Recipe Entity
recipe) <-
          Maybe (Inventory, IngredientList Entity, Recipe Entity)
chosenRecipe
            Maybe (Inventory, IngredientList Entity, Recipe Entity)
-> [Text] -> m (Inventory, IngredientList Entity, Recipe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text] -> [Text]
create
              [ Text
"You don't have the ingredients to make"
              , Text -> Text
indefinite Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
              , Text
"Missing:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines ([[MissingIngredient]] -> [Text]
displayMissingIngredients [[MissingIngredient]]
badRecipes)
              ]

        -- take recipe inputs from inventory and add outputs after recipeTime
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> Inventory -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
invTaken
        ((Int, Entity) -> m ()) -> IngredientList Entity -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Entity -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities (Entity -> m ())
-> ((Int, Entity) -> Entity) -> (Int, Entity) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd) (Recipe Entity
recipe Recipe Entity
-> Getting
     (IngredientList Entity) (Recipe Entity) (IngredientList Entity)
-> IngredientList Entity
forall s a. s -> Getting a s a -> a
^. Getting
  (IngredientList Entity) (Recipe Entity) (IngredientList Entity)
forall e (f :: * -> *).
Functor f =>
(IngredientList e -> f (IngredientList e))
-> Recipe e -> f (Recipe e)
recipeOutputs)
        -- Grant CraftedBitcoin achievement
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"bitcoin") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot GameplayAchievement
CraftedBitcoin

        Recipe Entity
-> Value -> [WorldUpdate Entity] -> [RobotUpdate] -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) e.
HasRobotStepState sig m =>
Recipe e
-> Value -> [WorldUpdate Entity] -> [RobotUpdate] -> m CESK
finishCookingRecipe Recipe Entity
recipe Value
VUnit [] (((Int, Entity) -> RobotUpdate)
-> IngredientList Entity -> [RobotUpdate]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Entity -> RobotUpdate) -> (Int, Entity) -> RobotUpdate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Entity -> RobotUpdate
AddEntity) IngredientList Entity
changeInv)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Has -> case [Value]
vs of
      [VText Text
name] -> do
        Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> (Int -> CESK) -> Int -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Bool -> CESK) -> (Int -> Bool) -> Int -> CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> m CESK) -> Int -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> Inventory -> Int
countByName Text
name Inventory
inv
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Equipped -> case [Value]
vs of
      [VText Text
name] -> do
        Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> (Int -> CESK) -> Int -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Bool -> CESK) -> (Int -> Bool) -> Int -> CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> m CESK) -> Int -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> Inventory -> Int
countByName Text
name Inventory
inv
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Count -> case [Value]
vs of
      [VText Text
name] -> do
        Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> (Int -> CESK) -> Int -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Int -> m CESK) -> Int -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> Inventory -> Int
countByName Text
name Inventory
inv
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Scout -> case [Value]
vs of
      [VDir Direction
d] -> do
        IntMap Robot
rMap <- Getting (IntMap Robot) GameState (IntMap Robot) -> m (IntMap Robot)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting (IntMap Robot) GameState (IntMap Robot)
 -> m (IntMap Robot))
-> Getting (IntMap Robot) GameState (IntMap Robot)
-> m (IntMap Robot)
forall a b. (a -> b) -> a -> b
$ (Robots -> Const (IntMap Robot) Robots)
-> GameState -> Const (IntMap Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (IntMap Robot) Robots)
 -> GameState -> Const (IntMap Robot) GameState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> Robots -> Const (IntMap Robot) Robots)
-> Getting (IntMap Robot) GameState (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> Robots -> Const (IntMap Robot) Robots
Lens' Robots (IntMap Robot)
robotMap
        Cosmic Location
myLoc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Heading
heading <- Direction -> m Heading
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m Heading
deriveHeading Direction
d
        MonoidMap SubworldName (MonoidMap Location IntSet)
botsByLocs <- Getting
  (MonoidMap SubworldName (MonoidMap Location IntSet))
  GameState
  (MonoidMap SubworldName (MonoidMap Location IntSet))
-> m (MonoidMap SubworldName (MonoidMap Location IntSet))
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (MonoidMap SubworldName (MonoidMap Location IntSet))
   GameState
   (MonoidMap SubworldName (MonoidMap Location IntSet))
 -> m (MonoidMap SubworldName (MonoidMap Location IntSet)))
-> Getting
     (MonoidMap SubworldName (MonoidMap Location IntSet))
     GameState
     (MonoidMap SubworldName (MonoidMap Location IntSet))
-> m (MonoidMap SubworldName (MonoidMap Location IntSet))
forall a b. (a -> b) -> a -> b
$ (Robots
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
-> GameState
-> Const
     (MonoidMap SubworldName (MonoidMap Location IntSet)) GameState
Lens' GameState Robots
robotInfo ((Robots
  -> Const
       (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
 -> GameState
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet)) GameState)
-> ((MonoidMap SubworldName (MonoidMap Location IntSet)
     -> Const
          (MonoidMap SubworldName (MonoidMap Location IntSet))
          (MonoidMap SubworldName (MonoidMap Location IntSet)))
    -> Robots
    -> Const
         (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
-> Getting
     (MonoidMap SubworldName (MonoidMap Location IntSet))
     GameState
     (MonoidMap SubworldName (MonoidMap Location IntSet))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonoidMap SubworldName (MonoidMap Location IntSet)
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet))
      (MonoidMap SubworldName (MonoidMap Location IntSet)))
-> Robots
-> Const
     (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots
Lens' Robots (MonoidMap SubworldName (MonoidMap Location IntSet))
robotsByLocation
        Int
selfRid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID

        -- Includes the base location, so we exclude the base robot later.
        let locsInDirection :: [Cosmic Location]
            locsInDirection :: [Cosmic Location]
locsInDirection = Int -> [Cosmic Location] -> [Cosmic Location]
forall a. Int -> [a] -> [a]
take Int
maxScoutRange ([Cosmic Location] -> [Cosmic Location])
-> [Cosmic Location] -> [Cosmic Location]
forall a b. (a -> b) -> a -> b
$ (Cosmic Location -> Cosmic Location)
-> Cosmic Location -> [Cosmic Location]
forall a. (a -> a) -> a -> [a]
iterate (Cosmic Location -> Heading -> Cosmic Location
`offsetBy` Heading
heading) Cosmic Location
myLoc

        let hasOpaqueEntity :: Cosmic Location -> m Bool
hasOpaqueEntity =
              (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
E.Opaque)) (m (Maybe Entity) -> m Bool)
-> (Cosmic Location -> m (Maybe Entity))
-> Cosmic Location
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt

        let hasVisibleBot :: Cosmic Location -> Bool
            hasVisibleBot :: Cosmic Location -> Bool
hasVisibleBot = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Int -> Bool
botIsVisible ([Int] -> Bool)
-> (Cosmic Location -> [Int]) -> Cosmic Location -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IS.toList (IntSet -> [Int])
-> (Cosmic Location -> IntSet) -> Cosmic Location -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet
excludeSelf (IntSet -> IntSet)
-> (Cosmic Location -> IntSet) -> Cosmic Location -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> IntSet
botsHere
             where
              excludeSelf :: IntSet -> IntSet
excludeSelf = (IntSet -> IntSet -> IntSet
`IS.difference` Int -> IntSet
IS.singleton Int
selfRid)
              botsHere :: Cosmic Location -> IntSet
botsHere (Cosmic SubworldName
swName Location
loc) =
                Location -> MonoidMap Location IntSet -> IntSet
forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MM.get Location
loc (MonoidMap Location IntSet -> IntSet)
-> MonoidMap Location IntSet -> IntSet
forall a b. (a -> b) -> a -> b
$
                  SubworldName
-> MonoidMap SubworldName (MonoidMap Location IntSet)
-> MonoidMap Location IntSet
forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MM.get SubworldName
swName MonoidMap SubworldName (MonoidMap Location IntSet)
botsByLocs
              botIsVisible :: Int -> Bool
botIsVisible = Bool -> (Robot -> Bool) -> Maybe Robot -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Robot -> Bool
canSee (Maybe Robot -> Bool) -> (Int -> Maybe Robot) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IntMap Robot -> Maybe Robot
forall a. Int -> IntMap a -> Maybe a
`IM.lookup` IntMap Robot
rMap)
              canSee :: Robot -> Bool
canSee = Bool -> Bool
not (Bool -> Bool) -> (Robot -> Bool) -> Robot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Getting Bool Robot Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Display -> Const Bool Display) -> Robot -> Const Bool Robot
Lens' Robot Display
robotDisplay ((Display -> Const Bool Display) -> Robot -> Const Bool Robot)
-> ((Bool -> Const Bool Bool) -> Display -> Const Bool Display)
-> Getting Bool Robot Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Display -> Const Bool Display
Lens' Display Bool
invisible)

        -- A robot on the same cell as an opaque entity is considered hidden.
        -- Returns (Just Bool) if the result is conclusively visible or opaque,
        -- or Nothing if we don't have a conclusive answer yet.
        let isConclusivelyVisible :: Bool -> Cosmic Location -> Maybe Bool
            isConclusivelyVisible :: Bool -> Cosmic Location -> Maybe Bool
isConclusivelyVisible Bool
isOpaque Cosmic Location
loc
              | Bool
isOpaque = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
              | Cosmic Location -> Bool
hasVisibleBot Cosmic Location
loc = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
              | Bool
otherwise = Maybe Bool
forall a. Maybe a
Nothing

        let isConclusivelyVisibleM :: Cosmic Location -> m (Maybe Bool)
isConclusivelyVisibleM Cosmic Location
loc = do
              Bool
opaque <- Cosmic Location -> m Bool
hasOpaqueEntity Cosmic Location
loc
              Maybe Bool -> m (Maybe Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> m (Maybe Bool)) -> Maybe Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Cosmic Location -> Maybe Bool
isConclusivelyVisible Bool
opaque Cosmic Location
loc

        -- This ensures that we only evaluate locations until
        -- a conclusive result is obtained, so we don't always
        -- have to inspect the maximum range of the command.
        Maybe Bool
result <- (Cosmic Location -> m (Maybe Bool))
-> [Cosmic Location] -> m (Maybe Bool)
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
(a -> m (Maybe b)) -> f a -> m (Maybe b)
firstJustM Cosmic Location -> m (Maybe Bool)
isConclusivelyVisibleM [Cosmic Location]
locsInDirection
        let foundBot :: Bool
foundBot = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
result
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn Bool
foundBot
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Whereami -> do
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Location -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Location -> CESK) -> Location -> CESK
forall a b. (a -> b) -> a -> b
$ Cosmic Location
loc Cosmic Location
-> Getting Location (Cosmic Location) Location -> Location
forall s a. s -> Getting a s a -> a
^. Getting Location (Cosmic Location) Location
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar
    Const
LocateMe -> do
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ (SubworldName, Location) -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Cosmic Location
loc Cosmic Location
-> Getting SubworldName (Cosmic Location) SubworldName
-> SubworldName
forall s a. s -> Getting a s a -> a
^. Getting SubworldName (Cosmic Location) SubworldName
forall a (f :: * -> *).
Functor f =>
(SubworldName -> f SubworldName) -> Cosmic a -> f (Cosmic a)
subworld, Cosmic Location
loc Cosmic Location
-> Getting Location (Cosmic Location) Location -> Location
forall s a. s -> Getting a s a -> a
^. Getting Location (Cosmic Location) Location
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar)
    Const
Waypoints -> case [Value]
vs of
      [VText Text
name] -> do
        Navigation (Map SubworldName) Location
lm <- Getting
  (Navigation (Map SubworldName) Location)
  GameState
  (Navigation (Map SubworldName) Location)
-> m (Navigation (Map SubworldName) Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (Navigation (Map SubworldName) Location)
   GameState
   (Navigation (Map SubworldName) Location)
 -> m (Navigation (Map SubworldName) Location))
-> Getting
     (Navigation (Map SubworldName) Location)
     GameState
     (Navigation (Map SubworldName) Location)
-> m (Navigation (Map SubworldName) Location)
forall a b. (a -> b) -> a -> b
$ (Landscape
 -> Const (Navigation (Map SubworldName) Location) Landscape)
-> GameState
-> Const (Navigation (Map SubworldName) Location) GameState
Lens' GameState Landscape
landscape ((Landscape
  -> Const (Navigation (Map SubworldName) Location) Landscape)
 -> GameState
 -> Const (Navigation (Map SubworldName) Location) GameState)
-> ((Navigation (Map SubworldName) Location
     -> Const
          (Navigation (Map SubworldName) Location)
          (Navigation (Map SubworldName) Location))
    -> Landscape
    -> Const (Navigation (Map SubworldName) Location) Landscape)
-> Getting
     (Navigation (Map SubworldName) Location)
     GameState
     (Navigation (Map SubworldName) Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Navigation (Map SubworldName) Location
 -> Const
      (Navigation (Map SubworldName) Location)
      (Navigation (Map SubworldName) Location))
-> Landscape
-> Const (Navigation (Map SubworldName) Location) Landscape
Lens' Landscape (Navigation (Map SubworldName) Location)
worldNavigation
        Cosmic SubworldName
swName Location
_ <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        let mwps :: Maybe (NonEmpty Location)
mwps = WaypointName
-> Map WaypointName (NonEmpty Location)
-> Maybe (NonEmpty Location)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> WaypointName
WaypointName Text
name) (Map WaypointName (NonEmpty Location) -> Maybe (NonEmpty Location))
-> Map WaypointName (NonEmpty Location)
-> Maybe (NonEmpty Location)
forall a b. (a -> b) -> a -> b
$ Map WaypointName (NonEmpty Location)
-> SubworldName
-> Map SubworldName (Map WaypointName (NonEmpty Location))
-> Map WaypointName (NonEmpty Location)
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Map WaypointName (NonEmpty Location)
forall a. Monoid a => a
mempty SubworldName
swName (Map SubworldName (Map WaypointName (NonEmpty Location))
 -> Map WaypointName (NonEmpty Location))
-> Map SubworldName (Map WaypointName (NonEmpty Location))
-> Map WaypointName (NonEmpty Location)
forall a b. (a -> b) -> a -> b
$ Navigation (Map SubworldName) Location
-> Map SubworldName (Map WaypointName (NonEmpty Location))
forall (additionalDimension :: * -> *) portalExitLoc.
Navigation additionalDimension portalExitLoc
-> additionalDimension (Map WaypointName (NonEmpty Location))
waypoints Navigation (Map SubworldName) Location
lm
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ [Location] -> CESK
forall a. Valuable a => a -> CESK
mkReturn ([Location] -> CESK) -> [Location] -> CESK
forall a b. (a -> b) -> a -> b
$ [Location]
-> (NonEmpty Location -> [Location])
-> Maybe (NonEmpty Location)
-> [Location]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty Location -> [Location]
forall a. NonEmpty a -> [a]
NE.toList Maybe (NonEmpty Location)
mwps
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Structures -> case [Value]
vs of
      [VText Text
name] -> do
        FoundRegistry RecognizableStructureContent Entity
registry <- Getting
  (FoundRegistry RecognizableStructureContent Entity)
  GameState
  (FoundRegistry RecognizableStructureContent Entity)
-> m (FoundRegistry RecognizableStructureContent Entity)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (FoundRegistry RecognizableStructureContent Entity)
   GameState
   (FoundRegistry RecognizableStructureContent Entity)
 -> m (FoundRegistry RecognizableStructureContent Entity))
-> Getting
     (FoundRegistry RecognizableStructureContent Entity)
     GameState
     (FoundRegistry RecognizableStructureContent Entity)
-> m (FoundRegistry RecognizableStructureContent Entity)
forall a b. (a -> b) -> a -> b
$ (Discovery
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> GameState
-> Const
     (FoundRegistry RecognizableStructureContent Entity) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const
       (FoundRegistry RecognizableStructureContent Entity) Discovery)
 -> GameState
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) GameState)
-> ((FoundRegistry RecognizableStructureContent Entity
     -> Const
          (FoundRegistry RecognizableStructureContent Entity)
          (FoundRegistry RecognizableStructureContent Entity))
    -> Discovery
    -> Const
         (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> Getting
     (FoundRegistry RecognizableStructureContent Entity)
     GameState
     (FoundRegistry RecognizableStructureContent Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognitionState RecognizableStructureContent Entity
 -> Const
      (FoundRegistry RecognizableStructureContent Entity)
      (RecognitionState RecognizableStructureContent Entity))
-> Discovery
-> Const
     (FoundRegistry RecognizableStructureContent Entity) Discovery
Lens'
  Discovery (RecognitionState RecognizableStructureContent Entity)
structureRecognition ((RecognitionState RecognizableStructureContent Entity
  -> Const
       (FoundRegistry RecognizableStructureContent Entity)
       (RecognitionState RecognizableStructureContent Entity))
 -> Discovery
 -> Const
      (FoundRegistry RecognizableStructureContent Entity) Discovery)
-> ((FoundRegistry RecognizableStructureContent Entity
     -> Const
          (FoundRegistry RecognizableStructureContent Entity)
          (FoundRegistry RecognizableStructureContent Entity))
    -> RecognitionState RecognizableStructureContent Entity
    -> Const
         (FoundRegistry RecognizableStructureContent Entity)
         (RecognitionState RecognizableStructureContent Entity))
-> (FoundRegistry RecognizableStructureContent Entity
    -> Const
         (FoundRegistry RecognizableStructureContent Entity)
         (FoundRegistry RecognizableStructureContent Entity))
-> Discovery
-> Const
     (FoundRegistry RecognizableStructureContent Entity) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundRegistry RecognizableStructureContent Entity
 -> Const
      (FoundRegistry RecognizableStructureContent Entity)
      (FoundRegistry RecognizableStructureContent Entity))
-> RecognitionState RecognizableStructureContent Entity
-> Const
     (FoundRegistry RecognizableStructureContent Entity)
     (RecognitionState RecognizableStructureContent Entity)
forall b1 a b2 (f :: * -> *).
Functor f =>
(FoundRegistry b1 a -> f (FoundRegistry b2 a))
-> RecognitionState b1 a -> f (RecognitionState b2 a)
foundStructures
        let maybeFoundStructures :: Maybe
  (NEMap
     (Cosmic Location, AbsoluteDir)
     (StructureWithGrid RecognizableStructureContent Entity))
maybeFoundStructures = StructureName
-> Map
     StructureName
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
-> Maybe
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> StructureName
StructureName Text
name) (Map
   StructureName
   (NEMap
      (Cosmic Location, AbsoluteDir)
      (StructureWithGrid RecognizableStructureContent Entity))
 -> Maybe
      (NEMap
         (Cosmic Location, AbsoluteDir)
         (StructureWithGrid RecognizableStructureContent Entity)))
-> Map
     StructureName
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
-> Maybe
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
forall a b. (a -> b) -> a -> b
$ FoundRegistry RecognizableStructureContent Entity
-> Map
     StructureName
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
forall b a.
FoundRegistry b a
-> Map
     StructureName
     (NEMap (Cosmic Location, AbsoluteDir) (StructureWithGrid b a))
foundByName FoundRegistry RecognizableStructureContent Entity
registry
            structures :: [((Cosmic Location, AbsoluteDir), StructureWithGrid RecognizableStructureContent Entity)]
            structures :: [((Cosmic Location, AbsoluteDir),
  StructureWithGrid RecognizableStructureContent Entity)]
structures = [((Cosmic Location, AbsoluteDir),
  StructureWithGrid RecognizableStructureContent Entity)]
-> (NEMap
      (Cosmic Location, AbsoluteDir)
      (StructureWithGrid RecognizableStructureContent Entity)
    -> [((Cosmic Location, AbsoluteDir),
         StructureWithGrid RecognizableStructureContent Entity)])
-> Maybe
     (NEMap
        (Cosmic Location, AbsoluteDir)
        (StructureWithGrid RecognizableStructureContent Entity))
-> [((Cosmic Location, AbsoluteDir),
     StructureWithGrid RecognizableStructureContent Entity)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (NonEmpty
  ((Cosmic Location, AbsoluteDir),
   StructureWithGrid RecognizableStructureContent Entity)
-> [((Cosmic Location, AbsoluteDir),
     StructureWithGrid RecognizableStructureContent Entity)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty
   ((Cosmic Location, AbsoluteDir),
    StructureWithGrid RecognizableStructureContent Entity)
 -> [((Cosmic Location, AbsoluteDir),
      StructureWithGrid RecognizableStructureContent Entity)])
-> (NEMap
      (Cosmic Location, AbsoluteDir)
      (StructureWithGrid RecognizableStructureContent Entity)
    -> NonEmpty
         ((Cosmic Location, AbsoluteDir),
          StructureWithGrid RecognizableStructureContent Entity))
-> NEMap
     (Cosmic Location, AbsoluteDir)
     (StructureWithGrid RecognizableStructureContent Entity)
-> [((Cosmic Location, AbsoluteDir),
     StructureWithGrid RecognizableStructureContent Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap
  (Cosmic Location, AbsoluteDir)
  (StructureWithGrid RecognizableStructureContent Entity)
-> NonEmpty
     ((Cosmic Location, AbsoluteDir),
      StructureWithGrid RecognizableStructureContent Entity)
forall k a. NEMap k a -> NonEmpty (k, a)
NEM.toList) Maybe
  (NEMap
     (Cosmic Location, AbsoluteDir)
     (StructureWithGrid RecognizableStructureContent Entity))
maybeFoundStructures

            bottomLeftCorner :: ((Cosmic (p Int32), b), StructureWithGrid b a) -> p Int32
bottomLeftCorner ((Cosmic (p Int32)
pos, b
_), StructureWithGrid b a
struc) = p Int32
topLeftCorner p Int32 -> Diff p Int32 -> p Int32
forall a. Num a => p a -> Diff p a -> p a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Heading
Diff p Int32
offsetHeight
             where
              topLeftCorner :: p Int32
topLeftCorner = Cosmic (p Int32)
pos Cosmic (p Int32)
-> Getting (p Int32) (Cosmic (p Int32)) (p Int32) -> p Int32
forall s a. s -> Getting a s a -> a
^. Getting (p Int32) (Cosmic (p Int32)) (p Int32)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar
              offsetHeight :: Heading
offsetHeight = Int32 -> Int32 -> Heading
forall a. a -> a -> V2 a
V2 Int32
0 (Int32 -> Heading) -> Int32 -> Heading
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32
forall a. Num a => a -> a
negate (AreaDimensions -> Int32
rectHeight (NonEmptyGrid (AtomicKeySymbol a) -> AreaDimensions
forall a. NonEmptyGrid a -> AreaDimensions
getNEGridDimensions (NonEmptyGrid (AtomicKeySymbol a) -> AreaDimensions)
-> NonEmptyGrid (AtomicKeySymbol a) -> AreaDimensions
forall a b. (a -> b) -> a -> b
$ ExtractedArea b a -> NonEmptyGrid (AtomicKeySymbol a)
forall b a. ExtractedArea b a -> NonEmptyGrid (AtomicKeySymbol a)
extractedGrid (ExtractedArea b a -> NonEmptyGrid (AtomicKeySymbol a))
-> ExtractedArea b a -> NonEmptyGrid (AtomicKeySymbol a)
forall a b. (a -> b) -> a -> b
$ StructureWithGrid b a -> ExtractedArea b a
forall b a. StructureWithGrid b a -> ExtractedArea b a
entityGrid StructureWithGrid b a
struc) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1)

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ [Location] -> CESK
forall a. Valuable a => a -> CESK
mkReturn ([Location] -> CESK) -> [Location] -> CESK
forall a b. (a -> b) -> a -> b
$ (((Cosmic Location, AbsoluteDir),
  StructureWithGrid RecognizableStructureContent Entity)
 -> Location)
-> [((Cosmic Location, AbsoluteDir),
     StructureWithGrid RecognizableStructureContent Entity)]
-> [Location]
forall a b. (a -> b) -> [a] -> [b]
map ((Cosmic Location, AbsoluteDir),
 StructureWithGrid RecognizableStructureContent Entity)
-> Location
forall {p :: * -> *} {b} {b} {a}.
(Diff p ~ V2, Affine p) =>
((Cosmic (p Int32), b), StructureWithGrid b a) -> p Int32
bottomLeftCorner [((Cosmic Location, AbsoluteDir),
  StructureWithGrid RecognizableStructureContent Entity)]
structures
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Floorplan -> case [Value]
vs of
      [VText Text
name] -> do
        Map
  StructureName (StructureInfo RecognizableStructureContent Entity)
structureTemplates <- Getting
  (Map
     StructureName (StructureInfo RecognizableStructureContent Entity))
  GameState
  (Map
     StructureName (StructureInfo RecognizableStructureContent Entity))
-> m (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (Map
      StructureName (StructureInfo RecognizableStructureContent Entity))
   GameState
   (Map
      StructureName (StructureInfo RecognizableStructureContent Entity))
 -> m (Map
         StructureName (StructureInfo RecognizableStructureContent Entity)))
-> Getting
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
-> m (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
forall a b. (a -> b) -> a -> b
$ (Landscape
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      Landscape)
-> GameState
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
Lens' GameState Landscape
landscape ((Landscape
  -> Const
       (Map
          StructureName (StructureInfo RecognizableStructureContent Entity))
       Landscape)
 -> GameState
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      GameState)
-> ((Map
       StructureName (StructureInfo RecognizableStructureContent Entity)
     -> Const
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity))
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity)))
    -> Landscape
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         Landscape)
-> Getting
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons RecognizableStructureContent Entity
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      (RecognizerAutomatons RecognizableStructureContent Entity))
-> Landscape
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     Landscape
Lens'
  Landscape
  (RecognizerAutomatons RecognizableStructureContent Entity)
recognizerAutomatons ((RecognizerAutomatons RecognizableStructureContent Entity
  -> Const
       (Map
          StructureName (StructureInfo RecognizableStructureContent Entity))
       (RecognizerAutomatons RecognizableStructureContent Entity))
 -> Landscape
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      Landscape)
-> ((Map
       StructureName (StructureInfo RecognizableStructureContent Entity)
     -> Const
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity))
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity)))
    -> RecognizerAutomatons RecognizableStructureContent Entity
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         (RecognizerAutomatons RecognizableStructureContent Entity))
-> (Map
      StructureName (StructureInfo RecognizableStructureContent Entity)
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity)))
-> Landscape
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   StructureName (StructureInfo RecognizableStructureContent Entity)
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity)))
-> RecognizerAutomatons RecognizableStructureContent Entity
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     (RecognizerAutomatons RecognizableStructureContent Entity)
forall b a (f :: * -> *).
Functor f =>
(Map StructureName (StructureInfo b a)
 -> f (Map StructureName (StructureInfo b a)))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
originalStructureDefinitions
        let maybeStructure :: Maybe (StructureInfo RecognizableStructureContent Entity)
maybeStructure = StructureName
-> Map
     StructureName (StructureInfo RecognizableStructureContent Entity)
-> Maybe (StructureInfo RecognizableStructureContent Entity)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> StructureName
StructureName Text
name) Map
  StructureName (StructureInfo RecognizableStructureContent Entity)
structureTemplates
        StructureInfo RecognizableStructureContent Entity
structureDef <-
          Maybe (StructureInfo RecognizableStructureContent Entity)
maybeStructure
            Maybe (StructureInfo RecognizableStructureContent Entity)
-> Exn -> m (StructureInfo RecognizableStructureContent Entity)
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Const -> [Text] -> Exn
cmdExn Const
Floorplan (Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"Unknown structure", Text -> Text
quote Text
name])
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK)
-> (NonEmptyGrid (Maybe Entity) -> CESK)
-> NonEmptyGrid (Maybe Entity)
-> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AreaDimensions -> CESK
forall a. Valuable a => a -> CESK
mkReturn (AreaDimensions -> CESK)
-> (NonEmptyGrid (Maybe Entity) -> AreaDimensions)
-> NonEmptyGrid (Maybe Entity)
-> CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyGrid (Maybe Entity) -> AreaDimensions
forall a. NonEmptyGrid a -> AreaDimensions
getNEGridDimensions (NonEmptyGrid (Maybe Entity) -> m CESK)
-> NonEmptyGrid (Maybe Entity) -> m CESK
forall a b. (a -> b) -> a -> b
$ StructureInfo RecognizableStructureContent Entity
-> NonEmptyGrid (Maybe Entity)
forall b a. StructureInfo b a -> NonEmptyGrid (AtomicKeySymbol a)
entityProcessedGrid StructureInfo RecognizableStructureContent Entity
structureDef
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
HasTag -> case [Value]
vs of
      [VText Text
eName, VText Text
tName] -> do
        EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
        Entity
e <-
          Text -> EntityMap -> Maybe Entity
lookupEntityName Text
eName EntityMap
em
            Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"I've never heard of", Text -> Text
indefiniteQ Text
eName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Bool -> CESK) -> Bool -> CESK
forall a b. (a -> b) -> a -> b
$ Text
tName Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` (Entity
e Entity -> Getting (Set Text) Entity (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. Getting (Set Text) Entity (Set Text)
Lens' Entity (Set Text)
entityTags)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
TagMembers -> case [Value]
vs of
      [VText Text
tagName] -> do
        Map Text (NonEmpty Text)
tm <- Getting
  (Map Text (NonEmpty Text)) GameState (Map Text (NonEmpty Text))
-> m (Map Text (NonEmpty Text))
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (Map Text (NonEmpty Text)) GameState (Map Text (NonEmpty Text))
 -> m (Map Text (NonEmpty Text)))
-> Getting
     (Map Text (NonEmpty Text)) GameState (Map Text (NonEmpty Text))
-> m (Map Text (NonEmpty Text))
forall a b. (a -> b) -> a -> b
$ (Discovery -> Const (Map Text (NonEmpty Text)) Discovery)
-> GameState -> Const (Map Text (NonEmpty Text)) GameState
Lens' GameState Discovery
discovery ((Discovery -> Const (Map Text (NonEmpty Text)) Discovery)
 -> GameState -> Const (Map Text (NonEmpty Text)) GameState)
-> ((Map Text (NonEmpty Text)
     -> Const (Map Text (NonEmpty Text)) (Map Text (NonEmpty Text)))
    -> Discovery -> Const (Map Text (NonEmpty Text)) Discovery)
-> Getting
     (Map Text (NonEmpty Text)) GameState (Map Text (NonEmpty Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text (NonEmpty Text)
 -> Const (Map Text (NonEmpty Text)) (Map Text (NonEmpty Text)))
-> Discovery -> Const (Map Text (NonEmpty Text)) Discovery
Lens' Discovery (Map Text (NonEmpty Text))
tagMembers
        case Text -> Map Text (NonEmpty Text) -> Maybe (NonEmpty Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
tagName Map Text (NonEmpty Text)
tm of
          Maybe (NonEmpty Text)
Nothing -> Exn -> m CESK
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m CESK) -> Exn -> m CESK
forall a b. (a -> b) -> a -> b
$ Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed Const
TagMembers ([Text] -> Text
T.unwords [Text
"No tag named", Text
tagName]) Maybe GameplayAchievement
forall a. Maybe a
Nothing
          Just NonEmpty Text
theMembers -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn NonEmpty Text
theMembers
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Detect -> case [Value]
vs of
      [VText Text
name, VRect Integer
x1 Integer
y1 Integer
x2 Integer
y2] -> do
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        let locs :: [Heading]
locs = Integer -> Integer -> Integer -> Integer -> [Heading]
rectCells Integer
x1 Integer
y1 Integer
x2 Integer
y2
        -- sort offsets by (Manhattan) distance so that we return the closest occurrence
        let sortedOffsets :: [Heading]
sortedOffsets = (Heading -> Int32) -> [Heading] -> [Heading]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(V2 Int32
x Int32
y) -> Int32 -> Int32
forall a. Num a => a -> a
abs Int32
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32 -> Int32
forall a. Num a => a -> a
abs Int32
y) [Heading]
locs
        let f :: Heading -> m Bool
f = (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Entity -> Bool) -> Maybe Entity -> Bool)
-> (Entity -> Bool) -> Maybe Entity -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entity -> Bool
isEntityNamed Text
name) (m (Maybe Entity) -> m Bool)
-> (Heading -> m (Maybe Entity)) -> Heading -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt (Cosmic Location -> m (Maybe Entity))
-> (Heading -> Cosmic Location) -> Heading -> m (Maybe Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc
        Maybe Heading
firstOne <- (Heading -> m Bool) -> [Heading] -> m (Maybe Heading)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m (Maybe a)
findM Heading -> m Bool
f [Heading]
sortedOffsets
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Heading -> CESK
forall a. Valuable a => a -> CESK
mkReturn Maybe Heading
firstOne
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Resonate -> case [Value]
vs of
      [VText Text
name, VRect Integer
x1 Integer
y1 Integer
x2 Integer
y2] -> (Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
doResonate (Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Entity -> Bool) -> Maybe Entity -> Bool)
-> (Entity -> Bool) -> Maybe Entity -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entity -> Bool
isEntityNamed Text
name) Integer
x1 Integer
y1 Integer
x2 Integer
y2
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Density -> case [Value]
vs of
      [VRect Integer
x1 Integer
y1 Integer
x2 Integer
y2] -> (Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
doResonate Maybe Entity -> Bool
forall a. Maybe a -> Bool
isJust Integer
x1 Integer
y1 Integer
x2 Integer
y2
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Sniff -> case [Value]
vs of
      [VText Text
name] -> do
        Maybe (Int32, Heading)
firstFound <- Text -> m (Maybe (Int32, Heading))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m (Maybe (Int32, Heading))
findNearest Text
name
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Int32 -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Int32 -> CESK) -> Int32 -> CESK
forall a b. (a -> b) -> a -> b
$ Int32
-> ((Int32, Heading) -> Int32) -> Maybe (Int32, Heading) -> Int32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int32
1) (Int32, Heading) -> Int32
forall a b. (a, b) -> a
fst Maybe (Int32, Heading)
firstFound
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Watch -> case [Value]
vs of
      [VDir Direction
d] -> do
        (Cosmic Location
loc, Maybe Entity
_me) <- Direction -> m (Cosmic Location, Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
        Cosmic Location -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m ()
addWatchedLocation Cosmic Location
loc
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Surveil -> case [Value]
vs of
      [VPair (VInt Integer
x) (VInt Integer
y)] -> do
        Cosmic SubworldName
swName Location
_ <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        let loc :: Cosmic Location
loc = SubworldName -> Location -> Cosmic Location
forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
swName (Location -> Cosmic Location) -> Location -> Cosmic Location
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Location
Location (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
        Cosmic Location -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m ()
addWatchedLocation Cosmic Location
loc
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Chirp -> case [Value]
vs of
      [VText Text
name] -> do
        Maybe (Int32, Heading)
firstFound <- Text -> m (Maybe (Int32, Heading))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m (Maybe (Int32, Heading))
findNearest Text
name
        Maybe Heading
mh <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
        Inventory
inst <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
        let processDirection :: AbsoluteDir -> Maybe Direction
processDirection AbsoluteDir
entityDir =
              if Text -> Inventory -> Int
countByName Text
"compass" Inventory
inst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
                then Direction -> Maybe Direction
forall a. a -> Maybe a
Just (Direction -> Maybe Direction) -> Direction -> Maybe Direction
forall a b. (a -> b) -> a -> b
$ AbsoluteDir -> Direction
DAbsolute AbsoluteDir
entityDir
                else case Maybe Heading
mh Maybe Heading -> (Heading -> Maybe Direction) -> Maybe Direction
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Heading -> Maybe Direction
toDirection of
                  Just (DAbsolute AbsoluteDir
robotDir) ->
                    Direction -> Maybe Direction
forall a. a -> Maybe a
Just (Direction -> Maybe Direction)
-> (PlanarRelativeDir -> Direction)
-> PlanarRelativeDir
-> Maybe Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativeDir -> Direction
DRelative (RelativeDir -> Direction)
-> (PlanarRelativeDir -> RelativeDir)
-> PlanarRelativeDir
-> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarRelativeDir -> RelativeDir
DPlanar (PlanarRelativeDir -> Maybe Direction)
-> PlanarRelativeDir -> Maybe Direction
forall a b. (a -> b) -> a -> b
$ AbsoluteDir
entityDir AbsoluteDir -> AbsoluteDir -> PlanarRelativeDir
`relativeTo` AbsoluteDir
robotDir
                  Maybe Direction
_ -> Maybe Direction
forall a. Maybe a
Nothing -- This may happen if the robot is facing "down"
            d :: Direction
d = Direction -> Maybe Direction -> Direction
forall a. a -> Maybe a -> a
fromMaybe (RelativeDir -> Direction
DRelative RelativeDir
DDown) (Maybe Direction -> Direction) -> Maybe Direction -> Direction
forall a b. (a -> b) -> a -> b
$ do
              (Int32, Heading)
entLoc <- Maybe (Int32, Heading)
firstFound
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Int32, Heading) -> Heading
forall a b. (a, b) -> b
snd (Int32, Heading)
entLoc Heading -> Heading -> Bool
forall a. Eq a => a -> a -> Bool
/= Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
              AbsoluteDir -> Maybe Direction
processDirection (AbsoluteDir -> Maybe Direction)
-> ((Int32, Heading) -> AbsoluteDir)
-> (Int32, Heading)
-> Maybe Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heading -> AbsoluteDir
nearestDirection (Heading -> AbsoluteDir)
-> ((Int32, Heading) -> Heading) -> (Int32, Heading) -> AbsoluteDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32, Heading) -> Heading
forall a b. (a, b) -> b
snd ((Int32, Heading) -> Maybe Direction)
-> (Int32, Heading) -> Maybe Direction
forall a b. (a -> b) -> a -> b
$ (Int32, Heading)
entLoc
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Direction -> CESK
forall a. Valuable a => a -> CESK
mkReturn Direction
d
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Heading -> do
      Maybe Heading
mh <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
      -- In general, (1) entities might not have an orientation, and
      -- (2) even if they do, orientation is a general vector, which
      -- might not correspond to a cardinal direction.  We could make
      -- 'heading' return a @Maybe Dir@ (/i.e./ @Unit + Dir@), or return a
      -- vector of type @Int * Int@, but those would both be annoying
      -- for players in the vast majority of cases.  We rather choose
      -- to just return the direction 'down' in any case where we don't
      -- otherwise have anything reasonable to return.
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK)
-> (Maybe Direction -> CESK) -> Maybe Direction -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Direction -> CESK)
-> (Maybe Direction -> Direction) -> Maybe Direction -> CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Maybe Direction -> Direction
forall a. a -> Maybe a -> a
fromMaybe (RelativeDir -> Direction
DRelative RelativeDir
DDown) (Maybe Direction -> m CESK) -> Maybe Direction -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Heading
mh Maybe Heading -> (Heading -> Maybe Direction) -> Maybe Direction
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Heading -> Maybe Direction
toDirection
    Const
Time -> do
      TickNumber Int64
t <- Getting TickNumber GameState TickNumber -> m TickNumber
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting TickNumber GameState TickNumber -> m TickNumber)
-> Getting TickNumber GameState TickNumber -> m TickNumber
forall a b. (a -> b) -> a -> b
$ (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
t) Store
s Cont
k
    Const
Drill -> case [Value]
vs of
      [VDir Direction
d] -> Direction -> m CESK
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Algebra sig m, Member (Throw Exn) sig, Member (State Robot) sig,
 Member (State GameState) sig) =>
Direction -> m CESK
doDrill Direction
d
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Use -> case [Value]
vs of
      [VText Text
deviceName, VDir Direction
d] -> do
        Inventory
ins <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
        Entity
equippedEntity <- Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
ensureEquipped Text
deviceName
        let verbPhrase :: Text
verbPhrase = [Text] -> Text
T.unwords [Text
"use", Text
deviceName, Text
"on"]
        Inventory -> Text -> Direction -> Entity -> m CESK
forall {m :: * -> *} {sig :: (* -> *) -> * -> *} {p}.
(Algebra sig m, Eq p, Member (Throw Exn) sig,
 Member (State Robot) sig, Member (State GameState) sig,
 Member (Reader (Recipe p)) (Reader (Recipe Entity))) =>
Inventory -> Text -> Direction -> p -> m CESK
applyDevice Inventory
ins Text
verbPhrase Direction
d Entity
equippedEntity
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Blocked -> do
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      Maybe Heading
orientation <- Getting (Maybe Heading) Robot (Maybe Heading) -> m (Maybe Heading)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation
      let nextLoc :: Cosmic Location
nextLoc = Cosmic Location
loc Cosmic Location -> Heading -> Cosmic Location
`offsetBy` (Maybe Heading
orientation Maybe Heading -> Heading -> Heading
forall a. Maybe a -> a -> a
? Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
      Maybe Entity
me <- Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
nextLoc
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Bool -> CESK) -> Bool -> CESK
forall a b. (a -> b) -> a -> b
$ Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Unwalkable) Maybe Entity
me
    Const
Scan -> case [Value]
vs of
      [VDir Direction
d] -> do
        (Cosmic Location
_loc, Maybe Entity
me) <- Direction -> m (Cosmic Location, Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
        Maybe Entity -> (Entity -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Entity
me ((Entity -> m ()) -> m ()) -> (Entity -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Entity
e -> do
          (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> Entity -> Inventory -> Inventory
insertCount Int
0 Entity
e
          Entity -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e
          -- Flag the world for a redraw since scanning something may
          -- change the way it is drawn (if the base is doing the
          -- scanning)
          m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Entity -> CESK
forall a. Valuable a => a -> CESK
mkReturn Maybe Entity
me
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Knows -> case [Value]
vs of
      [VText Text
name] -> do
        Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
        Inventory
ins <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
        let allKnown :: Inventory
allKnown = Inventory
inv Inventory -> Inventory -> Inventory
`E.union` Inventory
ins
        let knows :: Bool
knows = case Text -> Inventory -> [Entity]
E.lookupByName Text
name Inventory
allKnown of
              [] -> Bool
False
              [Entity]
_ -> Bool
True
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn Bool
knows
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Upload -> case [Value]
vs of
      [VRobot Int
otherID] -> do
        -- Make sure the other robot exists and is close
        Robot
_other <- Int -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> m Robot
getRobotWithinTouch Int
otherID

        -- Upload knowledge of everything in our inventory
        Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
        IngredientList Entity -> ((Int, Entity) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Inventory -> IngredientList Entity
elems Inventory
inv) (((Int, Entity) -> m ()) -> m ())
-> ((Int, Entity) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, Entity
e) ->
          (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((Inventory -> Identity Inventory) -> Robots -> Identity Robots)
-> (Inventory -> Identity Inventory)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Inventory -> Identity Inventory)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Inventory -> Identity Inventory)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
otherID ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Inventory -> Identity Inventory)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (Inventory -> Identity Inventory)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory)
 -> GameState -> Identity GameState)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> Entity -> Inventory -> Inventory
insertCount Int
0 Entity
e

        -- Upload our log
        Seq LogEntry
rlog <- Getting (Seq LogEntry) Robot (Seq LogEntry) -> m (Seq LogEntry)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Seq LogEntry) Robot (Seq LogEntry)
Lens' Robot (Seq LogEntry)
robotLog
        (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Robots -> Identity Robots)
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
otherID ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Maybe Robot -> Identity (Maybe Robot))
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Robot -> Identity Robot)
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Identity (Seq LogEntry))
-> Robot -> Identity Robot
Lens' Robot (Seq LogEntry)
robotLog ((Seq LogEntry -> Identity (Seq LogEntry))
 -> GameState -> Identity GameState)
-> Seq LogEntry -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Seq LogEntry
rlog

        -- Flag the world for redraw since uploading may change the
        -- base's knowledge and hence how entities are drawn (if they
        -- go from unknown to known).
        m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Random -> case [Value]
vs of
      [VInt Integer
hi] -> do
        Integer
n <- (Integer, Integer) -> m Integer
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Integer
0, Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Integer -> CESK
forall a. Valuable a => a -> CESK
mkReturn Integer
n
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Atomic -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m CESK
goAtomic
    Const
Instant -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m CESK
goAtomic
    Const
As -> case [Value]
vs of
      [VRobot Int
rid, Value
prog] -> do
        Robot
r <- Int -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID Int
rid m (Maybe Robot) -> (Maybe Robot -> m Robot) -> m Robot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Robot -> [Text] -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no actor with ID", String -> Text
forall source target. From source target => source -> target
from (Int -> String
forall a. Show a => a -> String
show Int
rid)])
        Value
v <- Store -> Robot -> Value -> m Value
runChildProg Store
s Robot
r Value
prog

        -- Return the value returned by the hypothetical command.
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
RobotNamed -> case [Value]
vs of
      [VText Text
rname] -> do
        Robot
r <- Text -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Text -> m (Maybe Robot)
robotWithName Text
rname m (Maybe Robot) -> (Maybe Robot -> m Robot) -> m Robot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Robot -> [Text] -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot named", Text
rname])
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Robot -> CESK
forall a. Valuable a => a -> CESK
mkReturn Robot
r
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
RobotNumbered -> case [Value]
vs of
      [VInt Integer
rid] -> do
        Robot
r <-
          Int -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
rid)
            m (Maybe Robot) -> (Maybe Robot -> m Robot) -> m Robot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Robot -> [Text] -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot with number", String -> Text
forall source target. From source target => source -> target
from (Integer -> String
forall a. Show a => a -> String
show Integer
rid)])
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Robot -> CESK
forall a. Valuable a => a -> CESK
mkReturn Robot
r
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Say -> case [Value]
vs of
      [VText Text
msg] -> do
        Bool
isPrivileged <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        -- current robot will be inserted into the robot set, so it needs the log
        LogEntry
m <- RobotLogSource -> Severity -> Text -> m LogEntry
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
traceLog RobotLogSource
Said Severity
Info Text
msg
        LogEntry -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
m
        let addToRobotLog :: (Has (State GameState) sgn m) => Robot -> m ()
            addToRobotLog :: forall (sgn :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sgn m =>
Robot -> m ()
addToRobotLog Robot
r = Robot -> StateC Robot m () -> m ()
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState Robot
r (StateC Robot m () -> m ()) -> StateC Robot m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
              Bool
hasLog <- Capability -> StateC Robot m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability (Capability -> StateC Robot m Bool)
-> Capability -> StateC Robot m Bool
forall a b. (a -> b) -> a -> b
$ Const -> Capability
CExecute Const
Log
              Bool
hasListen <- Capability -> StateC Robot m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability (Capability -> StateC Robot m Bool)
-> Capability -> StateC Robot m Bool
forall a b. (a -> b) -> a -> b
$ Const -> Capability
CExecute Const
Listen
              Int
rid <- Getting Int Robot Int -> StateC Robot m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
              Bool -> StateC Robot m () -> StateC Robot m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLog Bool -> Bool -> Bool
&& Bool
hasListen) (StateC Robot m () -> StateC Robot m ())
-> StateC Robot m () -> StateC Robot m ()
forall a b. (a -> b) -> a -> b
$
                (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Robots -> Identity Robots)
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
rid ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Maybe Robot -> Identity (Maybe Robot))
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Robot -> Identity Robot)
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Identity (Seq LogEntry))
-> Robot -> Identity Robot
Lens' Robot (Seq LogEntry)
robotLog ((Seq LogEntry -> Identity (Seq LogEntry))
 -> GameState -> Identity GameState)
-> (Seq LogEntry -> Seq LogEntry) -> StateC Robot m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq LogEntry -> LogEntry -> Seq LogEntry
forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
m)
        [Robot]
robotsAround <-
          StateC Robots Identity [Robot] -> m [Robot]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity [Robot] -> m [Robot])
-> StateC Robots Identity [Robot] -> m [Robot]
forall a b. (a -> b) -> a -> b
$
            if Bool
isPrivileged
              then Getting [Robot] Robots [Robot] -> StateC Robots Identity [Robot]
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting [Robot] Robots [Robot] -> StateC Robots Identity [Robot])
-> Getting [Robot] Robots [Robot] -> StateC Robots Identity [Robot]
forall a b. (a -> b) -> a -> b
$ (IntMap Robot -> Const [Robot] (IntMap Robot))
-> Robots -> Const [Robot] Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Const [Robot] (IntMap Robot))
 -> Robots -> Const [Robot] Robots)
-> (([Robot] -> Const [Robot] [Robot])
    -> IntMap Robot -> Const [Robot] (IntMap Robot))
-> Getting [Robot] Robots [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> [Robot])
-> ([Robot] -> Const [Robot] [Robot])
-> IntMap Robot
-> Const [Robot] (IntMap Robot)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to IntMap Robot -> [Robot]
forall a. IntMap a -> [a]
IM.elems
              else (Robots -> [Robot]) -> StateC Robots Identity [Robot]
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
gets ((Robots -> [Robot]) -> StateC Robots Identity [Robot])
-> (Robots -> [Robot]) -> StateC Robots Identity [Robot]
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> Int32 -> Robots -> [Robot]
robotsInArea Cosmic Location
loc Int32
forall i. Num i => i
hearingDistance
        (Robot -> m ()) -> [Robot] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Robot -> m ()
forall (sgn :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sgn m =>
Robot -> m ()
addToRobotLog [Robot]
robotsAround
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Listen -> do
      GameState
gs <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      Int
rid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
      Bool
isPrivileged <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
      Seq LogEntry
mq <- Getting (Seq LogEntry) GameState (Seq LogEntry) -> m (Seq LogEntry)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting (Seq LogEntry) GameState (Seq LogEntry)
 -> m (Seq LogEntry))
-> Getting (Seq LogEntry) GameState (Seq LogEntry)
-> m (Seq LogEntry)
forall a b. (a -> b) -> a -> b
$ (Messages -> Const (Seq LogEntry) Messages)
-> GameState -> Const (Seq LogEntry) GameState
Lens' GameState Messages
messageInfo ((Messages -> Const (Seq LogEntry) Messages)
 -> GameState -> Const (Seq LogEntry) GameState)
-> ((Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
    -> Messages -> Const (Seq LogEntry) Messages)
-> Getting (Seq LogEntry) GameState (Seq LogEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
-> Messages -> Const (Seq LogEntry) Messages
Lens' Messages (Seq LogEntry)
messageQueue
      let isClose :: LogEntry -> Bool
isClose LogEntry
e = Bool
isPrivileged Bool -> Bool -> Bool
|| Cosmic Location -> LogEntry -> Bool
messageIsFromNearby Cosmic Location
loc LogEntry
e
          notMine :: LogEntry -> Bool
notMine LogEntry
e = case LogEntry
e LogEntry -> Getting LogSource LogEntry LogSource -> LogSource
forall s a. s -> Getting a s a -> a
^. Getting LogSource LogEntry LogSource
Lens' LogEntry LogSource
leSource of
            SystemLog {} -> Bool
False
            RobotLog RobotLogSource
_ Int
lrid Cosmic Location
_ -> Int
rid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lrid
          limitLast :: Seq LogEntry -> Maybe Text
limitLast = \case
            Seq LogEntry
_s Seq.:|> LogEntry
l -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LogEntry
l LogEntry -> Getting Text LogEntry Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text LogEntry Text
Lens' LogEntry Text
leText
            Seq LogEntry
_ -> Maybe Text
forall a. Maybe a
Nothing
          mm :: Maybe Text
mm = Seq LogEntry -> Maybe Text
limitLast (Seq LogEntry -> Maybe Text)
-> (Seq LogEntry -> Seq LogEntry) -> Seq LogEntry -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogEntry -> Bool) -> Seq LogEntry -> Seq LogEntry
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((Bool -> Bool -> Bool)
-> (LogEntry -> Bool) -> (LogEntry -> Bool) -> LogEntry -> Bool
forall a b c.
(a -> b -> c)
-> (LogEntry -> a) -> (LogEntry -> b) -> LogEntry -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) LogEntry -> Bool
notMine LogEntry -> Bool
isClose) (Seq LogEntry -> Maybe Text) -> Seq LogEntry -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (LogEntry -> Bool) -> Seq LogEntry -> Seq LogEntry
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR (GameState -> LogEntry -> Bool
messageIsRecent GameState
gs) Seq LogEntry
mq
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$
        CESK -> (Text -> CESK) -> Maybe Text -> CESK
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Term -> Env -> Store -> Cont -> CESK
In (Const -> Term
forall ty. Const -> Term' ty
TConst Const
Listen) Env
emptyEnv Store
s (Frame
FExec Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)) -- continue listening
          (\Text
m -> Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
m) Store
s Cont
k) -- return found message
          Maybe Text
mm
    Const
Log -> case [Value]
vs of
      [VText Text
msg] -> do
        m LogEntry -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m LogEntry -> m ()) -> m LogEntry -> m ()
forall a b. (a -> b) -> a -> b
$ RobotLogSource -> Severity -> Text -> m LogEntry
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
traceLog RobotLogSource
Logged Severity
Info Text
msg
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
View -> case [Value]
vs of
      [VRobot Int
rid] -> do
        -- Only the base can actually change the view in the UI.  Other robots can
        -- execute this command but it does nothing (at least for now).
        Int
rn <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Int -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID Int
rid m (Maybe Robot) -> (Maybe Robot -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            -- If the robot does not exist...
            Maybe Robot
Nothing -> do
              Bool
cr <- Getting Bool GameState Bool -> m Bool
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
              Bool
ws <- Getting Bool GameState Bool -> m Bool
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting Bool GameState Bool -> m Bool)
-> Getting Bool GameState Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const Bool Landscape)
-> GameState -> Const Bool GameState
Lens' GameState Landscape
landscape ((Landscape -> Const Bool Landscape)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool) -> Landscape -> Const Bool Landscape)
-> Getting Bool GameState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Landscape -> Const Bool Landscape
Lens' Landscape Bool
worldScrollable
              case Bool
cr Bool -> Bool -> Bool
|| Bool
ws of
                -- If we are in creative mode or allowed to scroll, then we are allowed
                -- to learn that the robot doesn't exist.
                Bool
True -> Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m ()) -> Exn -> m ()
forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
c [Text
"There is no actor with ID", String -> Text
forall source target. From source target => source -> target
from (Int -> String
forall a. Show a => a -> String
show Int
rid), Text
"to view."]
                -- Otherwise, "unfocus" from any robot, which
                -- means the world view will turn to static.  The
                -- point is that there's no way to tell the difference
                -- between this situation and the situation where the
                -- robot exists but is too far away.
                Bool
False -> (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> (Robots -> Robots) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Robots -> Robots
unfocus

            -- If it does exist, set it as the view center.
            Just Robot
_ -> (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((ViewCenterRule -> Identity ViewCenterRule)
    -> Robots -> Identity Robots)
-> (ViewCenterRule -> Identity ViewCenterRule)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ViewCenterRule -> Identity ViewCenterRule)
-> Robots -> Identity Robots
Lens' Robots ViewCenterRule
viewCenterRule ((ViewCenterRule -> Identity ViewCenterRule)
 -> GameState -> Identity GameState)
-> ViewCenterRule -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Int -> ViewCenterRule
VCRobot Int
rid

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Appear -> case [Value]
vs of
      [VText Text
app, VInj Bool
hasAttr Value
mattr] -> do
        -- Set the robot's display character(s)
        case forall target source. From source target => source -> target
into @String Text
app of
          [Char
dc] -> do
            (Display -> Identity Display) -> Robot -> Identity Robot
Lens' Robot Display
robotDisplay ((Display -> Identity Display) -> Robot -> Identity Robot)
-> ((Char -> Identity Char) -> Display -> Identity Display)
-> (Char -> Identity Char)
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Identity Char) -> Display -> Identity Display
Lens' Display Char
defaultChar ((Char -> Identity Char) -> Robot -> Identity Robot)
-> Char -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
dc
            (Display -> Identity Display) -> Robot -> Identity Robot
Lens' Robot Display
robotDisplay ((Display -> Identity Display) -> Robot -> Identity Robot)
-> ((Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
    -> Display -> Identity Display)
-> (Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
-> Display -> Identity Display
Lens' Display (Map AbsoluteDir Char)
orientationMap ((Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
 -> Robot -> Identity Robot)
-> Map AbsoluteDir Char -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Map AbsoluteDir Char
forall k a. Map k a
M.empty
          [Char
dc, Char
nc, Char
ec, Char
sc, Char
wc] -> do
            (Display -> Identity Display) -> Robot -> Identity Robot
Lens' Robot Display
robotDisplay ((Display -> Identity Display) -> Robot -> Identity Robot)
-> ((Char -> Identity Char) -> Display -> Identity Display)
-> (Char -> Identity Char)
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Identity Char) -> Display -> Identity Display
Lens' Display Char
defaultChar ((Char -> Identity Char) -> Robot -> Identity Robot)
-> Char -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
dc
            (Display -> Identity Display) -> Robot -> Identity Robot
Lens' Robot Display
robotDisplay
              ((Display -> Identity Display) -> Robot -> Identity Robot)
-> ((Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
    -> Display -> Identity Display)
-> (Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
-> Display -> Identity Display
Lens' Display (Map AbsoluteDir Char)
orientationMap
              ((Map AbsoluteDir Char -> Identity (Map AbsoluteDir Char))
 -> Robot -> Identity Robot)
-> Map AbsoluteDir Char -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= [(AbsoluteDir, Char)] -> Map AbsoluteDir Char
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                [ (AbsoluteDir
DNorth, Char
nc)
                , (AbsoluteDir
DEast, Char
ec)
                , (AbsoluteDir
DSouth, Char
sc)
                , (AbsoluteDir
DWest, Char
wc)
                ]
          String
_other ->
            Const -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> [Text] -> m a
raise
              Const
Appear
              [ Text -> Text
quote Text
app
              , Text
"is not a valid appearance string."
              , Text
"'appear' must be given a string with exactly 1 or 5 characters."
              ]

        -- Possibly set the display attribute
        case (Bool
hasAttr, Value
mattr) of
          (Bool
True, VText Text
attr) -> (Display -> Identity Display) -> Robot -> Identity Robot
Lens' Robot Display
robotDisplay ((Display -> Identity Display) -> Robot -> Identity Robot)
-> ((Attribute -> Identity Attribute)
    -> Display -> Identity Display)
-> (Attribute -> Identity Attribute)
-> Robot
-> Identity Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attribute -> Identity Attribute) -> Display -> Identity Display
Lens' Display Attribute
displayAttr ((Attribute -> Identity Attribute) -> Robot -> Identity Robot)
-> Attribute -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Text -> Attribute
readAttribute Text
attr
          (Bool, Value)
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Create -> case [Value]
vs of
      [VText Text
name] -> do
        EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
        Entity
e <-
          Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em
            Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"I've never heard of", Text -> Text
indefiniteQ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
e
        Entity -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Halt -> case [Value]
vs of
      [VRobot Int
targetID] -> do
        Int
myID <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
        case Int
myID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
targetID of
          -- To halt ourselves, just return a cancelled CESK machine.
          -- It will be reinstalled as our current machine; then,
          -- based on the fact that our CESK machine is done we will
          -- be put to sleep and the REPL will be reset if we are the
          -- base robot.
          Bool
True -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ CESK -> CESK
cancel (CESK -> CESK) -> CESK -> CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
          Bool
False -> do
            -- Make sure the other robot exists and is close enough.
            Robot
target <- Int -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> m Robot
getRobotWithinTouch Int
targetID
            -- Make sure either we are privileged, OR the target robot
            -- is NOT.  In other words unprivileged bots should not be
            -- able to halt privileged ones.
            Bool
omni <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
            case Bool
omni Bool -> Bool -> Bool
|| Bool -> Bool
not (Robot
target Robot -> Getting Bool Robot Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Robot Bool
Lens' Robot Bool
systemRobot) of
              Bool
True -> StateC Robots Identity CESK -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity CESK -> m CESK)
-> StateC Robots Identity CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ do
                -- Cancel its CESK machine, and wake it up to ensure
                -- it can do cleanup + run to completion.
                (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((CESK -> Identity CESK)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (CESK -> Identity CESK)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
targetID ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((CESK -> Identity CESK)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (CESK -> Identity CESK)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine ((CESK -> Identity CESK) -> Robots -> Identity Robots)
-> (CESK -> CESK) -> StateC Robots Identity ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= CESK -> CESK
cancel
                Int -> StateC Robots Identity ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
Int -> m ()
activateRobot Int
targetID
                CESK -> StateC Robots Identity CESK
forall a. a -> StateC Robots Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> StateC Robots Identity CESK)
-> CESK -> StateC Robots Identity CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
              Bool
False -> Exn -> m CESK
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m CESK) -> Exn -> m CESK
forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
c [Text
"You are not authorized to halt that robot."]
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Ishere -> case [Value]
vs of
      [VText Text
name] -> do
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Maybe Entity
me <- Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
        let here :: Bool
here = Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Entity -> Bool
isEntityNamed Text
name) Maybe Entity
me
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn Bool
here
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Isempty -> do
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      Maybe Entity
me <- Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Bool -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Bool -> CESK) -> Bool -> CESK
forall a b. (a -> b) -> a -> b
$ Maybe Entity -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Entity
me
    Const
Self -> do
      Int
rid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Int -> Value
VRobot Int
rid) Store
s Cont
k
    Const
Parent -> do
      Maybe Int
mp <- Getting (Maybe Int) Robot (Maybe Int) -> m (Maybe Int)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Maybe Int) Robot (Maybe Int)
Lens' Robot (Maybe Int)
robotParentID
      Int
rid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Int -> Value
VRobot (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
rid Maybe Int
mp)) Store
s Cont
k
    Const
Base -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Int -> Value
VRobot Int
0) Store
s Cont
k
    Const
Meet -> do
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      Int
rid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
      GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
      let neighbor :: Maybe Robot
neighbor =
            (Robot -> Bool) -> [Robot] -> Maybe Robot
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
rid) (Int -> Bool) -> (Robot -> Int) -> Robot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID)) -- pick one other than ourself
              ([Robot] -> Maybe Robot)
-> (Robots -> [Robot]) -> Robots -> Maybe Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Int32) -> [Robot] -> [Robot]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Location -> Location -> Int32
manhattan (Location -> Location -> Int32)
-> (Cosmic Location -> Location)
-> Cosmic Location
-> Cosmic Location
-> Int32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Location (Cosmic Location) Location
-> Cosmic Location -> Location
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting Location (Cosmic Location) Location
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar) Cosmic Location
loc (Cosmic Location -> Int32)
-> (Robot -> Cosmic Location) -> Robot -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot
-> Getting (Cosmic Location) Robot (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation)) -- prefer closer
              ([Robot] -> [Robot]) -> (Robots -> [Robot]) -> Robots -> [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Bool) -> [Robot] -> [Robot]
forall a. (a -> Bool) -> [a] -> [a]
filter Robot -> Bool
isInteractive
              ([Robot] -> [Robot]) -> (Robots -> [Robot]) -> Robots -> [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Int32 -> Robots -> [Robot]
robotsInArea Cosmic Location
loc Int32
1
              (Robots -> Maybe Robot) -> Robots -> Maybe Robot
forall a b. (a -> b) -> a -> b
$ GameState
g GameState -> Getting Robots GameState Robots -> Robots
forall s a. s -> Getting a s a -> a
^. Getting Robots GameState Robots
Lens' GameState Robots
robotInfo -- all robots within Manhattan distance 1
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Maybe Robot -> CESK
forall a. Valuable a => a -> CESK
mkReturn Maybe Robot
neighbor
    Const
MeetAll -> do
      Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
      Int
rid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
      GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
      let neighborIDs :: [Robot]
neighborIDs = (Robot -> Bool) -> [Robot] -> [Robot]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
rid) (Int -> Bool) -> (Robot -> Int) -> Robot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID)) ([Robot] -> [Robot]) -> (Robots -> [Robot]) -> Robots -> [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Bool) -> [Robot] -> [Robot]
forall a. (a -> Bool) -> [a] -> [a]
filter Robot -> Bool
isInteractive ([Robot] -> [Robot]) -> (Robots -> [Robot]) -> Robots -> [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Int32 -> Robots -> [Robot]
robotsInArea Cosmic Location
loc Int32
1 (Robots -> [Robot]) -> Robots -> [Robot]
forall a b. (a -> b) -> a -> b
$ GameState
g GameState -> Getting Robots GameState Robots -> Robots
forall s a. s -> Getting a s a -> a
^. Getting Robots GameState Robots
Lens' GameState Robots
robotInfo
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ [Robot] -> CESK
forall a. Valuable a => a -> CESK
mkReturn [Robot]
neighborIDs
    Const
Whoami -> case [Value]
vs of
      [] -> do
        Text
name <- Getting Text Robot Text -> m Text
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Text Robot Text
Lens' Robot Text
robotName
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn Text
name
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Setname -> case [Value]
vs of
      [VText Text
name] -> do
        (Text -> Identity Text) -> Robot -> Identity Robot
Lens' Robot Text
robotName ((Text -> Identity Text) -> Robot -> Identity Robot)
-> Text -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Text
name
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Force -> case [Value]
vs of
      [VDelay Term
t Env
e] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t Env
e Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
If -> case [Value]
vs of
      -- Use the boolean to pick the correct branch, and apply @force@ to it.
      [VBool Bool
b, Value
thn, Value
els] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Value -> Bool -> Value
forall a. a -> a -> Bool -> a
bool Value
els Value
thn Bool
b) Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Inl -> case [Value]
vs of
      [Value
v] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value -> Value
VInj Bool
False Value
v) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Inr -> case [Value]
vs of
      [Value
v] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value -> Value
VInj Bool
True Value
v) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Case -> case [Value]
vs of
      [VInj Bool
side Value
v, Value
kl, Value
kr] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s (Value -> Frame
FApp (Value -> Value -> Bool -> Value
forall a. a -> a -> Bool -> a
bool Value
kl Value
kr Bool
side) Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Match -> case [Value]
vs of
      [VPair Value
v1 Value
v2, Value
kp] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v1 Store
s (Value -> Frame
FApp Value
kp Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Value -> Frame
FVArg Value
v2 Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Try -> case [Value]
vs of
      [Value
c1, Value
c2] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
c1 Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Frame
FExec Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Value -> Frame
FTry Value
c2 Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Undefined -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
User Text
"undefined") Store
s Cont
k
    Const
Fail -> case [Value]
vs of
      [VText Text
msg] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
User Text
msg) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Key -> case [Value]
vs of
      [VText Text
ktxt] -> case Parsec Void Text KeyCombo
-> String -> Text -> Either (ParseErrorBundle Text Void) KeyCombo
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text KeyCombo
parseKeyComboFull String
"" Text
ktxt of
        Right KeyCombo
kc -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (KeyCombo -> Value
VKey KeyCombo
kc) Store
s Cont
k
        Left ParseErrorBundle Text Void
_ -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed Const
Key ([Text] -> Text
T.unwords [Text
"Unknown key", Text -> Text
quote Text
ktxt]) Maybe GameplayAchievement
forall a. Maybe a
Nothing) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
InstallKeyHandler -> case [Value]
vs of
      [VText Text
hint, Value
handler] -> do
        (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> ((Maybe (Text, Value) -> Identity (Maybe (Text, Value)))
    -> GameControls -> Identity GameControls)
-> (Maybe (Text, Value) -> Identity (Maybe (Text, Value)))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Text, Value) -> Identity (Maybe (Text, Value)))
-> GameControls -> Identity GameControls
Lens' GameControls (Maybe (Text, Value))
inputHandler ((Maybe (Text, Value) -> Identity (Maybe (Text, Value)))
 -> GameState -> Identity GameState)
-> Maybe (Text, Value) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= (Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just (Text
hint, Value
handler)
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Reprogram -> case [Value]
vs of
      [VRobot Int
childRobotID, VDelay Term
cmd Env
env] -> do
        Robot
r <- m Robot
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get
        Bool
isPrivileged <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot

        -- check if robot exists
        Robot
childRobot <-
          Int -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID Int
childRobotID
            m (Maybe Robot) -> (Maybe Robot -> m Robot) -> m Robot
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Robot -> [Text] -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no actor with ID", String -> Text
forall source target. From source target => source -> target
from (Int -> String
forall a. Show a => a -> String
show Int
childRobotID) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."])

        -- check that current robot is not trying to reprogram self
        Int
myID <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
        (Int
childRobotID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
myID)
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You cannot make a robot reprogram itself."]

        -- check if robot has completed executing it's current command
        Value
_ <-
          CESK -> Maybe Value
finalValue (Robot
childRobot Robot -> Getting CESK Robot CESK -> CESK
forall s a. s -> Getting a s a -> a
^. Getting CESK Robot CESK
Lens' Robot CESK
machine)
            Maybe Value -> [Text] -> m Value
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"You cannot reprogram a robot that is actively running a program."]

        -- check if childRobot is at the correct distance
        -- a robot can program adjacent robots
        -- privileged bots ignore distance checks
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation

        Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt Bool
isPrivileged Cosmic Location
loc (Robot
childRobot Robot
-> Getting (Cosmic Location) Robot (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation)
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You can only reprogram an adjacent robot."]

        -- Figure out if we can supply what the target robot requires,
        -- and if so, what is needed.
        (Set Entity
toEquip, Inventory
toGive) <-
          Env
-> Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Env
-> Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements
            Env
env
            (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)
            (Robot
childRobot Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory)
            (Robot
childRobot Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices)
            Term
cmd
            Text
"The target robot"
            IncapableFix
FixByObtainDevice

        -- Update other robot's CESK machine.  The child robot
        -- inherits the parent robot's environment + store.
        StateC Robots Identity () -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity () -> m ())
-> StateC Robots Identity () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((CESK -> Identity CESK)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (CESK -> Identity CESK)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
Index (IntMap Robot)
childRobotID ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((CESK -> Identity CESK)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (CESK -> Identity CESK)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine ((CESK -> Identity CESK) -> Robots -> Identity Robots)
-> CESK -> StateC Robots Identity ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Term -> Env -> Store -> Cont -> CESK
In Term
cmd Env
env Store
s [Frame
FExec]

        -- Provision the target robot with any required devices and
        -- inventory that are lacking.
        Int -> Inventory -> Inventory -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> Inventory -> Inventory -> m ()
provisionChild Int
childRobotID ([Entity] -> Inventory
fromList ([Entity] -> Inventory)
-> (Set Entity -> [Entity]) -> Set Entity -> Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> [Entity]
forall a. Set a -> [a]
S.toList (Set Entity -> Inventory) -> Set Entity -> Inventory
forall a b. (a -> b) -> a -> b
$ Set Entity
toEquip) Inventory
toGive

        -- Finally, re-activate the reprogrammed target robot.
        StateC Robots Identity () -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity () -> m ())
-> StateC Robots Identity () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> StateC Robots Identity ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
Int -> m ()
activateRobot Int
childRobotID

        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Build -> case [Value]
vs of
      -- NOTE, pattern-matching on a VDelay here means we are
      -- /relying/ on the fact that 'Build' can only be given a
      -- /non-memoized/ delayed value.  If it were given a memoized
      -- delayed value we would see a VRef instead of a VDelay.  If
      -- and Try are generalized to handle any type of delayed value,
      -- but Build and Reprogram still assume they are given a VDelay
      -- and not a VRef.  In the future, if we enable memoized delays
      -- by default, or allow the user to explicitly request
      -- memoization via double braces or something similar, this will
      -- have to be generalized.  The difficulty is that we do a
      -- capability check on the delayed program at runtime, just
      -- before creating the newly built robot (see the call to
      -- 'requirements' below); but if we have a VRef instead of a
      -- VDelay, we may only be able to get a Value out of it instead
      -- of a Term as we currently do, and capability checking a Value
      -- is annoying and/or problematic.  One solution might be to
      -- annotate delayed expressions with their required capabilities
      -- at typechecking time, and carry those along so they flow to
      -- this point. Another solution would be to just bite the bullet
      -- and figure out how to do capability checking on Values (which
      -- would return the capabilities needed to *execute* them),
      -- hopefully without duplicating too much code.
      [VDelay Term
cmd Env
e] -> do
        Robot
r <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @Robot
        Int
pid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID

        (Set Entity
toEquip, Inventory
toGive) <-
          Env
-> Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Env
-> Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements Env
e (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) Inventory
E.empty Inventory
E.empty Term
cmd Text
"You" IncapableFix
FixByObtainDevice

        -- Pick a random display name.
        Text
displayName <- m Text
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m Text
randomName
        TimeSpec
createdAt <- m TimeSpec
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has Time sig m =>
m TimeSpec
getNow
        Bool
isSystemRobot <- Getting Bool Robot Bool -> m Bool
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Bool Robot Bool
Lens' Robot Bool
systemRobot

        -- Construct the new robot and add it to the world.
        let newDisplay :: Display
newDisplay = case Robot
r Robot
-> Getting ChildInheritance Robot ChildInheritance
-> ChildInheritance
forall s a. s -> Getting a s a -> a
^. (Display -> Const ChildInheritance Display)
-> Robot -> Const ChildInheritance Robot
Lens' Robot Display
robotDisplay ((Display -> Const ChildInheritance Display)
 -> Robot -> Const ChildInheritance Robot)
-> ((ChildInheritance -> Const ChildInheritance ChildInheritance)
    -> Display -> Const ChildInheritance Display)
-> Getting ChildInheritance Robot ChildInheritance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChildInheritance -> Const ChildInheritance ChildInheritance)
-> Display -> Const ChildInheritance Display
Lens' Display ChildInheritance
childInheritance of
              ChildInheritance
Invisible -> Display
defaultRobotDisplay Display -> (Display -> Display) -> Display
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Display -> Identity Display
Lens' Display Bool
invisible ((Bool -> Identity Bool) -> Display -> Identity Display)
-> Bool -> Display -> Display
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
              ChildInheritance
Inherit -> Display
defaultRobotDisplay Display -> (Display -> Display) -> Display
forall a b. a -> (a -> b) -> b
& Lens' Display Attribute -> Display -> Display -> Display
forall s a. Lens' s a -> s -> s -> s
inherit (Attribute -> f Attribute) -> Display -> f Display
Lens' Display Attribute
displayAttr (Robot
r Robot -> Getting Display Robot Display -> Display
forall s a. s -> Getting a s a -> a
^. Getting Display Robot Display
Lens' Robot Display
robotDisplay)
              ChildInheritance
DefaultDisplay -> Display
defaultRobotDisplay
        Robot
newRobot <-
          StateC Robots Identity Robot -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity Robot -> m Robot)
-> (TRobot -> StateC Robots Identity Robot) -> TRobot -> m Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CESK -> TRobot -> StateC Robots Identity Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
CESK -> TRobot -> m Robot
addTRobot' (Term -> Env -> Store -> Cont -> CESK
In Term
cmd Env
e Store
s [Frame
FExec]) (TRobot -> m Robot) -> TRobot -> m Robot
forall a b. (a -> b) -> a -> b
$
            Maybe Int
-> Text
-> Document Syntax
-> Maybe (Cosmic Location)
-> Heading
-> Display
-> Maybe TSyntax
-> [Entity]
-> IngredientList Entity
-> Bool
-> Bool
-> WalkabilityExceptions Text
-> TimeSpec
-> TRobot
mkRobot
              (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pid)
              Text
displayName
              (Text -> Document Syntax
Markdown.fromText (Text -> Document Syntax) -> Text -> Document Syntax
forall a b. (a -> b) -> a -> b
$ Text
"A robot built by the robot named " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Robot
r Robot -> Getting Text Robot Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Robot Text
Lens' Robot Text
robotName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".")
              (Cosmic Location -> Maybe (Cosmic Location)
forall a. a -> Maybe a
Just (Robot
r Robot
-> Getting (Cosmic Location) Robot (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation))
              ( ((Robot
r Robot
-> Getting (Maybe Heading) Robot (Maybe Heading) -> Maybe Heading
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation) Maybe Heading -> (Heading -> Maybe Heading) -> Maybe Heading
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Heading
dir -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Heading
dir Heading -> Heading -> Bool
forall a. Eq a => a -> a -> Bool
/= Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero) Maybe () -> Maybe Heading -> Maybe Heading
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Heading -> Maybe Heading
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Heading
dir)
                  Maybe Heading -> Heading -> Heading
forall a. Maybe a -> a -> a
? Heading
north
              )
              Display
newDisplay
              Maybe TSyntax
forall a. Maybe a
Nothing
              []
              []
              Bool
isSystemRobot
              Bool
False
              WalkabilityExceptions Text
forall a. Monoid a => Inclusions a
emptyExceptions
              TimeSpec
createdAt

        -- Provision the new robot with the necessary devices and inventory.
        Int -> Inventory -> Inventory -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> Inventory -> Inventory -> m ()
provisionChild (Robot
newRobot Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID) ([Entity] -> Inventory
fromList ([Entity] -> Inventory)
-> (Set Entity -> [Entity]) -> Set Entity -> Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> [Entity]
forall a. Set a -> [a]
S.toList (Set Entity -> Inventory) -> Set Entity -> Inventory
forall a b. (a -> b) -> a -> b
$ Set Entity
toEquip) Inventory
toGive

        -- Flag the world for a redraw and return the ID of the newly constructed robot.
        m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Robot -> CESK
forall a. Valuable a => a -> CESK
mkReturn Robot
newRobot
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Salvage -> case [Value]
vs of
      [] -> do
        Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        let okToSalvage :: Robot -> Bool
okToSalvage Robot
r = (Robot
r Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Robot -> Bool) -> Robot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Robot -> Bool
isActive (Robot -> Bool) -> Robot -> Bool
forall a b. (a -> b) -> a -> b
$ Robot
r)
        Maybe Robot
mtarget <- (GameState -> Maybe Robot) -> m (Maybe Robot)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
gets ((Robot -> Bool) -> [Robot] -> Maybe Robot
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Robot -> Bool
okToSalvage ([Robot] -> Maybe Robot)
-> (GameState -> [Robot]) -> GameState -> Maybe Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> GameState -> [Robot]
robotsAtLocation Cosmic Location
loc)
        case Maybe Robot
mtarget of
          Maybe Robot
Nothing -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn () -- Nothing to salvage
          Just Robot
target -> do
            -- Copy the salvaged robot's equipped devices into its inventory, in preparation
            -- for transferring it.
            let salvageInventory :: Inventory
salvageInventory = Inventory -> Inventory -> Inventory
E.union (Robot
target Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory) (Robot
target Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices)
            (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((Inventory -> Identity Inventory) -> Robots -> Identity Robots)
-> (Inventory -> Identity Inventory)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Inventory -> Identity Inventory)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Inventory -> Identity Inventory)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID) ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Inventory -> Identity Inventory)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (Inventory -> Identity Inventory)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
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) -> Maybe a -> f (Maybe b)
traverse ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory)
 -> GameState -> Identity GameState)
-> Inventory -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
salvageInventory

            let salvageItems :: [Text]
salvageItems = ((Int, Entity) -> [Text]) -> IngredientList Entity -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
n, Entity
e) -> Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
n (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)) (Inventory -> IngredientList Entity
E.elems Inventory
salvageInventory)
                numItems :: Int
numItems = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
salvageItems

            -- Copy over the salvaged robot's log, if we have one
            Inventory
inst <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
            EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
            Bool
isPrivileged <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
            Entity
logger <-
              Text -> EntityMap -> Maybe Entity
lookupEntityName Text
"logger" EntityMap
em
                Maybe Entity -> Exn -> m Entity
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Text -> Exn
Fatal Text
"While executing 'salvage': there's no such thing as a logger!?"
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isPrivileged Bool -> Bool -> Bool
|| Inventory
inst Inventory -> Entity -> Bool
`E.contains` Entity
logger) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (Seq LogEntry -> Identity (Seq LogEntry))
-> Robot -> Identity Robot
Lens' Robot (Seq LogEntry)
robotLog ((Seq LogEntry -> Identity (Seq LogEntry))
 -> Robot -> Identity Robot)
-> Seq LogEntry -> m ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Robot
target Robot
-> Getting (Seq LogEntry) Robot (Seq LogEntry) -> Seq LogEntry
forall s a. s -> Getting a s a -> a
^. Getting (Seq LogEntry) Robot (Seq LogEntry)
Lens' Robot (Seq LogEntry)
robotLog

            -- Immediately copy over any items the robot knows about
            -- but has 0 of
            let knownItems :: [Entity]
knownItems = ((Int, Entity) -> Entity) -> IngredientList Entity -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd (IngredientList Entity -> [Entity])
-> (Inventory -> IngredientList Entity) -> Inventory -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Bool)
-> IngredientList Entity -> IngredientList Entity
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> ((Int, Entity) -> Int) -> (Int, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Int
forall a b. (a, b) -> a
fst) (IngredientList Entity -> IngredientList Entity)
-> (Inventory -> IngredientList Entity)
-> Inventory
-> IngredientList Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> IngredientList Entity
elems (Inventory -> [Entity]) -> Inventory -> [Entity]
forall a b. (a -> b) -> a -> b
$ Inventory
salvageInventory
            (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Inventory
i -> (Entity -> Inventory -> Inventory)
-> Inventory -> [Entity] -> Inventory
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Entity -> Inventory -> Inventory
insertCount Int
0) Inventory
i [Entity]
knownItems

            -- Now reprogram the robot being salvaged to 'give' each
            -- item in its inventory to us, one at a time, then
            -- self-destruct at the end.  Make it a system robot so we
            -- don't have to worry about capabilities.
            (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> ((Bool -> Identity Bool) -> Robots -> Identity Robots)
-> (Bool -> Identity Bool)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Bool -> Identity Bool)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Bool -> Identity Bool)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID) ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Bool -> Identity Bool)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (Bool -> Identity Bool)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
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) -> Maybe a -> f (Maybe b)
traverse ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((Bool -> Identity Bool) -> Robot -> Identity Robot)
-> (Bool -> Identity Bool)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> Robot -> Identity Robot
Lens' Robot Bool
systemRobot ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> Bool -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True

            Int
ourID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use @Robot Getting Int Robot Int
Getter Robot Int
robotID

            -- The program for the salvaged robot to run
            let giveInventory :: Term
giveInventory =
                  (Text -> Term -> Term) -> Term -> [Text] -> Term
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text
-> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term
TBind Maybe Text
forall a. Maybe a
Nothing Maybe Polytype
forall a. Maybe a
Nothing Maybe Requirements
forall a. Maybe a
Nothing (Term -> Term -> Term) -> (Text -> Term) -> Text -> Term -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Term
giveItem) (Const -> Term
forall ty. Const -> Term' ty
TConst Const
Selfdestruct) [Text]
salvageItems
                giveItem :: Text -> Term
giveItem Text
item = Term -> Term -> Term
TApp (Term -> Term -> Term
TApp (Const -> Term
forall ty. Const -> Term' ty
TConst Const
Give) (Int -> Term
forall ty. Int -> Term' ty
TRobot Int
ourID)) (Text -> Term
forall ty. Text -> Term' ty
TText Text
item)

            -- Reprogram and activate the salvaged robot
            StateC Robots Identity () -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity () -> m ())
-> StateC Robots Identity () -> m ()
forall a b. (a -> b) -> a -> b
$ do
              (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap
                ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((CESK -> Identity CESK)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (CESK -> Identity CESK)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID)
                ((Maybe Robot -> Identity (Maybe Robot))
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((CESK -> Identity CESK)
    -> Maybe Robot -> Identity (Maybe Robot))
-> (CESK -> Identity CESK)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> Maybe Robot -> Identity (Maybe Robot)
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) -> Maybe a -> f (Maybe b)
traverse
                ((Robot -> Identity Robot)
 -> Maybe Robot -> Identity (Maybe Robot))
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> Maybe Robot
-> Identity (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine
                ((CESK -> Identity CESK) -> Robots -> Identity Robots)
-> CESK -> StateC Robots Identity ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Term -> Env -> Store -> Cont -> CESK
In Term
giveInventory Env
emptyEnv Store
emptyStore [Frame
FExec]

              Int -> StateC Robots Identity ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
Int -> m ()
activateRobot (Int -> StateC Robots Identity ())
-> Int -> StateC Robots Identity ()
forall a b. (a -> b) -> a -> b
$ Robot
target Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
robotID

            -- Now wait the right amount of time for it to finish.
            TickNumber
time <- Getting TickNumber GameState TickNumber -> m TickNumber
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting TickNumber GameState TickNumber -> m TickNumber)
-> Getting TickNumber GameState TickNumber -> m TickNumber
forall a b. (a -> b) -> a -> b
$ (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
            CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ TickNumber -> CESK -> CESK
Waiting (Int -> TickNumber -> TickNumber
addTicks (Int
numItems Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TickNumber
time) (() -> CESK
forall a. Valuable a => a -> CESK
mkReturn ())
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    -- run can take both types of text inputs
    -- with and without file extension as in
    -- "./path/to/file.sw" and "./path/to/file"
    Const
Run -> case [Value]
vs of
      [VText Text
fileName] -> do
        let filePath :: String
filePath = forall target source. From source target => source -> target
into @String Text
fileName
        Maybe String
sData <- forall e (m :: * -> *) a. Functor m => ThrowC e m a -> m (Maybe a)
throwToMaybe @SystemFailure (ThrowC SystemFailure m String -> m (Maybe String))
-> ThrowC SystemFailure m String -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ AssetData -> String -> ThrowC SystemFailure m String
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Script String
filePath
        Maybe String
sDataSW <- forall e (m :: * -> *) a. Functor m => ThrowC e m a -> m (Maybe a)
throwToMaybe @SystemFailure (ThrowC SystemFailure m String -> m (Maybe String))
-> ThrowC SystemFailure m String -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ AssetData -> String -> ThrowC SystemFailure m String
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Script (String
filePath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".sw")
        [Maybe String]
mf <- IO [Maybe String] -> m [Maybe String]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO [Maybe String] -> m [Maybe String])
-> IO [Maybe String] -> m [Maybe String]
forall a b. (a -> b) -> a -> b
$ (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
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 String -> IO (Maybe String)
readFileMay ([String] -> IO [Maybe String]) -> [String] -> IO [Maybe String]
forall a b. (a -> b) -> a -> b
$ [String
filePath, String
filePath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".sw"] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String
sData, Maybe String
sDataSW]

        String
f <- [Maybe String] -> Maybe String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe String]
mf Maybe String -> [Text] -> m String
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"File not found:", Text
fileName]

        Maybe TSyntax
mt <-
          Text -> Either Text (Maybe TSyntax)
processTerm (forall target source. From source target => source -> target
into @Text String
f) Either Text (Maybe TSyntax) -> (Text -> Exn) -> m (Maybe TSyntax)
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) b a.
Has (Throw e) sig m =>
Either b a -> (b -> e) -> m a
`isRightOr` \Text
err ->
            Const -> [Text] -> Exn
cmdExn Const
Run [Text
"Error in", Text
fileName, Text
"\n", Text
err]

        case Maybe TSyntax
mt of
          Maybe TSyntax
Nothing -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()
          Just TSyntax
t -> do
            m LogEntry -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m LogEntry -> m ()) -> m LogEntry -> m ()
forall a b. (a -> b) -> a -> b
$ RobotLogSource -> Severity -> Text -> m LogEntry
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
traceLog RobotLogSource
CmdStatus Severity
Info Text
"run: OK."
            CESK
cesk <- Getting CESK Robot CESK -> m CESK
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting CESK Robot CESK
Lens' Robot CESK
machine
            CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ TSyntax -> CESK -> CESK
continue TSyntax
t CESK
cesk
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Not -> case [Value]
vs of
      [VBool Bool
b] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool (Bool -> Bool
not Bool
b)) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Neg -> case [Value]
vs of
      [VInt Integer
n] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt (-Integer
n)) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Eq -> m CESK
returnEvalCmp
    Const
Neq -> m CESK
returnEvalCmp
    Const
Lt -> m CESK
returnEvalCmp
    Const
Gt -> m CESK
returnEvalCmp
    Const
Leq -> m CESK
returnEvalCmp
    Const
Geq -> m CESK
returnEvalCmp
    Const
And -> case [Value]
vs of
      [VBool Bool
a, VBool Bool
b] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool (Bool
a Bool -> Bool -> Bool
&& Bool
b)) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Or -> case [Value]
vs of
      [VBool Bool
a, VBool Bool
b] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool (Bool
a Bool -> Bool -> Bool
|| Bool
b)) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Add -> m CESK
returnEvalArith
    Const
Sub -> m CESK
returnEvalArith
    Const
Mul -> m CESK
returnEvalArith
    Const
Div -> m CESK
returnEvalArith
    Const
Exp -> m CESK
returnEvalArith
    Const
Format -> case [Value]
vs of
      [Value
v] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Text -> CESK) -> Text -> CESK
forall a b. (a -> b) -> a -> b
$ Value -> Text
prettyValue Value
v
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Read -> case [Value]
vs of
      [VType Type
ty, VText Text
txt] -> case Type -> Text -> Maybe Value
readValue Type
ty Text
txt of
        Maybe Value
Nothing -> Const -> [Text] -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> [Text] -> m a
raise Const
Read [Text
"Could not read", Text -> Text
forall a. Show a => a -> Text
showT Text
txt, Text
"at type", Type -> Text
forall a. PrettyPrec a => a -> Text
prettyText Type
ty]
        Just Value
v -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> CESK
forall a. Valuable a => a -> CESK
mkReturn Value
v)
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Print -> case [Value]
vs of
      [VText Text
printableName, VText Text
txt] -> do
        Entity
printable <- Text -> Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
printableName Text
"print"
        (Entity
printable Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Printable)
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You cannot print on", Text -> Text
indefinite Text
printableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"]
        let newEntityName :: Text
newEntityName = Text
printableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
printable
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert (Entity
printable Entity -> (Entity -> Entity) -> Entity
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> Entity -> Identity Entity
Lens' Entity Text
entityName ((Text -> Identity Text) -> Entity -> Identity Entity)
-> Text -> Entity -> Entity
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
newEntityName)
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn Text
newEntityName
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Erase -> case [Value]
vs of
      [VText Text
printableName] -> do
        Entity
toErase <- Text -> Text -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
printableName Text
"erase"
        let (Text
baseName, Text
_) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
printableName
        EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
        Entity
erased <-
          Text -> EntityMap -> Maybe Entity
lookupEntityName Text
baseName EntityMap
em
            Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"I've never heard of", Text -> Text
indefiniteQ Text
baseName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]
        (Entity
erased Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Printable)
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You cannot erase", Text -> Text
indefinite Text
baseName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"!"]

        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
toErase
        (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
erased
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn Text
baseName
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Chars -> case [Value]
vs of
      [VText Text
t] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Int -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Int -> CESK) -> Int -> CESK
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Split -> case [Value]
vs of
      [VInt Integer
i, VText Text
t] ->
        let p :: (Text, Text)
p = Int -> Text -> (Text, Text)
T.splitAt (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i) Text
t
            t2 :: (Value, Value)
t2 = ASetter (Text, Text) (Value, Value) Text Value
-> (Text -> Value) -> (Text, Text) -> (Value, Value)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Text, Text) (Value, Value) Text Value
Traversal (Text, Text) (Value, Value) Text Value
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both Text -> Value
VText (Text, Text)
p
         in CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out ((Value -> Value -> Value) -> (Value, Value) -> Value
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value -> Value -> Value
VPair (Value, Value)
t2) Store
s Cont
k
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Concat -> case [Value]
vs of
      [VText Text
v1, VText Text
v2] -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Text -> CESK) -> Text -> CESK
forall a b. (a -> b) -> a -> b
$ Text
v1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v2
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
CharAt -> case [Value]
vs of
      [VInt Integer
i, VText Text
t]
        | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
t) ->
            Const -> [Text] -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> [Text] -> m a
raise Const
CharAt [Text
"Index", Value -> Text
prettyValue (Integer -> Value
VInt Integer
i), Text
"out of bounds for length", forall source target. From source target => source -> target
from @String (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Text -> Int
T.length Text
t)]
        | Bool
otherwise -> CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> (Integer -> CESK) -> Integer -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Int -> CESK) -> (Integer -> Int) -> Integer -> CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Int) -> (Integer -> Char) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
t (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> m CESK) -> Integer -> m CESK
forall a b. (a -> b) -> a -> b
$ Integer
i
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
ToChar -> case [Value]
vs of
      [VInt Integer
i]
        | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord (Char
forall a. Bounded a => a
maxBound :: Char)) ->
            Const -> [Text] -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> [Text] -> m a
raise Const
ToChar [Text
"Value", Value -> Text
prettyValue (Integer -> Value
VInt Integer
i), Text
"is an invalid character code"]
        | Bool
otherwise ->
            CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> (Integer -> CESK) -> Integer -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CESK
forall a. Valuable a => a -> CESK
mkReturn (Text -> CESK) -> (Integer -> Text) -> Integer -> CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Text) -> (Integer -> Char) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> m CESK) -> Integer -> m CESK
forall a b. (a -> b) -> a -> b
$ Integer
i
      [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
AppF ->
      let msg :: Text
msg = Text
"The operator '$' should only be a syntactic sugar and removed in elaboration:\n"
       in Exn -> m CESK
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m CESK) -> (Text -> Exn) -> Text -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exn
Fatal (Text -> m CESK) -> Text -> m CESK
forall a b. (a -> b) -> a -> b
$ Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
badConstMsg
 where
  doTeleport :: Int -> (Cosmic Location -> Cosmic Location) -> m CESK
doTeleport Int
rid Cosmic Location -> Cosmic Location
locUpdateFunc = do
    -- Make sure the other robot exists and is close
    Robot
target <- Int -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> m Robot
getRobotWithinTouch Int
rid
    -- either change current robot or one in robot map
    let oldLoc :: Cosmic Location
oldLoc = Robot
target Robot
-> Getting (Cosmic Location) Robot (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        nextLoc :: Cosmic Location
nextLoc = Cosmic Location -> Cosmic Location
locUpdateFunc Cosmic Location
oldLoc

    Int
-> (forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
    (HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
    m' ())
-> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Int
-> (forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
    (HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
    m' ())
-> m ()
onTarget Int
rid ((forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
  (HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
  m' ())
 -> m ())
-> (forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
    (HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
    m' ())
-> m ()
forall a b. (a -> b) -> a -> b
$ do
      Cosmic Location -> MoveFailureHandler -> m' ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Cosmic Location -> MoveFailureHandler -> m ()
checkMoveAhead Cosmic Location
nextLoc (MoveFailureHandler -> m' ()) -> MoveFailureHandler -> m' ()
forall a b. (a -> b) -> a -> b
$ \case
        PathBlockedBy Maybe Entity
_ -> RobotFailure
Destroy
        PathLiquid Entity
_ -> RobotFailure
Destroy
      Cosmic Location -> Cosmic Location -> m' ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
oldLoc Cosmic Location
nextLoc

    -- Privileged robots can teleport without causing any
    -- improbable effects.  Unprivileged robots must be using an
    -- infinite improbability drive, which can cause a random entity
    -- to spawn near the target location.
    Bool
omni <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
omni (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      let area :: [Cosmic Location]
area = (Location -> Cosmic Location) -> [Location] -> [Cosmic Location]
forall a b. (a -> b) -> [a] -> [b]
map (Location -> Cosmic Location -> Cosmic Location
forall a b. a -> Cosmic b -> Cosmic a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Cosmic Location
nextLoc) ([Location] -> [Cosmic Location])
-> [Location] -> [Cosmic Location]
forall a b. (a -> b) -> a -> b
$ Location -> Int32 -> [Location]
getLocsInArea (Cosmic Location
nextLoc Cosmic Location
-> Getting Location (Cosmic Location) Location -> Location
forall s a. s -> Getting a s a -> a
^. Getting Location (Cosmic Location) Location
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar) Int32
5
      [Cosmic Location]
emptyLocs <- (Cosmic Location -> m Bool)
-> [Cosmic Location] -> m [Cosmic Location]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Entity -> Bool
forall a. Maybe a -> Bool
isNothing (m (Maybe Entity) -> m Bool)
-> (Cosmic Location -> m (Maybe Entity))
-> Cosmic Location
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt) [Cosmic Location]
area
      Maybe (Cosmic Location)
randomLoc <- (Cosmic Location -> Integer)
-> [Cosmic Location] -> m (Maybe (Cosmic Location))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice (Integer -> Cosmic Location -> Integer
forall a b. a -> b -> a
const Integer
1) [Cosmic Location]
emptyLocs
      [Entity]
es <- Getting EntityMap GameState EntityMap
-> (EntityMap -> [Entity]) -> m [Entity]
forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses ((Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap) EntityMap -> [Entity]
allEntities
      Maybe Entity
randomEntity <- (Entity -> Integer) -> [Entity] -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice (Integer -> Entity -> Integer
forall a b. a -> b -> a
const Integer
1) [Entity]
es
      case (Maybe (Cosmic Location)
randomLoc, Maybe Entity
randomEntity) of
        (Just Cosmic Location
loc, Just Entity
e) -> Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (Maybe Entity -> Maybe Entity -> Maybe Entity
forall a b. a -> b -> a
const (Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e))
        (Maybe (Cosmic Location), Maybe Entity)
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()

  doDrill :: Direction -> m CESK
doDrill Direction
d = do
    Inventory
ins <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices

    let equippedDrills :: [Entity]
equippedDrills = Capability -> Inventory -> [Entity]
extantElemsWithCapability (Const -> Capability
CExecute Const
Drill) Inventory
ins
        -- Heuristic: choose the drill with the more elaborate name.
        -- E.g. "metal drill" vs. "drill"
        preferredDrill :: Maybe Entity
preferredDrill = [Entity] -> Maybe Entity
forall a. [a] -> Maybe a
listToMaybe ([Entity] -> Maybe Entity) -> [Entity] -> Maybe Entity
forall a b. (a -> b) -> a -> b
$ (Entity -> Down Int) -> [Entity] -> [Entity]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int) -> (Entity -> Int) -> Entity -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int) -> (Entity -> Text) -> Entity -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName)) [Entity]
equippedDrills

    Entity
tool <- Maybe Entity
preferredDrill Maybe Entity -> Exn -> m Entity
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Text -> Exn
Fatal Text
"Drill is required but not equipped?!"
    Inventory -> Text -> Direction -> Entity -> m CESK
forall {m :: * -> *} {sig :: (* -> *) -> * -> *} {p}.
(Algebra sig m, Eq p, Member (Throw Exn) sig,
 Member (State Robot) sig, Member (State GameState) sig,
 Member (Reader (Recipe p)) (Reader (Recipe Entity))) =>
Inventory -> Text -> Direction -> p -> m CESK
applyDevice Inventory
ins Text
"drill" Direction
d Entity
tool

  applyDevice :: Inventory -> Text -> Direction -> p -> m CESK
applyDevice Inventory
ins Text
verbPhrase Direction
d p
tool = do
    (Cosmic Location
nextLoc, Entity
nextE) <- Text -> Direction -> m (Cosmic Location, Entity)
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Algebra sig m, Member (State Robot) sig,
 Member (State GameState) sig, Member (Throw Exn) sig) =>
Text -> Direction -> m (Cosmic Location, Entity)
getDeviceTarget Text
verbPhrase Direction
d
    IntMap [Recipe Entity]
inRs <- Getting (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
-> m (IntMap [Recipe Entity])
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
 -> m (IntMap [Recipe Entity]))
-> Getting
     (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
-> m (IntMap [Recipe Entity])
forall a b. (a -> b) -> a -> b
$ (Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> GameState -> Const (IntMap [Recipe Entity]) GameState
Lens' GameState Recipes
recipesInfo ((Recipes -> Const (IntMap [Recipe Entity]) Recipes)
 -> GameState -> Const (IntMap [Recipe Entity]) GameState)
-> ((IntMap [Recipe Entity]
     -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
    -> Recipes -> Const (IntMap [Recipe Entity]) Recipes)
-> Getting
     (IntMap [Recipe Entity]) GameState (IntMap [Recipe Entity])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap [Recipe Entity]
 -> Const (IntMap [Recipe Entity]) (IntMap [Recipe Entity]))
-> Recipes -> Const (IntMap [Recipe Entity]) Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesIn

    let recipes :: [Recipe Entity]
recipes = (Recipe Entity -> Bool) -> [Recipe Entity] -> [Recipe Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter Recipe Entity -> Bool
isApplicableRecipe (IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor IntMap [Recipe Entity]
inRs Entity
nextE)
        isApplicableRecipe :: Recipe Entity -> Bool
isApplicableRecipe = ((Int, p) -> Bool) -> IngredientList p -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
tool) (p -> Bool) -> ((Int, p) -> p) -> (Int, p) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, p) -> p
forall a b. (a, b) -> b
snd) (IngredientList p -> Bool)
-> (Recipe Entity -> IngredientList p) -> Recipe Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (IngredientList p) (Recipe p) (IngredientList p)
-> Recipe Entity -> IngredientList p
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting (IngredientList p) (Recipe p) (IngredientList p)
forall e (f :: * -> *).
Functor f =>
(IngredientList e -> f (IngredientList e))
-> Recipe e -> f (Recipe e)
recipeCatalysts

    Bool -> Bool
not ([Recipe Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Recipe Entity]
recipes)
      Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [ Text
"There is no way to"
                    , Text
verbPhrase
                    , Text -> Text
indefinite (Entity
nextE Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    ]

    Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory

    -- add the targeted entity so it can be consumed by the recipe
    let makeRecipe :: Recipe Entity
-> Either
     [MissingIngredient]
     ((Inventory, IngredientList Entity), Recipe Entity)
makeRecipe Recipe Entity
r = (,Recipe Entity
r) ((Inventory, IngredientList Entity)
 -> ((Inventory, IngredientList Entity), Recipe Entity))
-> Either [MissingIngredient] (Inventory, IngredientList Entity)
-> Either
     [MissingIngredient]
     ((Inventory, IngredientList Entity), Recipe Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inventory, Inventory)
-> Recipe Entity
-> Either [MissingIngredient] (Inventory, IngredientList Entity)
make' (Entity -> Inventory -> Inventory
insert Entity
nextE Inventory
inv, Inventory
ins) Recipe Entity
r
    Maybe ((Inventory, IngredientList Entity), Recipe Entity)
chosenRecipe <-
      (((Inventory, IngredientList Entity), Recipe Entity) -> Integer)
-> [((Inventory, IngredientList Entity), Recipe Entity)]
-> m (Maybe ((Inventory, IngredientList Entity), Recipe Entity))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice (\((Inventory
_, IngredientList Entity
_), Recipe Entity
r) -> Recipe Entity
r Recipe Entity
-> ((Integer -> Const Integer Integer)
    -> Recipe Entity -> Const Integer (Recipe Entity))
-> Integer
forall s a. s -> Getting a s a -> a
^. (Integer -> Const Integer Integer)
-> Recipe Entity -> Const Integer (Recipe Entity)
forall e (f :: * -> *).
Functor f =>
(Integer -> f Integer) -> Recipe e -> f (Recipe e)
recipeWeight) ([((Inventory, IngredientList Entity), Recipe Entity)]
 -> m (Maybe ((Inventory, IngredientList Entity), Recipe Entity)))
-> [((Inventory, IngredientList Entity), Recipe Entity)]
-> m (Maybe ((Inventory, IngredientList Entity), Recipe Entity))
forall a b. (a -> b) -> a -> b
$
        [Either
   [MissingIngredient]
   ((Inventory, IngredientList Entity), Recipe Entity)]
-> [((Inventory, IngredientList Entity), Recipe Entity)]
forall a b. [Either a b] -> [b]
rights ([Either
    [MissingIngredient]
    ((Inventory, IngredientList Entity), Recipe Entity)]
 -> [((Inventory, IngredientList Entity), Recipe Entity)])
-> [Either
      [MissingIngredient]
      ((Inventory, IngredientList Entity), Recipe Entity)]
-> [((Inventory, IngredientList Entity), Recipe Entity)]
forall a b. (a -> b) -> a -> b
$
          (Recipe Entity
 -> Either
      [MissingIngredient]
      ((Inventory, IngredientList Entity), Recipe Entity))
-> [Recipe Entity]
-> [Either
      [MissingIngredient]
      ((Inventory, IngredientList Entity), Recipe Entity)]
forall a b. (a -> b) -> [a] -> [b]
map Recipe Entity
-> Either
     [MissingIngredient]
     ((Inventory, IngredientList Entity), Recipe Entity)
makeRecipe [Recipe Entity]
recipes
    ((Inventory
invTaken, IngredientList Entity
outs), Recipe Entity
recipe) <-
      Maybe ((Inventory, IngredientList Entity), Recipe Entity)
chosenRecipe
        Maybe ((Inventory, IngredientList Entity), Recipe Entity)
-> [Text] -> m ((Inventory, IngredientList Entity), Recipe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"You don't have the ingredients to", Text
verbPhrase, Text -> Text
indefinite (Entity
nextE Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

    let (IngredientList Entity
out, IngredientList Entity
down) = ((Int, Entity) -> Bool)
-> IngredientList Entity
-> (IngredientList Entity, IngredientList Entity)
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Pickable) (Entity -> Bool)
-> ((Int, Entity) -> Entity) -> (Int, Entity) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd) IngredientList Entity
outs
        learn :: [RobotUpdate]
learn = ((Int, Entity) -> RobotUpdate)
-> IngredientList Entity -> [RobotUpdate]
forall a b. (a -> b) -> [a] -> [b]
map (Entity -> RobotUpdate
LearnEntity (Entity -> RobotUpdate)
-> ((Int, Entity) -> Entity) -> (Int, Entity) -> RobotUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd) IngredientList Entity
down
        gain :: [RobotUpdate]
gain = ((Int, Entity) -> RobotUpdate)
-> IngredientList Entity -> [RobotUpdate]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Entity -> RobotUpdate) -> (Int, Entity) -> RobotUpdate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Entity -> RobotUpdate
AddEntity) IngredientList Entity
out

    Maybe Entity
newEnt <- case IngredientList Entity
down of
      [] -> Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entity
forall a. Maybe a
Nothing
      [(Int
1, Entity
de)] -> Maybe Entity -> m (Maybe Entity)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Entity -> m (Maybe Entity))
-> Maybe Entity -> m (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
de
      IngredientList Entity
_ -> Exn -> m (Maybe Entity)
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m (Maybe Entity)) -> Exn -> m (Maybe Entity)
forall a b. (a -> b) -> a -> b
$ Text -> Exn
Fatal Text
"Bad recipe:\n more than one unmovable entity produced."
    let changeWorld :: WorldUpdate Entity
changeWorld =
          ReplaceEntity
            { updatedLoc :: Cosmic Location
updatedLoc = Cosmic Location
nextLoc
            , originalEntity :: Entity
originalEntity = Entity
nextE
            , newEntity :: Maybe Entity
newEntity = Maybe Entity
newEnt
            }

    -- take recipe inputs from inventory and add outputs after recipeTime
    (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> Inventory -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
invTaken

    let cmdOutput :: Value
cmdOutput = Maybe Entity -> Value
forall a. Valuable a => a -> Value
asValue (Maybe Entity -> Value) -> Maybe Entity -> Value
forall a b. (a -> b) -> a -> b
$ (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd ((Int, Entity) -> Entity) -> Maybe (Int, Entity) -> Maybe Entity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IngredientList Entity -> Maybe (Int, Entity)
forall a. [a] -> Maybe a
listToMaybe IngredientList Entity
out
    Recipe Entity
-> Value -> [WorldUpdate Entity] -> [RobotUpdate] -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) e.
HasRobotStepState sig m =>
Recipe e
-> Value -> [WorldUpdate Entity] -> [RobotUpdate] -> m CESK
finishCookingRecipe Recipe Entity
recipe Value
cmdOutput [WorldUpdate Entity
changeWorld] ([RobotUpdate]
learn [RobotUpdate] -> [RobotUpdate] -> [RobotUpdate]
forall a. Semigroup a => a -> a -> a
<> [RobotUpdate]
gain)

  getDeviceTarget :: Text -> Direction -> m (Cosmic Location, Entity)
getDeviceTarget Text
verb Direction
d = do
    Text
rname <- Getting Text Robot Text -> m Text
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Text Robot Text
Lens' Robot Text
robotName

    (Cosmic Location
nextLoc, Maybe Entity
nextME) <- Direction -> m (Cosmic Location, Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
    Entity
nextE <-
      Maybe Entity
nextME
        Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is nothing to", Text
verb, Text
directionText, Text
"robot", Text
rname Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]
    (Cosmic Location, Entity) -> m (Cosmic Location, Entity)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cosmic Location
nextLoc, Entity
nextE)
   where
    directionText :: Text
directionText = case Direction
d of
      DRelative RelativeDir
DDown -> Text
"under"
      DRelative (DPlanar PlanarRelativeDir
DForward) -> Text
"ahead of"
      DRelative (DPlanar PlanarRelativeDir
DBack) -> Text
"behind"
      Direction
_ -> Direction -> Text
directionSyntax Direction
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of"

  goAtomic :: HasRobotStepState sig m => m CESK
  goAtomic :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m CESK
goAtomic = case [Value]
vs of
    -- To execute an atomic block, set the runningAtomic flag,
    -- push an FFinishAtomic frame so that we unset the flag when done, and
    -- proceed to execute the argument.
    [Value
cmd] -> do
      (Bool -> Identity Bool) -> Robot -> Identity Robot
Lens' Robot Bool
runningAtomic ((Bool -> Identity Bool) -> Robot -> Identity Robot)
-> Bool -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
cmd Store
s (Frame
FExec Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Frame
FFinishAtomic Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)
    [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst

  -- Case-insensitive matching on entity names
  isEntityNamed :: T.Text -> Entity -> Bool
  isEntityNamed :: Text -> Entity -> Bool
isEntityNamed Text
n Entity
e = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toLower) (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName) Text
n

  badConst :: HasRobotStepState sig m => m a
  badConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst = Exn -> m a
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m a) -> Exn -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Exn
Fatal Text
badConstMsg

  badConstMsg :: Text
  badConstMsg :: Text
badConstMsg =
    [Text] -> Text
T.unlines
      [ Text
"Bad application of execConst:"
      , CESK -> Text
forall a. PrettyPrec a => a -> Text
prettyText (Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c ([Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
vs)) Store
s Cont
k)
      ]

  doResonate ::
    (HasRobotStepState sig m, Has (Lift IO) sig m) =>
    (Maybe Entity -> Bool) ->
    Integer ->
    Integer ->
    Integer ->
    Integer ->
    m CESK
  doResonate :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
doResonate Maybe Entity -> Bool
p Integer
x1 Integer
y1 Integer
x2 Integer
y2 = do
    Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
    let offsets :: [Heading]
offsets = Integer -> Integer -> Integer -> Integer -> [Heading]
rectCells Integer
x1 Integer
y1 Integer
x2 Integer
y2
    [Int]
hits <- (Heading -> m Int) -> [Heading] -> m [Int]
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 ((Maybe Entity -> Int) -> m (Maybe Entity) -> m Int
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> Int) -> (Maybe Entity -> Bool) -> Maybe Entity -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Entity -> Bool
p) (m (Maybe Entity) -> m Int)
-> (Heading -> m (Maybe Entity)) -> Heading -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt (Cosmic Location -> m (Maybe Entity))
-> (Heading -> Cosmic Location) -> Heading -> m (Maybe Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc) [Heading]
offsets
    CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
hits) Store
s Cont
k

  rectCells :: Integer -> Integer -> Integer -> Integer -> [V2 Int32]
  rectCells :: Integer -> Integer -> Integer -> Integer -> [Heading]
rectCells Integer
x1 Integer
y1 Integer
x2 Integer
y2 =
    Int32 -> Int32 -> Int32 -> Int32 -> [Heading]
rectCellsInt32
      (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x1)
      (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y1)
      (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x2)
      (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y2)

  rectCellsInt32 :: Int32 -> Int32 -> Int32 -> Int32 -> [V2 Int32]
  rectCellsInt32 :: Int32 -> Int32 -> Int32 -> Int32 -> [Heading]
rectCellsInt32 Int32
x1 Int32
y1 Int32
x2 Int32
y2 = [Int32 -> Int32 -> Heading
forall a. a -> a -> V2 a
V2 Int32
x Int32
y | Int32
x <- [Int32
xMin .. Int32
xMax], Int32
y <- [Int32
yMin .. Int32
yMax]]
   where
    (Int32
xMin, Int32
xMax) = (Int32, Int32) -> (Int32, Int32)
forall b. Ord b => (b, b) -> (b, b)
sortPair (Int32
x1, Int32
x2)
    (Int32
yMin, Int32
yMax) = (Int32, Int32) -> (Int32, Int32)
forall b. Ord b => (b, b) -> (b, b)
sortPair (Int32
y1, Int32
y2)

  findNearest ::
    HasRobotStepState sig m =>
    Text ->
    m (Maybe (Int32, V2 Int32))
  findNearest :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m (Maybe (Int32, Heading))
findNearest Text
name = do
    Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
    let f :: (a, Heading) -> m Bool
f = (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (Entity -> Bool) -> Maybe Entity -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Entity -> Bool) -> Maybe Entity -> Bool)
-> (Entity -> Bool) -> Maybe Entity -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Entity -> Bool
isEntityNamed Text
name) (m (Maybe Entity) -> m Bool)
-> ((a, Heading) -> m (Maybe Entity)) -> (a, Heading) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt (Cosmic Location -> m (Maybe Entity))
-> ((a, Heading) -> Cosmic Location)
-> (a, Heading)
-> m (Maybe Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc (Heading -> Cosmic Location)
-> ((a, Heading) -> Heading) -> (a, Heading) -> Cosmic Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Heading) -> Heading
forall a b. (a, b) -> b
snd
    ((Int32, Heading) -> m Bool)
-> [(Int32, Heading)] -> m (Maybe (Int32, Heading))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m (Maybe a)
findM (Int32, Heading) -> m Bool
forall {a}. (a, Heading) -> m Bool
f [(Int32, Heading)]
sortedOffsets
   where
    sortedOffsets :: [(Int32, V2 Int32)]
    sortedOffsets :: [(Int32, Heading)]
sortedOffsets = (Int32
0, Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero) (Int32, Heading) -> [(Int32, Heading)] -> [(Int32, Heading)]
forall a. a -> [a] -> [a]
: (Int32 -> [(Int32, Heading)]) -> [Int32] -> [(Int32, Heading)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int32 -> [(Int32, Heading)]
genDiamondSides [Int32
1 .. Int32
maxSniffRange]

    -- Grow a list of locations in a diamond shape outward, such that the nearest cells
    -- are searched first by construction, rather than having to sort.
    genDiamondSides :: Int32 -> [(Int32, V2 Int32)]
    genDiamondSides :: Int32 -> [(Int32, Heading)]
genDiamondSides Int32
diameter = [[(Int32, Heading)]] -> [(Int32, Heading)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int32 -> Int32 -> [(Int32, Heading)]
forall {a}. Num a => a -> a -> [(a, V2 a)]
f Int32
diameter Int32
x | Int32
x <- [Int32
0 .. Int32
diameter]]
     where
      -- Adds a single cell to each of the four sides of the diamond
      f :: a -> a -> [(a, V2 a)]
f a
d a
x = (V2 a -> (a, V2 a)) -> [V2 a] -> [(a, V2 a)]
forall a b. (a -> b) -> [a] -> [b]
map (a
d,) ([V2 a] -> [(a, V2 a)]) -> (V2 a -> [V2 a]) -> V2 a -> [(a, V2 a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [V2 a] -> [V2 a]
forall a. Int -> [a] -> [a]
take Int
4 ([V2 a] -> [V2 a]) -> (V2 a -> [V2 a]) -> V2 a -> [V2 a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 a -> V2 a) -> V2 a -> [V2 a]
forall a. (a -> a) -> a -> [a]
iterate V2 a -> V2 a
forall a. Num a => V2 a -> V2 a
perp (V2 a -> [(a, V2 a)]) -> V2 a -> [(a, V2 a)]
forall a b. (a -> b) -> a -> b
$ a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x (a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
x)

  finishCookingRecipe ::
    HasRobotStepState sig m =>
    Recipe e ->
    Value ->
    [WorldUpdate Entity] ->
    [RobotUpdate] ->
    m CESK
  finishCookingRecipe :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) e.
HasRobotStepState sig m =>
Recipe e
-> Value -> [WorldUpdate Entity] -> [RobotUpdate] -> m CESK
finishCookingRecipe Recipe e
r Value
v [WorldUpdate Entity]
wf [RobotUpdate]
rf =
    if Integer
remTime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
      then do
        Const -> [WorldUpdate Entity] -> [RobotUpdate] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Const -> [WorldUpdate Entity] -> [RobotUpdate] -> m ()
updateWorldAndRobots Const
c [WorldUpdate Entity]
wf [RobotUpdate]
rf
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
      else do
        TickNumber
time <- Getting TickNumber GameState TickNumber -> m TickNumber
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting TickNumber GameState TickNumber -> m TickNumber)
-> Getting TickNumber GameState TickNumber -> m TickNumber
forall a b. (a -> b) -> a -> b
$ (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
        CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> (CESK -> CESK) -> CESK -> m CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (CESK -> CESK) -> CESK -> CESK
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Integer
remTime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
1) (TickNumber -> CESK -> CESK
Waiting (Int -> TickNumber -> TickNumber
addTicks (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
remTime) TickNumber
time)) (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$
          Value -> Store -> Cont -> CESK
Out Value
v Store
s (Const -> [WorldUpdate Entity] -> [RobotUpdate] -> Frame
FImmediate Const
c [WorldUpdate Entity]
wf [RobotUpdate]
rf Frame -> Cont -> Cont
forall a. a -> [a] -> [a]
: Cont
k)
   where
    remTime :: Integer
remTime = Recipe e
r Recipe e -> Getting Integer (Recipe e) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer (Recipe e) Integer
forall e (f :: * -> *).
Functor f =>
(Integer -> f Integer) -> Recipe e -> f (Recipe e)
recipeTime

  ensureEquipped :: HasRobotStepState sig m => Text -> m Entity
  ensureEquipped :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
ensureEquipped Text
itemName = do
    Inventory
inst <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
    [Entity] -> Maybe Entity
forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
itemName Inventory
inst)
      Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"You don't have", Text -> Text
indefinite Text
itemName, Text
"equipped."]

  ensureItem :: HasRobotStepState sig m => Text -> Text -> m Entity
  ensureItem :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
action = do
    -- First, make sure we know about the entity.
    Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
    Inventory
inst <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices
    Entity
item <-
      [Maybe Entity] -> Maybe Entity
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Inventory -> Maybe Entity) -> [Inventory] -> [Maybe Entity]
forall a b. (a -> b) -> [a] -> [b]
map ([Entity] -> Maybe Entity
forall a. [a] -> Maybe a
listToMaybe ([Entity] -> Maybe Entity)
-> (Inventory -> [Entity]) -> Inventory -> Maybe Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inventory -> [Entity]
lookupByName Text
itemName) [Inventory
inv, Inventory
inst])
        Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"What is", Text -> Text
indefinite Text
itemName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?"]

    -- Next, check whether we have one.  If we don't, add a hint about
    -- 'create' in creative mode.
    Bool
creative <- Getting Bool GameState Bool -> m Bool
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Bool GameState Bool
Lens' GameState Bool
creativeMode
    let create :: [Text] -> [Text]
create [Text]
l = [Text]
l [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"You can make one first with 'create \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
itemName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"'." | Bool
creative]

    (Entity -> Inventory -> Int
E.lookup Entity
item Inventory
inv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
      Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text] -> [Text]
create [Text
"You don't have", Text -> Text
indefinite Text
itemName, Text
"to", Text
action Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

    Entity -> m Entity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
item

  -- Check the required devices and stocked inventory for running the given
  -- command on a target robot.  This function is used in common by
  -- both 'Build' and 'Reprogram'.
  --
  -- It is given as inputs the parent robot inventory, the inventory
  -- and equipped devices of the child (these will be empty in the
  -- case of 'Build'), and the command to be run (along with a few
  -- inputs to configure any error messages to be generated).
  --
  -- Throws an exception if it's not possible to set up the child
  -- robot with the things it needs to execute the given program.
  -- Otherwise, returns a pair consisting of the set of devices to be
  -- equipped, and the inventory that should be transferred from
  -- parent to child.
  checkRequirements ::
    HasRobotStepState sig m =>
    Env ->
    Inventory ->
    Inventory ->
    Inventory ->
    Term ->
    Text ->
    IncapableFix ->
    m (Set Entity, Inventory)
  checkRequirements :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Env
-> Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements Env
e Inventory
parentInventory Inventory
childInventory Inventory
childDevices Term
cmd Text
subject IncapableFix
fixI = do
    let reqCtx :: ReqCtx
reqCtx = Env
e Env -> Getting ReqCtx Env ReqCtx -> ReqCtx
forall s a. s -> Getting a s a -> a
^. Getting ReqCtx Env ReqCtx
Lens' Env ReqCtx
envReqs
        tdCtx :: TDCtx
tdCtx = Env
e Env -> Getting TDCtx Env TDCtx -> TDCtx
forall s a. s -> Getting a s a -> a
^. Getting TDCtx Env TDCtx
Lens' Env TDCtx
envTydefs
    EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
    Bool
privileged <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
    let R.Requirements (Set Capability -> [Capability]
forall a. Set a -> [a]
S.toList -> [Capability]
caps) (Set Text -> [Text]
forall a. Set a -> [a]
S.toList -> [Text]
devNames) Map Text Int
reqInvNames =
          TDCtx -> ReqCtx -> Term -> Requirements
R.requirements TDCtx
tdCtx ReqCtx
reqCtx Term
cmd

    -- Check that all required device names exist (fail with
    -- an exception if not) and convert them to 'Entity' values.
    ([Entity]
devs :: [Entity]) <- [Text] -> (Text -> m Entity) -> m [Entity]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
devNames ((Text -> m Entity) -> m [Entity])
-> (Text -> m Entity) -> m [Entity]
forall a b. (a -> b) -> a -> b
$ \Text
devName ->
      Text -> EntityMap -> Maybe Entity
E.lookupEntityName Text
devName EntityMap
em Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"Unknown device required: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
devName]

    -- Check that all required inventory entity names exist (fail with
    -- an exception if not) and convert them to 'Entity' values, with
    -- an associated count for each.
    (Inventory
reqInv :: Inventory) <- (IngredientList Entity -> Inventory)
-> m (IngredientList Entity) -> m Inventory
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IngredientList Entity -> Inventory
E.fromElems (m (IngredientList Entity) -> m Inventory)
-> (((Text, Int) -> m (Int, Entity)) -> m (IngredientList Entity))
-> ((Text, Int) -> m (Int, Entity))
-> m Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Int)]
-> ((Text, Int) -> m (Int, Entity)) -> m (IngredientList Entity)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map Text Int -> [(Text, Int)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Text Int
reqInvNames) (((Text, Int) -> m (Int, Entity)) -> m Inventory)
-> ((Text, Int) -> m (Int, Entity)) -> m Inventory
forall a b. (a -> b) -> a -> b
$ \(Text
eName, Int
n) ->
      (Int
n,)
        (Entity -> (Int, Entity)) -> m Entity -> m (Int, Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> EntityMap -> Maybe Entity
E.lookupEntityName Text
eName EntityMap
em
                Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"Unknown entity required: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
eName]
            )

    let -- List of possible devices per requirement.  For the
        -- requirements that stem from a required capability, we
        -- remember the capability alongside the possible devices, to
        -- help with later error message generation.
        possibleDevices :: [(Maybe Capability, [Entity])]
        possibleDevices :: [(Maybe Capability, [Entity])]
possibleDevices =
          (Capability -> (Maybe Capability, [Entity]))
-> [Capability] -> [(Maybe Capability, [Entity])]
forall a b. (a -> b) -> [a] -> [b]
map (Capability -> Maybe Capability
forall a. a -> Maybe a
Just (Capability -> Maybe Capability)
-> (Capability -> [Entity])
-> Capability
-> (Maybe Capability, [Entity])
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')
&&& (Capability -> EntityMap -> [Entity]
`devicesForCap` EntityMap
em)) [Capability]
caps -- Possible devices for capabilities
            [(Maybe Capability, [Entity])]
-> [(Maybe Capability, [Entity])] -> [(Maybe Capability, [Entity])]
forall a. [a] -> [a] -> [a]
++ (Entity -> (Maybe Capability, [Entity]))
-> [Entity] -> [(Maybe Capability, [Entity])]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe Capability
forall a. Maybe a
Nothing,) ([Entity] -> (Maybe Capability, [Entity]))
-> (Entity -> [Entity]) -> Entity -> (Maybe Capability, [Entity])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> [Entity] -> [Entity]
forall a. a -> [a] -> [a]
: [])) [Entity]
devs -- Outright required devices

        -- A device is OK if it is available in the inventory of the
        -- parent robot, or already equipped in the child robot.
        deviceOK :: Entity -> Bool
        deviceOK :: Entity -> Bool
deviceOK Entity
d = Inventory
parentInventory Inventory -> Entity -> Bool
`E.contains` Entity
d Bool -> Bool -> Bool
|| Inventory
childDevices Inventory -> Entity -> Bool
`E.contains` Entity
d

        -- Partition each list of possible devices into a set of
        -- available devices and a set of unavailable devices.
        -- There's a problem if some capability is required but no
        -- devices that provide it are available.  In that case we can
        -- print an error message, using the second set as a list of
        -- suggestions.
        partitionedDevices :: [(Set Entity, Set Entity)]
        partitionedDevices :: [(Set Entity, Set Entity)]
partitionedDevices =
          ((Maybe Capability, [Entity]) -> (Set Entity, Set Entity))
-> [(Maybe Capability, [Entity])] -> [(Set Entity, Set Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter
  ([Entity], [Entity]) (Set Entity, Set Entity) [Entity] (Set Entity)
-> ([Entity] -> Set Entity)
-> ([Entity], [Entity])
-> (Set Entity, Set Entity)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over ASetter
  ([Entity], [Entity]) (Set Entity, Set Entity) [Entity] (Set Entity)
Traversal
  ([Entity], [Entity]) (Set Entity, Set Entity) [Entity] (Set Entity)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
S.fromList (([Entity], [Entity]) -> (Set Entity, Set Entity))
-> ((Maybe Capability, [Entity]) -> ([Entity], [Entity]))
-> (Maybe Capability, [Entity])
-> (Set Entity, Set Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Bool) -> [Entity] -> ([Entity], [Entity])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Entity -> Bool
deviceOK ([Entity] -> ([Entity], [Entity]))
-> ((Maybe Capability, [Entity]) -> [Entity])
-> (Maybe Capability, [Entity])
-> ([Entity], [Entity])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Capability, [Entity]) -> [Entity]
forall a b. (a, b) -> b
snd) [(Maybe Capability, [Entity])]
possibleDevices

        -- Devices equipped on the child, as a Set instead of an
        -- Inventory for convenience.
        alreadyEquipped :: Set Entity
        alreadyEquipped :: Set Entity
alreadyEquipped = [Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
S.fromList ([Entity] -> Set Entity)
-> (Inventory -> [Entity]) -> Inventory -> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Entity) -> IngredientList Entity -> [Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> Entity
forall a b. (a, b) -> b
snd (IngredientList Entity -> [Entity])
-> (Inventory -> IngredientList Entity) -> Inventory -> [Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> IngredientList Entity
E.elems (Inventory -> Set Entity) -> Inventory -> Set Entity
forall a b. (a -> b) -> a -> b
$ Inventory
childDevices

        -- Figure out what is still missing of the required inventory:
        -- the required inventory, less any inventory the child robot
        -- already has.
        missingChildInv :: Inventory
missingChildInv = Inventory
reqInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
childInventory

    if Bool
privileged
      then
        (Set Entity, Inventory) -> m (Set Entity, Inventory)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
          ( -- When 'privileged', just equip ALL the devices
            -- providing each required capability (because, why
            -- not?). But don't re-equip any that are already
            -- equipped.
            [Set Entity] -> Set Entity
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (((Maybe Capability, [Entity]) -> Set Entity)
-> [(Maybe Capability, [Entity])] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map ([Entity] -> Set Entity
forall a. Ord a => [a] -> Set a
S.fromList ([Entity] -> Set Entity)
-> ((Maybe Capability, [Entity]) -> [Entity])
-> (Maybe Capability, [Entity])
-> Set Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Capability, [Entity]) -> [Entity]
forall a b. (a, b) -> b
snd) [(Maybe Capability, [Entity])]
possibleDevices) Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Entity
alreadyEquipped
          , -- Conjure the necessary missing inventory out of thin
            -- air.
            Inventory
missingChildInv
          )
      else do
        -- First, check that devices actually exist AT ALL to provide every
        -- required capability.  If not, we will generate an error message saying
        -- something like "missing capability X but no device yet provides it".
        let capsWithNoDevice :: [Capability]
capsWithNoDevice = ((Maybe Capability, [Entity]) -> Maybe Capability)
-> [(Maybe Capability, [Entity])] -> [Capability]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe Capability, [Entity]) -> Maybe Capability
forall a b. (a, b) -> a
fst ([(Maybe Capability, [Entity])] -> [Capability])
-> ([(Maybe Capability, [Entity])]
    -> [(Maybe Capability, [Entity])])
-> [(Maybe Capability, [Entity])]
-> [Capability]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Capability, [Entity]) -> Bool)
-> [(Maybe Capability, [Entity])] -> [(Maybe Capability, [Entity])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Entity] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Entity] -> Bool)
-> ((Maybe Capability, [Entity]) -> [Entity])
-> (Maybe Capability, [Entity])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Capability, [Entity]) -> [Entity]
forall a b. (a, b) -> b
snd) ([(Maybe Capability, [Entity])] -> [Capability])
-> [(Maybe Capability, [Entity])] -> [Capability]
forall a b. (a -> b) -> a -> b
$ [(Maybe Capability, [Entity])]
possibleDevices
        [Capability] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Capability]
capsWithNoDevice
          Bool -> Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
fixI (Set Capability -> Set Text -> Map Text Int -> Requirements
R.Requirements ([Capability] -> Set Capability
forall a. Ord a => [a] -> Set a
S.fromList [Capability]
capsWithNoDevice) Set Text
forall a. Set a
S.empty Map Text Int
forall k a. Map k a
M.empty) Term
cmd

        -- Now, ensure there is at least one device available to be
        -- equipped for each requirement, and minimize the resulting
        -- sets of device alternatives by removing any set which is a
        -- superset of another.
        let missingDevices :: Set (Set Entity)
missingDevices = Set (Set Entity) -> Set (Set Entity)
forall a. Ord a => Set (Set a) -> Set (Set a)
removeSupersets (Set (Set Entity) -> Set (Set Entity))
-> ([(Set Entity, Set Entity)] -> Set (Set Entity))
-> [(Set Entity, Set Entity)]
-> Set (Set Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set Entity] -> Set (Set Entity)
forall a. Ord a => [a] -> Set a
S.fromList ([Set Entity] -> Set (Set Entity))
-> ([(Set Entity, Set Entity)] -> [Set Entity])
-> [(Set Entity, Set Entity)]
-> Set (Set Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Entity, Set Entity) -> Set Entity)
-> [(Set Entity, Set Entity)] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Set Entity, Set Entity) -> Set Entity
forall a b. (a, b) -> b
snd ([(Set Entity, Set Entity)] -> [Set Entity])
-> ([(Set Entity, Set Entity)] -> [(Set Entity, Set Entity)])
-> [(Set Entity, Set Entity)]
-> [Set Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Entity, Set Entity) -> Bool)
-> [(Set Entity, Set Entity)] -> [(Set Entity, Set Entity)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Set Entity -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set Entity -> Bool)
-> ((Set Entity, Set Entity) -> Set Entity)
-> (Set Entity, Set Entity)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Entity, Set Entity) -> Set Entity
forall a b. (a, b) -> a
fst) ([(Set Entity, Set Entity)] -> Set (Set Entity))
-> [(Set Entity, Set Entity)] -> Set (Set Entity)
forall a b. (a -> b) -> a -> b
$ [(Set Entity, Set Entity)]
partitionedDevices
        let IncapableFixWords Text
fVerb Text
fNoun = IncapableFix -> IncapableFixWords
formatIncapableFix IncapableFix
fixI
        Set (Set Entity) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set (Set Entity)
missingDevices
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` ( Text -> Text -> Text
singularSubjectVerb Text
subject Text
"do"
                            Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"not have required " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fNoun Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", please"
                            Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
fVerb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
                            Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text
"\n  - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Set Entity -> Text) -> Set Entity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> Text
formatDevices (Set Entity -> Text) -> [Set Entity] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (Set Entity) -> [Set Entity]
forall a. Set a -> [a]
S.toList Set (Set Entity)
missingDevices)
                        )

        let minimalEquipSet :: Set Entity
minimalEquipSet = [Set Entity] -> Set Entity
forall a. Ord a => [Set a] -> Set a
smallHittingSet ((Set Entity -> Bool) -> [Set Entity] -> [Set Entity]
forall a. (a -> Bool) -> [a] -> [a]
filter (Set Entity -> Bool
forall a. Set a -> Bool
S.null (Set Entity -> Bool)
-> (Set Entity -> Set Entity) -> Set Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> Set Entity -> Set Entity
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Entity
alreadyEquipped) (((Set Entity, Set Entity) -> Set Entity)
-> [(Set Entity, Set Entity)] -> [Set Entity]
forall a b. (a -> b) -> [a] -> [b]
map (Set Entity, Set Entity) -> Set Entity
forall a b. (a, b) -> a
fst [(Set Entity, Set Entity)]
partitionedDevices))

            -- Check that we have enough in our inventory to cover the
            -- required devices PLUS what's missing from the child
            -- inventory.

            -- What do we need?
            neededParentInv :: Inventory
neededParentInv =
              Inventory
missingChildInv
                Inventory -> Inventory -> Inventory
`E.union` ([Entity] -> Inventory
fromList ([Entity] -> Inventory)
-> (Set Entity -> [Entity]) -> Set Entity -> Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> [Entity]
forall a. Set a -> [a]
S.toList (Set Entity -> Inventory) -> Set Entity -> Inventory
forall a b. (a -> b) -> a -> b
$ Set Entity
minimalEquipSet)

            -- What are we missing?
            missingParentInv :: Inventory
missingParentInv = Inventory
neededParentInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
parentInventory
            missingMap :: Map Text Int
missingMap =
              [(Text, Int)] -> Map Text Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                ([(Text, Int)] -> Map Text Int)
-> (Inventory -> [(Text, Int)]) -> Inventory -> Map Text Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Int) -> Bool) -> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Bool) -> ((Text, Int) -> Int) -> (Text, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Int) -> Int
forall a b. (a, b) -> b
snd)
                ([(Text, Int)] -> [(Text, Int)])
-> (Inventory -> [(Text, Int)]) -> Inventory -> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> (Text, Int))
-> IngredientList Entity -> [(Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Text) -> (Text, Int)
forall a b. (a, b) -> (b, a)
swap ((Int, Text) -> (Text, Int))
-> ((Int, Entity) -> (Int, Text)) -> (Int, Entity) -> (Text, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Text) -> (Int, Entity) -> (Int, Text)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName))
                (IngredientList Entity -> [(Text, Int)])
-> (Inventory -> IngredientList Entity)
-> Inventory
-> [(Text, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> IngredientList Entity
E.elems
                (Inventory -> Map Text Int) -> Inventory -> Map Text Int
forall a b. (a -> b) -> a -> b
$ Inventory
missingParentInv

        -- If we're missing anything, throw an error
        Inventory -> Bool
E.isEmpty Inventory
missingParentInv
          Bool -> Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
fixI (Set Capability -> Set Text -> Map Text Int -> Requirements
R.Requirements Set Capability
forall a. Set a
S.empty Set Text
forall a. Set a
S.empty Map Text Int
missingMap) Term
cmd

        (Set Entity, Inventory) -> m (Set Entity, Inventory)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Entity
minimalEquipSet, Inventory
missingChildInv)

  -- Destroy the current robot, as long as it is not the base robot.
  --
  -- Depending on whether we destroy (True) or do not destroy
  -- (False) the current robot, possibly grant an achievement.
  --
  -- Note we cannot simply return a Boolean and grant achievements
  -- at call sites, because in the case that we do not destroy the
  -- base we actually throw an exception, so we do not return to the
  -- original call site.
  destroyIfNotBase ::
    (HasRobotStepState sig m, Has (Lift IO) sig m) =>
    (Bool -> Maybe GameplayAchievement) ->
    m ()
  destroyIfNotBase :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Bool -> Maybe GameplayAchievement) -> m ()
destroyIfNotBase Bool -> Maybe GameplayAchievement
mAch = do
    Int
rid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
    Bool -> [Text] -> Maybe GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> Maybe GameplayAchievement -> m ()
holdsOrFailWithAchievement
      (Int
rid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
      [Text
"You consider destroying your base, but decide not to do it after all."]
      (Bool -> Maybe GameplayAchievement
mAch Bool
False)

    (Bool -> Identity Bool) -> Robot -> Identity Robot
Lens' Robot Bool
selfDestruct ((Bool -> Identity Bool) -> Robot -> Identity Robot)
-> Bool -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    Maybe GameplayAchievement -> (GameplayAchievement -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Bool -> Maybe GameplayAchievement
mAch Bool
True) GameplayAchievement -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievementForRobot

  -- Try to move the current robot once cell in a specific direction,
  -- checking for and applying any relevant effects (e.g. throwing an
  -- exception if blocked, drowning in water, etc.)
  moveInDirection :: (HasRobotStepState sig m, Has (Lift IO) sig m) => Heading -> m CESK
  moveInDirection :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Heading -> m CESK
moveInDirection Heading
orientation = do
    -- Figure out where we're going
    Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
    let nextLoc :: Cosmic Location
nextLoc = Cosmic Location
loc Cosmic Location -> Heading -> Cosmic Location
`offsetBy` Heading
orientation
    Cosmic Location -> MoveFailureHandler -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Cosmic Location -> MoveFailureHandler -> m ()
checkMoveAhead Cosmic Location
nextLoc (MoveFailureHandler -> m ()) -> MoveFailureHandler -> m ()
forall a b. (a -> b) -> a -> b
$ \case
      PathBlockedBy Maybe Entity
_ -> RobotFailure
ThrowExn
      PathLiquid Entity
_ -> RobotFailure
Destroy
    Cosmic Location -> Cosmic Location -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
loc Cosmic Location
nextLoc
    CESK -> m CESK
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CESK -> m CESK) -> CESK -> m CESK
forall a b. (a -> b) -> a -> b
$ () -> CESK
forall a. Valuable a => a -> CESK
mkReturn ()

  -- Given a possible movement failure, apply a movement failure
  -- handler to generate the appropriate effect.
  applyMoveFailureEffect ::
    (HasRobotStepState sig m, Has (Lift IO) sig m) =>
    Maybe MoveFailureMode ->
    MoveFailureHandler ->
    m ()
  applyMoveFailureEffect :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureMode -> MoveFailureHandler -> m ()
applyMoveFailureEffect Maybe MoveFailureMode
maybeFailure MoveFailureHandler
failureHandler =
    Maybe MoveFailureMode -> (MoveFailureMode -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe MoveFailureMode
maybeFailure ((MoveFailureMode -> m ()) -> m ())
-> (MoveFailureMode -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \MoveFailureMode
failureMode -> case MoveFailureHandler
failureHandler MoveFailureMode
failureMode of
      RobotFailure
IgnoreFail -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RobotFailure
Destroy -> (Bool -> Maybe GameplayAchievement) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Bool -> Maybe GameplayAchievement) -> m ()
destroyIfNotBase ((Bool -> Maybe GameplayAchievement) -> m ())
-> (Bool -> Maybe GameplayAchievement) -> m ()
forall a b. (a -> b) -> a -> b
$ \Bool
b -> case (Bool
b, MoveFailureMode
failureMode) of
        (Bool
True, PathLiquid Entity
_) -> GameplayAchievement -> Maybe GameplayAchievement
forall a. a -> Maybe a
Just GameplayAchievement
RobotIntoWater -- achievement for drowning
        (Bool
False, MoveFailureMode
_) -> GameplayAchievement -> Maybe GameplayAchievement
forall a. a -> Maybe a
Just GameplayAchievement
AttemptSelfDestructBase
        (Bool, MoveFailureMode)
_ -> Maybe GameplayAchievement
forall a. Maybe a
Nothing
      RobotFailure
ThrowExn -> Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Exn -> m ()) -> ([Text] -> Exn) -> [Text] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> [Text] -> Exn
cmdExn Const
c ([Text] -> m ()) -> [Text] -> m ()
forall a b. (a -> b) -> a -> b
$
        case MoveFailureMode
failureMode of
          PathBlockedBy Maybe Entity
ent -> case Maybe Entity
ent of
            Just Entity
e -> [Text
"There is a", Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName, Text
"in the way!"]
            Maybe Entity
Nothing -> [Text
"There is nothing to travel on!"]
          PathLiquid Entity
e -> [Text
"There is a dangerous liquid", Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName, Text
"in the way!"]

  -- Check whether there is any failure in moving to the given
  -- location, and apply the corresponding effect if so.
  checkMoveAhead ::
    (HasRobotStepState sig m, Has (Lift IO) sig m) =>
    Cosmic Location ->
    MoveFailureHandler ->
    m ()
  checkMoveAhead :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Cosmic Location -> MoveFailureHandler -> m ()
checkMoveAhead Cosmic Location
nextLoc MoveFailureHandler
failureHandler = do
    Maybe MoveFailureMode
maybeFailure <- Cosmic Location -> m (Maybe MoveFailureMode)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureMode)
checkMoveFailure Cosmic Location
nextLoc
    Maybe MoveFailureMode -> MoveFailureHandler -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureMode -> MoveFailureHandler -> m ()
applyMoveFailureEffect Maybe MoveFailureMode
maybeFailure MoveFailureHandler
failureHandler

  getRobotWithinTouch :: HasRobotStepState sig m => RID -> m Robot
  getRobotWithinTouch :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Int -> m Robot
getRobotWithinTouch Int
rid = do
    Int
cid <- Getting Int Robot Int -> m Int
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Int Robot Int
Getter Robot Int
robotID
    if Int
cid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rid
      then forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @Robot
      else do
        Maybe Robot
mother <- Int -> m (Maybe Robot)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID Int
rid
        Robot
other <- Maybe Robot
mother Maybe Robot -> [Text] -> m Robot
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot with ID", String -> Text
forall source target. From source target => source -> target
from (Int -> String
forall a. Show a => a -> String
show Int
rid) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

        let otherLoc :: Cosmic Location
otherLoc = Robot
other Robot
-> Getting (Cosmic Location) Robot (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
        Bool
privileged <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
        Cosmic Location
myLoc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation

        -- Make sure it is either in the same location or we do not care
        Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt Bool
privileged Cosmic Location
myLoc Cosmic Location
otherLoc
          Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"The robot with ID", String -> Text
forall source target. From source target => source -> target
from (Int -> String
forall a. Show a => a -> String
show Int
rid), Text
"is not close enough."]
        Robot -> m Robot
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Robot
other

  holdsOrFail :: (Has (Throw Exn) sig m) => Bool -> [Text] -> m ()
  holdsOrFail :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
holdsOrFail = Const -> Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Bool -> [Text] -> m ()
holdsOrFail' Const
c

  holdsOrFailWithAchievement :: (Has (Throw Exn) sig m) => Bool -> [Text] -> Maybe GameplayAchievement -> m ()
  holdsOrFailWithAchievement :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> Maybe GameplayAchievement -> m ()
holdsOrFailWithAchievement Bool
a [Text]
ts Maybe GameplayAchievement
mAch = case Maybe GameplayAchievement
mAch of
    Maybe GameplayAchievement
Nothing -> Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
holdsOrFail Bool
a [Text]
ts
    Just GameplayAchievement
ach -> Bool
a Bool -> Exn -> m ()
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` Const -> [Text] -> GameplayAchievement -> Exn
cmdExnWithAchievement Const
c [Text]
ts GameplayAchievement
ach

  isJustOrFail :: (Has (Throw Exn) sig m) => Maybe a -> [Text] -> m a
  isJustOrFail :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
isJustOrFail = Const -> Maybe a -> [Text] -> m a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> Maybe a -> [Text] -> m a
isJustOrFail' Const
c

  returnEvalCmp :: m CESK
returnEvalCmp = case [Value]
vs of
    [Value
v1, Value
v2] -> (\Bool
b -> Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool Bool
b) Store
s Cont
k) (Bool -> CESK) -> m Bool -> m CESK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Const -> Value -> Value -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Value -> Value -> m Bool
evalCmp Const
c Value
v1 Value
v2
    [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
  returnEvalArith :: m CESK
returnEvalArith = case [Value]
vs of
    [VInt Integer
n1, VInt Integer
n2] -> (\Integer
r -> Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt Integer
r) Store
s Cont
k) (Integer -> CESK) -> m Integer -> m CESK
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Const -> Integer -> Integer -> m Integer
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Integer -> Integer -> m Integer
evalArith Const
c Integer
n1 Integer
n2
    [Value]
_ -> m CESK
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst

  -- Make sure the robot has the thing in its inventory
  hasInInventoryOrFail :: HasRobotStepState sig m => Text -> m Entity
  hasInInventoryOrFail :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
eName = do
    Inventory
inv <- Getting Inventory Robot Inventory -> m Inventory
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory
    Entity
e <-
      [Entity] -> Maybe Entity
forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
eName Inventory
inv)
        Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"What is", Text -> Text
indefinite Text
eName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?"]
    let cmd :: Text
cmd = Text -> Text
T.toLower (Text -> Text) -> (Const -> Text) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Const -> String) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> String
forall a. Show a => a -> String
show (Const -> Text) -> Const -> Text
forall a b. (a -> b) -> a -> b
$ Const
c
    (Entity -> Inventory -> Int
E.lookup Entity
e Inventory
inv Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
      Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You don't have", Text -> Text
indefinite Text
eName, Text
"to", Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]
    Entity -> m Entity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e

  mkReturn :: Valuable a => a -> CESK
  mkReturn :: forall a. Valuable a => a -> CESK
mkReturn a
x = Value -> Store -> Cont -> CESK
Out (a -> Value
forall a. Valuable a => a -> Value
asValue a
x) Store
s Cont
k

  doPlantSeed ::
    (HasRobotStepState sig m, Has Effect.Time sig m) =>
    TerrainType ->
    Cosmic Location ->
    Entity ->
    m ()
  doPlantSeed :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
TerrainType -> Cosmic Location -> Entity -> m ()
doPlantSeed TerrainType
terrainHere Cosmic Location
loc Entity
e = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Growable) Bool -> Bool -> Bool
&& TerrainType -> Entity -> Bool
isAllowedInBiome TerrainType
terrainHere Entity
e) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      let Growth Maybe Text
maybeMaturesTo Maybe GrowthSpread
maybeSpread (GrowthTime (Integer
minT, Integer
maxT)) =
            (Entity
e Entity
-> Getting (Maybe Growth) Entity (Maybe Growth) -> Maybe Growth
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Growth) Entity (Maybe Growth)
Lens' Entity (Maybe Growth)
entityGrowth) Maybe Growth -> Growth -> Growth
forall a. Maybe a -> a -> a
? Growth
defaultGrowth

      EntityMap
em <- Getting EntityMap GameState EntityMap -> m EntityMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting EntityMap GameState EntityMap -> m EntityMap)
-> Getting EntityMap GameState EntityMap -> m EntityMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap
      let seedEntity :: Entity
seedEntity = Entity -> Maybe Entity -> Entity
forall a. a -> Maybe a -> a
fromMaybe Entity
e (Maybe Entity -> Entity) -> Maybe Entity -> Entity
forall a b. (a -> b) -> a -> b
$ (Text -> EntityMap -> Maybe Entity
`lookupEntityName` EntityMap
em) (Text -> Maybe Entity) -> Maybe Text -> Maybe Entity
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
maybeMaturesTo

      TimeSpec
createdAt <- m TimeSpec
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has Time sig m =>
m TimeSpec
getNow
      let radius :: Int
radius = Int -> (GrowthSpread -> Int) -> Maybe GrowthSpread -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 GrowthSpread -> Int
spreadRadius Maybe GrowthSpread
maybeSpread
          seedlingDensity :: Float
seedlingDensity = Float -> (GrowthSpread -> Float) -> Maybe GrowthSpread -> Float
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Float
0 GrowthSpread -> Float
spreadDensity Maybe GrowthSpread
maybeSpread
          -- See https://en.wikipedia.org/wiki/Triangular_number#Formula
          seedlingArea :: Int
seedlingArea = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
radius Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
radius Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          seedlingCount :: Integer
seedlingCount = Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
seedlingDensity Float -> Float -> Float
forall a. Num a => a -> a -> a
* Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seedlingArea

      -- Grow a new entity from a seed.
      Entity
-> (Integer, Integer)
-> Integer
-> Integer
-> Cosmic Location
-> TimeSpec
-> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity
-> (Integer, Integer)
-> Integer
-> Integer
-> Cosmic Location
-> TimeSpec
-> m ()
addSeedBot
        Entity
seedEntity
        (Integer
minT, Integer
maxT)
        Integer
seedlingCount
        (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
radius)
        Cosmic Location
loc
        TimeSpec
createdAt
   where
    isAllowedInBiome :: TerrainType -> Entity -> Bool
isAllowedInBiome TerrainType
terr Entity
ent =
      Set TerrainType -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set TerrainType
biomeRestrictions
        Bool -> Bool -> Bool
|| TerrainType
terr TerrainType -> Set TerrainType -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set TerrainType
biomeRestrictions
     where
      biomeRestrictions :: Set TerrainType
biomeRestrictions = Entity
ent Entity
-> Getting (Set TerrainType) Entity (Set TerrainType)
-> Set TerrainType
forall s a. s -> Getting a s a -> a
^. Getting (Set TerrainType) Entity (Set TerrainType)
Lens' Entity (Set TerrainType)
entityBiomes

  -- The code for grab and harvest is almost identical, hence factored
  -- out here.
  -- Optionally defer removal from the world, for the case of the Swap command.
  doGrab :: (HasRobotStepState sig m, Has Effect.Time sig m) => GrabbingCmd -> GrabRemoval -> m Entity
  doGrab :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
GrabbingCmd -> GrabRemoval -> m Entity
doGrab GrabbingCmd
cmd GrabRemoval
removalDeferral = do
    let verb :: Text
verb = GrabbingCmd -> Text
verbGrabbingCmd GrabbingCmd
cmd
        verbed :: Text
verbed = GrabbingCmd -> Text
verbedGrabbingCmd GrabbingCmd
cmd

    -- Ensure there is an entity here.
    Cosmic Location
loc <- Getting (Cosmic Location) Robot (Cosmic Location)
-> m (Cosmic Location)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting (Cosmic Location) Robot (Cosmic Location)
Getter Robot (Cosmic Location)
robotLocation
    (TerrainType
terrainHere, Maybe Entity
maybeEntityHere) <- Cosmic Location -> m (TerrainType, Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (TerrainType, Maybe Entity)
contentAt Cosmic Location
loc
    Entity
e <- Maybe Entity
maybeEntityHere Maybe Entity -> [Text] -> m Entity
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is nothing here to", Text
verb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

    -- Ensure it can be picked up.
    Bool
omni <- m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
    (Bool
omni Bool -> Bool -> Bool
|| Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Pickable)
      Bool -> [Text] -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"The", Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName, Text
"here can't be", Text
verbed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."]

    -- Entities with 'infinite' property are not removed
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GrabRemoval
removalDeferral GrabRemoval -> GrabRemoval -> Bool
forall a. Eq a => a -> a -> Bool
== GrabRemoval
DeferRemoval Bool -> Bool -> Bool
|| Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Infinite) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      -- Remove the entity from the world.
      Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (Maybe Entity -> Maybe Entity -> Maybe Entity
forall a b. a -> b -> a
const Maybe Entity
forall a. Maybe a
Nothing)
      m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw

    -- Possibly regrow the entity, if it is growable and the 'harvest'
    -- command was used.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GrabbingCmd
cmd GrabbingCmd -> GrabbingCmd -> Bool
forall a. Eq a => a -> a -> Bool
== GrabbingCmd
Harvest') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      TerrainType -> Cosmic Location -> Entity -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has Time sig m) =>
TerrainType -> Cosmic Location -> Entity -> m ()
doPlantSeed TerrainType
terrainHere Cosmic Location
loc Entity
e

    -- Add the picked up item to the robot's inventory.  If the
    -- entity yields something different, add that instead.
    Entity
e' <- case Entity
e Entity -> Getting (Maybe Text) Entity (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Entity (Maybe Text)
Lens' Entity (Maybe Text)
entityYields of
      Maybe Text
Nothing -> Entity -> m Entity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e
      Just Text
yielded ->
        -- NOTE: Using 'fromMaybe' here is a consequence of the inability
        -- to validate the lookup at parse time. Compare to 'entityCapabilities'
        -- (see summary of #1777).
        Entity -> Maybe Entity -> Entity
forall a. a -> Maybe a -> a
fromMaybe Entity
e (Maybe Entity -> Entity) -> m (Maybe Entity) -> m Entity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting EntityMap GameState EntityMap
-> (EntityMap -> Maybe Entity) -> m (Maybe Entity)
forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses ((Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap) (Text -> EntityMap -> Maybe Entity
lookupEntityName Text
yielded)

    (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Inventory) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
e'
    Entity -> m ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e'

    -- Return the item obtained.
    Entity -> m Entity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e'