{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.Game.Step where
import Control.Applicative (liftA2)
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 (catMaybes, 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.Language.Typed (Typed (..))
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)
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
| 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)
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 (Typed Maybe Value
Nothing Polytype
ty Requirements
req) -> case Robot -> Maybe (Value, Store)
getResult Robot
r of
Just (Value
v, Store
s) -> do
Lens' GameState REPLStatus
replStatus forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed (forall a. a -> Maybe a
Just Value
v) Polytype
ty Requirements
req)
Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Store
defStore forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Store
s
Maybe (Value, Store)
Nothing -> forall (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 ()
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
(s -> s) -> m ()
modify GameState -> GameState
recalcViewCenter
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
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
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 ()
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
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
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
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
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
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))
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)
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)
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))
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
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
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]
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
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
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
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
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)
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)
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
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 :: (Has (Throw Exn) sig m) => Const -> [Text] -> m a
raise :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> [Text] -> m a
raise Const
c [Text]
parts = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (Const -> [Text] -> Exn
cmdExn Const
c [Text]
parts)
withExceptions :: Monad m => Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions :: forall (m :: * -> *).
Monad m =>
Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions Store
s Cont
k ThrowC Exn m CESK
m = do
Either Exn CESK
res <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow ThrowC Exn m CESK
m
case Either Exn CESK
res of
Left Exn
exn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
Right CESK
a -> forall (m :: * -> *) a. Monad m => a -> m a
return CESK
a
tickRobot :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Robot
tickRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (Lift IO) sig m) =>
Robot -> m Robot
tickRobot Robot
r = do
RID
steps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use 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)
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
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'
stepCESK :: (Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) => CESK -> m CESK
stepCESK :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
CESK -> m CESK
stepCESK CESK
cesk = case CESK
cesk of
Waiting 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)
In Term
TUnit Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
In (TDir Direction
d) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Direction -> Value
VDir Direction
d) Store
s Cont
k
In (TInt Integer
n) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Integer -> Value
VInt Integer
n) Store
s Cont
k
In (TText Text
str) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
str) Store
s Cont
k
In (TBool Bool
b) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value
VBool Bool
b) Store
s Cont
k
In (TAntiText Text
v) Env
_ Store
s Cont
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
Fatal (Text -> Text -> Text
T.append Text
"Antiquoted variable found at runtime: $str:" Text
v)) Store
s Cont
k
In (TAntiInt Text
v) Env
_ Store
s Cont
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
Fatal (Text -> Text -> Text
T.append Text
"Antiquoted variable found at runtime: $int:" Text
v)) Store
s Cont
k
In (TRequireDevice {}) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (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
In (TRobot RID
rid) Env
_ Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRobot RID
rid) Store
s Cont
k
In (TConst Const
c) Env
_ Store
s Cont
k
| Const -> RID
arity Const
c forall a. Eq a => a -> a -> Bool
== RID
0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Const -> Bool
isCmd Const
c) -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c [] Store
s Cont
k
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c []) Store
s Cont
k
In (TVar Text
x) Env
e Store
s Cont
k -> forall (m :: * -> *).
Monad m =>
Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions Store
s Cont
k forall a b. (a -> b) -> a -> b
$ do
Value
v <-
forall t. Text -> Ctx t -> Maybe t
lookup Text
x Env
e
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Text -> Exn
Fatal ([Text] -> Text
T.unwords [Text
"Undefined variable", Text
x, Text
"encountered while running the interpreter."])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
In (TPair Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t1 Env
e Store
s (Term -> Env -> Frame
FSnd Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v1 Store
s (FSnd Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 Env
e Store
s (Value -> Frame
FFst Value
v1 forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v2 Store
s (FFst Value
v1 : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Value -> Value
VPair Value
v1 Value
v2) Store
s Cont
k
In (TLam Text
x Maybe Type
_ Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Text -> Term -> Env -> Value
VClo Text
x Term
t Env
e) Store
s Cont
k
In (TApp Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t1 Env
e Store
s (Term -> Env -> Frame
FArg Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v1 Store
s (FArg Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 Env
e Store
s (Value -> Frame
FApp Value
v1 forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v2 Store
s (FApp (VClo Text
x Term
t Env
e) : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t (forall t. Text -> t -> Ctx t -> Ctx t
addBinding Text
x Value
v2 Env
e) Store
s Cont
k
Out Value
v2 Store
s (FApp (VCApp Const
c [Value]
args) : Cont
k)
| Bool -> Bool
not (Const -> Bool
isCmd Const
c)
Bool -> Bool -> Bool
&& Const -> RID
arity Const
c forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> RID
length [Value]
args forall a. Num a => a -> a -> a
+ RID
1 ->
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c (forall a. [a] -> [a]
reverse (Value
v2 forall a. a -> [a] -> [a]
: [Value]
args)) Store
s Cont
k
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Const -> [Value] -> Value
VCApp Const
c (Value
v2 forall a. a -> [a] -> [a]
: [Value]
args)) Store
s Cont
k
Out Value
_ Store
s (FApp Value
_ : Cont
_) -> forall {m :: * -> *}. Monad m => Store -> Text -> m CESK
badMachineState Store
s Text
"FApp of non-function"
In (TLet Bool
False Text
x Maybe Polytype
_ Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t1 Env
e Store
s (Text -> Term -> Env -> Frame
FLet Text
x Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
In (TLet Bool
True Text
x Maybe Polytype
_ Term
t1 Term
t2) Env
e Store
s Cont
k ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (DelayType -> Term -> Term
TDelay (Maybe Text -> DelayType
MemoizedDelay forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
x) Term
t1) Env
e Store
s (Text -> Term -> Env -> Frame
FLet Text
x Term
t2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v1 Store
s (FLet Text
x Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 (forall t. Text -> t -> Ctx t -> Ctx t
addBinding Text
x Value
v1 Env
e) Store
s Cont
k
In tm :: Term
tm@(TDef Bool
r Text
x Maybe Polytype
_ Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *).
Monad m =>
Store -> Cont -> ThrowC Exn m CESK -> m CESK
withExceptions Store
s Cont
k forall a b. (a -> b) -> a -> b
$ do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
CEnv Term
tm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Text -> Term -> Env -> Value
VDef Bool
r Text
x Term
t Env
e) Store
s Cont
k
In (TBind Maybe Text
mx Term
t1 Term
t2) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Maybe Text -> Term -> Term -> Env -> Value
VBind Maybe Text
mx Term
t1 Term
t2 Env
e) Store
s Cont
k
In (TDelay DelayType
SimpleDelay Term
t) Env
e Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Term -> Env -> Value
VDelay Term
t Env
e) Store
s Cont
k
In (TDelay (MemoizedDelay Maybe Text
x) Term
t) Env
e Store
s Cont
k -> do
let (RID
loc, Store
s') = Env -> Term -> Store -> (RID, Store)
allocate (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall t. Text -> t -> Ctx t -> Ctx t
`addBinding` RID -> Value
VRef RID
loc) Maybe Text
x Env
e) Term
t Store
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (RID -> Value
VRef RID
loc) Store
s' Cont
k
Out Value
v Store
s (FUpdate RID
loc : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v (RID -> Cell -> Store -> Store
setCell RID
loc (Value -> Cell
V Value
v) Store
s) Cont
k
Out (VDef Bool
r Text
x Term
t Env
e) Store
s (Frame
FExec : Cont
k) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In (DelayType -> Term -> Term
TDelay (Maybe Text -> DelayType
MemoizedDelay forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
x) Bool
r) Term
t) Env
e Store
s (Text -> Frame
FDef Text
x forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v Store
s (FDef Text
x : Cont
k) ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Env -> Value
VResult Value
VUnit (forall t. Text -> t -> Ctx t
singleton Text
x Value
v)) Store
s Cont
k
Out (VCApp Const
c [Value]
args) Store
s (Frame
FExec : Cont
k) -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Const -> Bool
isTangible Const
c) forall a b. (a -> b) -> a -> b
$ Lens' Robot 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
Out Value
v Store
s (Frame
FFinishAtomic : Cont
k) -> do
Lens' Robot Bool
runningAtomic forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out (VBind Maybe Text
mx Term
c1 Term
c2 Env
e) Store
s (Frame
FExec : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
c1 Env
e Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Maybe Text -> Term -> Env -> Frame
FBind Maybe Text
mx Term
c2 Env
e forall a. a -> [a] -> [a]
: Cont
k)
Out (VResult Value
v Env
ve) Store
s (FBind Maybe Text
mx Term
t2 Env
e : Cont
k) -> do
let ve' :: Env
ve' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall t. Text -> t -> Ctx t -> Ctx t
`addBinding` Value
v) Maybe Text
mx Env
ve
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 (Env
e forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
ve') Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Env -> Cont -> Cont
fUnionEnv Env
ve' Cont
k)
Out Value
_ Store
s (FBind Maybe Text
Nothing Term
t2 Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 Env
e Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Cont
k)
Out Value
v Store
s (FBind (Just Text
x) Term
t2 Env
e : Cont
k) -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Term -> Env -> Store -> Cont -> CESK
In Term
t2 (forall t. Text -> t -> Ctx t -> Ctx t
addBinding Text
x Value
v Env
e) Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Env -> Cont -> Cont
fUnionEnv (forall t. Text -> t -> Ctx t
singleton Text
x Value
v) Cont
k)
Out (VResult Value
v Env
e2) Store
s (FUnionEnv Env
e1 : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Env -> Value
VResult Value
v (Env
e1 forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
e2)) Store
s Cont
k
Out Value
v Store
s (FUnionEnv Env
e : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Value -> Env -> Value
VResult Value
v Env
e) Store
s Cont
k
Out (VResult Value
v Env
e) Store
s (FLoadEnv TCtx
ctx ReqCtx
rctx : Cont
k) -> do
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext Env
defVals forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
e)
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext TCtx
defTypes forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t. Ctx t -> Ctx t -> Ctx t
`union` TCtx
ctx)
Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall t. Ctx t -> Ctx t -> Ctx t
`union` ReqCtx
rctx)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
v Store
s (FLoadEnv {} : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
_ Store
s (Frame
FExec : Cont
_) -> forall {m :: * -> *}. Monad m => Store -> Text -> m CESK
badMachineState Store
s Text
"FExec frame with non-executable value"
Out (VResult Value
v Env
_) Store
s Cont
k -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Out Value
v Store
s (FTry {} : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
Up Exn
exn Store
s [] -> do
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' []
Up exn :: Exn
exn@Fatal {} Store
s Cont
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s []
Up exn :: Exn
exn@Incapable {} Store
s Cont
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s []
Up exn :: Exn
exn@InfiniteLoop {} Store
s Cont
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s []
Up Exn
_ Store
s (FTry Value
c : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
c Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) forall a. a -> [a] -> [a]
: Frame
FExec forall a. a -> [a] -> [a]
: Cont
k)
Up Exn
exn Store
s (Frame
_ : Cont
k) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
done :: CESK
done@(Out Value
_ Store
_ []) -> forall (m :: * -> *) a. Monad m => a -> m a
return CESK
done
where
badMachineState :: Store -> Text -> m CESK
badMachineState Store
s Text
msg =
let msg' :: Text
msg' =
[Text] -> Text
T.unlines
[ Text -> Text -> Text
T.append Text
"Bad machine state in stepRobot: " Text
msg
, forall 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 []
fUnionEnv :: Env -> Cont -> Cont
fUnionEnv Env
e1 = \case
FUnionEnv Env
e2 : Cont
k -> Env -> Frame
FUnionEnv (Env
e2 forall t. Ctx t -> Ctx t -> Ctx t
`union` Env
e1) forall a. a -> [a] -> [a]
: Cont
k
Cont
k -> Env -> Frame
FUnionEnv Env
e1 forall a. a -> [a] -> [a]
: Cont
k
evalConst ::
(Has (State GameState) sig m, Has (State Robot) sig m, Has (Lift IO) sig m) => Const -> [Value] -> Store -> Cont -> m CESK
evalConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m,
Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
evalConst Const
c [Value]
vs Store
s Cont
k = do
Either Exn CESK
res <- forall exc (m :: * -> *) a. ErrorC exc m a -> m (Either exc a)
runError forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
execConst Const
c [Value]
vs Store
s Cont
k
case Either Exn CESK
res of
Left Exn
exn -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
exn Store
s Cont
k
Right CESK
cek' -> forall (m :: * -> *) a. Monad m => a -> m a
return CESK
cek'
seedProgram :: Integer -> Integer -> Text -> ProcessedTerm
seedProgram :: Integer -> Integer -> Text -> ProcessedTerm
seedProgram Integer
minTime Integer
randTime Text
thing =
[tmQ|
try {
r <- random (1 + $int:randTime);
wait (r + $int:minTime);
appear "|";
r <- random (1 + $int:randTime);
wait (r + $int:minTime);
place $str:thing;
} {};
selfdestruct
|]
addSeedBot :: Has (State GameState) sig m => Entity -> (Integer, Integer) -> 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
type HasRobotStepState sig m = (Has (State GameState) sig m, Has (State Robot) sig m, Has (Throw Exn) sig m)
execConst ::
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const ->
[Value] ->
Store ->
Cont ->
m CESK
execConst :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(HasRobotStepState sig m, Has (Lift IO) sig m) =>
Const -> [Value] -> Store -> Cont -> m CESK
execConst Const
c [Value]
vs Store
s Cont
k = do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
Has (Throw Exn) sig m) =>
Const -> m ()
ensureCanExecute Const
c
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
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
Robot
target <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
rid
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
Entity
e <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name
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
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
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."]
Entity
e <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> m Entity
hasInInventoryOrFail Text
name
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
Robot
_other <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
otherID
Entity
item <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
"give"
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
RID
focusedID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState RID
focusedRobotID
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
otherID forall a. Eq a => a -> a -> Bool
/= RID
myID) forall a b. (a -> b) -> a -> b
$ do
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
otherID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
item
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
delete Entity
item
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RID
focusedID forall a. Eq a => a -> a -> Bool
== RID
myID Bool -> Bool -> Bool
|| RID
focusedID forall a. Eq a => a -> a -> Bool
== RID
otherID) forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Install -> case [Value]
vs of
[VRobot RID
otherID, VText Text
itemName] -> do
Robot
_other <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
otherID
Entity
item <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Text -> Text -> m Entity
ensureItem Text
itemName Text
"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
Bool
True -> do
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
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
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]
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)
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)
]
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
"."]
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
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
Robot
_other <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> m Robot
getRobotWithinTouch RID
otherID
Inventory
inv <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Inventory
robotInventory
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Inventory -> [(RID, Entity)]
elems Inventory
inv) forall a b. (a -> b) -> a -> b
$ \(RID
_, Entity
e) ->
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
otherID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> Entity -> Inventory -> Inventory
insertCount RID
0 Entity
e
Seq LogEntry
rlog <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Seq LogEntry)
robotLog
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
otherID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot (Seq LogEntry)
robotLog forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Semigroup a) =>
ASetter' s a -> a -> m ()
<>= Seq LogEntry
rlog
forall (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
[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
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
Value
v <-
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @Robot (Robot
r forall a b. a -> (a -> b) -> b
& Lens' Robot Bool
systemRobot forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
evalState @GameState GameState
g forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Exn) sig m,
Has (State GameState) sig m, Has (State Robot) sig m) =>
CESK -> m Value
runCESK (Value -> Store -> Cont -> CESK
Out Value
prog Store
s [Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []), Frame
FExec])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
RobotNamed -> case [Value]
vs of
[VText Text
rname] -> do
Robot
r <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Text -> m (Maybe Robot)
robotWithName Text
rname forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"There is no robot named", Text
rname])
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
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
RID
rid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
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 isClose :: LogEntry -> Bool
isClose LogEntry
e = Bool
system Bool -> Bool -> Bool
|| Bool
creative Bool -> Bool -> Bool
|| V2 Int64 -> LogEntry -> Bool
messageIsFromNearby V2 Int64
loc LogEntry
e
let notMine :: LogEntry -> Bool
notMine LogEntry
e = RID
rid forall a. Eq a => a -> a -> Bool
/= LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry RID
leRobotID
let 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
let mm :: Maybe Text
mm = Seq LogEntry -> Maybe Text
limitLast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) LogEntry -> Bool
notMine LogEntry -> Bool
isClose) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR (GameState -> LogEntry -> Bool
messageIsRecent GameState
gs) Seq LogEntry
mq
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Term -> Env -> Store -> Cont -> CESK
In (Const -> Term
TConst Const
Listen) forall a. Monoid a => a
mempty Store
s (Frame
FExec forall a. a -> [a] -> [a]
: Cont
k))
(\Text
m -> Value -> Store -> Cont -> CESK
Out (Text -> Value
VText Text
m) Store
s Cont
k)
Maybe Text
mm
Const
Log -> case [Value]
vs of
[VText Text
msg] -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
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."])
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] ->
case RID -> Store -> Maybe Cell
lookupCell RID
loc Store
s of
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
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)
Just Blackhole {} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up Exn
InfiniteLoop Store
s Cont
k
Just (V Value
v) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
If -> case [Value]
vs of
[VBool Bool
b, Value
thn, Value
els] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (forall a. a -> a -> Bool -> a
bool Value
els Value
thn Bool
b) Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Inl -> case [Value]
vs of
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value -> Value
VInj Bool
False Value
v) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Inr -> case [Value]
vs of
[Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (Bool -> Value -> Value
VInj Bool
True Value
v) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Case -> case [Value]
vs of
[VInj Bool
side Value
v, Value
kl, Value
kr] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s (Value -> Frame
FApp (forall a. a -> a -> Bool -> a
bool Value
kl Value
kr Bool
side) forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Fst -> case [Value]
vs of
[VPair Value
v Value
_] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Snd -> case [Value]
vs of
[VPair Value
_ Value
v] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
v Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Try -> case [Value]
vs of
[Value
c1, Value
c2] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
c1 Store
s (Value -> Frame
FApp (Const -> [Value] -> Value
VCApp Const
Force []) forall a. a -> [a] -> [a]
: Frame
FExec forall a. a -> [a] -> [a]
: Value -> Frame
FTry Value
c2 forall a. a -> [a] -> [a]
: Cont
k)
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Undefined -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
User Text
"undefined") Store
s Cont
k
Const
Fail -> case [Value]
vs of
[VText Text
msg] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Exn -> Store -> Cont -> CESK
Up (Text -> Exn
User Text
msg) Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
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
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
"."])
RID
myID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
(RID
childRobotID forall a. Eq a => a -> a -> Bool
/= RID
myID)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text
"You cannot make a robot reprogram itself."]
(Value, Store)
_ <-
CESK -> Maybe (Value, Store)
finalValue (Robot
childRobot forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"You cannot reprogram a robot that is actively running a program."]
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."]
(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
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
childRobotID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Term -> Env -> Store -> Cont -> CESK
In Term
cmd Env
e Store
s [Frame
FExec]
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
childRobotID forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot RobotContext
robotContext
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> Inventory -> Inventory -> m ()
provisionChild RID
childRobotID ([Entity] -> Inventory
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set Entity
toInstall) Inventory
toGive
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
activateRobot RID
childRobotID
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out Value
VUnit Store
s Cont
k
[Value]
_ -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
HasRobotStepState sig m =>
m a
badConst
Const
Build -> case [Value]
vs of
[VDelay Term
cmd Env
e] -> do
Robot
r <- forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
m s
get @Robot
RID
pid <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot RID
robotID
(Set Entity
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
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
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
north
)
Display
defaultRobotDisplay
(Term -> Env -> Store -> Cont -> CESK
In Term
cmd Env
e Store
s [Frame
FExec])
[]
[]
Bool
False
Bool
False
TimeSpec
createdAt
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
RID -> Inventory -> Inventory -> m ()
provisionChild (Robot
newRobot forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID) ([Entity] -> Inventory
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ Set Entity
toInstall) Inventory
toGive
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> Store -> Cont -> CESK
Out (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
Just Robot
target -> do
let salvageInventory :: Inventory
salvageInventory = Inventory -> Inventory -> Inventory
E.union (Robot
target forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) (Robot
target forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
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
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
let knownItems :: [Entity]
knownItems = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== RID
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(RID, Entity)]
elems forall a b. (a -> b) -> a -> b
$ Inventory
salvageInventory
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Inventory
i -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (RID -> Entity -> Inventory -> Inventory
insertCount RID
0) Inventory
i [Entity]
knownItems
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Robot
target forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Bool
systemRobot forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True
RID
ourID <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use @Robot Getter Robot RID
robotID
let giveInventory :: Term
giveInventory =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Term -> Term -> Term
TBind forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Term
giveItem) (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)
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)
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
Const
Run -> case [Value]
vs of
[VText Text
fileName] -> do
let filePath :: String
filePath = forall target source. From source target => source -> target
into @String Text
fileName
Maybe String
sData <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
getDataFileNameSafe String
filePath
Maybe String
sDataSW <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
getDataFileNameSafe (String
filePath forall a. Semigroup a => a -> a -> a
<> String
".sw")
[Maybe String]
mf <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe String)
readFileMay forall a b. (a -> b) -> a -> b
$ [String
filePath, String
filePath forall a. Semigroup a => a -> a -> a
<> String
".sw"] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes [Maybe String
sData, Maybe String
sDataSW]
String
f <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe String]
mf forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Maybe a -> [Text] -> m a
`isJustOrFail` [Text
"File not found:", Text
fileName]
Maybe ProcessedTerm
mt <-
Text -> Either Text (Maybe ProcessedTerm)
processTerm (forall target source. From source target => source -> target
into @Text String
f) forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) b a.
Has (Throw e) sig m =>
Either b a -> (b -> e) -> m a
`isRightOr` \Text
err ->
Const -> [Text] -> Exn
cmdExn Const
Run [Text
"Error in", Text
fileName, Text
"\n", Text
err]
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
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
"?"]
Bool
creative <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode
let create :: [Text] -> [Text]
create [Text]
l = [Text]
l forall a. Semigroup a => a -> a -> a
<> [Text
"You can make one first with 'create \"" forall a. Semigroup a => a -> a -> a
<> Text
itemName forall a. Semigroup a => a -> a -> a
<> Text
"\"'." | Bool
creative]
(Entity -> Inventory -> RID
E.lookup Entity
item Inventory
inv forall a. Ord a => a -> a -> Bool
> RID
0)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Bool -> [Text] -> m ()
`holdsOrFail` [Text] -> [Text]
create [Text
"You don't have", Text -> Text
indefinite Text
itemName, Text
"to", Text
action forall a. Semigroup a => a -> a -> a
<> Text
"."]
forall (m :: * -> *) a. Monad m => a -> m a
return Entity
item
checkRequirements ::
HasRobotStepState sig m =>
Inventory ->
Inventory ->
Inventory ->
Term ->
Text ->
IncapableFix ->
m (Set Entity, Inventory)
checkRequirements :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Inventory
-> Inventory
-> Inventory
-> Term
-> Text
-> IncapableFix
-> m (Set Entity, Inventory)
checkRequirements Inventory
parentInventory Inventory
childInventory Inventory
childDevices Term
cmd Text
subject IncapableFix
fixI = do
ReqCtx
currentContext <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' Robot RobotContext
robotContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotContext ReqCtx
defReqs
EntityMap
em <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use 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
(R.Requirements (forall a. Set a -> [a]
S.toList -> [Capability]
caps) (forall a. Set a -> [a]
S.toList -> [Text]
devNames) Map Text RID
reqInvNames, ReqCtx
_capCtx) = ReqCtx -> Term -> (Requirements, ReqCtx)
R.requirements ReqCtx
currentContext Term
cmd
[Entity]
devs <- 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]
[(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
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
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
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
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
missingChildInv :: Inventory
missingChildInv = Inventory
reqInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
childInventory
if Bool
creative
then
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> Set a
S.fromList [[Entity]]
capDevices) forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Entity
alreadyInstalled, Inventory
missingChildInv)
else do
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)
)
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)
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)
missingParentInv :: Inventory
missingParentInv = Inventory
neededParentInv Inventory -> Inventory -> Inventory
`E.difference` Inventory
parentInventory
missingMap :: Map Text RID
missingMap =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> RID
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(RID, Entity)]
E.elems
forall a b. (a -> b) -> a -> b
$ Inventory
missingParentInv
Inventory -> Bool
E.isEmpty Inventory
missingParentInv
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
fixI (Set Capability -> Set Text -> Map Text RID -> Requirements
R.Requirements forall a. Set a
S.empty forall a. Set a
S.empty Map Text RID
missingMap) Term
cmd
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Entity
minimalInstallSet, Inventory
missingChildInv)
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
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
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 ()
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
"."]
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
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
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
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
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
"."])
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
"."]
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
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))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Growable) Bool -> Bool -> Bool
&& GrabbingCmd
cmd forall a. Eq a => a -> a -> Bool
== GrabbingCmd
Harvest') forall a b. (a -> b) -> a -> b
$ do
let GrowthTime (Integer
minT, Integer
maxT) = (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe GrowthTime)
entityGrowth) forall a. Maybe a -> a -> a
? GrowthTime
defaultGrowthTime
TimeSpec
createdAt <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Entity -> (Integer, Integer) -> V2 Int64 -> TimeSpec -> m ()
addSeedBot Entity
e (Integer
minT, Integer
maxT) V2 Int64
loc TimeSpec
createdAt
let yieldName :: Maybe Text
yieldName = Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity (Maybe Text)
entityYields
Entity
e' <- case Maybe Text
yieldName of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Entity
e
Just Text
n -> forall a. a -> Maybe a -> a
fromMaybe Entity
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a b (f :: * -> *) (sig :: (* -> *) -> * -> *).
Has (State s) sig f =>
Getting a s a -> (a -> b) -> f b
uses Lens' GameState EntityMap
entityMap (Text -> EntityMap -> Maybe Entity
lookupEntityName Text
n)
Lens' Robot Inventory
robotInventory forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= Entity -> Inventory -> Inventory
insert Entity
e'
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Entity -> m ()
updateDiscoveredEntities Entity
e'
forall (m :: * -> *) a. Monad m => a -> m a
return 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
data RobotFailure = ThrowExn | Destroy | IgnoreFail
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"
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
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
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))
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
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
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'
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))
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
incompatCmp :: Has (Throw Exn) sig m => Value -> Value -> m a
incompatCmp :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incompatCmp Value
v1 Value
v2 =
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$
Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.unwords [Text
"Incompatible comparison of ", Value -> Text
prettyValue Value
v1, Text
"and", Value -> Text
prettyValue Value
v2]
incomparable :: Has (Throw Exn) sig m => Value -> Value -> m a
incomparable :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Value -> Value -> m a
incomparable Value
v1 Value
v2 =
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$
Const -> Text -> Exn
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]
evalArith :: Has (Throw Exn) sig m => Const -> Integer -> Integer -> m Integer
evalArith :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Integer -> Integer -> m Integer
evalArith = \case
Const
Add -> forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> a) -> t -> t -> m a
ok forall a. Num a => a -> a -> a
(+)
Const
Sub -> forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> a) -> t -> t -> m a
ok (-)
Const
Mul -> forall {m :: * -> *} {t} {t} {a}.
Monad m =>
(t -> t -> a) -> t -> t -> m a
ok forall a. Num a => a -> a -> a
(*)
Const
Div -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeDiv
Const
Exp -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeExp
Const
c -> \Integer
_ Integer
_ -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Exn
Fatal forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
T.append Text
"evalArith called on bad constant " (forall source target. From source target => source -> target
from (forall a. Show a => a -> String
show Const
c))
where
ok :: (t -> t -> a) -> t -> t -> m a
ok t -> t -> a
f t
x t
y = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ t -> t -> a
f t
x t
y
safeDiv :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer
safeDiv :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Integer -> Integer -> m Integer
safeDiv Integer
_ Integer
0 = forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Const -> Text -> Exn
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
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
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
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)