{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.Game.Robot (
RobotPhase (..),
RID,
RobotR,
Robot,
TRobot,
RobotUpdate (..),
RobotContext,
defTypes,
defReqs,
defVals,
defStore,
emptyRobotContext,
robotEntity,
robotName,
trobotName,
unwalkableEntities,
robotCreatedAt,
robotDisplay,
robotLocation,
unsafeSetRobotLocation,
trobotLocation,
robotOrientation,
robotInventory,
equippedDevices,
robotLog,
robotLogUpdated,
inventoryHash,
robotCapabilities,
robotContext,
trobotContext,
robotID,
robotParentID,
robotHeavy,
machine,
systemRobot,
selfDestruct,
runningAtomic,
activityCounts,
tickStepBudget,
tangibleCommandCount,
commandsHistogram,
lifetimeStepCount,
activityWindow,
mkRobot,
instantiateRobot,
robotKnows,
isActive,
wantsToStep,
waitingUntil,
getResult,
hearingDistance,
) where
import Control.Lens hiding (Const, contains)
import Data.Aeson qualified as Ae (FromJSON, Key, KeyValue, ToJSON (..), object, (.=))
import Data.Hashable (hashWithSalt)
import Data.Kind qualified
import Data.Map (Map)
import Data.Maybe (catMaybes, fromMaybe, isNothing)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Text (Text)
import Data.Yaml ((.!=), (.:), (.:?))
import GHC.Generics (Generic)
import Linear
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.CESK
import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Location (Heading, Location, toDirection)
import Swarm.Game.Universe
import Swarm.Language.Capability (Capability)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Requirement (ReqCtx)
import Swarm.Language.Syntax (Const, Syntax)
import Swarm.Language.Text.Markdown (Document)
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Types (TCtx)
import Swarm.Language.Value as V
import Swarm.Log
import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs)
import Swarm.Util.WindowedCounter
import Swarm.Util.Yaml
import System.Clock (TimeSpec)
data RobotContext = RobotContext
{ RobotContext -> TCtx
_defTypes :: TCtx
, RobotContext -> ReqCtx
_defReqs :: ReqCtx
, RobotContext -> Env
_defVals :: Env
, RobotContext -> Store
_defStore :: Store
}
deriving (RobotContext -> RobotContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotContext -> RobotContext -> Bool
$c/= :: RobotContext -> RobotContext -> Bool
== :: RobotContext -> RobotContext -> Bool
$c== :: RobotContext -> RobotContext -> Bool
Eq, Int -> RobotContext -> ShowS
[RobotContext] -> ShowS
RobotContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RobotContext] -> ShowS
$cshowList :: [RobotContext] -> ShowS
show :: RobotContext -> String
$cshow :: RobotContext -> String
showsPrec :: Int -> RobotContext -> ShowS
$cshowsPrec :: Int -> RobotContext -> ShowS
Show, forall x. Rep RobotContext x -> RobotContext
forall x. RobotContext -> Rep RobotContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RobotContext x -> RobotContext
$cfrom :: forall x. RobotContext -> Rep RobotContext x
Generic, Value -> Parser [RobotContext]
Value -> Parser RobotContext
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RobotContext]
$cparseJSONList :: Value -> Parser [RobotContext]
parseJSON :: Value -> Parser RobotContext
$cparseJSON :: Value -> Parser RobotContext
Ae.FromJSON, [RobotContext] -> Encoding
[RobotContext] -> Value
RobotContext -> Encoding
RobotContext -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RobotContext] -> Encoding
$ctoEncodingList :: [RobotContext] -> Encoding
toJSONList :: [RobotContext] -> Value
$ctoJSONList :: [RobotContext] -> Value
toEncoding :: RobotContext -> Encoding
$ctoEncoding :: RobotContext -> Encoding
toJSON :: RobotContext -> Value
$ctoJSON :: RobotContext -> Value
Ae.ToJSON)
makeLenses ''RobotContext
emptyRobotContext :: RobotContext
emptyRobotContext :: RobotContext
emptyRobotContext = TCtx -> ReqCtx -> Env -> Store -> RobotContext
RobotContext forall t. Ctx t
Ctx.empty forall t. Ctx t
Ctx.empty forall t. Ctx t
Ctx.empty Store
emptyStore
type instance Index RobotContext = Ctx.Var
type instance IxValue RobotContext = Typed Value
instance Ixed RobotContext
instance At RobotContext where
at :: Index RobotContext
-> Lens' RobotContext (Maybe (IxValue RobotContext))
at Index RobotContext
name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RobotContext -> Maybe (Typed Value)
getter RobotContext -> Maybe (Typed Value) -> RobotContext
setter
where
getter :: RobotContext -> Maybe (Typed Value)
getter RobotContext
ctx =
do
Poly Type
typ <- forall t. Var -> Ctx t -> Maybe t
Ctx.lookup Index RobotContext
name (RobotContext
ctx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext TCtx
defTypes)
Value
val <- forall t. Var -> Ctx t -> Maybe t
Ctx.lookup Index RobotContext
name (RobotContext
ctx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Env
defVals)
Requirements
req <- forall t. Var -> Ctx t -> Maybe t
Ctx.lookup Index RobotContext
name (RobotContext
ctx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext ReqCtx
defReqs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. v -> Poly Type -> Requirements -> Typed v
Typed Value
val Poly Type
typ Requirements
req
setter :: RobotContext -> Maybe (Typed Value) -> RobotContext
setter RobotContext
ctx Maybe (Typed Value)
Nothing =
RobotContext
ctx
forall a b. a -> (a -> b) -> b
& Lens' RobotContext TCtx
defTypes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> Ctx t -> Ctx t
Ctx.delete Index RobotContext
name
forall a b. a -> (a -> b) -> b
& Lens' RobotContext Env
defVals forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> Ctx t -> Ctx t
Ctx.delete Index RobotContext
name
forall a b. a -> (a -> b) -> b
& Lens' RobotContext ReqCtx
defReqs forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> Ctx t -> Ctx t
Ctx.delete Index RobotContext
name
setter RobotContext
ctx (Just (Typed Value
val Poly Type
typ Requirements
req)) =
RobotContext
ctx
forall a b. a -> (a -> b) -> b
& Lens' RobotContext TCtx
defTypes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> t -> Ctx t -> Ctx t
Ctx.addBinding Index RobotContext
name Poly Type
typ
forall a b. a -> (a -> b) -> b
& Lens' RobotContext Env
defVals forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> t -> Ctx t -> Ctx t
Ctx.addBinding Index RobotContext
name Value
val
forall a b. a -> (a -> b) -> b
& Lens' RobotContext ReqCtx
defReqs forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> t -> Ctx t -> Ctx t
Ctx.addBinding Index RobotContext
name Requirements
req
type RID = Int
data RobotPhase
=
TemplateRobot
|
ConcreteRobot
data ActivityCounts = ActivityCounts
{ ActivityCounts -> Int
_tickStepBudget :: Int
, ActivityCounts -> Int
_tangibleCommandCount :: Int
, ActivityCounts -> Map Const Int
_commandsHistogram :: Map Const Int
, ActivityCounts -> Int
_lifetimeStepCount :: Int
, ActivityCounts -> WindowedCounter TickNumber
_activityWindow :: WindowedCounter TickNumber
}
deriving (ActivityCounts -> ActivityCounts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityCounts -> ActivityCounts -> Bool
$c/= :: ActivityCounts -> ActivityCounts -> Bool
== :: ActivityCounts -> ActivityCounts -> Bool
$c== :: ActivityCounts -> ActivityCounts -> Bool
Eq, Int -> ActivityCounts -> ShowS
[ActivityCounts] -> ShowS
ActivityCounts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityCounts] -> ShowS
$cshowList :: [ActivityCounts] -> ShowS
show :: ActivityCounts -> String
$cshow :: ActivityCounts -> String
showsPrec :: Int -> ActivityCounts -> ShowS
$cshowsPrec :: Int -> ActivityCounts -> ShowS
Show, forall x. Rep ActivityCounts x -> ActivityCounts
forall x. ActivityCounts -> Rep ActivityCounts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivityCounts x -> ActivityCounts
$cfrom :: forall x. ActivityCounts -> Rep ActivityCounts x
Generic, Value -> Parser [ActivityCounts]
Value -> Parser ActivityCounts
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivityCounts]
$cparseJSONList :: Value -> Parser [ActivityCounts]
parseJSON :: Value -> Parser ActivityCounts
$cparseJSON :: Value -> Parser ActivityCounts
Ae.FromJSON, [ActivityCounts] -> Encoding
[ActivityCounts] -> Value
ActivityCounts -> Encoding
ActivityCounts -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivityCounts] -> Encoding
$ctoEncodingList :: [ActivityCounts] -> Encoding
toJSONList :: [ActivityCounts] -> Value
$ctoJSONList :: [ActivityCounts] -> Value
toEncoding :: ActivityCounts -> Encoding
$ctoEncoding :: ActivityCounts -> Encoding
toJSON :: ActivityCounts -> Value
$ctoJSON :: ActivityCounts -> Value
Ae.ToJSON)
emptyActivityCount :: ActivityCounts
emptyActivityCount :: ActivityCounts
emptyActivityCount =
ActivityCounts
{ _tickStepBudget :: Int
_tickStepBudget = Int
0
, _tangibleCommandCount :: Int
_tangibleCommandCount = Int
0
, _commandsHistogram :: Map Const Int
_commandsHistogram = forall a. Monoid a => a
mempty
, _lifetimeStepCount :: Int
_lifetimeStepCount = Int
0
,
_activityWindow :: WindowedCounter TickNumber
_activityWindow = forall a. Int -> WindowedCounter a
mkWindow Int
64
}
makeLensesNoSigs ''ActivityCounts
tickStepBudget :: Lens' ActivityCounts Int
tangibleCommandCount :: Lens' ActivityCounts Int
commandsHistogram :: Lens' ActivityCounts (Map Const Int)
lifetimeStepCount :: Lens' ActivityCounts Int
activityWindow :: Lens' ActivityCounts (WindowedCounter TickNumber)
type family RobotLocation (phase :: RobotPhase) :: Data.Kind.Type where
RobotLocation 'TemplateRobot = Maybe (Cosmic Location)
RobotLocation 'ConcreteRobot = Cosmic Location
type family RobotID (phase :: RobotPhase) :: Data.Kind.Type where
RobotID 'TemplateRobot = ()
RobotID 'ConcreteRobot = RID
data RobotR (phase :: RobotPhase) = RobotR
{ forall (phase :: RobotPhase). RobotR phase -> Entity
_robotEntity :: Entity
, forall (phase :: RobotPhase). RobotR phase -> Inventory
_equippedDevices :: Inventory
, forall (phase :: RobotPhase). RobotR phase -> Set Capability
_robotCapabilities :: Set Capability
, forall (phase :: RobotPhase). RobotR phase -> Seq LogEntry
_robotLog :: Seq LogEntry
, forall (phase :: RobotPhase). RobotR phase -> Bool
_robotLogUpdated :: Bool
, forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation :: RobotLocation phase
, forall (phase :: RobotPhase). RobotR phase -> RobotContext
_robotContext :: RobotContext
, forall (phase :: RobotPhase). RobotR phase -> RobotID phase
_robotID :: RobotID phase
, forall (phase :: RobotPhase). RobotR phase -> Maybe Int
_robotParentID :: Maybe RID
, forall (phase :: RobotPhase). RobotR phase -> Bool
_robotHeavy :: Bool
, forall (phase :: RobotPhase). RobotR phase -> CESK
_machine :: CESK
, forall (phase :: RobotPhase). RobotR phase -> Bool
_systemRobot :: Bool
, forall (phase :: RobotPhase). RobotR phase -> Bool
_selfDestruct :: Bool
, forall (phase :: RobotPhase). RobotR phase -> ActivityCounts
_activityCounts :: ActivityCounts
, forall (phase :: RobotPhase). RobotR phase -> Bool
_runningAtomic :: Bool
, forall (phase :: RobotPhase). RobotR phase -> Set Var
_unwalkableEntities :: Set EntityName
, forall (phase :: RobotPhase). RobotR phase -> TimeSpec
_robotCreatedAt :: TimeSpec
}
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (phase :: RobotPhase) x.
Rep (RobotR phase) x -> RobotR phase
forall (phase :: RobotPhase) x.
RobotR phase -> Rep (RobotR phase) x
$cto :: forall (phase :: RobotPhase) x.
Rep (RobotR phase) x -> RobotR phase
$cfrom :: forall (phase :: RobotPhase) x.
RobotR phase -> Rep (RobotR phase) x
Generic)
deriving instance (Show (RobotLocation phase), Show (RobotID phase)) => Show (RobotR phase)
deriving instance (Eq (RobotLocation phase), Eq (RobotID phase)) => Eq (RobotR phase)
makeLensesExcluding ['_robotCapabilities, '_equippedDevices, '_robotLog] ''RobotR
type TRobot = RobotR 'TemplateRobot
type Robot = RobotR 'ConcreteRobot
instance ToSample Robot where
toSamples :: Proxy Robot -> [(Var, Robot)]
toSamples Proxy Robot
_ = forall a. a -> [(Var, a)]
SD.singleSample Robot
sampleBase
where
sampleBase :: Robot
sampleBase :: Robot
sampleBase =
forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot
Int
0
forall a. Maybe a
Nothing
Var
"base"
Document Syntax
"The starting robot."
Cosmic Location
defaultCosmicLocation
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
Display
defaultRobotDisplay
(ProcessedTerm -> Env -> Store -> CESK
initMachine [tmQ| move |] forall a. Monoid a => a
mempty Store
emptyStore)
[]
[]
Bool
False
Bool
False
forall a. Monoid a => a
mempty
TimeSpec
0
robotEntity :: Lens' (RobotR phase) Entity
unwalkableEntities :: Lens' Robot (Set EntityName)
robotCreatedAt :: Lens' Robot TimeSpec
robotName :: Lens' Robot Text
robotName :: Lens' Robot Var
robotName = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Var
entityName
trobotName :: Lens' TRobot Text
trobotName :: Lens' TRobot Var
trobotName = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Var
entityName
robotDisplay :: Lens' Robot Display
robotDisplay :: Lens' Robot Display
robotDisplay = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> Display
getDisplay forall {phase :: RobotPhase}.
RobotR phase -> Display -> RobotR phase
setDisplay
where
getDisplay :: Robot -> Display
getDisplay Robot
r =
(Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Display
entityDisplay)
forall a b. a -> (a -> b) -> b
& Lens' Display (Maybe Direction)
curOrientation forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Maybe Heading)
robotOrientation) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Heading -> Maybe Direction
toDirection)
setDisplay :: RobotR phase -> Display -> RobotR phase
setDisplay RobotR phase
r Display
d = RobotR phase
r forall a b. a -> (a -> b) -> b
& forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Display
entityDisplay forall s t a b. ASetter s t a b -> b -> s -> t
.~ Display
d
robotLocation :: Getter Robot (Cosmic Location)
unsafeSetRobotLocation :: Cosmic Location -> Robot -> Robot
unsafeSetRobotLocation :: Cosmic Location -> Robot -> Robot
unsafeSetRobotLocation Cosmic Location
loc Robot
r = Robot
r {_robotLocation :: RobotLocation 'ConcreteRobot
_robotLocation = Cosmic Location
loc}
trobotLocation :: Lens' TRobot (Maybe (Cosmic Location))
trobotLocation :: Lens' TRobot (Maybe (Cosmic Location))
trobotLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation (\TRobot
r Maybe (Cosmic Location)
l -> TRobot
r {_robotLocation :: RobotLocation 'TemplateRobot
_robotLocation = Maybe (Cosmic Location)
l})
robotOrientation :: Lens' Robot (Maybe Heading)
robotOrientation :: Lens' Robot (Maybe Heading)
robotOrientation = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity (Maybe Heading)
entityOrientation
robotInventory :: Lens' Robot Inventory
robotInventory :: Lens' Robot Inventory
robotInventory = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Inventory
entityInventory
robotContext :: Lens' Robot RobotContext
trobotContext :: Lens' TRobot RobotContext
trobotContext :: Lens' TRobot RobotContext
trobotContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> RobotContext
_robotContext (\TRobot
r RobotContext
c -> TRobot
r {_robotContext :: RobotContext
_robotContext = RobotContext
c})
robotID :: Getter Robot RID
instantiateRobot :: RID -> TRobot -> Robot
instantiateRobot :: Int -> TRobot -> Robot
instantiateRobot Int
i TRobot
r =
TRobot
r
{ _robotID :: RobotID 'ConcreteRobot
_robotID = Int
i
, _robotLocation :: RobotLocation 'ConcreteRobot
_robotLocation = forall a. a -> Maybe a -> a
fromMaybe Cosmic Location
defaultCosmicLocation forall a b. (a -> b) -> a -> b
$ forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation TRobot
r
}
robotParentID :: Lens' Robot (Maybe RID)
robotHeavy :: Lens' Robot Bool
equippedDevices :: Lens' Robot Inventory
equippedDevices :: Lens' Robot Inventory
equippedDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> Inventory
_equippedDevices forall {phase :: RobotPhase}.
RobotR phase -> Inventory -> RobotR phase
setEquipped
where
setEquipped :: RobotR phase -> Inventory -> RobotR phase
setEquipped RobotR phase
r Inventory
inst =
RobotR phase
r
{ _equippedDevices :: Inventory
_equippedDevices = Inventory
inst
, _robotCapabilities :: Set Capability
_robotCapabilities = Inventory -> Set Capability
inventoryCapabilities Inventory
inst
}
robotLog :: Lens' Robot (Seq LogEntry)
robotLog :: Lens' Robot (Seq LogEntry)
robotLog = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> Seq LogEntry
_robotLog forall {phase :: RobotPhase}.
RobotR phase -> Seq LogEntry -> RobotR phase
setLog
where
setLog :: RobotR phase -> Seq LogEntry -> RobotR phase
setLog RobotR phase
r Seq LogEntry
newLog =
RobotR phase
r
{ _robotLog :: Seq LogEntry
_robotLog = Seq LogEntry
newLog
,
_robotLogUpdated :: Bool
_robotLogUpdated =
forall (phase :: RobotPhase). RobotR phase -> Bool
_robotLogUpdated RobotR phase
r Bool -> Bool -> Bool
|| forall a. Seq a -> Int
Seq.length (forall (phase :: RobotPhase). RobotR phase -> Seq LogEntry
_robotLog RobotR phase
r) forall a. Eq a => a -> a -> Bool
/= forall a. Seq a -> Int
Seq.length Seq LogEntry
newLog
}
robotLogUpdated :: Lens' Robot Bool
inventoryHash :: Getter Robot Int
inventoryHash :: Getter Robot Int
inventoryHash = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\Robot
r -> Int
17 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Robot
r forall s a. s -> Getting a s a -> a
^. (forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Entity Int
entityHash)) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices))
robotKnows :: Robot -> Entity -> Bool
robotKnows :: Robot -> Entity -> Bool
robotKnows Robot
r Entity
e = Entity -> Inventory -> Bool
contains0plus Entity
e (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) Bool -> Bool -> Bool
|| Entity -> Inventory -> Bool
contains0plus Entity
e (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices)
robotCapabilities :: Getter Robot (Set Capability)
robotCapabilities :: Getter Robot (Set Capability)
robotCapabilities = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall (phase :: RobotPhase). RobotR phase -> Set Capability
_robotCapabilities
machine :: Lens' Robot CESK
systemRobot :: Lens' Robot Bool
selfDestruct :: Lens' Robot Bool
activityCounts :: Lens' Robot ActivityCounts
runningAtomic :: Lens' Robot Bool
mkRobot ::
RobotID phase ->
Maybe Int ->
Text ->
Document Syntax ->
RobotLocation phase ->
Heading ->
Display ->
CESK ->
[Entity] ->
[(Count, Entity)] ->
Bool ->
Bool ->
Set EntityName ->
TimeSpec ->
RobotR phase
mkRobot :: forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot RobotID phase
rid Maybe Int
pid Var
name Document Syntax
descr RobotLocation phase
loc Heading
dir Display
disp CESK
m [Entity]
devs [(Int, Entity)]
inv Bool
sys Bool
heavy Set Var
unwalkables TimeSpec
ts =
RobotR
{ _robotEntity :: Entity
_robotEntity =
Display
-> Var
-> Document Syntax
-> [EntityProperty]
-> [Capability]
-> Entity
mkEntity Display
disp Var
name Document Syntax
descr [] []
forall a b. a -> (a -> b) -> b
& Lens' Entity (Maybe Heading)
entityOrientation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Heading
dir
forall a b. a -> (a -> b) -> b
& Lens' Entity Inventory
entityInventory forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Int, Entity)] -> Inventory
fromElems [(Int, Entity)]
inv
, _equippedDevices :: Inventory
_equippedDevices = Inventory
inst
, _robotCapabilities :: Set Capability
_robotCapabilities = Inventory -> Set Capability
inventoryCapabilities Inventory
inst
, _robotLog :: Seq LogEntry
_robotLog = forall a. Seq a
Seq.empty
, _robotLogUpdated :: Bool
_robotLogUpdated = Bool
False
, _robotLocation :: RobotLocation phase
_robotLocation = RobotLocation phase
loc
, _robotContext :: RobotContext
_robotContext = RobotContext
emptyRobotContext
, _robotID :: RobotID phase
_robotID = RobotID phase
rid
, _robotParentID :: Maybe Int
_robotParentID = Maybe Int
pid
, _robotHeavy :: Bool
_robotHeavy = Bool
heavy
, _robotCreatedAt :: TimeSpec
_robotCreatedAt = TimeSpec
ts
, _machine :: CESK
_machine = CESK
m
, _systemRobot :: Bool
_systemRobot = Bool
sys
, _selfDestruct :: Bool
_selfDestruct = Bool
False
, _activityCounts :: ActivityCounts
_activityCounts = ActivityCounts
emptyActivityCount
, _runningAtomic :: Bool
_runningAtomic = Bool
False
, _unwalkableEntities :: Set Var
_unwalkableEntities = Set Var
unwalkables
}
where
inst :: Inventory
inst = [Entity] -> Inventory
fromList [Entity]
devs
instance FromJSONE EntityMap TRobot where
parseJSONE :: Value -> ParserE EntityMap TRobot
parseJSONE = forall e a.
String -> (Object -> ParserE e a) -> Value -> ParserE e a
withObjectE String
"robot" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
Bool
sys <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
let defDisplay :: Display
defDisplay = Display
defaultRobotDisplay forall a b. a -> (a -> b) -> b
& Lens' Display Bool
invisible forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
sys
forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot () forall a. Maybe a
Nothing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"loc")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dir" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (forall a b. a -> b -> a
const Display
defDisplay) (Object
v forall e a. FromJSONE e a => Object -> Var -> ParserE e (Maybe a)
..:? Var
"display" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= Display
defDisplay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Maybe ProcessedTerm -> CESK
mkMachine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"program"))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall e a. FromJSONE e a => Object -> Var -> ParserE e (Maybe a)
..:? Var
"devices" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall e a. FromJSONE e a => Object -> Var -> ParserE e (Maybe a)
..:? Var
"inventory" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
sys
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"heavy" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unwalkable" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= forall a. Monoid a => a
mempty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeSpec
0
where
mkMachine :: Maybe ProcessedTerm -> CESK
mkMachine Maybe ProcessedTerm
Nothing = Value -> Store -> Cont -> CESK
Out Value
VUnit Store
emptyStore []
mkMachine (Just ProcessedTerm
pt) = ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
pt forall a. Monoid a => a
mempty Store
emptyStore
(.=?) :: (Ae.KeyValue a, Ae.ToJSON v, Eq v) => Ae.Key -> v -> v -> Maybe a
.=? :: forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
(.=?) Key
n v
v v
defaultVal = if v
defaultVal forall a. Eq a => a -> a -> Bool
/= v
v then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
n forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Ae..= v
v else forall a. Maybe a
Nothing
(.==) :: (Ae.KeyValue a, Ae.ToJSON v) => Ae.Key -> v -> Maybe a
.== :: forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
(.==) Key
n v
v = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
n forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Ae..= v
v
instance Ae.ToJSON Robot where
toJSON :: Robot -> Value
toJSON Robot
r =
[Pair] -> Value
Ae.object forall a b. (a -> b) -> a -> b
$
forall a. [Maybe a] -> [a]
catMaybes
[ Key
"id" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot Int
robotID)
, Key
"name" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Display
entityDisplay)
, Key
"description" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity (Document Syntax)
entityDescription) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
, Key
"loc" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation)
, Key
"dir" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity (Maybe Heading)
entityOrientation) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
, Key
"display" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay) forall a b. (a -> b) -> a -> b
$ (Display
defaultRobotDisplay forall a b. a -> (a -> b) -> b
& Lens' Display Bool
invisible forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
sys)
, Key
"program" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine)
, Key
"devices" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Var
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices) forall a b. (a -> b) -> a -> b
$ []
, Key
"inventory" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (forall a b. (a -> b) -> [a] -> [b]
map (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity Var
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) forall a b. (a -> b) -> a -> b
$ []
, Key
"system" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? Bool
sys forall a b. (a -> b) -> a -> b
$ Bool
False
, Key
"heavy" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotHeavy) forall a b. (a -> b) -> a -> b
$ Bool
False
, Key
"log" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Seq LogEntry)
robotLog) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
,
Key
"capabilities" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Set Capability)
robotCapabilities) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
, Key
"logUpdated" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotLogUpdated) forall a b. (a -> b) -> a -> b
$ Bool
False
, Key
"context" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot RobotContext
robotContext) forall a b. (a -> b) -> a -> b
$ RobotContext
emptyRobotContext
, Key
"parent" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Maybe Int)
robotParentID) forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing
, Key
"createdAt" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot TimeSpec
robotCreatedAt) forall a b. (a -> b) -> a -> b
$ TimeSpec
0
, Key
"selfDestruct" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
selfDestruct) forall a b. (a -> b) -> a -> b
$ Bool
False
, Key
"activity" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts) forall a b. (a -> b) -> a -> b
$ ActivityCounts
emptyActivityCount
, Key
"runningAtomic" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
runningAtomic) forall a b. (a -> b) -> a -> b
$ Bool
False
]
where
sys :: Bool
sys = Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot
isActive :: Robot -> Bool
{-# INLINE isActive #-}
isActive :: Robot -> Bool
isActive = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Robot -> Maybe (Value, Store)
getResult
wantsToStep :: TickNumber -> Robot -> Bool
wantsToStep :: TickNumber -> Robot -> Bool
wantsToStep TickNumber
now Robot
robot
| Bool -> Bool
not (Robot -> Bool
isActive Robot
robot) = Bool
False
| Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (TickNumber
now forall a. Ord a => a -> a -> Bool
>=) (Robot -> Maybe TickNumber
waitingUntil Robot
robot)
waitingUntil :: Robot -> Maybe TickNumber
waitingUntil :: Robot -> Maybe TickNumber
waitingUntil Robot
robot =
case forall (phase :: RobotPhase). RobotR phase -> CESK
_machine Robot
robot of
Waiting TickNumber
time CESK
_ -> forall a. a -> Maybe a
Just TickNumber
time
CESK
_ -> forall a. Maybe a
Nothing
getResult :: Robot -> Maybe (Value, Store)
{-# INLINE getResult #-}
getResult :: Robot -> Maybe (Value, Store)
getResult = CESK -> Maybe (Value, Store)
finalValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot CESK
machine
hearingDistance :: (Num i) => i
hearingDistance :: forall i. Num i => i
hearingDistance = i
32