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

-- |
-- Module      :  Swarm.Game.Step
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Facilities for stepping the robot CESK machines, /i.e./ the actual
-- interpreter for the Swarm language.
module Swarm.Game.Step where

import Control.Carrier.Error.Either (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, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
import Control.Monad (forM, forM_, guard, msum, unless, when)
import Data.Array (bounds, (!))
import Data.Bifunctor (second)
import Data.Bool (bool)
import Data.Containers.ListUtils (nubOrd)
import Data.Either (partitionEithers, rights)
import Data.Foldable (asum, traverse_)
import Data.Functor (void)
import Data.Int (Int64)
import Data.IntMap qualified as IM
import Data.IntSet qualified as IS
import Data.List (find)
import Data.List qualified as L
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isNothing, listToMaybe)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Tuple (swap)
import Linear (V2 (..), zero, (^+^))
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.Recipe
import Swarm.Game.Robot
import Swarm.Game.Scenario (objectiveCondition)
import Swarm.Game.State
import Swarm.Game.Value
import Swarm.Game.World qualified as W
import Swarm.Language.Capability
import Swarm.Language.Context hiding (delete)
import Swarm.Language.Pipeline
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax
import Swarm.Util
import System.Clock (TimeSpec)
import System.Clock qualified
import System.Random (UniformRange, uniformR)
import Witch (From (from), into)
import Prelude hiding (lookup)

-- | The main function to do one game tick.  The only reason we need
--   @IO@ is so that robots can run programs loaded from files, via
--   the 'Run' command; but eventually I want to get rid of that
--   command and have a library of modules that you can create, edit,
--   and run all from within the UI (the library could also be loaded
--   from a file when the whole program starts up).
gameTick :: (Has (State GameState) sig m, Has (Lift IO) sig m) => m ()
gameTick :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
m ()
gameTick = do
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
wakeUpRobotsDoneSleeping
  IntSet
robotNames <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState IntSet
activeRobots
  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)
    case Maybe Robot
mr of
      Maybe Robot
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Robot
curRobot -> do
        Robot
curRobot' <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobot Robot
curRobot
        if Robot
curRobot' 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
curRobot'
            Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
            case Robot -> Maybe Integer
waitingUntil Robot
curRobot' of
              Just Integer
wakeUpTime
                -- if w=2 t=1 then we do not needlessly put robot to waiting queue
                | Integer
wakeUpTime forall a. Num a => a -> a -> a
- Integer
2 forall a. Ord a => a -> a -> Bool
<= Integer
time -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Integer -> m ()
sleepUntil RID
rn Integer
wakeUpTime
              Maybe Integer
Nothing ->
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Robot -> Bool
isActive Robot
curRobot') (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
sleepForever RID
rn)

  -- See if the base is finished with a computation, and if so, record
  -- the result in the game state so it can be displayed by the REPL;
  -- also save the current store into the robotContext so we can
  -- restore it the next time we start a computation.
  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 Lens' GameState REPLStatus
replStatus
      case REPLStatus
res of
        REPLWorking Polytype
ty Maybe Value
Nothing -> case Robot -> Maybe (Value, Store)
getResult Robot
r of
          Just (Value
v, Store
s) -> do
            Lens' GameState REPLStatus
replStatus forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Polytype -> Maybe Value -> REPLStatus
REPLWorking Polytype
ty (forall a. a -> Maybe a
Just Value
v)
            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
0 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 (m :: * -> *) a. Monad m => a -> m a
return ()
        REPLStatus
_otherREPLStatus -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe Robot
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Possibly update the view center.
  forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify GameState -> GameState
recalcViewCenter

  -- Possibly see if the winning condition for the current objective is met.
  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 (Objective
obj :| [Objective]
objs) -> do
      GameState
g <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @GameState

      -- Execute the win condition check *hypothetically*: i.e. in a
      -- fresh CESK machine, using a copy of the current game state.
      Either Exn Value
v <- 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 (Objective
obj forall s a. s -> Getting a s a -> a
^. Lens' Objective ProcessedTerm
objectiveCondition)
      case Either Exn Value
v of
        -- Log exceptions in the message queue so we can check for them in tests
        Left Exn
exn -> do
          EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState EntityMap
entityMap
          Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
          let h :: Robot
h = CESK -> TimeSpec -> Robot
hypotheticalRobot (Value -> Store -> Cont -> CESK
Out Value
VUnit Store
emptyStore []) TimeSpec
0
              hid :: RID
hid = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID Robot
h
              hn :: Text
hn = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot Text
robotName Robot
h
              farAway :: V2 Int64
farAway = forall a. a -> a -> V2 a
V2 forall a. Bounded a => a
maxBound forall a. Bounded a => a
maxBound
          let m :: LogEntry
m = Integer -> LogSource -> Text -> RID -> V2 Int64 -> Text -> LogEntry
LogEntry Integer
time LogSource
ErrorTrace Text
hn RID
hid V2 Int64
farAway forall a b. (a -> b) -> a -> b
$ EntityMap -> Exn -> Text
formatExn EntityMap
em Exn
exn
          forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
m
        Right (VBool Bool
True) -> Lens' GameState WinCondition
winCondition forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> WinCondition
Won Bool
False) NonEmpty Objective -> WinCondition
WinConditions (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Objective]
objs)
        Either Exn Value
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    WinCondition
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Advance the game time by one.
  Lens' GameState Integer
ticks forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State s) sig m, Num a) =>
ASetter' s a -> a -> m ()
+= Integer
1

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)

getNow :: Has (Lift IO) sig m => m TimeSpec
getNow :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow = forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
System.Clock.getTime Clock
System.Clock.Monotonic

-- | Create a special robot to check some hypothetical, for example the win condition.
--
-- Use ID (-1) so it won't conflict with any robots currently in the robot map.
hypotheticalRobot :: CESK -> TimeSpec -> Robot
hypotheticalRobot :: CESK -> TimeSpec -> Robot
hypotheticalRobot CESK
c = forall (phase :: RobotPhase).
RobotID phase
-> Maybe RID
-> Text
-> [Text]
-> RobotLocation phase
-> V2 Int64
-> Display
-> CESK
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> TimeSpec
-> RobotR phase
mkRobot (-RID
1) forall a. Maybe a
Nothing Text
"hypothesis" [] forall (f :: * -> *) a. (Additive f, Num a) => f a
zero forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Display
defaultRobotDisplay CESK
c [] [] Bool
True Bool
False

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 -- Add the special robot to the robot map, so it can look itself up if needed
  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

------------------------------------------------------------
-- Some utility functions
------------------------------------------------------------

-- | Set a flag telling the UI that the world needs to be redrawn.
flagRedraw :: (Has (State GameState) sig m) => m ()
flagRedraw :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw = Lens' GameState Bool
needsRedraw forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True

-- | Perform an action requiring a 'W.World' state component in a
--   larger context with a 'GameState'.
zoomWorld :: (Has (State GameState) sig m) => StateC (W.World Int Entity) Identity b -> m b
zoomWorld :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC (World RID Entity) Identity b -> m b
zoomWorld StateC (World RID Entity) Identity b
n = do
  World RID Entity
w <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (World RID Entity)
world
  let (World RID Entity
w', b
a) = forall a. Identity a -> a
run (forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
runState World RID Entity
w StateC (World RID Entity) Identity b
n)
  Lens' GameState (World RID Entity)
world forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= World RID Entity
w'
  forall (m :: * -> *) a. Monad m => a -> m a
return b
a

-- | Get the entity (if any) at a given location.
entityAt :: (Has (State GameState) sig m) => V2 Int64 -> m (Maybe Entity)
entityAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
loc = forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC (World RID Entity) Identity b -> m b
zoomWorld (forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m (Maybe e)
W.lookupEntityM @Int (V2 Int64 -> Coords
W.locToCoords V2 Int64
loc))

-- | Modify the entity (if any) at a given location.
updateEntityAt ::
  (Has (State GameState) sig m) => V2 Int64 -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt V2 Int64
loc Maybe Entity -> Maybe Entity
upd = forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC (World RID Entity) Identity b -> m b
zoomWorld (forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> (Maybe e -> Maybe e) -> m ()
W.updateM @Int (V2 Int64 -> Coords
W.locToCoords V2 Int64
loc) Maybe Entity -> Maybe Entity
upd)

-- | Get the robot with a given ID.
robotWithID :: (Has (State GameState) sig m) => RID -> m (Maybe Robot)
robotWithID :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m (Maybe Robot)
robotWithID RID
rid = 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)

-- | Get the robot with a given name.
robotWithName :: (Has (State GameState) sig m) => Text -> m (Maybe Robot)
robotWithName :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Text -> m (Maybe Robot)
robotWithName Text
rname = 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 (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. IntMap a -> [a]
IM.elems 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 (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall a b. (a -> b) -> a -> b
$ \Robot
r -> Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName forall a. Eq a => a -> a -> Bool
== Text
rname))

-- | Generate a uniformly random number using the random generator in
--   the game state.
uniform :: (Has (State GameState) sig m, UniformRange a) => (a, a) -> m a
uniform :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (a, a)
bnds = do
  StdGen
rand <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState StdGen
randGen
  let (a
n, StdGen
g) = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (a, a)
bnds StdGen
rand
  Lens' GameState StdGen
randGen forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= StdGen
g
  forall (m :: * -> *) a. Monad m => a -> m a
return a
n

-- | Given a weighting function and a list of values, choose one of
--   the values randomly (using the random generator in the game
--   state), with the probability of each being proportional to its
--   weight.  Return @Nothing@ if the list is empty.
weightedChoice :: Has (State GameState) sig m => (a -> Integer) -> [a] -> m (Maybe a)
weightedChoice :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice a -> Integer
weight [a]
as = do
  Integer
r <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Integer
0, Integer
total 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
$ Integer -> [a] -> Maybe a
go Integer
r [a]
as
 where
  total :: Integer
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map a -> Integer
weight [a]
as)

  go :: Integer -> [a] -> Maybe a
go Integer
_ [] = forall a. Maybe a
Nothing
  go !Integer
k (a
x : [a]
xs)
    | Integer
k forall a. Ord a => a -> a -> Bool
< Integer
w = forall a. a -> Maybe a
Just a
x
    | Bool
otherwise = Integer -> [a] -> Maybe a
go (Integer
k forall a. Num a => a -> a -> a
- Integer
w) [a]
xs
   where
    w :: Integer
w = a -> Integer
weight a
x

-- | Generate a random robot name in the form adjective_name.
randomName :: Has (State GameState) sig m => m Text
randomName :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m Text
randomName = do
  Array RID Text
adjs <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use @GameState Getter GameState (Array RID Text)
adjList
  Array RID Text
names <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use @GameState Getter GameState (Array RID Text)
nameList
  RID
i <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (forall i e. Array i e -> (i, i)
bounds Array RID Text
adjs)
  RID
j <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (forall i e. Array i e -> (i, i)
bounds Array RID Text
names)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Array RID Text
adjs forall i e. Ix i => Array i e -> i -> e
! RID
i, Text
"_", Array RID Text
names forall i e. Ix i => Array i e -> i -> e
! RID
j]

------------------------------------------------------------
-- Debugging
------------------------------------------------------------

-- | Create a log entry given current robot and game time in ticks noting whether it has been said.
--
--   This is the more generic version used both for (recorded) said messages and normal logs.
createLogEntry :: (Has (State GameState) sig m, Has (State Robot) sig m) => LogSource -> Text -> m LogEntry
createLogEntry :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
LogSource -> Text -> m LogEntry
createLogEntry LogSource
source 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
  Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
  V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> LogSource -> Text -> RID -> V2 Int64 -> Text -> LogEntry
LogEntry Integer
time LogSource
source Text
rn RID
rid V2 Int64
loc Text
msg

-- | Print some text via the robot's log.
traceLog :: (Has (State GameState) sig m, Has (State Robot) sig m) => LogSource -> Text -> m LogEntry
traceLog :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
LogSource -> Text -> m LogEntry
traceLog LogSource
source Text
msg = do
  LogEntry
m <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
LogSource -> Text -> m LogEntry
createLogEntry LogSource
source 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

-- | Print a showable value via the robot's log.
--
-- Useful for debugging.
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) =>
LogSource -> Text -> m LogEntry
traceLog LogSource
Logged 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

------------------------------------------------------------
-- Exceptions and validation
------------------------------------------------------------

-- | Capabilities needed for a specific robot to evaluate or execute a
--   constant.  Right now, the only difference is whether the robot is
--   heavy or not when executing the 'Move' command, but there might
--   be other exceptions added in the future.
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
c Robot
_ = Const -> Maybe Capability
constCaps Const
c

-- | Ensure that a robot is capable of executing a certain constant
--   (either because it has a device which gives it that capability,
--   or it is a system robot, or we are in creative mode).
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
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
      Bool
sys <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
      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
sys Bool -> Bool -> Bool
|| Bool
creative Bool -> Bool -> Bool
|| Bool
hasCaps)
        forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
FixByInstall (Capability -> Requirements
R.singletonCap Capability
cap) (Const -> Term
TConst Const
c)

-- | Test whether the current robot has a given capability (either
--   because it has a device which gives it that capability, or it is a
--   system robot, or we are in creative mode).
hasCapability :: (Has (State Robot) sig m, Has (State GameState) sig m) => Capability -> m Bool
hasCapability :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
cap = do
  Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
  Bool
sys <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
  Set Capability
caps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Set Capability)
robotCapabilities
  forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
sys Bool -> Bool -> Bool
|| Bool
creative Bool -> Bool -> Bool
|| Capability
cap forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
caps)

-- | Ensure that either a robot has a given capability, OR we are in creative
--   mode.
hasCapabilityFor ::
  (Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Capability -> Term -> m ()
hasCapabilityFor :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
 Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
cap Term
term = do
  Bool
h <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
cap
  Bool
h forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
FixByInstall (Capability -> Requirements
R.singletonCap Capability
cap) Term
term

-- | Create an exception about a command failing.
cmdExn :: Const -> [Text] -> Exn
cmdExn :: Const -> [Text] -> Exn
cmdExn Const
c [Text]
parts = Const -> Text -> Exn
CmdFailed Const
c ([Text] -> Text
T.unwords [Text]
parts)

-- | Raise an exception about a command failing with a formatted error message.
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)

-- | Run a subcomputation that might throw an exception in a context
--   where we are returning a CESK machine; any exception will be
--   turned into an 'Up' state.
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

------------------------------------------------------------
-- Stepping robots
------------------------------------------------------------

-- | Run a robot for one tick, which may consist of up to
--   'robotStepsPerTick' CESK machine steps and at most one tangible
--   command execution, whichever comes first.
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 Lens' GameState 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 RID
tickSteps forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
steps)

-- | Recursive helper function for 'tickRobot', which checks if the
--   robot is actively running and still has steps left, and if so
--   runs it for one step, then calls itself recursively to continue
--   stepping the robot.
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
  | Robot -> Bool
isActive 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 RID
tickSteps forall a. Ord a => a -> a -> Bool
> RID
0) =
    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
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Robot
r

-- | Single-step a robot by decrementing its 'tickSteps' counter and
--   running its CESK machine for one step.
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 RID
tickSteps 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))
  forall (m :: * -> *) a. Monad m => a -> m a
return 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'

-- | The main CESK machine workhorse.  Given a robot, look at its CESK
--   machine state and figure out a single next step.
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
  -- (sendIO $ appendFile "out.txt" (prettyCESK cesk)) >>

  ------------------------------------------------------------
  -- Evaluation

  -- We wake up robots whose wake-up time has been reached. If it hasn't yet
  -- then stepCESK is a no-op.
  Waiting Integer
wakeupTime CESK
cesk' -> do
    Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
    if Integer
wakeupTime forall a. Ord a => a -> a -> Bool
<= Integer
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 WorldUpdate
wf RobotUpdate
rf : Cont
k) -> do
    Either Exn (World RID Entity)
wc <- WorldUpdate -> World RID Entity -> Either Exn (World RID Entity)
worldUpdate WorldUpdate
wf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (World RID Entity)
world
    case Either Exn (World RID Entity)
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 World RID Entity
wo -> do
        Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RobotUpdate -> Inventory -> Inventory
robotUpdateInventory RobotUpdate
rf
        Lens' GameState (World RID Entity)
world forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= World RID Entity
wo
        Lens' GameState Bool
needsRedraw forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
 Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK (Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k)

  -- Now some straightforward cases.  These all immediately turn
  -- into values.
  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
  -- There should not be any antiquoted variables left at this point.
  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
  -- Require and requireDevice just turn into no-ops.
  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 (Const -> Term
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 (Const -> Term
TConst Const
Noop) Env
e Store
s Cont
k
  -- Normally it's not possible to have a TRobot value in surface
  -- syntax, but the salvage command generates a program that needs to
  -- refer directly to the salvaging robot.
  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
  -- Function constants of arity 0 are evaluated immediately
  -- (e.g. parent, self).  Any other constant is turned into a VCApp,
  -- which is waiting for arguments and/or an FExec frame.
  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
  -- To evaluate a variable, just look it up in the context.
  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

  -- To evaluate a pair, start evaluating the first component.
  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)
  -- Once that's done, evaluate the second component.
  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)
  -- Finally, put the results together into a pair value.
  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
  -- Lambdas immediately turn into closures.
  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
  -- To evaluate an application, start by focusing on the left-hand
  -- side and saving the argument for later.
  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)
  -- Once that's done, switch to evaluating the argument.
  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)
  -- We can evaluate an application of a closure in the usual way.
  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
  -- We can also evaluate an application of a constant by collecting
  -- arguments, eventually dispatching to evalConst for function
  -- constants.
  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"
  -- To evaluate non-recursive let expressions, we start by focusing on the
  -- let-bound expression.
  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)
  -- To evaluate recursive let expressions, we evaluate the memoized
  -- delay of the let-bound expression.  Every free occurrence of x
  -- in the let-bound expression and the body has already been
  -- rewritten by elaboration to 'force x'.
  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)
  -- Once we've finished with the let-binding, we switch to evaluating
  -- the body in a suitably extended environment.
  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
  -- Definitions immediately turn into VDef values, awaiting execution.
  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

  -- Bind expressions don't evaluate: just package it up as a value
  -- until such time as it is to be executed.
  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
  -- Simple (non-memoized) delay expressions immediately turn into
  -- VDelay values, awaiting application of 'Force'.
  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
  -- For memoized delay expressions, we allocate a new cell in the store and
  -- return a reference to it.
  In (TDelay (MemoizedDelay Maybe Text
x) Term
t) Env
e Store
s Cont
k -> do
    -- Note that if the delay expression is recursive, we add a
    -- binding to the environment that wil be used to evaluate the
    -- body, binding the variable to a reference to the memory cell we
    -- just allocated for the body expression itself.  As a fun aside,
    -- notice how Haskell's recursion and laziness play a starring
    -- role: @loc@ is both an output from @allocate@ and used as part
    -- of an input! =D
    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
  -- If we see an update frame, it means we're supposed to set the value
  -- of a particular cell to the value we just finished computing.
  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 -> Cell -> Store -> Store
setCell RID
loc (Value -> Cell
V Value
v) Store
s) Cont
k
  ------------------------------------------------------------
  -- Execution

  -- To execute a definition, we immediately turn the body into a
  -- delayed value, so it will not even be evaluated until it is
  -- called.  We memoize both recursive and non-recursive definitions,
  -- since the point of a definition is that it may be used many times.
  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)
  -- Once we have finished evaluating the (memoized, delayed) body of
  -- a definition, we return a special VResult value, which packages
  -- up the return value from the @def@ command itself (@unit@)
  -- together with the resulting environment (the variable bound to
  -- the delayed value).
  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
  -- To execute a constant application, delegate to the 'evalConst'
  -- function.  Set tickSteps to 0 if the command is supposed to take
  -- a tick, so the robot won't take any more steps this tick.
  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 RID
tickSteps 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

  -- Reset the runningAtomic flag when we encounter an FFinishAtomic frame.
  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

  -- To execute a bind expression, evaluate and execute the first
  -- command, and remember the second for execution later.
  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)
  -- If first command completes with a value along with an environment
  -- resulting from definition commands and/or binds, switch to
  -- evaluating the second command of the bind.  Extend the
  -- environment with both the environment resulting from the first
  -- command, as well as a binding for the result (if the bind was of
  -- the form @x <- c1; c2@).  Remember that we must execute the
  -- second command once it has been evaluated, then union any
  -- resulting definition environment with the definition environment
  -- from the first command.
  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)
  -- If the first command completes with a simple value and there is no binder,
  -- then we just continue without worrying about the environment.
  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)
  -- If the first command completes with a simple value and there is a binder,
  -- we promote it to the returned environment as well.
  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)
  -- If a command completes with a value and definition environment,
  -- and the next continuation frame contains a previous environment
  -- to union with, then pass the unioned environments along in
  -- another VResult.

  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
  -- Or, if a command completes with no environment, but there is a
  -- previous environment to union with, just use that environment.
  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
  -- If the top of the continuation stack contains a 'FLoadEnv' frame,
  -- it means we are supposed to load up the resulting definition
  -- environment, store, and type and capability contexts into the robot's
  -- top-level environment and contexts, so they will be available to
  -- future programs.
  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
  -- Any other type of value wiwth an FExec frame is an error (should
  -- never happen).
  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"
  -- If we see a VResult in any other context, simply discard it.  For
  -- example, this is what happens when there are binders (i.e. a "do
  -- block") nested inside another block instead of at the top level.
  -- It used to be that (1) only 'def' could generate a VResult, and
  -- (2) 'def' was guaranteed to only occur at the top level, hence
  -- any VResult would be caught by a FLoadEnv frame, and seeing a
  -- VResult anywhere else was an error.  But
  -- https://github.com/swarm-game/swarm/commit/b62d27e566565aa9a3ff351d91b23d2589b068dc
  -- made top-level binders export a variable binding, also via the
  -- VResult mechanism, and unlike 'def', binders do not have to occur
  -- at the top level only.  This led to
  -- https://github.com/swarm-game/swarm/issues/327 , which was fixed
  -- by changing this case from an error to simply ignoring the
  -- VResult wrapper.
  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
  ------------------------------------------------------------
  -- Exception handling
  ------------------------------------------------------------

  -- First, if we were running a try block but evaluation completed normally,
  -- just ignore the try block and continue.
  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
  -- If an exception rises all the way to the top level without being
  -- handled, turn it into an error message.

  -- HOWEVER, we have to make sure to check that the robot has the
  -- 'log' capability which is required to collect and view logs.
  --
  -- Notice how we call resetBlackholes on the store, so that any
  -- cells which were in the middle of being evaluated will be reset.
  Up Exn
exn Store
s [] -> do
    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 Lens' GameState 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) =>
LogSource -> Text -> m LogEntry
traceLog LogSource
ErrorTrace (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' []
  -- Fatal errors, capability errors, and infinite loop errors can't
  -- be caught; just throw away the continuation stack.
  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 []
  -- Otherwise, if we are raising an exception up the continuation
  -- stack and come to a Try frame, force and then execute the associated catch
  -- block.
  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)
  -- Otherwise, keep popping from the continuation stack.
  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
  -- Finally, if we're done evaluating and the continuation stack is
  -- empty, return the machine unchanged.
  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 source target. From source target => source -> target
from (CESK -> String
prettyCESK 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 []

  -- Note, the order of arguments to `union` is important in the below
  -- definition of fUnionEnv.  I wish I knew how to add an automated
  -- test for this.  But you can tell the difference in the following
  -- REPL session:
  --
  -- > x <- return 1; x <- return 2
  -- 2 : int
  -- > x
  -- 2 : int
  --
  -- If we switch the code to read 'e1 `union` e2' instead, then
  -- the first expression above still correctly evaluates to 2, but
  -- x ends up incorrectly bound to 1.

  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

-- | Eexecute a constant, catching any exception thrown and returning
--   it via a CESK machine state.
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'

-- | A system program for a "seed robot", to regrow a growable entity
--   after it is harvested.
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
  |]

-- | Construct a "seed robot" from entity, time range and position,
--   and add it to the world.  It has low priority and will be covered
--   by placed entities.
addSeedBot :: Has (State GameState) sig m => Entity -> (Integer, Integer) -> V2 Int64 -> TimeSpec -> m ()
addSeedBot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> (Integer, Integer) -> V2 Int64 -> TimeSpec -> m ()
addSeedBot Entity
e (Integer
minT, Integer
maxT) V2 Int64
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
-> [Text]
-> RobotLocation phase
-> V2 Int64
-> Display
-> CESK
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> TimeSpec
-> RobotR phase
mkRobot
        ()
        forall a. Maybe a
Nothing
        Text
"seed"
        [Text
"A growing seed."]
        (forall a. a -> Maybe a
Just V2 Int64
loc)
        (forall a. a -> a -> V2 a
V2 Int64
0 Int64
0)
        ( Char -> Display
defaultEntityDisplay Char
'.'
            forall a b. a -> (a -> b) -> b
& Lens' Display AttrName
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 AttrName
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
        TimeSpec
ts

-- | All functions that are used for robot step can access 'GameState' and the current 'Robot'.
--
-- They can also throw exception of our custom type, which is handled elsewhere.
-- Because of that the constraint is only 'Throw', but not 'Catch'/'Error'.
type HasRobotStepState sig m = (Has (State GameState) sig m, Has (State Robot) sig m, Has (Throw Exn) sig m)

-- | Interpret the execution (or evaluation) of a constant application
--   to some values.
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
  -- First, ensure the robot is capable of executing/evaluating this constant.
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
 Has (Throw Exn) sig m) =>
Const -> m ()
ensureCanExecute Const
c

  -- Now proceed to actually carry out the operation.
  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
        Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> CESK -> CESK
Waiting (Integer
time forall a. Num a => a -> a -> a
+ Integer
d) (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 =>
m ()
destroyIfNotBase
      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
      -- Figure out where we're going
      V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
      Maybe (V2 Int64)
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe (V2 Int64))
robotOrientation
      let nextLoc :: V2 Int64
nextLoc = V2 Int64
loc forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Maybe (V2 Int64)
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
      forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
V2 Int64 -> MoveFailure -> m ()
checkMoveAhead V2 Int64
nextLoc forall a b. (a -> b) -> a -> b
$
        MoveFailure
          { failIfBlocked :: RobotFailure
failIfBlocked = RobotFailure
ThrowExn
          , failIfDrown :: RobotFailure
failIfDrown = RobotFailure
Destroy
          }
      forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
V2 Int64 -> V2 Int64 -> m ()
updateRobotLocation V2 Int64
loc V2 Int64
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
Teleport -> case [Value]
vs of
      [VRobot RID
rid, VPair (VInt Integer
x) (VInt Integer
y)] -> do
        -- Make sure the other robot exists and is close
        Robot
target <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
rid
        -- either change current robot or one in robot map
        let oldLoc :: V2 Int64
oldLoc = Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation
            nextLoc :: V2 Int64
nextLoc = forall a. a -> a -> V2 a
V2 (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 =>
RID
-> (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
    HasRobotStepState sig m =>
    m ())
-> m ()
onTarget RID
rid forall a b. (a -> b) -> a -> b
$ do
          forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
V2 Int64 -> MoveFailure -> m ()
checkMoveAhead V2 Int64
nextLoc forall a b. (a -> b) -> a -> b
$
            MoveFailure
              { failIfBlocked :: RobotFailure
failIfBlocked = RobotFailure
Destroy
              , failIfDrown :: RobotFailure
failIfDrown = RobotFailure
Destroy
              }
          forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
V2 Int64 -> V2 Int64 -> m ()
updateRobotLocation V2 Int64
oldLoc V2 Int64
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 (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m CESK
doGrab GrabbingCmd
Grab'
    Const
Harvest -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m CESK
doGrab GrabbingCmd
Harvest'
    Const
Swap -> case [Value]
vs of
      [VText Text
name] -> do
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
        -- Make sure the robot has the thing in its inventory
        Entity
e <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name
        -- Grab
        CESK
r <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m CESK
doGrab GrabbingCmd
Swap'
        case CESK
r of
          Out {} -> do
            -- Place the entity and remove it from the inventory
            forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt V2 Int64
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
          CESK
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        forall (m :: * -> *) a. Monad m => a -> m a
return CESK
r
      [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 (Direction -> Term
TDir Direction
d)
        Lens' Robot (Maybe (V2 Int64))
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 -> V2 Int64 -> V2 Int64
applyTurn Direction
d
        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
Place -> case [Value]
vs of
      [VText Text
name] -> do
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation

        -- Make sure there's nothing already here
        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 =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
loc
        Bool
nothingHere forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"There is already an entity here."]

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

        -- Place the entity and remove it from the inventory
        forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt V2 Int64
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
Give -> case [Value]
vs of
      [VRobot RID
otherID, VText Text
itemName] -> do
        -- Make sure the other robot exists and is close
        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"

        -- Giving something to ourself should be a no-op.  We need
        -- this as a special case since it will not work to modify
        -- ourselves in the robotMap --- after performing a tick we
        -- return a modified Robot which gets put back in the
        -- robotMap, overwriting any changes to this robot made
        -- directly in the robotMap during the tick.
        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
          -- Make the exchange
          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

          -- Flag the UI for a redraw if we are currently showing either robot's inventory
          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
Install -> case [Value]
vs of
      [VRobot RID
otherID, VText Text
itemName] -> do
        -- Make sure the other robot exists and is close
        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
"install"

        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
        case RID
otherID forall a. Eq a => a -> a -> Bool
== RID
myID of
          -- We have to special case installing something on ourselves
          -- for the same reason as Give.
          Bool
True -> do
            -- Don't do anything if the robot already has the device.
            Bool
already <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' Robot Inventory
installedDevices 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
installedDevices 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

              -- Flag the UI for a redraw if we are currently showing our inventory
              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
          Bool
False -> do
            let otherDevices :: (Inventory -> Const (First Bool) Inventory)
-> GameState -> Const (First Bool) GameState
otherDevices = 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
installedDevices
            Maybe Bool
already <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ forall a s.
Getting (First a) s a -> IndexPreservingGetter s (Maybe a)
pre ((Inventory -> Const (First Bool) Inventory)
-> GameState -> Const (First Bool) GameState
otherDevices 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 (Maybe Bool
already forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True) 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
installedDevices 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

              -- Flag the UI for a redraw if we are currently showing
              -- either robot's inventory
              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
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
installedDevices
        EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState 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 Lens' GameState (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]

        -- Only consider recipes where the number of things we are trying to make
        -- is greater in the outputs than in the inputs.  This prevents us from doing
        -- silly things like making copper pipes when the user says "make furnace".
        let recipes :: [Recipe Entity]
recipes = 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 installed"
            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)

        -- Try recipes and make a weighted random choice among the
        -- ones we have ingredients for.
        let ([[MissingIngredient]]
badRecipes, [(Inventory, Inventory -> Inventory, 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, Inventory -> Inventory, Recipe Entity)
make (Inventory
inv, Inventory
ins)) forall a b. (a -> b) -> a -> b
$ [Recipe Entity]
recipes
        Maybe (Inventory, Inventory -> Inventory, 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, Inventory -> Inventory, Recipe Entity)]
goodRecipes
        (Inventory
invTaken, Inventory -> Inventory
changeInv, Recipe Entity
recipe) <-
          Maybe (Inventory, Inventory -> Inventory, 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)
              ]

        -- take recipe inputs from inventory and add outputs after recipeTime
        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 -> WorldUpdate -> RobotUpdate -> m CESK
finishCookingRecipe Recipe Entity
recipe ((World RID Entity -> Either Exn (World RID Entity)) -> WorldUpdate
WorldUpdate forall a b. b -> Either a b
Right) ((Inventory -> Inventory) -> RobotUpdate
RobotUpdate Inventory -> Inventory
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
Installed -> 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
installedDevices
        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
Whereami -> do
      V2 Int64
x Int64
y <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
      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 (Integer -> Value
VInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x)) (Integer -> Value
VInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
y))) Store
s Cont
k
    Const
Time -> do
      Integer
t <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
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 Integer
t) Store
s Cont
k
    Const
Drill -> case [Value]
vs of
      [VDir 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
        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
installedDevices

        let toyDrill :: [Entity]
toyDrill = Text -> Inventory -> [Entity]
lookupByName Text
"drill" Inventory
ins
            metalDrill :: [Entity]
metalDrill = Text -> Inventory -> [Entity]
lookupByName Text
"metal drill" Inventory
ins
            insDrill :: Maybe Entity
insDrill = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ [Entity]
metalDrill forall a. Semigroup a => a -> a -> a
<> [Entity]
toyDrill

        Entity
drill <- Maybe Entity
insDrill 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 installed?!"

        let directionText :: Text
directionText = case Direction
d of
              Direction
DDown -> Text
"under"
              Direction
DForward -> Text
"ahead of"
              Direction
DBack -> Text
"behind"
              Direction
_ -> DirInfo -> Text
dirSyntax (Direction -> DirInfo
dirInfo Direction
d) forall a. Semigroup a => a -> a -> a
<> Text
" of"

        (V2 Int64
nextLoc, Maybe Entity
nextME) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (V2 Int64, 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 drill", Text
directionText, Text
"robot", Text
rname forall a. Semigroup a => a -> a -> a
<> Text
"."]

        IntMap [Recipe Entity]
inRs <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap [Recipe Entity])
recipesIn

        let recipes :: [Recipe Entity]
recipes = forall a. (a -> Bool) -> [a] -> [a]
filter Recipe Entity -> Bool
drilling (IntMap [Recipe Entity] -> Entity -> [Recipe Entity]
recipesFor IntMap [Recipe Entity]
inRs Entity
nextE)
            drilling :: Recipe Entity -> Bool
drilling = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== Entity
drill) 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)
recipeRequirements

        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 drill", 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
"."]

        -- add the drilled entity so it can be consumed by the recipe
        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. [Either a b] -> [b]
rights (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 drill", 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
            changeInv :: Inventory -> Inventory
changeInv =
              forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry RID -> Entity -> Inventory -> Inventory
insertCount)) [(RID, Entity)]
out
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ RID -> Entity -> Inventory -> Inventory
insertCount RID
0)) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(RID, Entity)]
down)
            changeWorld :: World RID Entity -> Either Exn (World RID Entity)
changeWorld = Entity
-> V2 Int64
-> [(RID, Entity)]
-> World RID Entity
-> Either Exn (World RID Entity)
changeWorld' Entity
nextE V2 Int64
nextLoc [(RID, Entity)]
down

        -- take recipe inputs from inventory and add outputs after recipeTime
        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 (sig :: (* -> *) -> * -> *) (m :: * -> *) e.
HasRobotStepState sig m =>
Recipe e -> WorldUpdate -> RobotUpdate -> m CESK
finishCookingRecipe Recipe Entity
recipe ((World RID Entity -> Either Exn (World RID Entity)) -> WorldUpdate
WorldUpdate World RID Entity -> Either Exn (World RID Entity)
changeWorld) ((Inventory -> Inventory) -> RobotUpdate
RobotUpdate Inventory -> Inventory
changeInv)
      [Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Blocked -> do
      V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
      Maybe (V2 Int64)
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe (V2 Int64))
robotOrientation
      let nextLoc :: V2 Int64
nextLoc = V2 Int64
loc forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ (Maybe (V2 Int64)
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 =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
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
        (V2 Int64
_loc, Maybe Entity
me) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (V2 Int64, Maybe Entity)
lookInDirection Direction
d
        Value
res <- case Maybe Entity
me of
          Maybe Entity
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Value -> Value
VInj Bool
False Value
VUnit
          Just 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 (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Value -> Value
VInj Bool
True (Text -> Value
VText (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName))

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
res 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
installedDevices
        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
        -- Make sure the other robot exists and is close
        Robot
_other <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
otherID

        -- Upload knowledge of everything in our inventory
        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

        -- Upload our log
        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 (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 -> case [Value]
vs of
      -- To execute an atomic block, set the runningAtomic flag,
      -- push an FFinishAtomic frame so that we unset the flag when done, and
      -- proceed to execute the argument.
      [Value
cmd] -> do
        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
    Const
As -> case [Value]
vs of
      [VRobot RID
rid, Value
prog] -> do
        -- Get the named robot and current game state
        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 robot 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

        -- Execute the given program *hypothetically*: i.e. in a fresh
        -- CESK machine, using *copies* of the current store, robot
        -- and game state.  We discard the state afterwards so any
        -- modifications made by prog do not persist.  Note we also
        -- set the copied robot to be a "system" robot so it is
        -- capable of executing any commands; the As command
        -- already requires "God" capability.
        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])

        -- Return the value returned by the hypothetical command.
        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])
        let robotValue :: Value
robotValue = RID -> Value
VRobot (Robot
r forall s a. s -> Getting a s a -> a
^. 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 Value
robotValue 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)])
        let robotValue :: Value
robotValue = RID -> Value
VRobot (Robot
r forall s a. s -> Getting a s a -> a
^. 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 Value
robotValue 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
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
        Bool
system <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
        LogEntry
m <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
LogSource -> Text -> m LogEntry
traceLog LogSource
Said Text
msg -- current robot will inserted to robot set, so it needs the log
        forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
m
        let addLatestClosest :: V2 Int64 -> Seq LogEntry -> Seq LogEntry
addLatestClosest V2 Int64
rl = \case
              Seq LogEntry
Seq.Empty -> forall a. Seq a
Seq.Empty
              Seq LogEntry
es Seq.:|> LogEntry
e
                | LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Integer
leTime forall a. Ord a => a -> a -> Bool
< LogEntry
m forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Integer
leTime -> 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
                | V2 Int64 -> V2 Int64 -> Int64
manhattan V2 Int64
rl (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry (V2 Int64)
leLocation) forall a. Ord a => a -> a -> Bool
> V2 Int64 -> V2 Int64 -> Int64
manhattan V2 Int64
rl (LogEntry
m forall s a. s -> Getting a s a -> a
^. Lens' LogEntry (V2 Int64)
leLocation) -> 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
        let addToRobotLog :: Has (State GameState) sgn m => Robot -> m ()
            addToRobotLog :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addToRobotLog Robot
r = do
              Robot
r' <- forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m s
execState 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
                V2 Int64
loc' <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
hasLog Bool -> Bool -> Bool
&& Bool
hasListen) (Lens' Robot (Seq LogEntry)
robotLog forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= V2 Int64 -> Seq LogEntry -> Seq LogEntry
addLatestClosest V2 Int64
loc')
              forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addRobot Robot
r'
        [Robot]
robotsAround <-
          if Bool
creative Bool -> Bool -> Bool
|| Bool
system
            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
$ V2 Int64 -> Int64 -> GameState -> [Robot]
robotsInArea V2 Int64
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
      V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
      Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
      Bool
system <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
      Seq LogEntry
mq <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (Seq LogEntry)
messageQueue
      let recentAndClose :: LogEntry -> Bool
recentAndClose LogEntry
e = Bool
system Bool -> Bool -> Bool
|| Bool
creative Bool -> Bool -> Bool
|| GameState -> LogEntry -> Bool
messageIsRecent GameState
gs LogEntry
e Bool -> Bool -> Bool
&& V2 Int64 -> LogEntry -> Bool
messageIsFromNearby V2 Int64
loc LogEntry
e
          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 a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR LogEntry -> Bool
recentAndClose 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 (Const -> Term
TConst Const
Listen) forall a. Monoid a => a
mempty Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Cont
k)) -- continue listening
          (\Text
m -> Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
m) Store
s Cont
k) -- return found message
          Maybe Text
mm
    Const
Log -> case [Value]
vs of
      [VText Text
msg] -> do
        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) =>
LogSource -> Text -> m LogEntry
traceLog LogSource
Logged 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
        Robot
_ <-
          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 robot with ID", forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show RID
rid), Text
"to view."])

        -- Only the base can actually change the view in the UI.  Other robots can
        -- execute this command but it does nothing (at least for now).
        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
$
          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 Direction 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 Direction Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Direction
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 Direction Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Direction
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 Direction Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Direction
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 Direction Char)
orientationMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Direction
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 Lens' GameState 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
Ishere -> case [Value]
vs of
      [VText Text
name] -> do
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
        Maybe Entity
me <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
loc
        case Maybe Entity
me of
          Maybe Entity
Nothing -> 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
False) Store
s Cont
k
          Just Entity
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool (Text -> Text
T.toLower (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toLower Text
name)) Store
s Cont
k
      [Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    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
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] ->
        -- To force a VRef, we look up the location in the store.
        case RID -> Store -> Maybe Cell
lookupCell RID
loc Store
s of
          -- If there's no cell at that location, it's a bug!  It
          -- shouldn't be possible to get a VRef to a non-existent
          -- location, since the only way VRefs get created is at the
          -- time we allocate a new cell.
          Maybe Cell
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
          -- If the location contains an unevaluated expression, it's
          -- time to evaluate it.  Set the cell to a 'Blackhole', push
          -- an 'FUpdate' frame so we remember to update the location
          -- to its value once we finish evaluating it, and focus on
          -- the expression.
          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 -> Cell -> Store -> Store
setCell RID
loc (Term -> Env -> Cell
Blackhole Term
t Env
e') Store
s) (RID -> Frame
FUpdate RID
loc forall a. a -> [a] -> [a]
: Cont
k)
          -- If the location contains a Blackhole, that means we are
          -- already currently in the middle of evaluating it, i.e. it
          -- depends on itself, so throw an 'InfiniteLoop' error.
          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
          -- If the location already contains a value, just return it.
          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
      -- If a force is applied to any other kind of value, just ignore it.
      -- This is needed because of the way we wrap all free variables in @force@
      -- in case they come from a @def@ which are always wrapped in @delay@.
      -- But binders (i.e. @x <- ...@) are also exported to the global context.
      [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
      -- Use the boolean to pick the correct branch, and apply @force@ to it.
      [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
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
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode

        -- check if robot exists
        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 robot 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
"."])

        -- check that current robot is not trying to reprogram self
        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."]

        -- check if robot has completed executing it's current command
        (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."]

        -- check if childRobot is at the correct distance
        -- a robot can program adjacent robots
        -- creative mode ignores distance checks
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
        (Bool
creative Bool -> Bool -> Bool
|| (Robot
childRobot forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation) V2 Int64 -> V2 Int64 -> Int64
`manhattan` V2 Int64
loc forall a. Ord a => a -> a -> Bool
<= Int64
1)
          forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You can only reprogram an adjacent robot."]

        -- Figure out if we can supply what the target robot requires,
        -- and if so, what is needed.
        (Set Entity
toInstall, 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
installedDevices)
            Term
cmd
            Text
"The target robot"
            IncapableFix
FixByObtain

        -- update other robot's CESK machine, environment and context
        -- the childRobot inherits the parent robot's environment
        -- and context which collectively mean all the variables
        -- declared in the parent robot
        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

        -- Provision the target robot with any required devices and
        -- inventory that are lacking.
        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
toInstall) Inventory
toGive

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

        -- Pick a random display name.
        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

        -- Construct the new robot and add it to the world.
        Robot
newRobot <-
          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
-> [Text]
-> RobotLocation phase
-> V2 Int64
-> Display
-> CESK
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> TimeSpec
-> RobotR phase
mkRobot
              ()
              (forall a. a -> Maybe a
Just RID
pid)
              Text
displayName
              [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 (V2 Int64)
robotLocation))
              ( ((Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Maybe (V2 Int64))
robotOrientation) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \V2 Int64
dir -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (V2 Int64
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 V2 Int64
dir)
                  forall a. Maybe a -> a -> a
? V2 Int64
east
              )
              Display
defaultRobotDisplay
              (Term -> Env -> Store -> Cont -> CESK
In Term
cmd Env
e Store
s [Frame
FExec])
              []
              []
              Bool
False
              Bool
False
              TimeSpec
createdAt

        -- Provision the new robot with the necessary devices and inventory.
        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
toInstall) Inventory
toGive

        -- Flag the world for a redraw and return the name of the newly constructed robot.
        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 (RID -> Value
VRobot (Robot
newRobot forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID)) Store
s Cont
k
      [Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    Const
Salvage -> case [Value]
vs of
      [] -> do
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
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
. V2 Int64 -> GameState -> [Robot]
robotsAtLocation V2 Int64
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 -- Nothing to salvage
          Just Robot
target -> do
            -- Copy the salvaged robot's installed devices into its inventory, in preparation
            -- for transferring it.
            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
installedDevices)
            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

            -- Copy over the salvaged robot's log, if we have one
            Inventory
inst <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
installedDevices
            EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState 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
            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
creative 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

            -- Immediately copy over any items the robot knows about
            -- but has 0 of
            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

            -- Now reprogram the robot being salvaged to 'give' each
            -- item in its inventory to us, one at a time, then
            -- self-destruct at the end.  Make it a system robot so we
            -- don't have to worry about capabilities.
            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

            -- The program for the salvaged robot to run
            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) (Const -> Term
TConst Const
Selfdestruct) [Text]
salvageItems
                giveItem :: Text -> Term
giveItem Text
item = Term -> Term -> Term
TApp (Term -> Term -> Term
TApp (Const -> Term
TConst Const
Give) (RID -> Term
TRobot RID
ourID)) (Text -> Term
TText Text
item)

            -- Reprogram and activate the salvaged robot
            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)

            -- Now wait the right amount of time for it to finish.
            Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> CESK -> CESK
Waiting (Integer
time forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral RID
numItems forall a. Num a => a -> a -> a
+ Integer
1) (Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k)
      [Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
    -- run can take both types of text inputs
    -- with and without file extension as in
    -- "./path/to/file.sw" and "./path/to/file"
    Const
Run -> case [Value]
vs of
      [VText Text
fileName] -> do
        [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 target source. From source target => source -> target
into Text
fileName, forall target source. From source target => source -> target
into forall a b. (a -> b) -> a -> b
$ Text
fileName forall a. Semigroup a => a -> a -> a
<> Text
".sw"]

        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]

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe ProcessedTerm
mt of
          Maybe ProcessedTerm
Nothing -> Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
          Just ProcessedTerm
t -> 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
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
  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:"
      , forall source target. From source target => source -> target
from (CESK -> String
prettyCESK (Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c (forall a. [a] -> [a]
reverse [Value]
vs)) Store
s Cont
k))
      ]

  finishCookingRecipe :: HasRobotStepState sig m => Recipe e -> WorldUpdate -> RobotUpdate -> m CESK
  finishCookingRecipe :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) e.
HasRobotStepState sig m =>
Recipe e -> WorldUpdate -> RobotUpdate -> m CESK
finishCookingRecipe Recipe e
r WorldUpdate
wf RobotUpdate
rf = do
    Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
    let remTime :: Integer
remTime = Recipe e
r forall s a. s -> Getting a s a -> a
^. forall e. Lens' (Recipe e) Integer
recipeTime
    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 Integer -> CESK -> CESK
Waiting (Integer
remTime forall a. Num a => a -> a -> a
+ Integer
time)) forall a b. (a -> b) -> a -> b
$
      Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s (WorldUpdate -> RobotUpdate -> Frame
FImmediate WorldUpdate
wf RobotUpdate
rf forall a. a -> [a] -> [a]
: Cont
k)

  lookInDirection :: HasRobotStepState sig m => Direction -> m (V2 Int64, Maybe Entity)
  lookInDirection :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (V2 Int64, Maybe Entity)
lookInDirection Direction
d = do
    V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
    Maybe (V2 Int64)
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe (V2 Int64))
robotOrientation
    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 (Direction -> Term
TDir Direction
d)
    let nextLoc :: V2 Int64
nextLoc = V2 Int64
loc forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Direction -> V2 Int64 -> V2 Int64
applyTurn Direction
d (Maybe (V2 Int64)
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
    (V2 Int64
nextLoc,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
nextLoc
  ensureItem :: HasRobotStepState sig m => Text -> Text -> m Entity
  ensureItem :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
action = do
    -- First, make sure we know about the entity.
    Inventory
inv <- 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
installedDevices
    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
"?"]

    -- Next, check whether we have one.  If we don't, add a hint about
    -- 'create' in creative mode.
    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

  -- Check the required devices and inventory for running the given
  -- command on a target robot.  This function is used in common by
  -- both 'Build' and 'Reprogram'.
  --
  -- It is given as inputs the parent robot inventory, the inventory
  -- and installed devices of the child (these will be empty in the
  -- case of 'Build'), and the command to be run (along with a few
  -- inputs to configure any error messages to be generated).
  --
  -- Throws an exception if it's not possible to set up the child
  -- robot with the things it needs to execute the given program.
  -- Otherwise, returns a pair consisting of the set of devices to be
  -- installed, and the inventory that should be transferred from
  -- parent to child.
  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 Lens' GameState 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 -- Note that _capCtx must be empty: at least at the
        -- moment, definitions are only allowed at the top level,
        -- so there can't be any inside the argument to build.
        -- (Though perhaps there is an argument that this ought to be
        -- relaxed specifically in the cases of 'Build' and 'Reprogram'.)
        -- See #349
        (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

    -- Check that all required device names exist, and fail with
    -- an exception if not
    [Entity]
devs <- 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]

    -- Check that all required inventory entity names exist, and fail
    -- with an exception if not
    [(RID, Entity)]
reqElems <- 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 reqInv :: Inventory
reqInv = [(RID, Entity)] -> Inventory
E.fromElems [(RID, Entity)]
reqElems

    let -- List of possible devices per requirement.  Devices for
        -- required capabilities come first, then singleton devices
        -- that are required directly.  This order is important since
        -- later we zip required capabilities with this list to figure
        -- out which capabilities are missing.
        capDevices :: [[Entity]]
capDevices = forall a b. (a -> b) -> [a] -> [b]
map (Capability -> EntityMap -> [Entity]
`deviceForCap` EntityMap
em) [Capability]
caps forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
: []) [Entity]
devs

        -- A device is OK if it is available in the inventory of the
        -- parent robot, or already installed in the child robot.
        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

        -- take a pair of device sets providing capabilities that is
        -- split into (AVAIL,MISSING) and if there are some available
        -- ignore missing because we only need them for error message
        ignoreOK :: ([a], [a]) -> ([a], [a])
ignoreOK ([], [a]
miss) = ([], [a]
miss)
        ignoreOK ([a]
ds, [a]
_miss) = ([a]
ds, [])

        ([Set Entity]
deviceSets, [Set Entity]
missingDeviceSets) =
          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] -> [a]
nubOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map (forall {a} {a}. ([a], [a]) -> ([a], [a])
ignoreOK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition Entity -> Bool
deviceOK) [[Entity]]
capDevices

        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
        -- capabilities not provided by any device in inventory
        missingCaps :: Set Capability
missingCaps = 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) -> 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
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Capability]
caps [Set Entity]
deviceSets

        alreadyInstalled :: Set Entity
alreadyInstalled = 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

        -- Figure out what is missing from the required inventory
        missingChildInv :: Inventory
missingChildInv = Inventory
reqInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
childInventory

    if Bool
creative
      then -- In creative mode, just return ALL the devices
        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 [[Entity]]
capDevices) forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Entity
alreadyInstalled, Inventory
missingChildInv)
      else do
        -- check if robot has all devices to execute new command
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Set Entity]
missingDeviceSets
          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
<$> 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) [Set Entity]
missingDeviceSets)
                        )
        -- check that there are in fact devices to provide every required capability
        Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Set Entity]
deviceSets) 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 Set Capability
missingCaps forall a. Set a
S.empty forall k a. Map k a
M.empty) Term
cmd

        let minimalInstallSet :: Set Entity
minimalInstallSet = 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
alreadyInstalled) [Set Entity]
deviceSets)

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

            -- What do we need?
            neededParentInv :: Inventory
neededParentInv =
              Inventory
missingChildInv
                Inventory -> Inventory -> Inventory
`E.union` ([Entity] -> Inventory
fromList 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
minimalInstallSet)

            -- What are we missing?
            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

        -- If we're missing anything, throw an error
        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
minimalInstallSet, Inventory
missingChildInv)

  -- replace some entity in the world with another entity
  changeWorld' ::
    Entity ->
    V2 Int64 ->
    IngredientList Entity ->
    W.World Int Entity ->
    Either Exn (W.World Int Entity)
  changeWorld' :: Entity
-> V2 Int64
-> [(RID, Entity)]
-> World RID Entity
-> Either Exn (World RID Entity)
changeWorld' Entity
eThen V2 Int64
loc [(RID, Entity)]
down World RID Entity
w =
    let eNow :: Maybe Entity
eNow = forall t e. Coords -> World t e -> Maybe e
W.lookupEntity (V2 Int64 -> Coords
W.locToCoords V2 Int64
loc) World RID Entity
w
     in if forall a. a -> Maybe a
Just Entity
eThen forall a. Eq a => a -> a -> Bool
/= Maybe Entity
eNow
          then forall a b. a -> Either a b
Left 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
            World RID Entity
w forall {t} {e}. World t e -> V2 Int64 -> Maybe e -> World t e
`updateLoc` V2 Int64
loc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [(RID, Entity)]
down of
              [] -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
              [(RID, Entity)
de] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (RID, Entity)
de
              [(RID, Entity)]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> Exn
Fatal Text
"Bad recipe:\n more than one unmovable entity produced."

  destroyIfNotBase :: HasRobotStepState sig m => m ()
  destroyIfNotBase :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m ()
destroyIfNotBase = do
    RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
    (RID
rid forall a. Eq a => a -> a -> Bool
/= RID
0) forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You consider destroying your base, but decide not to do it after all."]
    Lens' Robot Bool
selfDestruct forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True

  -- Make sure nothing is in the way. Note that system robots implicitly ignore and base throws on failure.
  checkMoveAhead :: HasRobotStepState sig m => V2 Int64 -> MoveFailure -> m ()
  checkMoveAhead :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
V2 Int64 -> MoveFailure -> m ()
checkMoveAhead V2 Int64
nextLoc MoveFailure {RobotFailure
failIfDrown :: RobotFailure
failIfBlocked :: RobotFailure
failIfDrown :: MoveFailure -> RobotFailure
failIfBlocked :: MoveFailure -> RobotFailure
..} = do
    Maybe Entity
me <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
nextLoc
    Bool
systemRob <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
    case Maybe Entity
me of
      Maybe Entity
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Entity
e
        | Bool
systemRob -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise -> do
          -- robots can not walk through walls
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Unwalkable) forall a b. (a -> b) -> a -> b
$
            case RobotFailure
failIfBlocked of
              RobotFailure
Destroy -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m ()
destroyIfNotBase
              RobotFailure
ThrowExn -> 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 a", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"in the way!"]
              RobotFailure
IgnoreFail -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

          -- robots drown if they walk over liquid without boat
          Set Capability
caps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Set Capability)
robotCapabilities
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Liquid Bool -> Bool -> Bool
&& Capability
CFloat forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Capability
caps) forall a b. (a -> b) -> a -> b
$
            case RobotFailure
failIfDrown of
              RobotFailure
Destroy -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
m ()
destroyIfNotBase
              RobotFailure
ThrowExn -> 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 a dangerous liquid", Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName, Text
"in the way!"]
              RobotFailure
IgnoreFail -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  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
"."]
        -- Make sure it is either in the same location or we do not care
        Bool
omni <- Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
        V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
        (Bool
omni Bool -> Bool -> Bool
|| (Robot
other forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation) V2 Int64 -> V2 Int64 -> Int64
`manhattan` V2 Int64
loc forall a. Ord a => a -> a -> Bool
<= Int64
1)
          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

  -- update some tile in the world setting it to entity or making it empty
  updateLoc :: World t e -> V2 Int64 -> Maybe e -> World t e
updateLoc World t e
w V2 Int64
loc Maybe e
res = forall e t.
Coords -> (Maybe e -> Maybe e) -> World t e -> World t e
W.update (V2 Int64 -> Coords
W.locToCoords V2 Int64
loc) (forall a b. a -> b -> a
const Maybe e
res) World t e
w

  holdsOrFail :: (Has (Throw Exn) sig m) => Bool -> [Text] -> m ()
  holdsOrFail :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
holdsOrFail Bool
a [Text]
ts = Bool
a forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` Const -> [Text] -> Exn
cmdExn Const
c [Text]
ts

  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 Maybe a
a [Text]
ts = Maybe a
a forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Const -> [Text] -> Exn
cmdExn Const
c [Text]
ts

  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

  -- Make sure the robot has the thing in its inventory
  hasInInventoryOrFail :: HasRobotStepState sig m => Text -> m Entity
  hasInInventoryOrFail :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
eName = do
    Inventory
inv <- 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

  -- The code for grab and harvest is almost identical, hence factored
  -- out here.
  doGrab :: (HasRobotStepState sig m, Has (Lift IO) sig m) => GrabbingCmd -> m CESK
  doGrab :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
GrabbingCmd -> m CESK
doGrab GrabbingCmd
cmd = do
    let verb :: Text
verb = GrabbingCmd -> Text
verbGrabbingCmd GrabbingCmd
cmd
        verbed :: Text
verbed = GrabbingCmd -> Text
verbedGrabbingCmd GrabbingCmd
cmd

    -- Ensure there is an entity here.
    V2 Int64
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (V2 Int64)
robotLocation
    Entity
e <-
      forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> m (Maybe Entity)
entityAt V2 Int64
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
"."])

    -- Ensure it can be picked up.
    Bool
omni <- Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
    (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
"."]

    -- Remove the entity from the world.
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
V2 Int64 -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt V2 Int64
loc (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw

    -- Immediately regenerate entities with 'infinite' property.
    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 =>
V2 Int64 -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt V2 Int64
loc (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Entity
e))

    -- Possibly regrow the entity, if it is growable and the 'harvest'
    -- command was used.
    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

      -- Grow a new entity from a seed.
      forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> (Integer, Integer) -> V2 Int64 -> TimeSpec -> m ()
addSeedBot Entity
e (Integer
minT, Integer
maxT) V2 Int64
loc TimeSpec
createdAt

    -- Add the picked up item to the robot's inventory.  If the
    -- entity yields something different, add that instead.
    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 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'

    -- Return the name of the item obtained.
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText (Entity
e' forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName)) Store
s Cont
k

------------------------------------------------------------
-- Some utility functions
------------------------------------------------------------

-- | How to handle failure, for example when moving to blocked location
data RobotFailure = ThrowExn | Destroy | IgnoreFail

-- | How to handle failure when moving/teleporting to a location.
data MoveFailure = MoveFailure
  { MoveFailure -> RobotFailure
failIfBlocked :: RobotFailure
  , MoveFailure -> RobotFailure
failIfDrown :: RobotFailure
  }

data GrabbingCmd = Grab' | Harvest' | Swap' 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"

verbedGrabbingCmd :: GrabbingCmd -> Text
verbedGrabbingCmd :: GrabbingCmd -> Text
verbedGrabbingCmd = \case
  GrabbingCmd
Harvest' -> Text
"harvested"
  GrabbingCmd
Grab' -> Text
"grabbed"
  GrabbingCmd
Swap' -> Text
"swapped"

-- | Give some entities from a parent robot (the robot represented by
--   the ambient @State Robot@ effect) to a child robot (represented
--   by the given 'RID') as part of a 'Build' or 'Reprogram' command.
--   The first 'Inventory' is devices to be installed, and the second
--   is entities to be transferred.
--
--   In classic mode, the entities will be /transferred/ (that is,
--   removed from the parent robot's inventory); in creative mode, the
--   entities will be copied/created, that is, no entities will be
--   removed from the parent robot.
provisionChild ::
  (HasRobotStepState sig m) =>
  RID ->
  Inventory ->
  Inventory ->
  m ()
provisionChild :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> Inventory -> Inventory -> m ()
provisionChild RID
childID Inventory
toInstall Inventory
toGive = do
  -- Install and give devices to child
  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
installedDevices 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
toInstall
  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

  -- Delete all items from parent in classic mode
  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
toInstall Inventory -> Inventory -> Inventory
`E.union` Inventory
toGive))

-- | Update the location of a robot, and simultaneously update the
--   'robotsByLocation' map, so we can always look up robots by
--   location.  This should be the /only/ way to update the location
--   of a robot.
updateRobotLocation ::
  (HasRobotStepState sig m) =>
  V2 Int64 ->
  V2 Int64 ->
  m ()
updateRobotLocation :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
V2 Int64 -> V2 Int64 -> m ()
updateRobotLocation V2 Int64
oldLoc V2 Int64
newLoc
  | V2 Int64
oldLoc forall a. Eq a => a -> a -> Bool
== V2 Int64
newLoc = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = 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 (V2 Int64) IntSet)
robotsByLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at V2 Int64
oldLoc forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> Maybe IntSet -> Maybe IntSet
deleteOne RID
rid
    Lens' GameState (Map (V2 Int64) IntSet)
robotsByLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at V2 Int64
newLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non forall s. AsEmpty s => s
Empty forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.insert RID
rid
    forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify (V2 Int64 -> Robot -> Robot
unsafeSetRobotLocation V2 Int64
newLoc)
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
 where
  -- Make sure empty sets don't hang around in the
  -- robotsByLocation map.  We don't want a key with an
  -- empty set at every location any robot has ever
  -- visited!
  deleteOne :: RID -> Maybe IntSet -> Maybe IntSet
deleteOne RID
_ Maybe IntSet
Nothing = forall a. Maybe a
Nothing
  deleteOne RID
x (Just IntSet
s)
    | IntSet -> Bool
IS.null IntSet
s' = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just IntSet
s'
   where
    s' :: IntSet
s' = RID -> IntSet -> IntSet
IS.delete RID
x IntSet
s

-- | Execute a stateful action on a target robot --- whether the
--   current one or another.
onTarget ::
  HasRobotStepState sig m =>
  RID ->
  (forall sig' m'. (HasRobotStepState sig' m') => m' ()) ->
  m ()
onTarget :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID
-> (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
    HasRobotStepState sig m =>
    m ())
-> m ()
onTarget RID
rid forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState 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 =>
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 =>
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'

------------------------------------------------------------
-- Comparison
------------------------------------------------------------

-- | Evaluate the application of a comparison operator.  Returns
--   @Nothing@ if the application does not make sense.
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 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
$ Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
"evalCmp called on bad constant " (forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Const
c))

-- | Compare two values, returning an 'Ordering' if they can be
--   compared, or @Nothing@ if they cannot.
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
  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

-- | Values with different types were compared; this should not be
--   possible since the type system should catch it.
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]

-- | Values were compared of a type which cannot be compared
--   (e.g. functions, etc.).
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
CmdFailed Const
Lt forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
T.unwords [Text
"Comparison is undefined for ", Value -> Text
prettyValue Value
v1, Text
"and", Value -> Text
prettyValue Value
v2]

------------------------------------------------------------
-- Arithmetic
------------------------------------------------------------

-- | Evaluate the application of an arithmetic operator, returning
--   an exception in the case of a failing operation, or in case we
--   incorrectly use it on a bad 'Const' in the library.
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

-- | Perform an integer division, but return @Nothing@ for division by
--   zero.
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
CmdFailed Const
Div 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

-- | Perform exponentiation, but return @Nothing@ if the power is negative.
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
CmdFailed Const
Exp 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

------------------------------------------------------------
-- Updating discovered entities, recipes, and commands
------------------------------------------------------------

-- | Update the global list of discovered entities, and check for new recipes.
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 Lens' GameState 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 Inventory
allDiscoveredEntities forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Inventory
newAllDiscovered

-- | Update the availableRecipes list.
-- This implementation is not efficient:
-- * Every time we discover a new entity, we iterate through the entire list of recipes to see which ones we can make.
--   Trying to do something more clever seems like it would definitely be a case of premature optimization.
--   One doesn't discover new entities all that often.
-- * For each usable recipe, we do a linear search through the list of known recipes to see if we already know it.
--   This is a little more troubling, since it's quadratic in the number of recipes.
--   But it probably doesn't really make that much difference until we get up to thousands of recipes.
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 Lens' GameState (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 (Lens' GameState (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 (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 = forall a. Ord a => [a] -> Set a
S.fromList (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity [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 (Lens' GameState (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 (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)