{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.Game.Robot (
LogSource (..),
LogEntry (..),
leText,
leSaid,
leRobotName,
leTime,
leLocation,
leRobotID,
RobotPhase (..),
RID,
RobotR,
Robot,
TRobot,
RobotContext,
defTypes,
defReqs,
defVals,
defStore,
robotEntity,
robotName,
trobotName,
robotCreatedAt,
robotDisplay,
robotLocation,
unsafeSetRobotLocation,
trobotLocation,
robotOrientation,
robotInventory,
installedDevices,
robotLog,
robotLogUpdated,
inventoryHash,
robotCapabilities,
robotContext,
robotID,
robotParentID,
robotHeavy,
machine,
systemRobot,
selfDestruct,
tickSteps,
runningAtomic,
mkRobot,
instantiateRobot,
robotKnows,
isActive,
waitingUntil,
getResult,
hearingDistance,
) where
import Control.Lens hiding (contains)
import Data.Aeson (FromJSON, ToJSON)
import Data.Hashable (hashWithSalt)
import Data.Int (Int64)
import Data.Maybe (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 Swarm.Game.CESK
import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Value as V
import Swarm.Language.Capability (Capability)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Requirement (ReqCtx)
import Swarm.Language.Syntax (toDirection)
import Swarm.Language.Types (TCtx)
import Swarm.Util ()
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
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
ToJSON)
makeLenses ''RobotContext
data LogSource = Said | Logged | ErrorTrace
deriving (Int -> LogSource -> ShowS
[LogSource] -> ShowS
LogSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogSource] -> ShowS
$cshowList :: [LogSource] -> ShowS
show :: LogSource -> String
$cshow :: LogSource -> String
showsPrec :: Int -> LogSource -> ShowS
$cshowsPrec :: Int -> LogSource -> ShowS
Show, LogSource -> LogSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogSource -> LogSource -> Bool
$c/= :: LogSource -> LogSource -> Bool
== :: LogSource -> LogSource -> Bool
$c== :: LogSource -> LogSource -> Bool
Eq, Eq LogSource
LogSource -> LogSource -> Bool
LogSource -> LogSource -> Ordering
LogSource -> LogSource -> LogSource
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogSource -> LogSource -> LogSource
$cmin :: LogSource -> LogSource -> LogSource
max :: LogSource -> LogSource -> LogSource
$cmax :: LogSource -> LogSource -> LogSource
>= :: LogSource -> LogSource -> Bool
$c>= :: LogSource -> LogSource -> Bool
> :: LogSource -> LogSource -> Bool
$c> :: LogSource -> LogSource -> Bool
<= :: LogSource -> LogSource -> Bool
$c<= :: LogSource -> LogSource -> Bool
< :: LogSource -> LogSource -> Bool
$c< :: LogSource -> LogSource -> Bool
compare :: LogSource -> LogSource -> Ordering
$ccompare :: LogSource -> LogSource -> Ordering
Ord, forall x. Rep LogSource x -> LogSource
forall x. LogSource -> Rep LogSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogSource x -> LogSource
$cfrom :: forall x. LogSource -> Rep LogSource x
Generic, Value -> Parser [LogSource]
Value -> Parser LogSource
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LogSource]
$cparseJSONList :: Value -> Parser [LogSource]
parseJSON :: Value -> Parser LogSource
$cparseJSON :: Value -> Parser LogSource
FromJSON, [LogSource] -> Encoding
[LogSource] -> Value
LogSource -> Encoding
LogSource -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LogSource] -> Encoding
$ctoEncodingList :: [LogSource] -> Encoding
toJSONList :: [LogSource] -> Value
$ctoJSONList :: [LogSource] -> Value
toEncoding :: LogSource -> Encoding
$ctoEncoding :: LogSource -> Encoding
toJSON :: LogSource -> Value
$ctoJSON :: LogSource -> Value
ToJSON)
data LogEntry = LogEntry
{
LogEntry -> Integer
_leTime :: Integer
,
LogEntry -> LogSource
_leSaid :: LogSource
,
LogEntry -> Text
_leRobotName :: Text
,
LogEntry -> Int
_leRobotID :: Int
,
LogEntry -> V2 Int64
_leLocation :: V2 Int64
,
LogEntry -> Text
_leText :: Text
}
deriving (Int -> LogEntry -> ShowS
[LogEntry] -> ShowS
LogEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogEntry] -> ShowS
$cshowList :: [LogEntry] -> ShowS
show :: LogEntry -> String
$cshow :: LogEntry -> String
showsPrec :: Int -> LogEntry -> ShowS
$cshowsPrec :: Int -> LogEntry -> ShowS
Show, LogEntry -> LogEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogEntry -> LogEntry -> Bool
$c/= :: LogEntry -> LogEntry -> Bool
== :: LogEntry -> LogEntry -> Bool
$c== :: LogEntry -> LogEntry -> Bool
Eq, Eq LogEntry
LogEntry -> LogEntry -> Bool
LogEntry -> LogEntry -> Ordering
LogEntry -> LogEntry -> LogEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogEntry -> LogEntry -> LogEntry
$cmin :: LogEntry -> LogEntry -> LogEntry
max :: LogEntry -> LogEntry -> LogEntry
$cmax :: LogEntry -> LogEntry -> LogEntry
>= :: LogEntry -> LogEntry -> Bool
$c>= :: LogEntry -> LogEntry -> Bool
> :: LogEntry -> LogEntry -> Bool
$c> :: LogEntry -> LogEntry -> Bool
<= :: LogEntry -> LogEntry -> Bool
$c<= :: LogEntry -> LogEntry -> Bool
< :: LogEntry -> LogEntry -> Bool
$c< :: LogEntry -> LogEntry -> Bool
compare :: LogEntry -> LogEntry -> Ordering
$ccompare :: LogEntry -> LogEntry -> Ordering
Ord, forall x. Rep LogEntry x -> LogEntry
forall x. LogEntry -> Rep LogEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogEntry x -> LogEntry
$cfrom :: forall x. LogEntry -> Rep LogEntry x
Generic, Value -> Parser [LogEntry]
Value -> Parser LogEntry
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LogEntry]
$cparseJSONList :: Value -> Parser [LogEntry]
parseJSON :: Value -> Parser LogEntry
$cparseJSON :: Value -> Parser LogEntry
FromJSON, [LogEntry] -> Encoding
[LogEntry] -> Value
LogEntry -> Encoding
LogEntry -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LogEntry] -> Encoding
$ctoEncodingList :: [LogEntry] -> Encoding
toJSONList :: [LogEntry] -> Value
$ctoJSONList :: [LogEntry] -> Value
toEncoding :: LogEntry -> Encoding
$ctoEncoding :: LogEntry -> Encoding
toJSON :: LogEntry -> Value
$ctoJSON :: LogEntry -> Value
ToJSON)
makeLenses ''LogEntry
type RID = Int
data RobotPhase
=
TemplateRobot
|
ConcreteRobot
type family RobotLocation (phase :: RobotPhase) :: * where
RobotLocation 'TemplateRobot = Maybe (V2 Int64)
RobotLocation 'ConcreteRobot = V2 Int64
type family RobotID (phase :: RobotPhase) :: * 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
_installedDevices :: 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 -> Int
_tickSteps :: Int
, forall (phase :: RobotPhase). RobotR phase -> Bool
_runningAtomic :: Bool
, 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)
deriving instance (ToJSON (RobotLocation phase), ToJSON (RobotID phase)) => ToJSON (RobotR phase)
let exclude = ['_robotCapabilities, '_installedDevices, '_robotLog]
in makeLensesWith
( lensRules
& generateSignatures .~ False
& lensField . mapped . mapped %~ \fn n ->
if n `elem` exclude then [] else fn n
)
''RobotR
type TRobot = RobotR 'TemplateRobot
type Robot = RobotR 'ConcreteRobot
robotEntity :: Lens' (RobotR phase) Entity
robotCreatedAt :: Lens' Robot TimeSpec
robotName :: Lens' Robot Text
robotName :: Lens' Robot Text
robotName = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Text
entityName
trobotName :: Lens' TRobot Text
trobotName :: Lens' TRobot Text
trobotName = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Text
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 (V2 Int64))
robotOrientation) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= V2 Int64 -> 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 (V2 Int64)
unsafeSetRobotLocation :: V2 Int64 -> Robot -> Robot
unsafeSetRobotLocation :: V2 Int64 -> Robot -> Robot
unsafeSetRobotLocation V2 Int64
loc Robot
r = Robot
r {_robotLocation :: RobotLocation 'ConcreteRobot
_robotLocation = V2 Int64
loc}
trobotLocation :: Lens' TRobot (Maybe (V2 Int64))
trobotLocation :: Lens' TRobot (Maybe (V2 Int64))
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 (V2 Int64)
l -> TRobot
r {_robotLocation :: RobotLocation 'TemplateRobot
_robotLocation = Maybe (V2 Int64)
l})
robotOrientation :: Lens' Robot (Maybe (V2 Int64))
robotOrientation :: Lens' Robot (Maybe (V2 Int64))
robotOrientation = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity (Maybe (V2 Int64))
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
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 (forall a. a -> a -> V2 a
V2 Int64
0 Int64
0) (forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation TRobot
r)
}
robotParentID :: Lens' Robot (Maybe RID)
robotHeavy :: Lens' Robot Bool
installedDevices :: Lens' Robot Inventory
installedDevices :: Lens' Robot Inventory
installedDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> Inventory
_installedDevices forall {phase :: RobotPhase}.
RobotR phase -> Inventory -> RobotR phase
setInstalled
where
setInstalled :: RobotR phase -> Inventory -> RobotR phase
setInstalled RobotR phase
r Inventory
inst =
RobotR phase
r
{ _installedDevices :: Inventory
_installedDevices = 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
installedDevices))
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
installedDevices)
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
tickSteps :: Lens' Robot Int
runningAtomic :: Lens' Robot Bool
mkRobot ::
RobotID phase ->
Maybe Int ->
Text ->
[Text] ->
RobotLocation phase ->
V2 Int64 ->
Display ->
CESK ->
[Entity] ->
[(Count, Entity)] ->
Bool ->
Bool ->
TimeSpec ->
RobotR phase
mkRobot :: forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Text
-> [Text]
-> RobotLocation phase
-> V2 Int64
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> TimeSpec
-> RobotR phase
mkRobot RobotID phase
rid Maybe Int
pid Text
name [Text]
descr RobotLocation phase
loc V2 Int64
dir Display
disp CESK
m [Entity]
devs [(Int, Entity)]
inv Bool
sys Bool
heavy TimeSpec
ts =
RobotR
{ _robotEntity :: Entity
_robotEntity =
Display
-> Text -> [Text] -> [EntityProperty] -> [Capability] -> Entity
mkEntity Display
disp Text
name [Text]
descr [] []
forall a b. a -> (a -> b) -> b
& Lens' Entity (Maybe (V2 Int64))
entityOrientation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ V2 Int64
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
, _installedDevices :: Inventory
_installedDevices = 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 = 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
, _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
, _tickSteps :: Int
_tickSteps = Int
0
, _runningAtomic :: Bool
_runningAtomic = Bool
False
}
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 ->
forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Text
-> [Text]
-> RobotLocation phase
-> V2 Int64
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> 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 (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 (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"display" forall a. Parser (Maybe a) -> a -> Parser a
.!= Display
defaultRobotDisplay)
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 -> Text -> ParserE e (Maybe a)
..:? Text
"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 -> Text -> ParserE e (Maybe a)
..:? Text
"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 e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system" 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
"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. 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
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
waitingUntil :: Robot -> Maybe Integer
waitingUntil :: Robot -> Maybe Integer
waitingUntil Robot
robot =
case forall (phase :: RobotPhase). RobotR phase -> CESK
_machine Robot
robot of
Waiting Integer
time CESK
_ -> forall a. a -> Maybe a
Just Integer
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