{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.Game.Step where
import Control.Applicative (Applicative (..))
import Control.Arrow ((&&&))
import Control.Carrier.Error.Either (ErrorC, runError)
import Control.Carrier.State.Lazy
import Control.Carrier.Throw.Either (ThrowC, runThrow)
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 (foldM, forM, forM_, guard, msum, unless, when, zipWithM)
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.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
import Data.Ord (Down (Down))
import Data.Sequence ((><))
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.Time (getZonedTime)
import Data.Tuple (swap)
import Linear (V2 (..), perp, zero)
import Prettyprinter (pretty)
import Swarm.Game.Achievement.Attainment
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.Failure
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.ResourceLoading (getDataFileNameSafe)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Objective qualified as OB
import Swarm.Game.Scenario.Objective.WinCheck qualified as WC
import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..), destination, reorientation)
import Swarm.Game.Scenario.Topography.Navigation.Util
import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..))
import Swarm.Game.State
import Swarm.Game.Step.Combustion qualified as Combustion
import Swarm.Game.Step.Pathfinding
import Swarm.Game.Step.Util
import Swarm.Game.Universe
import Swarm.Game.Value
import Swarm.Game.World qualified as W
import Swarm.Language.Capability
import Swarm.Language.Context hiding (delete)
import Swarm.Language.Key (parseKeyComboFull)
import Swarm.Language.Parse (runParser)
import Swarm.Language.Pipeline
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Pretty (BulletList (BulletList, bulletListItems), prettyText)
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax
import Swarm.Language.Text.Markdown qualified as Markdown
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Value
import Swarm.Log
import Swarm.Util hiding (both)
import Swarm.Util.Effect (throwToMaybe)
import Swarm.Util.WindowedCounter qualified as WC
import System.Clock (TimeSpec)
import Witch (From (from), into)
import Prelude hiding (Applicative (..), lookup)
gameTick :: (Has (State GameState) sig m, Has (Lift IO) sig m) => m Bool
gameTick :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m Bool
gameTick = do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
wakeUpRobotsDoneSleeping
IntSet
active <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState IntSet
activeRobots
RID
focusedRob <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState RID
focusedRobotID
Bool
ticked <-
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Step
WorldTick -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
IntSet -> m ()
runRobotIDs IntSet
active
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> TickNumber -> TickNumber
addTicks RID
1
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
RobotStep SingleStep
ss -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep SingleStep
ss RID
focusedRob IntSet
active
Maybe Robot
mr <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
0)
case Maybe Robot
mr of
Just Robot
r -> do
REPLStatus
res <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus
case REPLStatus
res of
REPLWorking (Typed Maybe Value
Nothing Polytype
ty Requirements
req) -> case Robot -> Maybe (Value, Store)
getResult Robot
r of
Just (Value
v, Store
s) -> do
Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed (forall a. a -> Maybe a
Just Value
v) Polytype
ty Requirements
req)
Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Store
defStore forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Store
s
Maybe (Value, Store)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
REPLStatus
_otherREPLStatus -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe Robot
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify GameState -> GameState
recalcViewCenter
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ticked forall a b. (a -> b) -> a -> b
$ do
WinCondition
wc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState WinCondition
winCondition
case WinCondition
wc of
WinConditions WinStatus
winState ObjectiveCompletion
oc -> do
GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
EntityMap -> GameState -> WinStatus -> ObjectiveCompletion -> m ()
hypotheticalWinCheck EntityMap
em GameState
g WinStatus
winState ObjectiveCompletion
oc
WinCondition
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
ticked
finishGameTick :: (Has (State GameState) sig m, Has (Lift IO) sig m) => m ()
finishGameTick :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
finishGameTick =
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Step
WorldTick -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
RobotStep SingleStep
SBefore -> Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Step
WorldTick
RobotStep SingleStep
_ -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m Bool
gameTick forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
finishGameTick
insertBackRobot :: Has (State GameState) sig m => RID -> Robot -> m ()
insertBackRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Robot -> m ()
insertBackRobot RID
rn Robot
rob = do
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
if Robot
rob forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
selfDestruct
then forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
deleteRobot RID
rn
else do
Lens' GameState (IntMap Robot)
robotMap forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. RID -> a -> IntMap a -> IntMap a
IM.insert RID
rn Robot
rob
case Robot -> Maybe TickNumber
waitingUntil Robot
rob of
Just TickNumber
wakeUpTime
| TickNumber
wakeUpTime forall a. Ord a => a -> a -> Bool
<= RID -> TickNumber -> TickNumber
addTicks RID
2 TickNumber
time -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> TickNumber -> m ()
sleepUntil RID
rn TickNumber
wakeUpTime
Maybe TickNumber
Nothing ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Robot -> Bool
isActive Robot
rob) (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
sleepForever RID
rn)
runRobotIDs :: (Has (State GameState) sig m, Has (Lift IO) sig m) => IS.IntSet -> m ()
runRobotIDs :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
IntSet -> m ()
runRobotIDs IntSet
robotNames = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntSet -> [RID]
IS.toList IntSet
robotNames) forall a b. (a -> b) -> a -> b
$ \RID
rn -> do
Maybe Robot
mr <- forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses Lens' GameState (IntMap Robot)
robotMap (forall a. RID -> IntMap a -> Maybe a
IM.lookup RID
rn)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Robot
mr (forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (State GameState) sig,
Member (Lift IO) sig) =>
RID -> Robot -> m ()
stepOneRobot RID
rn)
where
stepOneRobot :: RID -> Robot -> m ()
stepOneRobot RID
rn Robot
rob = forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobot Robot
rob forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Robot -> m ()
insertBackRobot RID
rn
singleStep :: (Has (State GameState) sig m, Has (Lift IO) sig m) => SingleStep -> RID -> IS.IntSet -> m Bool
singleStep :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep SingleStep
ss RID
focRID IntSet
robotSet = do
let (IntSet
preFoc, Bool
focusedActive, IntSet
postFoc) = RID -> IntSet -> (IntSet, Bool, IntSet)
IS.splitMember RID
focRID IntSet
robotSet
case SingleStep
ss of
SingleStep
SBefore -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
IntSet -> m ()
runRobotIDs IntSet
preFoc
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= SingleStep -> Step
RobotStep (RID -> SingleStep
SSingle RID
focRID)
RID
steps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RID
robotStepsPerTick
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
focRID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tickStepBudget forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= RID
steps
if IntSet -> Bool
IS.null IntSet
preFoc
then forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep (RID -> SingleStep
SSingle RID
focRID) RID
focRID IntSet
robotSet
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
SSingle RID
rid | Bool -> Bool
not Bool
focusedActive -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep (RID -> SingleStep
SAfter RID
rid) RID
rid IntSet
postFoc
SSingle RID
rid -> do
Maybe Robot
mOldR <- forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses Lens' GameState (IntMap Robot)
robotMap (forall a. RID -> IntMap a -> Maybe a
IM.lookup RID
focRID)
case Maybe Robot
mOldR of
Maybe Robot
Nothing | RID
rid forall a. Eq a => a -> a -> Bool
== RID
focRID -> do
forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (State GameState) sig) =>
Text -> m ()
debugLog Text
"The debugged robot does not exist! Exiting single step mode."
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
IntSet -> m ()
runRobotIDs IntSet
postFoc
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Step
WorldTick
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> TickNumber -> TickNumber
addTicks RID
1
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Maybe Robot
Nothing | Bool
otherwise -> do
forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (State GameState) sig) =>
Text -> m ()
debugLog Text
"The previously debugged robot does not exist!"
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep SingleStep
SBefore RID
focRID IntSet
postFoc
Just Robot
oldR -> do
Robot
newR <- (if RID
rid forall a. Eq a => a -> a -> Bool
== RID
focRID then forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
stepRobot else forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobotRec) Robot
oldR
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Robot -> m ()
insertBackRobot RID
focRID Robot
newR
if RID
rid forall a. Eq a => a -> a -> Bool
== RID
focRID
then do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Robot
newR forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tickStepBudget forall a. Eq a => a -> a -> Bool
== RID
0) forall a b. (a -> b) -> a -> b
$
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= SingleStep -> Step
RobotStep (RID -> SingleStep
SAfter RID
focRID)
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep SingleStep
SBefore RID
focRID IntSet
postFoc
SAfter RID
rid | RID
focRID forall a. Ord a => a -> a -> Bool
<= RID
rid -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
IntSet -> m ()
runRobotIDs IntSet
postFoc
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState Step
gameStep forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= SingleStep -> Step
RobotStep SingleStep
SBefore
Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> TickNumber -> TickNumber
addTicks RID
1
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
SAfter RID
rid | Bool
otherwise -> do
let (IntSet
_pre, IntSet
postRID) = RID -> IntSet -> (IntSet, IntSet)
IS.split RID
rid IntSet
robotSet
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
SingleStep -> RID -> IntSet -> m Bool
singleStep SingleStep
SBefore RID
focRID IntSet
postRID
where
h :: Robot
h = CESK -> TimeSpec -> Robot
hypotheticalRobot (Value -> Store -> Cont -> CESK
Out Value
VUnit Store
emptyStore []) TimeSpec
0
debugLog :: Text -> m ()
debugLog Text
txt = do
LogEntry
m <- forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @Robot Robot
h forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
createLogEntry RobotLogSource
RobotError Severity
Debug Text
txt
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
m
data CompletionsWithExceptions = CompletionsWithExceptions
{ CompletionsWithExceptions -> [Text]
exceptions :: [Text]
, CompletionsWithExceptions -> ObjectiveCompletion
completions :: ObjectiveCompletion
, CompletionsWithExceptions -> [Objective]
completionAnnouncementQueue :: [OB.Objective]
}
hypotheticalWinCheck ::
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
EntityMap ->
GameState ->
WinStatus ->
ObjectiveCompletion ->
m ()
hypotheticalWinCheck :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
EntityMap -> GameState -> WinStatus -> ObjectiveCompletion -> m ()
hypotheticalWinCheck EntityMap
em GameState
g WinStatus
ws ObjectiveCompletion
oc = do
CompletionsWithExceptions
finalAccumulator <-
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Member (Lift IO) sig, Algebra sig m) =>
CompletionsWithExceptions
-> Objective -> m CompletionsWithExceptions
foldFunc CompletionsWithExceptions
initialAccumulator forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse [Objective]
incompleteGoals
let newWinState :: WinStatus
newWinState = case WinStatus
ws of
WinStatus
Ongoing -> ObjectiveCompletion -> WinStatus
getNextWinState forall a b. (a -> b) -> a -> b
$ CompletionsWithExceptions -> ObjectiveCompletion
completions CompletionsWithExceptions
finalAccumulator
WinStatus
_ -> WinStatus
ws
Lens' GameState WinCondition
winCondition forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions WinStatus
newWinState (CompletionsWithExceptions -> ObjectiveCompletion
completions CompletionsWithExceptions
finalAccumulator)
case WinStatus
newWinState of
Unwinnable Bool
_ -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievement GameplayAchievement
LoseScenario
WinStatus
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq Announcement)
announcementQueue forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Seq a -> Seq a -> Seq a
>< forall a. [a] -> Seq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map Objective -> Announcement
ObjectiveCompleted forall a b. (a -> b) -> a -> b
$ CompletionsWithExceptions -> [Objective]
completionAnnouncementQueue CompletionsWithExceptions
finalAccumulator))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (State GameState) sig) =>
Text -> m ()
handleException forall a b. (a -> b) -> a -> b
$ CompletionsWithExceptions -> [Text]
exceptions CompletionsWithExceptions
finalAccumulator
where
getNextWinState :: ObjectiveCompletion -> WinStatus
getNextWinState ObjectiveCompletion
completedObjs
| ObjectiveCompletion -> Bool
WC.didWin ObjectiveCompletion
completedObjs = Bool -> WinStatus
Won Bool
False
| ObjectiveCompletion -> Bool
WC.didLose ObjectiveCompletion
completedObjs = Bool -> WinStatus
Unwinnable Bool
False
| Bool
otherwise = WinStatus
Ongoing
(ObjectiveCompletion
withoutIncomplete, [Objective]
incompleteGoals) = ObjectiveCompletion -> (ObjectiveCompletion, [Objective])
OB.extractIncomplete ObjectiveCompletion
oc
initialAccumulator :: CompletionsWithExceptions
initialAccumulator = [Text]
-> ObjectiveCompletion -> [Objective] -> CompletionsWithExceptions
CompletionsWithExceptions [] ObjectiveCompletion
withoutIncomplete []
foldFunc :: CompletionsWithExceptions
-> Objective -> m CompletionsWithExceptions
foldFunc (CompletionsWithExceptions [Text]
exnTexts ObjectiveCompletion
currentCompletions [Objective]
announcements) Objective
obj = do
Either Exn Value
v <-
if ObjectiveCompletion -> Objective -> Bool
WC.isPrereqsSatisfied ObjectiveCompletion
currentCompletions Objective
obj
then forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @Exn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @GameState GameState
g forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m) =>
ProcessedTerm -> m Value
evalPT forall a b. (a -> b) -> a -> b
$ Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective ProcessedTerm
OB.objectiveCondition
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> Value
VBool Bool
False
let simplified :: Either Text Bool
simplified = Either Exn Value -> Either Text Bool
simplifyResult forall a b. (a -> b) -> a -> b
$ Value -> Value
stripVResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Exn Value
v
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either Text Bool
simplified of
Left Text
exnText ->
[Text]
-> ObjectiveCompletion -> [Objective] -> CompletionsWithExceptions
CompletionsWithExceptions
(Text
exnText forall a. a -> [a] -> [a]
: [Text]
exnTexts)
(Objective -> ObjectiveCompletion -> ObjectiveCompletion
OB.addIncomplete Objective
obj ObjectiveCompletion
currentCompletions)
[Objective]
announcements
Right Bool
boolResult ->
[Text]
-> ObjectiveCompletion -> [Objective] -> CompletionsWithExceptions
CompletionsWithExceptions
[Text]
exnTexts
(Objective -> ObjectiveCompletion -> ObjectiveCompletion
modifyCompletions Objective
obj ObjectiveCompletion
currentCompletions)
([Objective] -> [Objective]
modifyAnnouncements [Objective]
announcements)
where
(Objective -> ObjectiveCompletion -> ObjectiveCompletion
modifyCompletions, [Objective] -> [Objective]
modifyAnnouncements)
| Bool
boolResult = (Objective -> ObjectiveCompletion -> ObjectiveCompletion
OB.addCompleted, (Objective
obj forall a. a -> [a] -> [a]
:))
| ObjectiveCompletion -> Objective -> Bool
WC.isUnwinnable ObjectiveCompletion
currentCompletions Objective
obj = (Objective -> ObjectiveCompletion -> ObjectiveCompletion
OB.addUnwinnable, forall a. a -> a
id)
| Bool
otherwise = (Objective -> ObjectiveCompletion -> ObjectiveCompletion
OB.addIncomplete, forall a. a -> a
id)
simplifyResult :: Either Exn Value -> Either Text Bool
simplifyResult = \case
Left Exn
exn -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ EntityMap -> Exn -> Text
formatExn EntityMap
em Exn
exn
Right (VBool Bool
x) -> forall a b. b -> Either a b
Right Bool
x
Right Value
val ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords
[ Text
"Non boolean value:"
, Value -> Text
prettyValue Value
val
, Text
"real:"
, String -> Text
T.pack (forall a. Show a => a -> String
show Value
val)
]
handleException :: Text -> m ()
handleException Text
exnText = do
LogEntry
m <- forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @Robot Robot
h forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
createLogEntry RobotLogSource
RobotError Severity
Critical Text
exnText
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
m
where
h :: Robot
h = CESK -> TimeSpec -> Robot
hypotheticalRobot (Value -> Store -> Cont -> CESK
Out Value
VUnit Store
emptyStore []) TimeSpec
0
evalPT ::
(Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m) =>
ProcessedTerm ->
m Value
evalPT :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m) =>
ProcessedTerm -> m Value
evalPT ProcessedTerm
t = forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m) =>
CESK -> m Value
evaluateCESK (ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
t forall t. Ctx t
empty Store
emptyStore)
hypotheticalRobot :: CESK -> TimeSpec -> Robot
hypotheticalRobot :: CESK -> TimeSpec -> Robot
hypotheticalRobot CESK
c =
forall (phase :: RobotPhase).
RobotID phase
-> Maybe RID
-> Text
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> Set Text
-> TimeSpec
-> RobotR phase
mkRobot
(-RID
1)
forall a. Maybe a
Nothing
Text
"hypothesis"
forall a. Monoid a => a
mempty
Cosmic Location
defaultCosmicLocation
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
Display
defaultRobotDisplay
CESK
c
[]
[]
Bool
True
Bool
False
forall a. Monoid a => a
mempty
evaluateCESK ::
(Has (Lift IO) sig m, Has (Throw Exn) sig m, Has (State GameState) sig m) =>
CESK ->
m Value
evaluateCESK :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m) =>
CESK -> m Value
evaluateCESK CESK
cesk = do
TimeSpec
createdAt <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow
let r :: Robot
r = CESK -> TimeSpec -> Robot
hypotheticalRobot CESK
cesk TimeSpec
createdAt
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addRobot Robot
r
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState Robot
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m, Has (State Robot) sig m) =>
CESK -> m Value
runCESK forall a b. (a -> b) -> a -> b
$ CESK
cesk
runCESK ::
( Has (Lift IO) sig m
, Has (Throw Exn) sig m
, Has (State GameState) sig m
, Has (State Robot) sig m
) =>
CESK ->
m Value
runCESK :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m, Has (State Robot) sig m) =>
CESK -> m Value
runCESK (Up Exn
exn Store
_ []) = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError Exn
exn
runCESK CESK
cesk = case CESK -> Maybe (Value, Store)
finalValue CESK
cesk of
Just (Value
v, Store
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
Maybe (Value, Store)
Nothing -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK CESK
cesk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m, Has (State Robot) sig m) =>
CESK -> m Value
runCESK
createLogEntry ::
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource ->
Severity ->
Text ->
m LogEntry
createLogEntry :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
createLogEntry RobotLogSource
source Severity
sev Text
msg = do
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
Text
rn <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Text
robotName
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TickNumber -> LogSource -> Severity -> Text -> Text -> LogEntry
LogEntry TickNumber
time (RobotLogSource -> RID -> Cosmic Location -> LogSource
RobotLog RobotLogSource
source RID
rid Cosmic Location
loc) Severity
sev Text
rn Text
msg
traceLog :: (Has (State GameState) sig m, Has (State Robot) sig m) => RobotLogSource -> Severity -> Text -> m LogEntry
traceLog :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
traceLog RobotLogSource
source Severity
sev Text
msg = do
LogEntry
m <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
createLogEntry RobotLogSource
source Severity
sev Text
msg
Lens' Robot (Seq LogEntry)
robotLog forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Seq a -> a -> Seq a
Seq.|> LogEntry
m)
forall (m :: * -> *) a. Monad m => a -> m a
return LogEntry
m
traceLogShow :: (Has (State GameState) sig m, Has (State Robot) sig m, Show a) => a -> m ()
traceLogShow :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, Has (State Robot) sig m, Show a) =>
a -> m ()
traceLogShow = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
traceLog RobotLogSource
Logged Severity
Info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
constCapsFor :: Const -> Robot -> Maybe Capability
constCapsFor :: Const -> Robot -> Maybe Capability
constCapsFor Const
Move Robot
r
| Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotHeavy = forall a. a -> Maybe a
Just Capability
CMoveheavy
constCapsFor Const
Backup Robot
r
| Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotHeavy = forall a. a -> Maybe a
Just Capability
CMoveheavy
constCapsFor Const
Stride Robot
r
| Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotHeavy = forall a. a -> Maybe a
Just Capability
CMoveheavy
constCapsFor Const
c Robot
_ = Const -> Maybe Capability
constCaps Const
c
ensureCanExecute :: (Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Const -> m ()
ensureCanExecute :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
Has (Throw Exn) sig m) =>
Const -> m ()
ensureCanExecute Const
c =
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
gets @Robot (Const -> Robot -> Maybe Capability
constCapsFor Const
c) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Capability
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Capability
cap -> do
Bool
isPrivileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
Set Capability
robotCaps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Set Capability)
robotCapabilities
let hasCaps :: Bool
hasCaps = Capability
cap forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
robotCaps
(Bool
isPrivileged Bool -> Bool -> Bool
|| Bool
hasCaps)
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
FixByEquip (Capability -> Requirements
R.singletonCap Capability
cap) (forall ty. Const -> Term' ty
TConst Const
c)
cmdExnWithAchievement :: Const -> [Text] -> GameplayAchievement -> Exn
cmdExnWithAchievement :: Const -> [Text] -> GameplayAchievement -> Exn
cmdExnWithAchievement Const
c [Text]
parts GameplayAchievement
a = Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed Const
c ([Text] -> Text
T.unwords [Text]
parts) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just GameplayAchievement
a
raise :: (Has (Throw Exn) sig m) => Const -> [Text] -> m a
raise :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> [Text] -> m a
raise Const
c [Text]
parts = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Const -> [Text] -> Exn
cmdExn Const
c [Text]
parts)
withExceptions :: Monad m => Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions :: forall (m :: * -> *).
Monad m =>
Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions Store
s Cont
k ThrowC Exn m CESK
m = do
Either Exn CESK
res <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow ThrowC Exn m CESK
m
case Either Exn CESK
res of
Left Exn
exn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
Right CESK
a -> forall (m :: * -> *) a. Monad m => a -> m a
return CESK
a
tickRobot :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot
tickRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobot Robot
r = do
RID
steps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RID
robotStepsPerTick
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobotRec (Robot
r forall a b. a -> (a -> b) -> b
& Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tickStepBudget forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
steps)
tickRobotRec :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot
tickRobotRec :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobotRec Robot
r = do
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
case TickNumber -> Robot -> Bool
wantsToStep TickNumber
time Robot
r Bool -> Bool -> Bool
&& (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
runningAtomic Bool -> Bool -> Bool
|| Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tickStepBudget forall a. Ord a => a -> a -> Bool
> RID
0) of
Bool
True -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
stepRobot Robot
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobotRec
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Robot
r
stepRobot :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot
stepRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
stepRobot Robot
r = do
(Robot
r', CESK
cesk') <- forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
runState (Robot
r forall a b. a -> (a -> b) -> b
& Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tickStepBudget forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ RID
1) (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine))
TickNumber
t <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
Bool
isCreative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
let shouldTrackActivity :: Bool
shouldTrackActivity = Bool
isCreative Bool -> Bool -> Bool
|| Bool -> Bool
not (Robot
r' forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
shouldTrackActivity (TickNumber -> Robot -> Robot
maintainActivityWindow TickNumber
t) forall a b. (a -> b) -> a -> b
$
Robot
r'
forall a b. a -> (a -> b) -> b
& Lens' Robot CESK
machine forall s t a b. ASetter s t a b -> b -> s -> t
.~ CESK
cesk'
forall a b. a -> (a -> b) -> b
& Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
lifetimeStepCount forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ RID
1
where
maintainActivityWindow :: TickNumber -> Robot -> Robot
maintainActivityWindow TickNumber
t Robot
bot =
Robot
bot forall a b. a -> (a -> b) -> b
& (Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts (WindowedCounter TickNumber)
activityWindow forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a.
(Ord a, Offsettable a) =>
a -> WindowedCounter a -> WindowedCounter a
WC.insert TickNumber
t)
updateWorld ::
(Has (State GameState) sig m, Has (Throw Exn) sig m) =>
Const ->
WorldUpdate Entity ->
m ()
updateWorld :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Throw Exn) sig m) =>
Const -> WorldUpdate Entity -> m ()
updateWorld Const
c (ReplaceEntity Cosmic Location
loc Entity
eThen Maybe Entity
down) = do
MultiWorld RID Entity
w <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld RID Entity)
multiWorld
let eNow :: Maybe Entity
eNow = forall t e. Cosmic Coords -> MultiWorld t e -> Maybe e
W.lookupCosmicEntity (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> Coords
W.locToCoords Cosmic Location
loc) MultiWorld RID Entity
w
if forall a. a -> Maybe a
Just Entity
eThen forall a. Eq a => a -> a -> Bool
/= Maybe Entity
eNow
then forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
c [Text
"The", Entity
eThen forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"is not there."]
else forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Maybe Entity
down
applyRobotUpdates ::
(Has (State GameState) sig m, Has (State Robot) sig m) =>
[RobotUpdate] ->
m ()
applyRobotUpdates :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
[RobotUpdate] -> m ()
applyRobotUpdates =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \case
AddEntity RID
c Entity
e -> Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> Entity -> Inventory -> Inventory
E.insertCount RID
c Entity
e
LearnEntity Entity
e -> Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> Entity -> Inventory -> Inventory
E.insertCount RID
0 Entity
e
data SKpair = SKpair Store Cont
processImmediateFrame ::
(Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) =>
Value ->
SKpair ->
ErrorC Exn m () ->
m CESK
processImmediateFrame :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Value -> SKpair -> ErrorC Exn m () -> m CESK
processImmediateFrame Value
v (SKpair Store
s Cont
k) ErrorC Exn m ()
unreliableComputation = do
Either Exn ()
wc <- forall exc (m :: * -> *) a. ErrorC exc m a -> m (Either exc a)
runError ErrorC Exn m ()
unreliableComputation
case Either Exn ()
wc of
Left Exn
exn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
Right () -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
updateWorldAndRobots ::
(HasRobotStepState sig m) =>
Const ->
[WorldUpdate Entity] ->
[RobotUpdate] ->
m ()
updateWorldAndRobots :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Const -> [WorldUpdate Entity] -> [RobotUpdate] -> m ()
updateWorldAndRobots Const
cmd [WorldUpdate Entity]
wf [RobotUpdate]
rf = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Throw Exn) sig m) =>
Const -> WorldUpdate Entity -> m ()
updateWorld Const
cmd) [WorldUpdate Entity]
wf
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
[RobotUpdate] -> m ()
applyRobotUpdates [RobotUpdate]
rf
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
stepCESK :: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) => CESK -> m CESK
stepCESK :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK CESK
cesk = case CESK
cesk of
Waiting TickNumber
wakeupTime CESK
cesk' -> do
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
if TickNumber
wakeupTime forall a. Ord a => a -> a -> Bool
<= TickNumber
time
then forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK CESK
cesk'
else forall (m :: * -> *) a. Monad m => a -> m a
return CESK
cesk
Out Value
v Store
s (FImmediate Const
cmd [WorldUpdate Entity]
wf [RobotUpdate]
rf : Cont
k) ->
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Value -> SKpair -> ErrorC Exn m () -> m CESK
processImmediateFrame Value
v (Store -> Cont -> SKpair
SKpair Store
s Cont
k) forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Const -> [WorldUpdate Entity] -> [RobotUpdate] -> m ()
updateWorldAndRobots Const
cmd [WorldUpdate Entity]
wf [RobotUpdate]
rf
In Term
TUnit Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
In (TDir Direction
d) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Direction -> Value
VDir Direction
d) Store
s Cont
k
In (TInt Integer
n) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt Integer
n) Store
s Cont
k
In (TText Text
str) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
str) Store
s Cont
k
In (TBool Bool
b) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool Bool
b) Store
s Cont
k
In (TAntiText Text
v) Env
_ Store
s Cont
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
Fatal (Text -> Text -> Text
T.append Text
"Antiquoted variable found at runtime: $str:" Text
v)) Store
s Cont
k
In (TAntiInt Text
v) Env
_ Store
s Cont
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
Fatal (Text -> Text -> Text
T.append Text
"Antiquoted variable found at runtime: $int:" Text
v)) Store
s Cont
k
In (TRequireDevice {}) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (forall ty. Const -> Term' ty
TConst Const
Noop) Env
e Store
s Cont
k
In (TRequire {}) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (forall ty. Const -> Term' ty
TConst Const
Noop) Env
e Store
s Cont
k
In (TRequirements Text
x Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Term -> Env -> Value
VRequirements Text
x Term
t Env
e) Store
s Cont
k
In (TAnnotate Term
v Polytype
_) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
v Env
e Store
s Cont
k
In (TRobot RID
rid) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRobot RID
rid) Store
s Cont
k
In (TConst Const
c) Env
_ Store
s Cont
k
| Const -> RID
arity Const
c forall a. Eq a => a -> a -> Bool
== RID
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Const -> Bool
isCmd Const
c) -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c [] Store
s Cont
k
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c []) Store
s Cont
k
In (TVar Text
x) Env
e Store
s Cont
k -> forall (m :: * -> *).
Monad m =>
Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions Store
s Cont
k forall a b. (a -> b) -> a -> b
$ do
Value
v <-
forall t. Text -> Ctx t -> Maybe t
lookup Text
x Env
e
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Text -> Exn
Fatal ([Text] -> Text
T.unwords [Text
"Undefined variable", Text
x, Text
"encountered while running the interpreter."])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
In (TPair Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t1 Env
e Store
s (Term -> Env -> Frame
FSnd Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v1 Store
s (FSnd Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 Env
e Store
s (Value -> Frame
FFst Value
v1 forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v2 Store
s (FFst Value
v1 : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Value -> Value
VPair Value
v1 Value
v2) Store
s Cont
k
In (TLam Text
x Maybe Type
_ Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Term -> Env -> Value
VClo Text
x Term
t Env
e) Store
s Cont
k
In (TApp Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t1 Env
e Store
s (Term -> Env -> Frame
FArg Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v1 Store
s (FArg Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 Env
e Store
s (Value -> Frame
FApp Value
v1 forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v2 Store
s (FApp (VClo Text
x Term
t Env
e) : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t (forall t. Text -> t -> Ctx t -> Ctx t
addBinding Text
x Value
v2 Env
e) Store
s Cont
k
Out Value
v2 Store
s (FApp (VCApp Const
c [Value]
args) : Cont
k)
| Bool -> Bool
not (Const -> Bool
isCmd Const
c)
Bool -> Bool -> Bool
&& Const -> RID
arity Const
c forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> RID
length [Value]
args forall a. Num a => a -> a -> a
+ RID
1 ->
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c (forall a. [a] -> [a]
reverse (Value
v2 forall a. a -> [a] -> [a]
: [Value]
args)) Store
s Cont
k
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c (Value
v2 forall a. a -> [a] -> [a]
: [Value]
args)) Store
s Cont
k
Out Value
_ Store
s (FApp Value
_ : Cont
_) -> forall {m :: * -> *}. Monad m => Store -> Text -> m CESK
badMachineState Store
s Text
"FApp of non-function"
In (TRcd Map Text (Maybe Term)
m) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall k a. Map k a -> [(k, a)]
M.assocs Map Text (Maybe Term)
m of
[] -> Value -> Store -> Cont -> CESK
Out (Map Text Value -> Value
VRcd forall k a. Map k a
M.empty) Store
s Cont
k
((Text
x, Maybe Term
t) : [(Text, Maybe Term)]
fs) -> Term -> Env -> Store -> Cont -> CESK
In (forall a. a -> Maybe a -> a
fromMaybe (forall ty. Text -> Term' ty
TVar Text
x) Maybe Term
t) Env
e Store
s (Env -> [(Text, Value)] -> Text -> [(Text, Maybe Term)] -> Frame
FRcd Env
e [] Text
x [(Text, Maybe Term)]
fs forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v Store
s (FRcd Env
_ [(Text, Value)]
done Text
x [] : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Map Text Value -> Value
VRcd (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Text
x, Value
v) forall a. a -> [a] -> [a]
: [(Text, Value)]
done))) Store
s Cont
k
Out Value
v Store
s (FRcd Env
e [(Text, Value)]
done Text
x ((Text
y, Maybe Term
t) : [(Text, Maybe Term)]
rest) : Cont
k) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (forall a. a -> Maybe a -> a
fromMaybe (forall ty. Text -> Term' ty
TVar Text
y) Maybe Term
t) Env
e Store
s (Env -> [(Text, Value)] -> Text -> [(Text, Maybe Term)] -> Frame
FRcd Env
e ((Text
x, Value
v) forall a. a -> [a] -> [a]
: [(Text, Value)]
done) Text
y [(Text, Maybe Term)]
rest forall a. a -> [a] -> [a]
: Cont
k)
In (TProj Term
t Text
x) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t Env
e Store
s (Text -> Frame
FProj Text
x forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v Store
s (FProj Text
x : Cont
k) -> case Value
v of
VRcd Map Text Value
m -> case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
x Map Text Value
m of
Maybe Value
Nothing -> forall {m :: * -> *}. Monad m => Store -> Text -> m CESK
badMachineState Store
s forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"Record projection for variable", Text
x, Text
"that does not exist"]
Just Value
xv -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
xv Store
s Cont
k
Value
_ -> forall {m :: * -> *}. Monad m => Store -> Text -> m CESK
badMachineState Store
s Text
"FProj frame with non-record value"
In (TLet Bool
False Text
x Maybe Polytype
_ Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t1 Env
e Store
s (Text -> Term -> Env -> Frame
FLet Text
x Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
In (TLet Bool
True Text
x Maybe Polytype
_ Term
t1 Term
t2) Env
e Store
s Cont
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (DelayType -> Term -> Term
TDelay (Maybe Text -> DelayType
MemoizedDelay forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
x) Term
t1) Env
e Store
s (Text -> Term -> Env -> Frame
FLet Text
x Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v1 Store
s (FLet Text
x Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 (forall t. Text -> t -> Ctx t -> Ctx t
addBinding Text
x Value
v1 Env
e) Store
s Cont
k
In tm :: Term
tm@(TDef Bool
r Text
x Maybe Polytype
_ Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *).
Monad m =>
Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions Store
s Cont
k forall a b. (a -> b) -> a -> b
$ do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
CEnv Term
tm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Text -> Term -> Env -> Value
VDef Bool
r Text
x Term
t Env
e) Store
s Cont
k
In (TBind Maybe Text
mx Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Maybe Text -> Term -> Term -> Env -> Value
VBind Maybe Text
mx Term
t1 Term
t2 Env
e) Store
s Cont
k
In (TDelay DelayType
SimpleDelay Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Term -> Env -> Value
VDelay Term
t Env
e) Store
s Cont
k
In (TDelay (MemoizedDelay Maybe Text
x) Term
t) Env
e Store
s Cont
k -> do
let (RID
loc, Store
s') = Env -> Term -> Store -> (RID, Store)
allocate (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall t. Text -> t -> Ctx t -> Ctx t
`addBinding` RID -> Value
VRef RID
loc) Maybe Text
x Env
e) Term
t Store
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRef RID
loc) Store
s' Cont
k
Out Value
v Store
s (FUpdate RID
loc : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v (RID -> MemCell -> Store -> Store
setStore RID
loc (Value -> MemCell
V Value
v) Store
s) Cont
k
Out (VRequirements Text
src Term
t Env
_) Store
s (Frame
FExec : Cont
k) -> do
ReqCtx
currentContext <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
let (R.Requirements Set Capability
caps Set Text
devs Map Text RID
inv, ReqCtx
_) = ReqCtx -> Term -> (Requirements, ReqCtx)
R.requirements ReqCtx
currentContext Term
t
devicesForCaps, requiredDevices :: Set (Set Text)
devicesForCaps :: Set (Set Text)
devicesForCaps = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Capability -> EntityMap -> [Entity]
`deviceForCap` EntityMap
em)) Set Capability
caps
requiredDevices :: Set (Set Text)
requiredDevices = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall a. a -> Set a
S.singleton Set Text
devs
deviceSets :: Set (Set Text)
deviceSets :: Set (Set Text)
deviceSets =
forall a. Ord a => Set (Set a) -> Set (Set a)
removeSupersets forall a b. (a -> b) -> a -> b
$ Set (Set Text)
devicesForCaps forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set (Set Text)
requiredDevices
reqLog :: Text
reqLog =
forall a. PrettyPrec a => a -> Text
prettyText forall a b. (a -> b) -> a -> b
$
forall i. (forall a. Doc a) -> [i] -> BulletList i
BulletList
(forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"Requirements for", Text -> Text
bquote Text
src forall a. Semigroup a => a -> a -> a
<> Text
":"])
( forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. BulletList i -> [i]
bulletListItems)
[ forall i. (forall a. Doc a) -> [i] -> BulletList i
BulletList
Doc a
"Equipment:"
(Text -> [Text] -> Text
T.intercalate Text
" OR " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
S.toList Set (Set Text)
deviceSets)
, forall i. (forall a. Doc a) -> [i] -> BulletList i
BulletList
Doc a
"Inventory:"
((\(Text
e, RID
n) -> Text
e forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text -> Text
parens (forall a. Show a => a -> Text
showT RID
n)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
M.assocs Map Text RID
inv)
]
)
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
reqLog
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Out (VDef Bool
r Text
x Term
t Env
e) Store
s (Frame
FExec : Cont
k) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (DelayType -> Term -> Term
TDelay (Maybe Text -> DelayType
MemoizedDelay forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
x) Bool
r) Term
t) Env
e Store
s (Text -> Frame
FDef Text
x forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v Store
s (FDef Text
x : Cont
k) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Env -> Value
VResult Value
VUnit (forall t. Text -> t -> Ctx t
singleton Text
x Value
v)) Store
s Cont
k
Out (VCApp Const
c [Value]
args) Store
s (Frame
FExec : Cont
k) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Const -> Bool
isTangible Const
c) forall a b. (a -> b) -> a -> b
$ Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tickStepBudget forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= RID
0
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c (forall a. [a] -> [a]
reverse [Value]
args) Store
s Cont
k
Out Value
v Store
s (Frame
FFinishAtomic : Cont
k) -> do
Lens' Robot Bool
runningAtomic forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
b Store
s (FMeetAll Value
_ [] : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
b Store
s Cont
k
Out Value
b Store
s (FMeetAll Value
f (RID
rid : [RID]
rids) : Cont
k) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
b Store
s (Value -> Frame
FApp Value
f forall a. a -> [a] -> [a]
: Term -> Env -> Frame
FArg (forall ty. RID -> Term' ty
TRobot RID
rid) forall t. Ctx t
empty forall a. a -> [a] -> [a]
: Frame
FExec forall a. a -> [a] -> [a]
: Frame
FDiscardEnv forall a. a -> [a] -> [a]
: Value -> [RID] -> Frame
FMeetAll Value
f [RID]
rids forall a. a -> [a] -> [a]
: Cont
k)
Out (VBind Maybe Text
mx Term
c1 Term
c2 Env
e) Store
s (Frame
FExec : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
c1 Env
e Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Maybe Text -> Term -> Env -> Frame
FBind Maybe Text
mx Term
c2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out (VResult Value
v Env
ve) Store
s (FBind Maybe Text
mx Term
t2 Env
e : Cont
k) -> do
let ve' :: Env
ve' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall t. Text -> t -> Ctx t -> Ctx t
`addBinding` Value
v) Maybe Text
mx Env
ve
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 (Env
e forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
ve') Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Env -> Cont -> Cont
fUnionEnv Env
ve' Cont
k)
Out Value
_ Store
s (FBind Maybe Text
Nothing Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 Env
e Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v Store
s (FBind (Just Text
x) Term
t2 Env
e : Cont
k) -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 (forall t. Text -> t -> Ctx t -> Ctx t
addBinding Text
x Value
v Env
e) Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Env -> Cont -> Cont
fUnionEnv (forall t. Text -> t -> Ctx t
singleton Text
x Value
v) Cont
k)
Out (VResult Value
v Env
e2) Store
s (FUnionEnv Env
e1 : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Env -> Value
VResult Value
v (Env
e1 forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
e2)) Store
s Cont
k
Out Value
v Store
s (FUnionEnv Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Env -> Value
VResult Value
v Env
e) Store
s Cont
k
Out (VResult Value
v Env
_) Store
s (Frame
FDiscardEnv : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
v Store
s (Frame
FDiscardEnv : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out (VResult Value
v Env
e) Store
s (FLoadEnv TCtx
ctx ReqCtx
rctx : Cont
k) -> do
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Env
defVals forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
e)
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext TCtx
defTypes forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t. Ctx t -> Ctx t -> Ctx t
`union` TCtx
ctx)
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t. Ctx t -> Ctx t -> Ctx t
`union` ReqCtx
rctx)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
v Store
s (FLoadEnv {} : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
_ Store
s (Frame
FExec : Cont
_) -> forall {m :: * -> *}. Monad m => Store -> Text -> m CESK
badMachineState Store
s Text
"FExec frame with non-executable value"
Out (VResult Value
v Env
_) Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
v Store
s (FTry {} : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Up Exn
exn Store
s [] -> do
case Exn
exn of
CmdFailed Const
_ Text
_ (Just GameplayAchievement
a) -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievement GameplayAchievement
a
Exn
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
let s' :: Store
s' = Store -> Store
resetBlackholes Store
s
Bool
h <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
CLog
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
if Bool
h
then do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
RobotLogSource -> Severity -> Text -> m LogEntry
traceLog RobotLogSource
RobotError Severity
Error (EntityMap -> Exn -> Text
formatExn EntityMap
em Exn
exn)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s []
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s' []
Up exn :: Exn
exn@Fatal {} Store
s Cont
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s []
Up exn :: Exn
exn@Incapable {} Store
s Cont
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s []
Up exn :: Exn
exn@InfiniteLoop {} Store
s Cont
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s []
Up Exn
_ Store
s (FTry Value
c : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
c Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) forall a. a -> [a] -> [a]
: Frame
FExec forall a. a -> [a] -> [a]
: Cont
k)
Up Exn
exn Store
s (Frame
_ : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
done :: CESK
done@(Out Value
_ Store
_ []) -> forall (m :: * -> *) a. Monad m => a -> m a
return CESK
done
where
badMachineState :: Store -> Text -> m CESK
badMachineState Store
s Text
msg =
let msg' :: Text
msg' =
[Text] -> Text
T.unlines
[ Text -> Text -> Text
T.append Text
"Bad machine state in stepRobot: " Text
msg
, forall a. PrettyPrec a => a -> Text
prettyText CESK
cesk
]
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
Fatal Text
msg') Store
s []
fUnionEnv :: Env -> Cont -> Cont
fUnionEnv Env
e1 = \case
FUnionEnv Env
e2 : Cont
k -> Env -> Frame
FUnionEnv (Env
e2 forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
e1) forall a. a -> [a] -> [a]
: Cont
k
Cont
k -> Env -> Frame
FUnionEnv Env
e1 forall a. a -> [a] -> [a]
: Cont
k
evalConst ::
(Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) => Const -> [Value] -> Store -> Cont -> m CESK
evalConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c [Value]
vs Store
s Cont
k = do
Either Exn CESK
res <- forall exc (m :: * -> *) a. ErrorC exc m a -> m (Either exc a)
runError forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
execConst Const
c [Value]
vs Store
s Cont
k
case Either Exn CESK
res of
Left Exn
exn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
Right CESK
cek' -> forall (m :: * -> *) a. Monad m => a -> m a
return CESK
cek'
seedProgram :: Integer -> Integer -> Text -> ProcessedTerm
seedProgram :: Integer -> Integer -> Text -> ProcessedTerm
seedProgram Integer
minTime Integer
randTime Text
thing =
[tmQ|
try {
r <- random (1 + $int:randTime);
wait (r + $int:minTime);
appear "|";
r <- random (1 + $int:randTime);
wait (r + $int:minTime);
place $str:thing;
} {};
selfdestruct
|]
addSeedBot ::
Has (State GameState) sig m =>
Entity ->
(Integer, Integer) ->
Cosmic Location ->
TimeSpec ->
m ()
addSeedBot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> (Integer, Integer) -> Cosmic Location -> TimeSpec -> m ()
addSeedBot Entity
e (Integer
minT, Integer
maxT) Cosmic Location
loc TimeSpec
ts =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TRobot -> m Robot
addTRobot forall a b. (a -> b) -> a -> b
$
forall (phase :: RobotPhase).
RobotID phase
-> Maybe RID
-> Text
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> Set Text
-> TimeSpec
-> RobotR phase
mkRobot
()
forall a. Maybe a
Nothing
Text
"seed"
(Text -> Document Syntax
Markdown.fromText forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"A growing", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"seed."])
(forall a. a -> Maybe a
Just Cosmic Location
loc)
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
( Char -> Display
defaultEntityDisplay Char
'.'
forall a b. a -> (a -> b) -> b
& Lens' Display Attribute
displayAttr forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
entityDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display Attribute
displayAttr)
forall a b. a -> (a -> b) -> b
& Lens' Display RID
displayPriority forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
0
)
(ProcessedTerm -> Env -> Store -> CESK
initMachine (Integer -> Integer -> Text -> ProcessedTerm
seedProgram Integer
minT (Integer
maxT forall a. Num a => a -> a -> a
- Integer
minT) (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)) forall t. Ctx t
empty Store
emptyStore)
[]
[(RID
1, Entity
e)]
Bool
True
Bool
False
forall a. Monoid a => a
mempty
TimeSpec
ts
execConst ::
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const ->
[Value] ->
Store ->
Cont ->
m CESK
execConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
execConst Const
c [Value]
vs Store
s Cont
k = do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
Has (Throw Exn) sig m) =>
Const -> m ()
ensureCanExecute Const
c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Const -> Bool
isTangible Const
c) forall a b. (a -> b) -> a -> b
$
Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts RID
tangibleCommandCount forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State s) sig m, Num a) =>
ASetter' s a -> a -> m ()
+= RID
1
Lens' Robot ActivityCounts
activityCounts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ActivityCounts (Map Const RID)
commandsHistogram forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Num a => a -> a -> a
(+) Const
c RID
1
case Const
c of
Const
Noop -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Const
Return -> case [Value]
vs of
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Wait -> case [Value]
vs of
[VInt Integer
d] -> do
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m ()
purgeFarAwayWatches
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TickNumber -> CESK -> CESK
Waiting (RID -> TickNumber -> TickNumber
addTicks (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d) TickNumber
time) (Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Selfdestruct -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Bool -> Maybe GameplayAchievement) -> m ()
destroyIfNotBase forall a b. (a -> b) -> a -> b
$ \case Bool
False -> forall a. a -> Maybe a
Just GameplayAchievement
AttemptSelfDestructBase; Bool
_ -> forall a. Maybe a
Nothing
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Const
Move -> do
Maybe Heading
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Heading -> m CESK
moveInDirection forall a b. (a -> b) -> a -> b
$ Maybe Heading
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
Const
Backup -> do
Maybe Heading
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Heading -> m CESK
moveInDirection forall a b. (a -> b) -> a -> b
$ Direction -> Heading -> Heading
applyTurn (RelativeDir -> Direction
DRelative forall a b. (a -> b) -> a -> b
$ PlanarRelativeDir -> RelativeDir
DPlanar PlanarRelativeDir
DBack) forall a b. (a -> b) -> a -> b
$ Maybe Heading
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Integer
d
Value
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
PathfindingTarget
goal <-
if Bool
findEntity
then case Value
goalVal of
VText Text
eName -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> PathfindingTarget
EntityTarget Text
eName
Value
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
else case Value
goalVal of
VPair (VInt Integer
x) (VInt Integer
y) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Location -> PathfindingTarget
LocationTarget forall a b. (a -> b) -> a -> b
$
Int32 -> Int32 -> Location
Location (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
Value
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Cosmic Location
robotLoc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Maybe Direction
result <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (State GameState) sig m) =>
Maybe Integer
-> Cosmic Location -> PathfindingTarget -> m (Maybe Direction)
pathCommand Maybe Integer
maybeLimit Cosmic Location
robotLoc PathfindingTarget
goal
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Maybe Direction
result) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Push -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Maybe Heading
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
let applyHeading :: Cosmic Location -> Cosmic Location
applyHeading = (Cosmic Location -> Heading -> Cosmic Location
`offsetBy` (Maybe Heading
orient forall a. Maybe a -> a -> 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
Maybe Entity
maybeCurrentE <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
nextLoc
case Maybe Entity
maybeCurrentE of
Just Entity
e -> do
Bool
nothingHere <- forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
placementLoc
Bool
nothingHere 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'
Bool
omni <- 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
Portable Bool -> Bool -> Bool
&& Bool -> Bool
not (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Liquid))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"The", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"here can't be", Text
verbed forall a. Semigroup a => a -> a -> a
<> Text
"."]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
nextLoc (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
placementLoc (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Entity
e))
Maybe Entity
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
loc Cosmic Location
nextLoc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Const
Stride -> case [Value]
vs of
[VInt Integer
d] -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral RID
maxStrideRange) forall a b. (a -> b) -> a -> b
$
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show RID
maxStrideRange
, Text
"units."
]
)
forall a. Maybe a
Nothing
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Maybe Heading
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
let heading :: Heading
heading = Maybe Heading
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
let locsInDirection :: [Cosmic Location]
locsInDirection :: [Cosmic Location]
locsInDirection =
forall a. RID -> [a] -> [a]
take (forall a. Ord a => a -> a -> a
min (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d) RID
maxStrideRange) forall a b. (a -> b) -> a -> b
$
forall a. RID -> [a] -> [a]
drop RID
1 forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (Cosmic Location -> Heading -> Cosmic Location
`offsetBy` Heading
heading) Cosmic Location
loc
[Maybe MoveFailureDetails]
failureMaybes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailure [Cosmic Location]
locsInDirection
let maybeFirstFailure :: Maybe MoveFailureDetails
maybeFirstFailure = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe MoveFailureDetails]
failureMaybes
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureDetails -> MoveFailureHandler -> m ()
applyMoveFailureEffect Maybe MoveFailureDetails
maybeFirstFailure forall a b. (a -> b) -> a -> b
$ \case
MoveFailureMode
PathBlocked -> RobotFailure
ThrowExn
MoveFailureMode
PathLiquid -> RobotFailure
Destroy
let maybeLastLoc :: Maybe (Cosmic Location)
maybeLastLoc = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe MoveFailureDetails
maybeFirstFailure
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Cosmic Location]
locsInDirection
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Cosmic Location)
maybeLastLoc forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
loc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Teleport -> case [Value]
vs of
[VRobot RID
rid, VPair (VInt Integer
x) (VInt Integer
y)] -> do
Robot
target <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
rid
let oldLoc :: Cosmic Location
oldLoc = Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation
nextLoc :: Cosmic Location
nextLoc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Location
Location (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)) Cosmic Location
oldLoc
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
RID
-> (forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
(HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
m' ())
-> m ()
onTarget RID
rid forall a b. (a -> b) -> a -> b
$ do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Cosmic Location -> MoveFailureHandler -> m ()
checkMoveAhead Cosmic Location
nextLoc forall a b. (a -> b) -> a -> b
$ \case
MoveFailureMode
PathBlocked -> RobotFailure
Destroy
MoveFailureMode
PathLiquid -> RobotFailure
Destroy
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
oldLoc Cosmic Location
nextLoc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Grab -> forall a. Valuable a => a -> CESK
mkReturn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m Entity
doGrab GrabbingCmd
Grab'
Const
Harvest -> forall a. Valuable a => a -> CESK
mkReturn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m Entity
doGrab GrabbingCmd
Harvest'
Const
Ignite -> case [Value]
vs of
[VDir Direction
d] -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const -> Direction -> m ()
Combustion.igniteCommand Const
c Direction
d
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Swap -> case [Value]
vs of
[VText Text
name] -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Entity
e <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name
Entity
newE <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m Entity
doGrab GrabbingCmd
Swap'
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Entity
e))
Lens' Robot Inventory
robotInventory 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entity
e forall a. Eq a => a -> a -> Bool
== Entity
newE) forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievement GameplayAchievement
SwapSame
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Valuable a => a -> CESK
mkReturn Entity
newE
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Turn -> case [Value]
vs of
[VDir Direction
d] -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Direction -> Bool
isCardinal Direction
d) forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
COrient (forall ty. Direction -> Term' ty
TDir Direction
d)
Lens' Robot (Maybe Heading)
robotOrientation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just 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
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
Inventory
inst <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Direction
d forall a. Eq a => a -> a -> Bool
== RelativeDir -> Direction
DRelative RelativeDir
DDown Bool -> Bool -> Bool
&& Text -> Inventory -> RID
countByName Text
"compass" Inventory
inst forall a. Eq a => a -> a -> Bool
== RID
0) forall a b. (a -> b) -> a -> b
$ do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievement GameplayAchievement
GetDisoriented
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Place -> case [Value]
vs of
[VText Text
name] -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Bool
nothingHere <- forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
Bool
nothingHere forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"There is already an entity here."]
Entity
e <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Entity
e))
Lens' Robot Inventory
robotInventory 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
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Ping -> case [Value]
vs of
[VRobot RID
otherID] -> do
Maybe Robot
maybeOtherRobot <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID RID
otherID
Robot
selfRobot <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue forall a b. (a -> b) -> a -> b
$ Robot -> Maybe Robot -> Maybe Heading
displacementVector Robot
selfRobot Maybe Robot
maybeOtherRobot) Store
s Cont
k
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 = (forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Double
euclidean forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot (Cosmic Location)
robotLocation) Robot
selfRobot Robot
otherRobot
(Double
_minRange, Double
maxRange) = Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange (forall a. a -> Maybe a
Just Robot
selfRobot) (forall a. a -> Maybe a
Just Robot
otherRobot)
Double
d <- forall b. DistanceMeasure b -> Maybe b
getFiniteDistance DistanceMeasure Double
dist
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Double
d forall a. Ord a => a -> a -> Bool
<= Double
maxRange
Robot -> Cosmic Location -> Maybe Heading
orientationBasedRelativePosition Robot
selfRobot forall a b. (a -> b) -> a -> b
$ forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot (Cosmic Location)
robotLocation Robot
otherRobot
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Give -> case [Value]
vs of
[VRobot RID
otherID, VText Text
itemName] -> do
Robot
_other <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
otherID
Entity
item <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
"give"
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
RID
focusedID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState RID
focusedRobotID
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
otherID forall a. Eq a => a -> a -> Bool
/= RID
myID) forall a b. (a -> b) -> a -> b
$ do
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
otherID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory 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
Lens' Robot Inventory
robotInventory 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
focusedID forall a. Eq a => a -> a -> Bool
== RID
myID Bool -> Bool -> Bool
|| RID
focusedID forall a. Eq a => a -> a -> Bool
== RID
otherID) forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Equip -> case [Value]
vs of
[VText Text
itemName] -> do
Entity
item <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
"equip"
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
RID
focusedID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState RID
focusedRobotID
Bool
already <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' Robot Inventory
equippedDevices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Inventory -> Entity -> Bool
`E.contains` Entity
item))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
already forall a b. (a -> b) -> a -> b
$ do
Lens' Robot Inventory
equippedDevices 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
Lens' Robot Inventory
robotInventory 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
focusedID forall a. Eq a => a -> a -> Bool
== RID
myID) forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Unequip -> case [Value]
vs of
[VText Text
itemName] -> do
Entity
item <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
ensureEquipped Text
itemName
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
RID
focusedID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState RID
focusedRobotID
Lens' Robot Inventory
equippedDevices 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
Lens' Robot Inventory
robotInventory 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
focusedID forall a. Eq a => a -> a -> Bool
== RID
myID) forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Make -> case [Value]
vs of
[VText Text
name] -> do
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
Inventory
ins <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
Entity
e <-
Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em
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 forall a. Semigroup a => a -> a -> a
<> Text
"."]
IntMap [Recipe Entity]
outRs <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Recipes
recipesInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Recipes (IntMap [Recipe Entity])
recipesOut
Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
let create :: [Text] -> [Text]
create [Text]
l = [Text]
l forall a. Semigroup a => a -> a -> a
<> [Text
"You can use 'create \"" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"\"' instead." | Bool
creative]
let recipes :: [Recipe Entity]
recipes = 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 = forall {b} {t :: * -> *}. (Num b, Foldable t) => t (b, Entity) -> b
countIn (Recipe Entity
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeOutputs) forall a. Ord a => a -> a -> Bool
> forall {b} {t :: * -> *}. (Num b, Foldable t) => t (b, Entity) -> b
countIn (Recipe Entity
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeInputs)
countIn :: t (b, Entity) -> b
countIn t (b, Entity)
xs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
0 forall a b. (a, b) -> a
fst (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Entity
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) t (b, Entity)
xs)
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Recipe Entity]
recipes)
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 forall a. Semigroup a => a -> a -> a
<> Text
"."]
let displayMissingCount :: a -> MissingType -> target
displayMissingCount a
mc = \case
MissingType
MissingInput -> forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show a
mc)
MissingType
MissingCatalyst -> target
"not equipped"
displayMissingIngredient :: MissingIngredient -> Text
displayMissingIngredient (MissingIngredient MissingType
mk RID
mc Entity
me) =
Text
" - " forall a. Semigroup a => a -> a -> a
<> Entity
me forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName forall a. Semigroup a => a -> a -> a
<> Text
" (" forall a. Semigroup a => a -> a -> a
<> forall {target} {a}.
(From String target, Show a, IsString target) =>
a -> MissingType -> target
displayMissingCount RID
mc MissingType
mk forall a. Semigroup a => a -> a -> a
<> Text
")"
displayMissingIngredients :: [[MissingIngredient]] -> [Text]
displayMissingIngredients [[MissingIngredient]]
xs = forall a. [a] -> [[a]] -> [a]
L.intercalate [Text
"OR"] (forall a b. (a -> b) -> [a] -> [b]
map MissingIngredient -> Text
displayMissingIngredient forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[MissingIngredient]]
xs)
let ([[MissingIngredient]]
badRecipes, [(Inventory, [(RID, Entity)], Recipe Entity)]
goodRecipes) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Inventory, Inventory)
-> Recipe Entity
-> Either
[MissingIngredient] (Inventory, [(RID, Entity)], Recipe Entity)
make (Inventory
inv, Inventory
ins)) forall a b. (a -> b) -> a -> b
$ [Recipe Entity]
recipes
Maybe (Inventory, [(RID, Entity)], Recipe Entity)
chosenRecipe <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice (forall s a. s -> Getting a s a -> a
^. forall s t a b. Field3 s t a b => Lens s t a b
_3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Lens' (Recipe e) Integer
recipeWeight) [(Inventory, [(RID, Entity)], Recipe Entity)]
goodRecipes
(Inventory
invTaken, [(RID, Entity)]
changeInv, Recipe Entity
recipe) <-
Maybe (Inventory, [(RID, Entity)], Recipe Entity)
chosenRecipe
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 forall a. Semigroup a => a -> a -> a
<> Text
"."
, Text
"Missing:\n" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unlines ([[MissingIngredient]] -> [Text]
displayMissingIngredients [[MissingIngredient]]
badRecipes)
]
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
invTaken
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (Recipe Entity
recipe forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) (IngredientList e)
recipeOutputs)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) e.
HasRobotStepState sig m =>
Recipe e
-> Value -> [WorldUpdate Entity] -> [RobotUpdate] -> m CESK
finishCookingRecipe Recipe Entity
recipe Value
VUnit [] (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RID -> Entity -> RobotUpdate
AddEntity) [(RID, Entity)]
changeInv)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Has -> case [Value]
vs of
[VText Text
name] -> do
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool ((forall a. Ord a => a -> a -> Bool
> RID
0) forall a b. (a -> b) -> a -> b
$ Text -> Inventory -> RID
countByName Text
name Inventory
inv)) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Equipped -> case [Value]
vs of
[VText Text
name] -> do
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool ((forall a. Ord a => a -> a -> Bool
> RID
0) forall a b. (a -> b) -> a -> b
$ Text -> Inventory -> RID
countByName Text
name Inventory
inv)) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Count -> case [Value]
vs of
[VText Text
name] -> do
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Inventory -> RID
countByName Text
name Inventory
inv)) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Scout -> case [Value]
vs of
[VDir Direction
d] -> do
IntMap Robot
rMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
Cosmic Location
myLoc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Heading
heading <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m Heading
deriveHeading Direction
d
Map SubworldName (Map Location IntSet)
botsByLocs <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
RID
selfRid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
let locsInDirection :: [Cosmic Location]
locsInDirection :: [Cosmic Location]
locsInDirection = forall a. RID -> [a] -> [a]
take RID
maxScoutRange forall a b. (a -> b) -> a -> b
$ 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
E.Opaque)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt
let hasVisibleBot :: Cosmic Location -> Bool
hasVisibleBot :: Cosmic Location -> Bool
hasVisibleBot = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RID -> Bool
botIsVisible forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [RID]
IS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntSet
excludeSelf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> IntSet
botsHere
where
excludeSelf :: IntSet -> IntSet
excludeSelf = (IntSet -> IntSet -> IntSet
`IS.difference` RID -> IntSet
IS.singleton RID
selfRid)
botsHere :: Cosmic Location -> IntSet
botsHere (Cosmic SubworldName
swName Location
loc) =
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty Location
loc forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty SubworldName
swName Map SubworldName (Map Location IntSet)
botsByLocs
botIsVisible :: RID -> Bool
botIsVisible = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Robot -> Bool
canSee forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. RID -> IntMap a -> Maybe a
`IM.lookup` IntMap Robot
rMap)
canSee :: Robot -> Bool
canSee = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display Bool
invisible)
let isConclusivelyVisible :: Bool -> Cosmic Location -> Maybe Bool
isConclusivelyVisible :: Bool -> Cosmic Location -> Maybe Bool
isConclusivelyVisible Bool
isOpaque Cosmic Location
loc
| Bool
isOpaque = forall a. a -> Maybe a
Just Bool
False
| Cosmic Location -> Bool
hasVisibleBot Cosmic Location
loc = forall a. a -> Maybe a
Just Bool
True
| Bool
otherwise = 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Cosmic Location -> Maybe Bool
isConclusivelyVisible Bool
opaque Cosmic Location
loc
Maybe Bool
result <- 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 = forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
result
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool Bool
foundBot) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Whereami -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue forall a b. (a -> b) -> a -> b
$ Cosmic Location
loc forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) Store
s Cont
k
Const
Waypoint -> case [Value]
vs of
[VText Text
name, VInt Integer
idx] -> do
Navigation (Map SubworldName) Location
lm <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (Navigation (Map SubworldName) Location)
worldNavigation
Cosmic SubworldName
swName Location
_ <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> WaypointName
WaypointName Text
name) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty SubworldName
swName forall a b. (a -> b) -> a -> b
$ forall (additionalDimension :: * -> *) portalExitLoc.
Navigation additionalDimension portalExitLoc
-> additionalDimension (Map WaypointName (NonEmpty Location))
waypoints Navigation (Map SubworldName) Location
lm of
Maybe (NonEmpty Location)
Nothing -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed Const
Waypoint ([Text] -> Text
T.unwords [Text
"No waypoint named", Text
name]) forall a. Maybe a
Nothing
Just NonEmpty Location
wps -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue (forall a. NonEmpty a -> RID
NE.length NonEmpty Location
wps, forall b a. Integral b => NonEmpty a -> b -> a
indexWrapNonEmpty NonEmpty Location
wps Integer
idx)) Store
s Cont
k
[Value]
_ -> 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 <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
let locs :: [Heading]
locs = Integer -> Integer -> Integer -> Integer -> [Heading]
rectCells Integer
x1 Integer
y1 Integer
x2 Integer
y2
let sortedOffsets :: [Heading]
sortedOffsets = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(V2 Int32
x Int32
y) -> forall a. Num a => a -> a
abs Int32
x forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs Int32
y) [Heading]
locs
let f :: Heading -> m Bool
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall a b. (a -> b) -> a -> b
$ Text -> Entity -> Bool
isEntityNamed Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc
Maybe Heading
firstOne <- forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m (Maybe a)
findM Heading -> m Bool
f [Heading]
sortedOffsets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Maybe Heading
firstOne) Store
s Cont
k
[Value]
_ -> 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] -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
doResonate (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall a b. (a -> b) -> a -> b
$ Text -> Entity -> Bool
isEntityNamed Text
name) Integer
x1 Integer
y1 Integer
x2 Integer
y2
[Value]
_ -> 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] -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Maybe Entity -> Bool)
-> Integer -> Integer -> Integer -> Integer -> m CESK
doResonate forall a. Maybe a -> Bool
isJust Integer
x1 Integer
y1 Integer
x2 Integer
y2
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Sniff -> case [Value]
vs of
[VText Text
name] -> do
Maybe (Int32, Heading)
firstFound <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m (Maybe (Int32, Heading))
findNearest Text
name
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int32
1) forall a b. (a, b) -> a
fst Maybe (Int32, Heading)
firstFound) Store
s Cont
k
[Value]
_ -> 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) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m ()
addWatchedLocation Cosmic Location
loc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> 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
_ <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
let loc :: Cosmic Location
loc = forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
swName forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 -> Location
Location (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m ()
addWatchedLocation Cosmic Location
loc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Chirp -> case [Value]
vs of
[VText Text
name] -> do
Maybe (Int32, Heading)
firstFound <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m (Maybe (Int32, Heading))
findNearest Text
name
Maybe Heading
mh <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
Inventory
inst <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
let processDirection :: AbsoluteDir -> Maybe Direction
processDirection AbsoluteDir
entityDir =
if Text -> Inventory -> RID
countByName Text
"compass" Inventory
inst forall a. Ord a => a -> a -> Bool
>= RID
1
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AbsoluteDir -> Direction
DAbsolute AbsoluteDir
entityDir
else case Maybe Heading
mh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Heading -> Maybe Direction
toDirection of
Just (DAbsolute AbsoluteDir
robotDir) ->
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativeDir -> Direction
DRelative forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarRelativeDir -> RelativeDir
DPlanar forall a b. (a -> b) -> a -> b
$ AbsoluteDir
entityDir AbsoluteDir -> AbsoluteDir -> PlanarRelativeDir
`relativeTo` AbsoluteDir
robotDir
Maybe Direction
_ -> forall a. Maybe a
Nothing
val :: Value
val = Direction -> Value
VDir forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (RelativeDir -> Direction
DRelative RelativeDir
DDown) forall a b. (a -> b) -> a -> b
$ do
(Int32, Heading)
entLoc <- Maybe (Int32, Heading)
firstFound
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Int32, Heading)
entLoc forall a. Eq a => a -> a -> Bool
/= forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
AbsoluteDir -> Maybe Direction
processDirection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heading -> AbsoluteDir
nearestDirection forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Int32, Heading)
entLoc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
val Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Heading -> do
Maybe Heading
mh <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Direction -> Value
VDir (forall a. a -> Maybe a -> a
fromMaybe (RelativeDir -> Direction
DRelative RelativeDir
DDown) forall a b. (a -> b) -> a -> b
$ Maybe Heading
mh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Heading -> Maybe Direction
toDirection)) Store
s Cont
k
Const
Time -> do
TickNumber Int64
t <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt forall a b. (a -> b) -> a -> b
$ 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] -> forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (Throw Exn) sig, Member (State Robot) sig,
Member (State GameState) sig) =>
Direction -> m CESK
doDrill Direction
d
[Value]
_ -> 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 <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
Entity
equippedEntity <- 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"]
forall {sig :: (* -> *) -> * -> *} {m :: * -> *} {p}.
(Algebra sig m, Member (Throw Exn) sig, Member (State Robot) sig,
Member (State GameState) sig, Eq p,
Member (Reader (Recipe p)) (Reader (Recipe Entity))) =>
Inventory -> Text -> Direction -> p -> m CESK
applyDevice Inventory
ins Text
verbPhrase Direction
d Entity
equippedEntity
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Blocked -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Maybe Heading
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
let nextLoc :: Cosmic Location
nextLoc = Cosmic Location
loc Cosmic Location -> Heading -> Cosmic Location
`offsetBy` (Maybe Heading
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
Maybe Entity
me <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
nextLoc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Unwalkable) Maybe Entity
me)) Store
s Cont
k
Const
Scan -> case [Value]
vs of
[VDir Direction
d] -> do
(Cosmic Location
_loc, Maybe Entity
me) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Entity
me forall a b. (a -> b) -> a -> b
$ \Entity
e -> do
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> Entity -> Inventory -> Inventory
insertCount RID
0 Entity
e
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Maybe Entity
me) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Knows -> case [Value]
vs of
[VText Text
name] -> do
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
Inventory
ins <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool Bool
knows) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Upload -> case [Value]
vs of
[VRobot RID
otherID] -> do
Robot
_other <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
otherID
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Inventory -> [(RID, Entity)]
elems Inventory
inv) forall a b. (a -> b) -> a -> b
$ \(RID
_, Entity
e) ->
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
otherID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> Entity -> Inventory -> Inventory
insertCount RID
0 Entity
e
Seq LogEntry
rlog <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Seq LogEntry)
robotLog
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
otherID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot (Seq LogEntry)
robotLog forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Seq LogEntry
rlog
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Random -> case [Value]
vs of
[VInt Integer
hi] -> do
Integer
n <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Integer
0, Integer
hi forall a. Num a => a -> a -> a
- Integer
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt Integer
n) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Atomic -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m CESK
goAtomic
Const
Instant -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m CESK
goAtomic
Const
As -> case [Value]
vs of
[VRobot RID
rid, Value
prog] -> do
Robot
r <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID RID
rid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no actor with ID", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
rid)])
GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
Value
v <-
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @Robot (Robot
r forall a b. a -> (a -> b) -> b
& Lens' Robot Bool
systemRobot forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @GameState GameState
g forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m, Has (State Robot) sig m) =>
CESK -> m Value
runCESK (Value -> Store -> Cont -> CESK
Out Value
prog Store
s [Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []), Frame
FExec])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
RobotNamed -> case [Value]
vs of
[VText Text
rname] -> do
Robot
r <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Text -> m (Maybe Robot)
robotWithName Text
rname forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot named", Text
rname])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Robot
r) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
RobotNumbered -> case [Value]
vs of
[VInt Integer
rid] -> do
Robot
r <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
rid)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot with number", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Integer
rid)])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Robot
r) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Say -> case [Value]
vs of
[VText Text
msg] -> do
Bool
isPrivileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
LogEntry
m <- 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
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
m
let measureToLog :: Cosmic Location -> LogSource -> DistanceMeasure Int32
measureToLog Cosmic Location
robLoc = \case
RobotLog RobotLogSource
_ RID
_ Cosmic Location
logLoc -> forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Int32
manhattan Cosmic Location
robLoc Cosmic Location
logLoc
LogSource
SystemLog -> forall b. b -> DistanceMeasure b
Measurable Int32
0
addLatestClosest :: Cosmic Location -> Seq LogEntry -> Seq LogEntry
addLatestClosest Cosmic Location
rl = \case
Seq LogEntry
Seq.Empty -> forall a. a -> Seq a
Seq.singleton LogEntry
m
Seq LogEntry
es Seq.:|> LogEntry
e
| LogEntry
e LogEntry -> LogEntry -> Bool
`isEarlierThan` LogEntry
m -> Seq LogEntry
es forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
e forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
m
| LogEntry
e LogEntry -> LogEntry -> Bool
`isFartherThan` LogEntry
m -> Seq LogEntry
es forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
m
| Bool
otherwise -> Seq LogEntry
es forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
e
where
isEarlierThan :: LogEntry -> LogEntry -> Bool
isEarlierThan = forall a. Ord a => a -> a -> Bool
(<) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime)
isFartherThan :: LogEntry -> LogEntry -> Bool
isFartherThan = forall a. Ord a => a -> a -> Bool
(>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Cosmic Location -> LogSource -> DistanceMeasure Int32
measureToLog Cosmic Location
rl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' LogEntry LogSource
leSource)
let addToRobotLog :: (Has (State GameState) sgn m) => Robot -> m ()
addToRobotLog :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addToRobotLog Robot
r = do
Maybe (RID, Cosmic Location)
maybeRidLoc <- forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState Robot
r forall a b. (a -> b) -> a -> b
$ do
Bool
hasLog <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
CLog
Bool
hasListen <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
CListen
Cosmic Location
loc' <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
hasLog Bool -> Bool -> Bool
&& Bool
hasListen
forall a. a -> Maybe a
Just (RID
rid, Cosmic Location
loc')
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (RID, Cosmic Location)
maybeRidLoc forall a b. (a -> b) -> a -> b
$ \(RID
rid, Cosmic Location
loc') ->
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot (Seq LogEntry)
robotLog forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Cosmic Location -> Seq LogEntry -> Seq LogEntry
addLatestClosest Cosmic Location
loc'
[Robot]
robotsAround <-
if Bool
isPrivileged
then forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. IntMap a -> [a]
IM.elems
else forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea Cosmic Location
loc forall i. Num i => i
hearingDistance
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addToRobotLog [Robot]
robotsAround
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> 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 <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
Bool
isPrivileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
Seq LogEntry
mq <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
SystemLog {} -> Bool
False
RobotLog RobotLogSource
_ RID
lrid Cosmic Location
_ -> RID
rid forall a. Eq a => a -> a -> Bool
/= RID
lrid
limitLast :: Seq LogEntry -> Maybe Text
limitLast = \case
Seq LogEntry
_s Seq.:|> LogEntry
l -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LogEntry
l forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Text
leText
Seq LogEntry
_ -> forall a. Maybe a
Nothing
mm :: Maybe Text
mm = Seq LogEntry -> Maybe Text
limitLast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (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) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR (GameState -> LogEntry -> Bool
messageIsRecent GameState
gs) Seq LogEntry
mq
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Term -> Env -> Store -> Cont -> CESK
In (forall ty. Const -> Term' ty
TConst Const
Listen) forall a. Monoid a => a
mempty Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Cont
k))
(\Text
m -> Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
m) Store
s Cont
k)
Maybe Text
mm
Const
Log -> case [Value]
vs of
[VText Text
msg] -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
View -> case [Value]
vs of
[VRobot RID
rid] -> do
RID
rn <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
rn forall a. Eq a => a -> a -> Bool
== RID
0) forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID RID
rid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Robot
Nothing -> do
Bool
cr <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
Bool
ws <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable
case Bool
cr Bool -> Bool -> Bool
|| Bool
ws of
Bool
True -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
c [Text
"There is no actor with ID", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
rid), Text
"to view."]
Bool
False -> forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify GameState -> GameState
unfocus
Just Robot
_ -> Lens' GameState ViewCenterRule
viewCenterRule forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= RID -> ViewCenterRule
VCRobot RID
rid
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Appear -> case [Value]
vs of
[VText Text
app] -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
case forall target source. From source target => source -> target
into @String Text
app of
[Char
dc] -> do
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display Char
defaultChar forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
dc
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display (Map AbsoluteDir Char)
orientationMap forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= forall k a. Map k a
M.empty
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Char
dc, Char
nc, Char
ec, Char
sc, Char
wc] -> do
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display Char
defaultChar forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
dc
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display (Map AbsoluteDir Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix AbsoluteDir
DNorth forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
nc
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display (Map AbsoluteDir Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix AbsoluteDir
DEast forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
ec
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display (Map AbsoluteDir Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix AbsoluteDir
DSouth forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
sc
Lens' Robot Display
robotDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Display (Map AbsoluteDir Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix AbsoluteDir
DWest forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Char
wc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
String
_other -> 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. 'appear' must be given a string with exactly 1 or 5 characters."]
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Create -> case [Value]
vs of
[VText Text
name] -> do
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
Entity
e <-
Text -> EntityMap -> Maybe Entity
lookupEntityName Text
name EntityMap
em
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 forall a. Semigroup a => a -> a -> a
<> Text
"."]
Lens' Robot Inventory
robotInventory 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
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Halt -> case [Value]
vs of
[VRobot RID
targetID] -> do
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
case RID
myID forall a. Eq a => a -> a -> Bool
== RID
targetID of
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CESK -> CESK
cancel forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Bool
False -> do
Robot
target <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
targetID
Bool
omni <- 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 forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot) of
Bool
True -> do
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
targetID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= CESK -> CESK
cancel
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
sleepForever RID
targetID
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Bool
False -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
c [Text
"You are not authorized to halt that robot."]
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Ishere -> case [Value]
vs of
[VText Text
name] -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Maybe Entity
me <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
let here :: Bool
here = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Entity -> Bool
isEntityNamed Text
name) Maybe Entity
me
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool Bool
here) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Isempty -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Maybe Entity
me <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool (forall a. Maybe a -> Bool
isNothing Maybe Entity
me)) Store
s Cont
k
Const
Self -> do
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRobot RID
rid) Store
s Cont
k
Const
Parent -> do
Maybe RID
mp <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe RID)
robotParentID
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRobot (forall a. a -> Maybe a -> a
fromMaybe RID
rid Maybe RID
mp)) Store
s Cont
k
Const
Base -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRobot RID
0) Store
s Cont
k
Const
Meet -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
let neighbor :: Maybe Robot
neighbor =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
/= RID
rid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Location -> Location -> Int32
manhattan forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) Cosmic Location
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation))
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea Cosmic Location
loc Int32
1 GameState
g
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Maybe Robot
neighbor) Store
s Cont
k
Const
MeetAll -> case [Value]
vs of
[Value
f, Value
b] -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState
let neighborIDs :: [RID]
neighborIDs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= RID
rid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID) forall a b. (a -> b) -> a -> b
$ Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea Cosmic Location
loc Int32
1 GameState
g
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
b Store
s (Value -> [RID] -> Frame
FMeetAll Value
f [RID]
neighborIDs forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Whoami -> case [Value]
vs of
[] -> do
Text
name <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Text
robotName
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
name) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Setname -> case [Value]
vs of
[VText Text
name] -> do
Lens' Robot Text
robotName forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Text
name
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Force -> case [Value]
vs of
[VDelay Term
t Env
e] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t Env
e Store
s Cont
k
[VRef RID
loc] ->
case RID -> Store -> Maybe MemCell
lookupStore RID
loc Store
s of
Maybe MemCell
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Exn -> Store -> Cont -> CESK
Up (Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
"Reference to unknown memory cell " (forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
loc))) Store
s Cont
k
Just (E Term
t Env
e') -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t Env
e' (RID -> MemCell -> Store -> Store
setStore RID
loc (Term -> Env -> MemCell
Blackhole Term
t Env
e') Store
s) (RID -> Frame
FUpdate RID
loc forall a. a -> [a] -> [a]
: Cont
k)
Just Blackhole {} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
InfiniteLoop Store
s Cont
k
Just (V Value
v) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
If -> case [Value]
vs of
[VBool Bool
b, Value
thn, Value
els] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. a -> a -> Bool -> a
bool Value
els Value
thn Bool
b) Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Inl -> case [Value]
vs of
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Inr -> case [Value]
vs of
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_ -> 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s (Value -> Frame
FApp (forall a. a -> a -> Bool -> a
bool Value
kl Value
kr Bool
side) forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Fst -> case [Value]
vs of
[VPair Value
v Value
_] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Snd -> case [Value]
vs of
[VPair Value
_ Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Try -> case [Value]
vs of
[Value
c1, Value
c2] -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 []) forall a. a -> [a] -> [a]
: Frame
FExec forall a. a -> [a] -> [a]
: Value -> Frame
FTry Value
c2 forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Undefined -> forall (m :: * -> *) a. Monad m => a -> m a
return 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
User Text
msg) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Key -> case [Value]
vs of
[VText Text
ktxt] -> case forall a. Parser a -> Text -> Either Text a
runParser Parser KeyCombo
parseKeyComboFull Text
ktxt of
Right KeyCombo
kc -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (KeyCombo -> Value
VKey KeyCombo
kc) Store
s Cont
k
Left Text
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return 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]) forall a. Maybe a
Nothing) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
InstallKeyHandler -> case [Value]
vs of
[VText Text
hint, Value
handler] -> do
Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe (Text, Value))
inputHandler forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (Text
hint, Value
handler)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Reprogram -> case [Value]
vs of
[VRobot RID
childRobotID, VDelay Term
cmd Env
e] -> do
Robot
r <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get
Bool
isPrivileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
Robot
childRobot <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID RID
childRobotID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no actor with ID", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
childRobotID) forall a. Semigroup a => a -> a -> a
<> Text
"."])
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
(RID
childRobotID forall a. Eq a => a -> a -> Bool
/= RID
myID)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You cannot make a robot reprogram itself."]
(Value, Store)
_ <-
CESK -> Maybe (Value, Store)
finalValue (Robot
childRobot forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine)
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."]
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt Bool
isPrivileged Cosmic Location
loc (Robot
childRobot forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You can only reprogram an adjacent robot."]
(Set Entity
toEquip, Inventory
toGive) <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements
(Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory)
(Robot
childRobot forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory)
(Robot
childRobot forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices)
Term
cmd
Text
"The target robot"
IncapableFix
FixByObtain
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
childRobotID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine 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
e Store
s [Frame
FExec]
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
childRobotID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot RobotContext
robotContext
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> Inventory -> Inventory -> m ()
provisionChild RID
childRobotID ([Entity] -> Inventory
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set Entity
toEquip) Inventory
toGive
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
activateRobot RID
childRobotID
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Build -> case [Value]
vs of
[VDelay Term
cmd Env
e] -> do
Robot
r <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @Robot
RID
pid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
(Set Entity
toEquip, Inventory
toGive) <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) Inventory
E.empty Inventory
E.empty Term
cmd Text
"You" IncapableFix
FixByObtain
Text
displayName <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m Text
randomName
TimeSpec
createdAt <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow
Bool
isSystemRobot <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
RobotContext
parentCtx <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot RobotContext
robotContext
Robot
newRobot <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TRobot -> m Robot
addTRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lens' TRobot RobotContext
trobotContext forall s t a b. ASetter s t a b -> b -> s -> t
.~ RobotContext
parentCtx) forall a b. (a -> b) -> a -> b
$
forall (phase :: RobotPhase).
RobotID phase
-> Maybe RID
-> Text
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> Set Text
-> TimeSpec
-> RobotR phase
mkRobot
()
(forall a. a -> Maybe a
Just RID
pid)
Text
displayName
(Text -> Document Syntax
Markdown.fromText forall a b. (a -> b) -> a -> b
$ Text
"A robot built by the robot named " forall a. Semigroup a => a -> a -> a
<> (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName) forall a. Semigroup a => a -> a -> a
<> Text
".")
(forall a. a -> Maybe a
Just (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation))
( ((Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Maybe Heading)
robotOrientation) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Heading
dir -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Heading
dir forall a. Eq a => a -> a -> Bool
/= forall (f :: * -> *) a. (Additive f, Num a) => f a
zero) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Heading
dir)
forall a. Maybe a -> a -> a
? Heading
north
)
Display
defaultRobotDisplay
(Term -> Env -> Store -> Cont -> CESK
In Term
cmd Env
e Store
s [Frame
FExec])
[]
[]
Bool
isSystemRobot
Bool
False
forall a. Monoid a => a
mempty
TimeSpec
createdAt
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> Inventory -> Inventory -> m ()
provisionChild (Robot
newRobot forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID) ([Entity] -> Inventory
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set Entity
toEquip) Inventory
toGive
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. Valuable a => a -> Value
asValue Robot
newRobot) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Salvage -> case [Value]
vs of
[] -> do
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
let okToSalvage :: Robot -> Bool
okToSalvage Robot
r = (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID forall a. Eq a => a -> a -> Bool
/= RID
0) Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Robot -> Bool
isActive forall a b. (a -> b) -> a -> b
$ Robot
r)
Maybe Robot
mtarget <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State s) sig m =>
(s -> a) -> m a
gets (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Robot -> Bool
okToSalvage 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Just Robot
target -> do
let salvageInventory :: Inventory
salvageInventory = Inventory -> Inventory -> Inventory
E.union (Robot
target forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) (Robot
target forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices)
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
salvageInventory
let salvageItems :: [Text]
salvageItems = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(RID
n, Entity
e) -> forall a. RID -> a -> [a]
replicate RID
n (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)) (Inventory -> [(RID, Entity)]
E.elems Inventory
salvageInventory)
numItems :: RID
numItems = forall (t :: * -> *) a. Foldable t => t a -> RID
length [Text]
salvageItems
Inventory
inst <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
Bool
isPrivileged <- 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
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!?"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isPrivileged Bool -> Bool -> Bool
|| Inventory
inst Inventory -> Entity -> Bool
`E.contains` Entity
logger) forall a b. (a -> b) -> a -> b
$ Lens' Robot (Seq LogEntry)
robotLog forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Robot
target forall s a. s -> Getting a s a -> a
^. Lens' Robot (Seq LogEntry)
robotLog
let knownItems :: [Entity]
knownItems = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== RID
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(RID, Entity)]
elems forall a b. (a -> b) -> a -> b
$ Inventory
salvageInventory
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Inventory
i -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RID -> Entity -> Inventory -> Inventory
insertCount RID
0) Inventory
i [Entity]
knownItems
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Bool
systemRobot forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
RID
ourID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use @Robot Getter Robot RID
robotID
let giveInventory :: Term
giveInventory =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Term -> Term -> Term
TBind forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Term
giveItem) (forall ty. Const -> Term' ty
TConst Const
Selfdestruct) [Text]
salvageItems
giveItem :: Text -> Term
giveItem Text
item = Term -> Term -> Term
TApp (Term -> Term -> Term
TApp (forall ty. Const -> Term' ty
TConst Const
Give) (forall ty. RID -> Term' ty
TRobot RID
ourID)) (forall ty. Text -> Term' ty
TText Text
item)
Lens' GameState (IntMap Robot)
robotMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine
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 forall t. Ctx t
empty Store
emptyStore [Frame
FExec]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
activateRobot (Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID)
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TickNumber -> CESK -> CESK
Waiting (RID -> TickNumber -> TickNumber
addTicks (RID
numItems forall a. Num a => a -> a -> a
+ RID
1) TickNumber
time) (Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Script (String
filePath forall a. Semigroup a => a -> a -> a
<> String
".sw")
[Maybe String]
mf <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe String)
readFileMay forall a b. (a -> b) -> a -> b
$ [String
filePath, String
filePath forall a. Semigroup a => a -> a -> a
<> String
".sw"] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [Maybe String
sData, Maybe String
sDataSW]
String
f <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe String]
mf forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"File not found:", Text
fileName]
Maybe ProcessedTerm
mt <-
Text -> Either Text (Maybe ProcessedTerm)
processTerm (forall target source. From source target => source -> target
into @Text String
f) 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 ProcessedTerm
mt of
Maybe ProcessedTerm
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
Just t :: ProcessedTerm
t@(ProcessedTerm TModule
_ Requirements
_ ReqCtx
reqCtx) -> do
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= ReqCtx
reqCtx
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProcessedTerm -> Env -> Store -> Cont -> CESK
initMachine' ProcessedTerm
t forall t. Ctx t
empty Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Not -> case [Value]
vs of
[VBool Bool
b] -> forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Neg -> case [Value]
vs of
[VInt Integer
n] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt (-Integer
n)) Store
s Cont
k
[Value]
_ -> 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Or -> case [Value]
vs of
[VBool Bool
a, VBool Bool
b] -> forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_ -> 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText (Value -> Text
prettyValue Value
v)) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Chars -> case [Value]
vs of
[VText Text
t] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> RID
T.length Text
t)) Store
s Cont
k
[Value]
_ -> 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 = RID -> Text -> (Text, Text)
T.splitAt (forall a. Num a => Integer -> a
fromInteger Integer
i) Text
t
t2 :: (Value, Value)
t2 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both Text -> Value
VText (Text, Text)
p
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value -> Value -> Value
VPair (Value, Value)
t2) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Concat -> case [Value]
vs of
[VText Text
v1, VText Text
v2] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText (Text
v1 forall a. Semigroup a => a -> a -> a
<> Text
v2)) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
CharAt -> case [Value]
vs of
[VInt Integer
i, VText Text
t]
| Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> RID
T.length Text
t) ->
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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Text -> RID
T.length Text
t)]
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> RID
ord forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RID -> Char
T.index Text
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
i) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
ToChar -> case [Value]
vs of
[VInt Integer
i]
| Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> RID
ord (forall a. Bounded a => a
maxBound :: Char)) ->
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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
i) Store
s Cont
k
[Value]
_ -> 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 forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$ Text
msg forall a. Semigroup a => a -> a -> a
<> Text
badConstMsg
where
doDrill :: Direction -> m CESK
doDrill Direction
d = do
Inventory
ins <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
let equippedDrills :: [Entity]
equippedDrills = Capability -> Inventory -> [Entity]
extantElemsWithCapability Capability
CDrill Inventory
ins
preferredDrill :: Maybe Entity
preferredDrill = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RID
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)) [Entity]
equippedDrills
Entity
tool <- Maybe Entity
preferredDrill 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?!"
forall {sig :: (* -> *) -> * -> *} {m :: * -> *} {p}.
(Algebra sig m, Member (Throw Exn) sig, Member (State Robot) sig,
Member (State GameState) sig, Eq p,
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) <- forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (Throw Exn) sig, Member (State Robot) sig,
Member (State GameState) sig) =>
Text -> Direction -> m (Cosmic Location, Entity)
getDeviceTarget Text
verbPhrase Direction
d
IntMap [Recipe Entity]
inRs <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Recipes
recipesInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Recipes (IntMap [Recipe Entity])
recipesIn
let recipes :: [Recipe Entity]
recipes = 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== p
tool) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view forall e. Lens' (Recipe e) (IngredientList e)
recipeCatalysts
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Recipe Entity]
recipes)
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 forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall a. Semigroup a => a -> a -> a
<> Text
"."
]
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
let makeRecipe :: Recipe Entity
-> Either
[MissingIngredient] ((Inventory, [(RID, Entity)]), Recipe Entity)
makeRecipe Recipe Entity
r = (,Recipe Entity
r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inventory, Inventory)
-> Recipe Entity
-> Either [MissingIngredient] (Inventory, [(RID, Entity)])
make' (Entity -> Inventory -> Inventory
insert Entity
nextE Inventory
inv, Inventory
ins) Recipe Entity
r
Maybe ((Inventory, [(RID, Entity)]), Recipe Entity)
chosenRecipe <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice (\((Inventory
_, [(RID, Entity)]
_), Recipe Entity
r) -> Recipe Entity
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) Integer
recipeWeight) forall a b. (a -> b) -> a -> b
$
forall a b. [Either a b] -> [b]
rights forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map Recipe Entity
-> Either
[MissingIngredient] ((Inventory, [(RID, Entity)]), Recipe Entity)
makeRecipe [Recipe Entity]
recipes
((Inventory
invTaken, [(RID, Entity)]
outs), Recipe Entity
recipe) <-
Maybe ((Inventory, [(RID, Entity)]), Recipe Entity)
chosenRecipe
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 forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall a. Semigroup a => a -> a -> a
<> Text
"."]
let ([(RID, Entity)]
out, [(RID, Entity)]
down) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Portable) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(RID, Entity)]
outs
learn :: [RobotUpdate]
learn = forall a b. (a -> b) -> [a] -> [b]
map (Entity -> RobotUpdate
LearnEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(RID, Entity)]
down
gain :: [RobotUpdate]
gain = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RID -> Entity -> RobotUpdate
AddEntity) [(RID, Entity)]
out
Maybe Entity
newEntity <- case [(RID, Entity)]
down of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
[(RID
1, Entity
de)] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Entity
de
[(RID, Entity)]
_ -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError 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
newEntity
}
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
invTaken
let cmdOutput :: Value
cmdOutput = forall a. Valuable a => a -> Value
asValue forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
listToMaybe [(RID, Entity)]
out
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 forall a. Semigroup a => a -> a -> a
<> [RobotUpdate]
gain)
getDeviceTarget :: Text -> Direction -> m (Cosmic Location, Entity)
getDeviceTarget Text
verb Direction
d = do
Text
rname <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Text
robotName
(Cosmic Location
nextLoc, Maybe Entity
nextME) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d
Entity
nextE <-
Maybe Entity
nextME
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 forall a. Semigroup a => a -> a -> a
<> Text
"."]
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 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
[Value
cmd] -> do
Lens' Robot Bool
runningAtomic forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
cmd Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Frame
FFinishAtomic forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
isEntityNamed :: T.Text -> Entity -> Bool
isEntityNamed :: Text -> Entity -> Bool
isEntityNamed Text
n Entity
e = (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toLower) (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) Text
n
badConst :: HasRobotStepState sig m => m a
badConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError 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:"
, String -> Text
T.pack (forall a. Show a => a -> String
show Const
c)
, String -> Text
T.pack (forall a. Show a => a -> String
show (forall a. [a] -> [a]
reverse [Value]
vs))
, forall a. PrettyPrec a => a -> Text
prettyText (Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c (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 <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
let offsets :: [Heading]
offsets = Integer -> Integer -> Integer -> Integer -> [Heading]
rectCells Integer
x1 Integer
y1 Integer
x2 Integer
y2
[RID]
hits <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Enum a => a -> RID
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Entity -> Bool
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc) [Heading]
offsets
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [RID]
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
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x1)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y1)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x2)
(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 = [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) = forall b. Ord b => (b, b) -> (b, b)
sortPair (Int32
x1, Int32
x2)
(Int32
yMin, Int32
yMax) = 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 <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
let f :: (a, Heading) -> m Bool
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall a b. (a -> b) -> a -> b
$ Text -> Entity -> Bool
isEntityNamed Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m (Maybe a)
findM forall {a}. (a, Heading) -> m Bool
f [(Int32, Heading)]
sortedOffsets
where
sortedOffsets :: [(Int32, V2 Int32)]
sortedOffsets :: [(Int32, Heading)]
sortedOffsets = (Int32
0, forall (f :: * -> *) a. (Additive f, Num a) => f a
zero) forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int32 -> [(Int32, Heading)]
genDiamondSides [Int32
1 .. Int32
maxSniffRange]
genDiamondSides :: Int32 -> [(Int32, V2 Int32)]
genDiamondSides :: Int32 -> [(Int32, Heading)]
genDiamondSides Int32
diameter = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall {a}. Num a => a -> a -> [(a, V2 a)]
f Int32
diameter Int32
x | Int32
x <- [Int32
0 .. Int32
diameter]]
where
f :: a -> a -> [(a, V2 a)]
f a
d a
x = forall a b. (a -> b) -> [a] -> [b]
map (a
d,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RID -> [a] -> [a]
take RID
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate forall a. Num a => V2 a -> V2 a
perp forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 a
x (a
d 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 forall a. Ord a => a -> a -> Bool
<= Integer
0
then do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Const -> [WorldUpdate Entity] -> [RobotUpdate] -> m ()
updateWorldAndRobots Const
c [WorldUpdate Entity]
wf [RobotUpdate]
rf
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
else do
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Integer
remTime forall a. Ord a => a -> a -> Bool
<= Integer
1 then forall a. a -> a
id else TickNumber -> CESK -> CESK
Waiting (RID -> TickNumber -> TickNumber
addTicks (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
remTime) TickNumber
time)) 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 forall a. a -> [a] -> [a]
: Cont
k)
where
remTime :: Integer
remTime = Recipe e
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) Integer
recipeTime
ensureEquipped :: HasRobotStepState sig m => Text -> m Entity
ensureEquipped :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
ensureEquipped Text
itemName = do
Inventory
inst <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
itemName Inventory
inst)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"You don't have a", 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
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
Inventory
inst <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
equippedDevices
Entity
item <-
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inventory -> [Entity]
lookupByName Text
itemName) [Inventory
inv, Inventory
inst])
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"What is", Text -> Text
indefinite Text
itemName forall a. Semigroup a => a -> a -> a
<> Text
"?"]
Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
let create :: [Text] -> [Text]
create [Text]
l = [Text]
l forall a. Semigroup a => a -> a -> a
<> [Text
"You can make one first with 'create \"" forall a. Semigroup a => a -> a -> a
<> Text
itemName forall a. Semigroup a => a -> a -> a
<> Text
"\"'." | Bool
creative]
(Entity -> Inventory -> RID
E.lookup Entity
item Inventory
inv forall a. Ord a => a -> a -> Bool
> RID
0)
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 forall a. Semigroup a => a -> a -> a
<> Text
"."]
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
item
checkRequirements ::
HasRobotStepState sig m =>
Inventory ->
Inventory ->
Inventory ->
Term ->
Text ->
IncapableFix ->
m (Set Entity, Inventory)
checkRequirements :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements Inventory
parentInventory Inventory
childInventory Inventory
childDevices Term
cmd Text
subject IncapableFix
fixI = do
ReqCtx
currentContext <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap
Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
let
(R.Requirements (forall a. Set a -> [a]
S.toList -> [Capability]
caps) (forall a. Set a -> [a]
S.toList -> [Text]
devNames) Map Text RID
reqInvNames, ReqCtx
_capCtx) = ReqCtx -> Term -> (Requirements, ReqCtx)
R.requirements ReqCtx
currentContext Term
cmd
([Entity]
devs :: [Entity]) <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
devNames forall a b. (a -> b) -> a -> b
$ \Text
devName ->
Text -> EntityMap -> Maybe Entity
E.lookupEntityName Text
devName EntityMap
em forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"Unknown device required: " forall a. Semigroup a => a -> a -> a
<> Text
devName]
(Inventory
reqInv :: Inventory) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(RID, Entity)] -> Inventory
E.fromElems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
M.assocs Map Text RID
reqInvNames) forall a b. (a -> b) -> a -> b
$ \(Text
eName, RID
n) ->
(RID
n,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> EntityMap -> Maybe Entity
E.lookupEntityName Text
eName EntityMap
em
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"Unknown entity required: " forall a. Semigroup a => a -> a -> a
<> Text
eName]
)
let
possibleDevices :: [(Maybe Capability, [Entity])]
possibleDevices :: [(Maybe Capability, [Entity])]
possibleDevices =
forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a
Just forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Capability -> EntityMap -> [Entity]
`deviceForCap` EntityMap
em)) [Capability]
caps
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Maybe a
Nothing,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [])) [Entity]
devs
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
partitionedDevices :: [(Set Entity, Set Entity)]
partitionedDevices :: [(Set Entity, Set Entity)]
partitionedDevices =
forall a b. (a -> b) -> [a] -> [b]
map (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Entity -> Bool
deviceOK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Maybe Capability, [Entity])]
possibleDevices
alreadyEquipped :: Set Entity
alreadyEquipped :: Set Entity
alreadyEquipped = forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(RID, Entity)]
E.elems forall a b. (a -> b) -> a -> b
$ Inventory
childDevices
missingChildInv :: Inventory
missingChildInv = Inventory
reqInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
childInventory
if Bool
creative
then
forall (m :: * -> *) a. Monad m => a -> m a
return
(
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Maybe Capability, [Entity])]
possibleDevices) forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Entity
alreadyEquipped
,
Inventory
missingChildInv
)
else do
let capsWithNoDevice :: [Capability]
capsWithNoDevice = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [(Maybe Capability, [Entity])]
possibleDevices
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Capability]
capsWithNoDevice
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 RID -> Requirements
R.Requirements (forall a. Ord a => [a] -> Set a
S.fromList [Capability]
capsWithNoDevice) forall a. Set a
S.empty forall k a. Map k a
M.empty) Term
cmd
let missingDevices :: [Set Entity]
missingDevices = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(Set Entity, Set Entity)]
partitionedDevices
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Set Entity]
missingDevices
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` ( Text -> Text -> Text
singularSubjectVerb Text
subject Text
"do"
forall a. a -> [a] -> [a]
: Text
"not have required devices, please"
forall a. a -> [a] -> [a]
: IncapableFix -> Text
formatIncapableFix IncapableFix
fixI forall a. Semigroup a => a -> a -> a
<> Text
":"
forall a. a -> [a] -> [a]
: ((Text
"\n - " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Entity -> Text
formatDevices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Set Entity]
missingDevices)
)
let minimalEquipSet :: Set Entity
minimalEquipSet = forall a. Ord a => [Set a] -> Set a
smallHittingSet (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Set a -> Bool
S.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Entity
alreadyEquipped) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Set Entity, Set Entity)]
partitionedDevices))
neededParentInv :: Inventory
neededParentInv =
Inventory
missingChildInv
Inventory -> Inventory -> Inventory
`E.union` ([Entity] -> Inventory
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set Entity
minimalEquipSet)
missingParentInv :: Inventory
missingParentInv = Inventory
neededParentInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
parentInventory
missingMap :: Map Text RID
missingMap =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> RID
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> (b, a)
swap 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 (forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(RID, Entity)]
E.elems
forall a b. (a -> b) -> a -> b
$ Inventory
missingParentInv
Inventory -> Bool
E.isEmpty Inventory
missingParentInv
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 RID -> Requirements
R.Requirements forall a. Set a
S.empty forall a. Set a
S.empty Map Text RID
missingMap) Term
cmd
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Entity
minimalEquipSet, Inventory
missingChildInv)
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
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> Maybe GameplayAchievement -> m ()
holdsOrFailWithAchievement
(RID
rid forall a. Eq a => a -> a -> Bool
/= RID
0)
[Text
"You consider destroying your base, but decide not to do it after all."]
(Bool -> Maybe GameplayAchievement
mAch Bool
False)
Lens' Robot Bool
selfDestruct forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievement (Bool -> Maybe GameplayAchievement
mAch Bool
True)
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
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
let nextLoc :: Cosmic Location
nextLoc = Cosmic Location
loc Cosmic Location -> Heading -> Cosmic Location
`offsetBy` Heading
orientation
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Cosmic Location -> MoveFailureHandler -> m ()
checkMoveAhead Cosmic Location
nextLoc forall a b. (a -> b) -> a -> b
$ \case
MoveFailureMode
PathBlocked -> RobotFailure
ThrowExn
MoveFailureMode
PathLiquid -> RobotFailure
Destroy
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
loc Cosmic Location
nextLoc
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
applyMoveFailureEffect ::
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureDetails ->
MoveFailureHandler ->
m ()
applyMoveFailureEffect :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureDetails -> MoveFailureHandler -> m ()
applyMoveFailureEffect Maybe MoveFailureDetails
maybeFailure MoveFailureHandler
failureHandler =
case Maybe MoveFailureDetails
maybeFailure of
Maybe MoveFailureDetails
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (MoveFailureDetails Entity
e MoveFailureMode
failureMode) -> case MoveFailureHandler
failureHandler MoveFailureMode
failureMode of
RobotFailure
IgnoreFail -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
RobotFailure
Destroy -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
(Bool -> Maybe GameplayAchievement) -> m ()
destroyIfNotBase forall a b. (a -> b) -> a -> b
$ \Bool
b -> case (Bool
b, MoveFailureMode
failureMode) of
(Bool
True, MoveFailureMode
PathLiquid) -> forall a. a -> Maybe a
Just GameplayAchievement
RobotIntoWater
(Bool, MoveFailureMode)
_ -> forall a. Maybe a
Nothing
RobotFailure
ThrowExn -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> [Text] -> Exn
cmdExn Const
c forall a b. (a -> b) -> a -> b
$
case MoveFailureMode
failureMode of
MoveFailureMode
PathBlocked -> [Text
"There is a", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"in the way!"]
MoveFailureMode
PathLiquid -> [Text
"There is a dangerous liquid", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"in the way!"]
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 MoveFailureDetails
maybeFailure <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailure Cosmic Location
nextLoc
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Maybe MoveFailureDetails -> MoveFailureHandler -> m ()
applyMoveFailureEffect Maybe MoveFailureDetails
maybeFailure MoveFailureHandler
failureHandler
getRobotWithinTouch :: HasRobotStepState sig m => RID -> m Robot
getRobotWithinTouch :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
rid = do
RID
cid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
if RID
cid forall a. Eq a => a -> a -> Bool
== RID
rid
then forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @Robot
else do
Maybe Robot
mother <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID RID
rid
Robot
other <- Maybe Robot
mother forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot with ID", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
rid) forall a. Semigroup a => a -> a -> a
<> Text
"."]
let otherLoc :: Cosmic Location
otherLoc = Robot
other forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation
Bool
privileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
Cosmic Location
myLoc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt Bool
privileged Cosmic Location
myLoc Cosmic Location
otherLoc
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"The robot with ID", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
rid), Text
"is not close enough."]
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 = 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 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
holdsOrFail Bool
a [Text]
ts
Just GameplayAchievement
ach -> Bool
a 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 = 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Value -> Value -> m Bool
evalCmp Const
c Value
v1 Value
v2
[Value]
_ -> 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Integer -> Integer -> m Integer
evalArith Const
c Integer
n1 Integer
n2
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
hasInInventoryOrFail :: HasRobotStepState sig m => Text -> m Entity
hasInInventoryOrFail :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
eName = do
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
Entity
e <-
forall a. [a] -> Maybe a
listToMaybe (Text -> Inventory -> [Entity]
lookupByName Text
eName Inventory
inv)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"What is", Text -> Text
indefinite Text
eName forall a. Semigroup a => a -> a -> a
<> Text
"?"]
let cmd :: Text
cmd = Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Const
c
(Entity -> Inventory -> RID
E.lookup Entity
e Inventory
inv forall a. Ord a => a -> a -> Bool
> RID
0)
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 forall a. Semigroup a => a -> a -> a
<> Text
"."]
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 (forall a. Valuable a => a -> Value
asValue a
x) Store
s Cont
k
doGrab :: (HasRobotStepState sig m, Has (Lift IO) sig m) => GrabbingCmd -> m Entity
doGrab :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m Entity
doGrab GrabbingCmd
cmd = do
let verb :: Text
verb = GrabbingCmd -> Text
verbGrabbingCmd GrabbingCmd
cmd
verbed :: Text
verbed = GrabbingCmd -> Text
verbedGrabbingCmd GrabbingCmd
cmd
Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
Entity
e <-
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is nothing here to", Text
verb forall a. Semigroup a => a -> a -> a
<> Text
"."])
Bool
omni <- 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
Portable)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"The", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"here can't be", Text
verbed forall a. Semigroup a => a -> a -> a
<> Text
"."]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Infinite) forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt Cosmic Location
loc (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Entity
e))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Growable) Bool -> Bool -> Bool
&& GrabbingCmd
cmd forall a. Eq a => a -> a -> Bool
== GrabbingCmd
Harvest') forall a b. (a -> b) -> a -> b
$ do
let GrowthTime (Integer
minT, Integer
maxT) = (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe GrowthTime)
entityGrowth) forall a. Maybe a -> a -> a
? GrowthTime
defaultGrowthTime
TimeSpec
createdAt <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> (Integer, Integer) -> Cosmic Location -> TimeSpec -> m ()
addSeedBot Entity
e (Integer
minT, Integer
maxT) Cosmic Location
loc TimeSpec
createdAt
let yieldName :: Maybe Text
yieldName = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityYields
Entity
e' <- case Maybe Text
yieldName of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e
Just Text
n -> forall a. a -> Maybe a -> a
fromMaybe Entity
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses (Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap) (Text -> EntityMap -> Maybe Entity
lookupEntityName Text
n)
Lens' Robot Inventory
robotInventory 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'
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e'
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e'
addWatchedLocation ::
HasRobotStepState sig m =>
Cosmic Location ->
m ()
addWatchedLocation :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m ()
addWatchedLocation Cosmic Location
loc = do
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>) Cosmic Location
loc (forall a. a -> Set a
S.singleton RID
rid)
purgeFarAwayWatches ::
HasRobotStepState sig m => m ()
purgeFarAwayWatches :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m ()
purgeFarAwayWatches = do
Bool
privileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
Cosmic Location
myLoc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
let isNearby :: Cosmic Location -> Bool
isNearby = Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt Bool
privileged Cosmic Location
myLoc
f :: Cosmic Location -> Set RID -> Set RID
f Cosmic Location
loc =
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Cosmic Location -> Bool
isNearby Cosmic Location
loc
then forall a. Ord a => a -> Set a -> Set a
S.delete RID
rid
else forall a. a -> a
id
Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey Cosmic Location -> Set RID -> Set RID
f
isNearbyOrExempt :: Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt :: Bool -> Cosmic Location -> Cosmic Location -> Bool
isNearbyOrExempt Bool
privileged Cosmic Location
myLoc Cosmic Location
otherLoc =
Bool
privileged Bool -> Bool -> Bool
|| case forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Int32
manhattan Cosmic Location
myLoc Cosmic Location
otherLoc of
DistanceMeasure Int32
InfinitelyFar -> Bool
False
Measurable Int32
x -> Int32
x forall a. Ord a => a -> a -> Bool
<= Int32
1
grantAchievement ::
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement ->
m ()
grantAchievement :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
GameplayAchievement -> m ()
grantAchievement GameplayAchievement
a = do
ZonedTime
currentTime <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO ZonedTime
getZonedTime
Maybe String
scenarioPath <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (Maybe String)
currentScenarioPath
Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Map GameplayAchievement Attainment)
gameAchievements
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith
forall a. Semigroup a => a -> a -> a
(<>)
GameplayAchievement
a
(CategorizedAchievement -> Maybe String -> ZonedTime -> Attainment
Attainment (GameplayAchievement -> CategorizedAchievement
GameplayAchievement GameplayAchievement
a) Maybe String
scenarioPath ZonedTime
currentTime)
data RobotFailure = ThrowExn | Destroy | IgnoreFail
type MoveFailureHandler = MoveFailureMode -> RobotFailure
data GrabbingCmd = Grab' | Harvest' | Swap' | Push' deriving (GrabbingCmd -> GrabbingCmd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrabbingCmd -> GrabbingCmd -> Bool
$c/= :: GrabbingCmd -> GrabbingCmd -> Bool
== :: GrabbingCmd -> GrabbingCmd -> Bool
$c== :: GrabbingCmd -> GrabbingCmd -> Bool
Eq, RID -> GrabbingCmd -> ShowS
[GrabbingCmd] -> ShowS
GrabbingCmd -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrabbingCmd] -> ShowS
$cshowList :: [GrabbingCmd] -> ShowS
show :: GrabbingCmd -> String
$cshow :: GrabbingCmd -> String
showsPrec :: RID -> GrabbingCmd -> ShowS
$cshowsPrec :: RID -> GrabbingCmd -> ShowS
Show)
verbGrabbingCmd :: GrabbingCmd -> Text
verbGrabbingCmd :: GrabbingCmd -> Text
verbGrabbingCmd = \case
GrabbingCmd
Harvest' -> Text
"harvest"
GrabbingCmd
Grab' -> Text
"grab"
GrabbingCmd
Swap' -> Text
"swap"
GrabbingCmd
Push' -> Text
"push"
verbedGrabbingCmd :: GrabbingCmd -> Text
verbedGrabbingCmd :: GrabbingCmd -> Text
verbedGrabbingCmd = \case
GrabbingCmd
Harvest' -> Text
"harvested"
GrabbingCmd
Grab' -> Text
"grabbed"
GrabbingCmd
Swap' -> Text
"swapped"
GrabbingCmd
Push' -> Text
"pushed"
formatDevices :: Set Entity -> Text
formatDevices :: Set Entity -> Text
formatDevices = Text -> [Text] -> Text
T.intercalate Text
" or " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList
provisionChild ::
(HasRobotStepState sig m) =>
RID ->
Inventory ->
Inventory ->
m ()
provisionChild :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> Inventory -> Inventory -> m ()
provisionChild RID
childID Inventory
toEquip Inventory
toGive = do
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
childID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
equippedDevices forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Inventory -> Inventory -> Inventory
E.union Inventory
toEquip
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
childID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Inventory -> Inventory -> Inventory
E.union Inventory
toGive
Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
creative forall a b. (a -> b) -> a -> b
$
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Inventory -> Inventory -> Inventory
`E.difference` (Inventory
toEquip Inventory -> Inventory -> Inventory
`E.union` Inventory
toGive))
updateRobotLocation ::
(HasRobotStepState sig m) =>
Cosmic Location ->
Cosmic Location ->
m ()
updateRobotLocation :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> Cosmic Location -> m ()
updateRobotLocation Cosmic Location
oldLoc Cosmic Location
newLoc
| Cosmic Location
oldLoc forall a. Eq a => a -> a -> Bool
== Cosmic Location
newLoc = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Cosmic Location
newlocWithPortal <- forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Algebra sig m, Member (State Robot) sig,
Member (State GameState) sig) =>
Cosmic Location -> m (Cosmic Location)
applyPortal Cosmic Location
newLoc
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> RID -> m ()
removeRobotFromLocationMap Cosmic Location
oldLoc RID
rid
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Cosmic Location -> m ()
addRobotToLocation RID
rid Cosmic Location
newlocWithPortal
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify (Cosmic Location -> Robot -> Robot
unsafeSetRobotLocation Cosmic Location
newlocWithPortal)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
where
applyPortal :: Cosmic Location -> m (Cosmic Location)
applyPortal Cosmic Location
loc = do
Navigation (Map SubworldName) Location
lms <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (Navigation (Map SubworldName) Location)
worldNavigation
let maybePortalInfo :: Maybe (AnnotatedDestination Location)
maybePortalInfo = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Cosmic Location
loc forall a b. (a -> b) -> a -> b
$ forall (additionalDimension :: * -> *) portalExitLoc.
Navigation additionalDimension portalExitLoc
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
portals Navigation (Map SubworldName) Location
lms
updatedLoc :: Cosmic Location
updatedLoc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Cosmic Location
loc forall a. AnnotatedDestination a -> Cosmic a
destination Maybe (AnnotatedDestination Location)
maybePortalInfo
maybeTurn :: Maybe Direction
maybeTurn = forall a. AnnotatedDestination a -> Direction
reorientation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AnnotatedDestination Location)
maybePortalInfo
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Direction
maybeTurn forall a b. (a -> b) -> a -> b
$ \Direction
d ->
Lens' Robot (Maybe Heading)
robotOrientation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just 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
forall (m :: * -> *) a. Monad m => a -> m a
return Cosmic Location
updatedLoc
onTarget ::
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
RID ->
(forall sig' m'. (HasRobotStepState sig' m', Has (Lift IO) sig' m') => m' ()) ->
m ()
onTarget :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
RID
-> (forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
(HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
m' ())
-> m ()
onTarget RID
rid forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
(HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
m' ()
act = do
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
case RID
myID forall a. Eq a => a -> a -> Bool
== RID
rid of
Bool
True -> forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
(HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
m' ()
act
Bool
False -> do
Maybe Robot
mtgt <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rid)
case Maybe Robot
mtgt of
Maybe Robot
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Robot
tgt -> do
Robot
tgt' <- forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m s
execState @Robot Robot
tgt forall (sig' :: (* -> *) -> * -> *) (m' :: * -> *).
(HasRobotStepState sig' m', Has (Lift IO) sig' m') =>
m' ()
act
if Robot
tgt' forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
selfDestruct
then forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
deleteRobot RID
rid
else Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
rid forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Robot
tgt'
evalCmp :: Has (Throw Exn) sig m => Const -> Value -> Value -> m Bool
evalCmp :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Value -> Value -> m Bool
evalCmp Const
c Value
v1 Value
v2 = Const -> m Ordering -> m Bool
decideCmp Const
c forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Value -> Value -> m Ordering
compareValues Value
v1 Value
v2
where
decideCmp :: Const -> m Ordering -> m Bool
decideCmp = \case
Const
Eq -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== Ordering
EQ)
Const
Neq -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
/= Ordering
EQ)
Const
Lt -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== Ordering
LT)
Const
Gt -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== Ordering
GT)
Const
Leq -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
/= Ordering
GT)
Const
Geq -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
/= Ordering
LT)
Const
_ -> forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Exn
Fatal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"evalCmp called on bad constant " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source target. From source target => source -> target
from forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Const
c
compareValues :: Has (Throw Exn) sig m => Value -> Value -> m Ordering
compareValues :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Value -> Value -> m Ordering
compareValues Value
v1 = case Value
v1 of
Value
VUnit -> \case Value
VUnit -> forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
EQ; Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
VUnit Value
v2
VInt Integer
n1 -> \case VInt Integer
n2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> a -> Ordering
compare Integer
n1 Integer
n2); Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VText Text
t1 -> \case VText Text
t2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> a -> Ordering
compare Text
t1 Text
t2); Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VDir Direction
d1 -> \case VDir Direction
d2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> a -> Ordering
compare Direction
d1 Direction
d2); Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VBool Bool
b1 -> \case VBool Bool
b2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> a -> Ordering
compare Bool
b1 Bool
b2); Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VRobot RID
r1 -> \case VRobot RID
r2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> a -> Ordering
compare RID
r1 RID
r2); Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VInj Bool
s1 Value
v1' -> \case
VInj Bool
s2 Value
v2' ->
case forall a. Ord a => a -> a -> Ordering
compare Bool
s1 Bool
s2 of
Ordering
EQ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Value -> Value -> m Ordering
compareValues Value
v1' Value
v2'
Ordering
o -> forall (m :: * -> *) a. Monad m => a -> m a
return Ordering
o
Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VPair Value
v11 Value
v12 -> \case
VPair Value
v21 Value
v22 ->
forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Value -> Value -> m Ordering
compareValues Value
v11 Value
v21 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Value -> Value -> m Ordering
compareValues Value
v12 Value
v22
Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VRcd Map Text Value
m1 -> \case
VRcd Map Text Value
m2 -> forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Value -> Value -> m Ordering
compareValues forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. Map k a -> [a]
M.elems) Map Text Value
m1 Map Text Value
m2
Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VKey KeyCombo
kc1 -> \case
VKey KeyCombo
kc2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => a -> a -> Ordering
compare KeyCombo
kc1 KeyCombo
kc2)
Value
v2 -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2
VClo {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VCApp {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VDef {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VResult {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VBind {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VDelay {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VRef {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
VRequirements {} -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1
incompatCmp :: Has (Throw Exn) sig m => Value -> Value -> m a
incompatCmp :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2 =
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$
Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords [Text
"Incompatible comparison of ", Value -> Text
prettyValue Value
v1, Text
"and", Value -> Text
prettyValue Value
v2]
incomparable :: Has (Throw Exn) sig m => Value -> Value -> m a
incomparable :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1 Value
v2 =
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$
Const -> [Text] -> Exn
cmdExn
Const
Lt
[Text
"Comparison is undefined for ", Value -> Text
prettyValue Value
v1, Text
"and", Value -> Text
prettyValue Value
v2]
evalArith :: Has (Throw Exn) sig m => Const -> Integer -> Integer -> m Integer
evalArith :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Integer -> Integer -> m Integer
evalArith = \case
Const
Add -> forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> a) -> t -> t -> m a
ok forall a. Num a => a -> a -> a
(+)
Const
Sub -> forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> a) -> t -> t -> m a
ok (-)
Const
Mul -> forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> a) -> t -> t -> m a
ok forall a. Num a => a -> a -> a
(*)
Const
Div -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeDiv
Const
Exp -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeExp
Const
c -> \Integer
_ Integer
_ -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
"evalArith called on bad constant " (forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Const
c))
where
ok :: (t -> t -> a) -> t -> t -> m a
ok t -> t -> a
f t
x t
y = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ t -> t -> a
f t
x t
y
safeDiv :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer
safeDiv :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeDiv Integer
_ Integer
0 = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
Div forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"Division by zero"
safeDiv Integer
a Integer
b = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
a forall a. Integral a => a -> a -> a
`div` Integer
b
safeExp :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer
safeExp :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeExp Integer
a Integer
b
| Integer
b forall a. Ord a => a -> a -> Bool
< Integer
0 = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> [Text] -> Exn
cmdExn Const
Exp forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"Negative exponent"
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
a forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
b
updateDiscoveredEntities :: (HasRobotStepState sig m) => Entity -> m ()
updateDiscoveredEntities :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e = do
Inventory
allDiscovered <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery Inventory
allDiscoveredEntities
if Entity -> Inventory -> Bool
E.contains0plus Entity
e Inventory
allDiscovered
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else do
let newAllDiscovered :: Inventory
newAllDiscovered = RID -> Entity -> Inventory -> Inventory
E.insertCount RID
1 Entity
e Inventory
allDiscovered
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
(Inventory, Inventory) -> Entity -> m ()
updateAvailableRecipes (Inventory
newAllDiscovered, Inventory
newAllDiscovered) Entity
e
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> m ()
updateAvailableCommands Entity
e
Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery Inventory
allDiscoveredEntities forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
newAllDiscovered
updateAvailableRecipes :: Has (State GameState) sig m => (Inventory, Inventory) -> Entity -> m ()
updateAvailableRecipes :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
(Inventory, Inventory) -> Entity -> m ()
updateAvailableRecipes (Inventory, Inventory)
invs Entity
e = do
IntMap [Recipe Entity]
allInRecipes <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Recipes
recipesInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Recipes (IntMap [Recipe Entity])
recipesIn
let entityRecipes :: [Recipe Entity]
entityRecipes = IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor IntMap [Recipe Entity]
allInRecipes Entity
e
usableRecipes :: [Recipe Entity]
usableRecipes = forall a. (a -> Bool) -> [a] -> [a]
filter ((Inventory, Inventory) -> Recipe Entity -> Bool
knowsIngredientsFor (Inventory, Inventory)
invs) [Recipe Entity]
entityRecipes
[Recipe Entity]
knownRecipes <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications (Recipe Entity))
availableRecipes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent
let newRecipes :: [Recipe Entity]
newRecipes = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Recipe Entity]
knownRecipes) [Recipe Entity]
usableRecipes
newCount :: RID
newCount = forall (t :: * -> *) a. Foldable t => t a -> RID
length [Recipe Entity]
newRecipes
Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications (Recipe Entity))
availableRecipes forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Monoid a => a -> a -> a
mappend (forall a. RID -> [a] -> Notifications a
Notifications RID
newCount [Recipe Entity]
newRecipes)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> m ()
updateAvailableCommands Entity
e
updateAvailableCommands :: Has (State GameState) sig m => Entity -> m ()
updateAvailableCommands :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> m ()
updateAvailableCommands Entity
e = do
let newCaps :: Set Capability
newCaps = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Set Capability)
entityCapabilities
keepConsts :: Maybe Capability -> Bool
keepConsts = \case
Just Capability
cap -> Capability
cap forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
newCaps
Maybe Capability
Nothing -> Bool
False
entityConsts :: [Const]
entityConsts = forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Capability -> Bool
keepConsts forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Maybe Capability
constCaps) [Const]
allConst
[Const]
knownCommands <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent
let newCommands :: [Const]
newCommands = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Const]
knownCommands) [Const]
entityConsts
newCount :: RID
newCount = forall (t :: * -> *) a. Foldable t => t a -> RID
length [Const]
newCommands
Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Monoid a => a -> a -> a
mappend (forall a. RID -> [a] -> Notifications a
Notifications RID
newCount [Const]
newCommands)