Commit 2ab02e34 authored by Haye Böhm's avatar Haye Böhm

Fix CI

parent 421ea9fb
Pipeline #13855 passed with stage
in 12 minutes and 49 seconds
......@@ -192,8 +192,8 @@ handleAlarm (me, (alarmLoc, detector), (actorLoc, actor), priority)
isFailed (MoveFailed _) = True
isFailed _ = False
taskToDo :: !(!Coord3D, !SectionStatus) !User !(Shared MySectionStatusMap) !(UserActorShare o a) !(Shared MySectionInventoryMap)
-> Task (MoveSt String)
taskToDo :: !(!Coord3D, !SectionStatus) !User !(sds1 () MySectionStatusMap MySectionStatusMap) !(UserActorShare o a) !(sds2 () MySectionInventoryMap MySectionInventoryMap)
-> Task (MoveSt String) | RWShared sds1 & RWShared sds2
taskToDo (alarmLoc, status) user shStatusMap shUserActor shInventoryMap
= viewSharedInformation ("Handle " <+++ toString status <+++ " in Section: " <+++ alarmLoc) [ViewAs todoTable] (sectionForUserShare user |*| myUserActorMap |*| shStatusMap |*| shInventoryMap |*| lockedExitsShare |*| lockedHopsShare |*| sharedGraph)
>>* [ OnAction (Action "Use Fire Extinguisher") (ifValue (mayUseExtinguisher status) (withUser useExtinquisher))
......
......@@ -5,4 +5,4 @@ import C2.Framework.MapEnvironment
import C2.Apps.ShipAdventure.Types
shipEditorTabs :: Task ()
sharedMapAction :: RWShared () (MapAction SectionStatus) (MapAction SectionStatus)
sharedMapAction :: SDSLens () (MapAction SectionStatus) (MapAction SectionStatus)
......@@ -53,7 +53,7 @@ importShip
doImport :: !String -> Task ()
doImport mapName
= getMap mapName
>>- \data -> set data (myInventoryMap >+< myNetwork >+< myCables >+< myDevices >+< maps2DShare)
>>- \data -> set data (myInventoryMap >*< myNetwork >*< myCables >*< myDevices >*< maps2DShare)
>>| viewInformation "Ship imported" [] "Ship imported"
>>| importShip @! ()
......@@ -101,11 +101,11 @@ mapTitleFontSize =: 10.0
********************************************************************************************************************/
viewLayout = updateMapStatus EditMode @! ()
sharedMapAction :: RWShared () (MapAction SectionStatus) (MapAction SectionStatus)
sharedMapAction :: SDSLens () (MapAction SectionStatus) (MapAction SectionStatus)
sharedMapAction = sharedStore "sharedMapAction" (FocusOnMap 0) // start at the top-level (all maps)
sharedEditShip :: RWShared () (Maps2D,MapAction SectionStatus) (Maps2D,MapAction SectionStatus)
sharedEditShip = maps2DShare >+< sharedMapAction
sharedEditShip :: SDSParallel () (Maps2D,MapAction SectionStatus) (Maps2D,MapAction SectionStatus)
sharedEditShip = maps2DShare >*< sharedMapAction
manageDevices :: Task ()
manageDevices
......@@ -170,7 +170,7 @@ derive class iTask EditDeviceType, EditDevice
manageCables :: Task ()
manageCables = intMapCrudWith "Cables" [ChooseFromGrid id] [] [] [] (\cable -> cable.Cable.cableId) myCables @! ()
intMapCrud :: !String !(r -> Int) !(RWShared () (IntMap r) (IntMap r)) -> Task r | iTask r
intMapCrud :: !String !(r -> Int) !(SDSLens () (IntMap r) (IntMap r)) -> Task r | iTask r
intMapCrud descr mkId share = crud descr 'DIS'.elems (putItem mkId) (delItem mkId) share
where
putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
......@@ -178,7 +178,7 @@ intMapCrud descr mkId share = crud descr 'DIS'.elems (putItem mkId) (delItem mkI
delItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
delItem mkId item allItems = 'DIS'.del (mkId item) allItems
intMapCrudWith :: !String ![ChoiceOption r] [EnterOption r] [ViewOption r] [UpdateOption r r] !(r -> Int) !(RWShared () (IntMap r) (IntMap r)) -> Task r | iTask r
intMapCrudWith :: !String ![ChoiceOption r] [EnterOption r] [ViewOption r] [UpdateOption r r] !(r -> Int) !(SDSLens () (IntMap r) (IntMap r)) -> Task r | iTask r
intMapCrudWith descr cos eos vos uos mkId share = crudWith descr cos eos vos uos 'DIS'.elems (putItem mkId) (delItem mkId) share
where
putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
......@@ -261,17 +261,17 @@ editSectionContents
\mid c2d -> let focusedShare = sdsFocus (mid, c2d) devicesInSectionShare
in updateSectionEditor (mkDesc mid c2d "Devices")
[ChooseFromCheckGroup (\d -> d.Device.description)]
(mapRead mrf (myDevices |+< focusedShare)) focusedShare
(mapRead mrf (myDevices |*< focusedShare)) focusedShare
)
, withSelectedSection (
\mid c2d -> let focusedShare = sdsFocus (mid, c2d) cablesInSectionShare
in updateSectionEditor (mkDesc mid c2d "Cables")
[ChooseFromCheckGroup (\d -> d.Cable.description)]
(mapRead ('DIS'.elems o fst) (myCables |+< focusedShare)) focusedShare
(mapRead ('DIS'.elems o fst) (myCables |*< focusedShare)) focusedShare
)
] @! () //TODO <<@ ApplyLayout layout @! ()
where
updateSectionEditor :: !String ![ChoiceOption a] (Shared [a]) (Shared [a]) -> Task [a] | iTask a
updateSectionEditor :: !String ![ChoiceOption a] (sds1 () [a] [a]) (sds2 () [a] [a]) -> Task [a] | iTask a & RWShared sds1 & RWShared sds2
updateSectionEditor d updOpts listShare focusedShare
= editSharedMultipleChoiceWithShared (Title d) updOpts listShare focusedShare
......
......@@ -25,9 +25,9 @@ import C2.Apps.ShipAdventure.Types
derive class iTask Target, Script, Condition
handleFireScript :: Shared [Script]
handleFloodScript :: Shared [Script]
handleSmokeScript :: Shared [Script]
handleFireScript :: SDSLens () [Script] [Script]
handleFloodScript :: SDSLens () [Script] [Script]
handleSmokeScript :: SDSLens () [Script] [Script]
changeFireScript :: Task ()
changeFloodScript :: Task ()
......
......@@ -12,13 +12,13 @@ import qualified Data.Map as DM
derive class iTask Target, Script, Condition
handleFireScript :: Shared [Script]
handleFireScript :: SDSLens () [Script] [Script]
handleFireScript = sharedStore "handleFireScript" []
handleFloodScript :: Shared [Script]
handleFloodScript :: SDSLens () [Script] [Script]
handleFloodScript = sharedStore "handleFloodScript" []
handleSmokeScript :: Shared [Script]
handleSmokeScript :: SDSLens () [Script] [Script]
handleSmokeScript = sharedStore "handleSmokeScript" []
changeFireScript :: Task ()
......@@ -30,7 +30,7 @@ changeFloodScript = changeScript "Handling Flood" handleFloodScript
changeSmokeScript :: Task ()
changeSmokeScript = changeScript "Handling Smoke" handleSmokeScript
changeScript :: !String !(Shared [Script]) -> Task ()
changeScript :: !String !(sds () [Script] [Script]) -> Task () | RWShared sds
changeScript prompt script
= viewSharedInformation ("Current Script: " <+++ prompt) [ViewAs (\script -> [toString i +++ " : " +++ line \\ line <- map toSingleLineText script & i <- [1..]])] script
>>* [ OnAction (Action "Fine") (always (return ()))
......
......@@ -149,32 +149,32 @@ instance toString Device
// shared stores:
myUserActorMap :: UserActorShare ObjectType ActorStatus
myStatusMap :: RWShared () MySectionStatusMap MySectionStatusMap
myInventoryMap :: RWShared () MySectionInventoryMap MySectionInventoryMap
myNetwork :: RWShared () Network Network
myCables :: RWShared () (IntMap Cable) (IntMap Cable)
myDevices :: RWShared () (IntMap Device) (IntMap Device)
commandAims :: RWShared () [CommandAim] [CommandAim]
capabilityMap :: RWShared () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
disabledSections :: RWShared () (Set Coord3D) (Set Coord3D)
deviceKindsForCapability :: RWShared Capability CapabilityExpr CapabilityExpr
statusInSectionShare :: RWShared Coord3D SectionStatus SectionStatus
myStatusMap :: SDSLens () MySectionStatusMap MySectionStatusMap
myInventoryMap :: SDSLens () MySectionInventoryMap MySectionInventoryMap
myNetwork :: SDSLens () Network Network
myCables :: SDSLens () (IntMap Cable) (IntMap Cable)
myDevices :: SDSLens () (IntMap Device) (IntMap Device)
commandAims :: SDSLens () [CommandAim] [CommandAim]
capabilityMap :: SDSLens () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
disabledSections :: SDSLens () (Set Coord3D) (Set Coord3D)
deviceKindsForCapability :: SDSLens Capability CapabilityExpr CapabilityExpr
statusInSectionShare :: SDSLens Coord3D SectionStatus SectionStatus
inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType
deviceIdInNetworkSectionShare :: RWShared Coord3D [DeviceId] [DeviceId]
devicesInSectionShare :: RWShared Coord3D [Device] [Device]
deviceWithIdShare :: RWShared DeviceId Device Device
cableWithIdShare :: RWShared CableId Cable Cable
cablesInSectionShare :: RWShared Coord3D [Cable] [Cable]
deviceIdInNetworkSectionShare :: SDSLens Coord3D [DeviceId] [DeviceId]
devicesInSectionShare :: SDSSequence Coord3D [Device] [Device]
deviceWithIdShare :: SDSLens DeviceId Device Device
cableWithIdShare :: SDSLens CableId Cable Cable
cablesInSectionShare :: SDSLens Coord3D [Cable] [Cable]
cablesForSection :: !Coord3D !Network -> [Cable]
allActiveAlarms :: ReadOnlyShared [(!Coord3D, !SectionStatus)]
allAvailableActors :: ReadOnlyShared [(!Coord3D, !MyActor)]
allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
// setting and resetting of the detection systems:
setAlarm :: !User !(!Coord3D, !SectionStatus) !(Shared MySectionStatusMap) -> Task ()
setAlarm :: !User !(!Coord3D, !SectionStatus) !(sds () MySectionStatusMap MySectionStatusMap) -> Task () | RWShared sds
// making images from a map
......
......@@ -88,17 +88,17 @@ instance == Capability where
myUserActorMap :: UserActorShare ObjectType ActorStatus
myUserActorMap = sharedStore "myUserActorMap" 'DM'.newMap
myStatusMap :: RWShared () MySectionStatusMap MySectionStatusMap
myStatusMap :: SDSLens () MySectionStatusMap MySectionStatusMap
myStatusMap = sharedStore "myStatusMap" 'DM'.newMap
statusInSectionShare :: RWShared Coord3D SectionStatus SectionStatus
statusInSectionShare :: SDSLens Coord3D SectionStatus SectionStatus
statusInSectionShare = mapLens "statusInSectionShare" myStatusMap (Just NormalStatus)
deviceKindsForCapability :: RWShared Capability CapabilityExpr CapabilityExpr
deviceKindsForCapability :: SDSLens Capability CapabilityExpr CapabilityExpr
deviceKindsForCapability
= mapLens "deviceKindsForCapability" capabilityMap Nothing
myInventoryMap :: RWShared () MySectionInventoryMap MySectionInventoryMap
myInventoryMap :: SDSLens () MySectionInventoryMap MySectionInventoryMap
myInventoryMap = sharedStore "myInventoryMap" 'DM'.newMap
viewDisabledDevices :: Task ()
......@@ -279,11 +279,11 @@ mkAllSensors sd hs ws
// my physical mapping of the devices in a network
deviceWithIdShare :: RWShared DeviceId Device Device
deviceWithIdShare :: SDSLens DeviceId Device Device
deviceWithIdShare = intMapLens "deviceWithIdShare" myDevices Nothing
deviceIdInNetworkSectionShare :: RWShared Coord3D [DeviceId] [DeviceId]
deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) myNetwork
deviceIdInNetworkSectionShare :: SDSLens Coord3D [DeviceId] [DeviceId]
deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing myNetwork
where
read :: !Coord3D !Network -> MaybeError TaskException [DeviceId]
read c3d network = Ok (fromMaybe [] ('DM'.get c3d network.devices))
......@@ -294,7 +294,7 @@ deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const (
notify :: !Coord3D !Network ![DeviceId] -> SDSNotifyPred Coord3D
notify c3d network devIds = \_ idx` -> c3d == idx`
devicesInSectionShare :: RWShared Coord3D [Device] [Device]
devicesInSectionShare :: SDSSequence Coord3D [Device] [Device]
devicesInSectionShare
= sdsSequence "devicesInSectionShare" id mkP2 (\_ _ -> Right mkR) (SDSWrite write1) (SDSWrite write2) deviceIdInNetworkSectionShare myDevices
where
......@@ -307,7 +307,7 @@ devicesInSectionShare
write2 :: Coord3D !(IntMap Device) ![Device] -> MaybeError TaskException (Maybe (IntMap Device))
write2 _ deviceMap devices = Ok (Just (foldr (\device deviceMap -> 'DIS'.put device.Device.deviceId device deviceMap) deviceMap devices))
myDevices :: RWShared () (IntMap Device) (IntMap Device)
myDevices :: SDSLens () (IntMap Device) (IntMap Device)
myDevices = sharedStore "myDevices" devices
where
devices = 'DIS'.fromList [ f dt
......@@ -316,10 +316,10 @@ myDevices = sharedStore "myDevices" devices
f :: !Device -> (!DeviceId, !Device)
f dev = (dev.Device.deviceId, dev)
commandAims :: RWShared () [CommandAim] [CommandAim]
commandAims :: SDSLens () [CommandAim] [CommandAim]
commandAims = sharedStore "commandAims" []
capabilityMap :: RWShared () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
capabilityMap :: SDSLens () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
capabilityMap = sharedStore "capabilityMap" ('DM'.fromList defaultList)
where
defaultList
......@@ -339,7 +339,7 @@ instance * CapabilityExpr where
cap :: DeviceKind -> CapabilityExpr
cap k = DeviceExpr k
myNetwork :: RWShared () Network Network
myNetwork :: SDSLens () Network Network
myNetwork = sharedStore "myNetwork"
{ Network
| devices = 'DM'.newMap
......@@ -347,16 +347,16 @@ myNetwork = sharedStore "myNetwork"
, cableMapping = 'DIS'.newMap
}
myCables :: RWShared () (IntMap Cable) (IntMap Cable)
myCables = sdsProject (SDSLensRead read) (SDSLensWrite write) myNetwork
myCables :: SDSLens () (IntMap Cable) (IntMap Cable)
myCables = sdsProject (SDSLensRead read) (SDSLensWrite write) Nothing myNetwork
where
read :: !Network -> MaybeError TaskException (IntMap Cable)
read { Network | cables } = Ok cables
write :: !Network !(IntMap Cable) -> MaybeError TaskException (Maybe Network)
write network cables = Ok (Just {network & cables = cables})
cablesInSectionShare :: RWShared Coord3D [Cable] [Cable]
cablesInSectionShare = sdsLens "cablesInSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) myNetwork
cablesInSectionShare :: SDSLens Coord3D [Cable] [Cable]
cablesInSectionShare = sdsLens "cablesInSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing myNetwork
where
read :: !Coord3D !Network -> MaybeError TaskException [Cable]
read c3d network = Ok (cablesForSection c3d network)
......@@ -375,7 +375,7 @@ cablesForSection c3d { Network | cables, cableMapping }
[] -> []
xs -> [cable \\ Just cable <- (map (\cid -> 'DIS'.get cid cables) xs)]
cableWithIdShare :: RWShared CableId Cable Cable
cableWithIdShare :: SDSLens CableId Cable Cable
cableWithIdShare = intMapLens "cableWithIdShare" myCables Nothing
cutCable :: !Coord3D !CableId !Network -> Network
......@@ -387,9 +387,9 @@ patchCable roomNo cableId network = { network & cableMapping = 'DIS'.alter (fmap
inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType
inventoryInSectionShare = mapLens "inventoryInSectionShare" myInventoryMap (Just 'DIS'.newMap)
allAvailableActors :: ReadOnlyShared [(!Coord3D, !MyActor)]
allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
allAvailableActors
= /*toReadOnly */ (sdsProject (SDSLensRead readActors) SDSNoWrite (sectionUsersShare |*| myUserActorMap))
= /*toReadOnly */ (sdsProject (SDSLensRead readActors) (SDSLensWrite \_ _. Ok Nothing) Nothing (sectionUsersShare |*| myUserActorMap))
where
readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(!Coord3D, !MyActor)]
readActors (sectionUsersMap, userActorMap)
......@@ -398,9 +398,9 @@ allAvailableActors
, Just (c3d, a) <- [findUser u sectionUsersMap userActorMap]
| a.actorStatus.occupied === Available]
allActiveAlarms :: ReadOnlyShared [(!Coord3D, !SectionStatus)]
allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allActiveAlarms
= /*toReadOnly */ (sdsProject (SDSLensRead readAlarms) SDSNoWrite myStatusMap)
= /*toReadOnly */ (sdsProject (SDSLensRead readAlarms) (SDSLensWrite \_ _. Ok Nothing) Nothing myStatusMap)
where
readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(!Coord3D, !SectionStatus)]
readAlarms statusMap = Ok [ (number, status) \\ (number, status) <- 'DM'.toList statusMap
......@@ -437,7 +437,7 @@ where
, updModel = \((((((((((disSects, _), exitLocks), hopLocks), inventoryMap), statusMap), sectionUsersMap), userActorMap), network), allDevices), _) (ms2d`, cl`) -> ((((((((((disSects, ms2d`), exitLocks), hopLocks), inventoryMap), statusMap), sectionUsersMap), userActorMap), network), allDevices), cl`)
}
disabledSections :: RWShared () (Set Coord3D) (Set Coord3D)
disabledSections :: SDSLens () (Set Coord3D) (Set Coord3D)
disabledSections = sharedStore "disabledSections" 'DS'.newSet
updateSectionStatus :: !Coord3D -> Task (MapAction SectionStatus)
......@@ -456,12 +456,12 @@ where
-> ((((((((ms2d`, exitLocks), hopLocks), inventoryMap), statusMap), actorMap), network), allDevices), cl`)
}
setAlarm :: !User !(!Coord3D, !SectionStatus) !(Shared MySectionStatusMap) -> Task ()
setAlarm :: !User !(!Coord3D, !SectionStatus) !(sds () MySectionStatusMap MySectionStatusMap) -> Task () | RWShared sds
setAlarm user (alarmLoc, status) shStatusMap
= setSectionStatus alarmLoc status shStatusMap
>>| addLog user "" ("Resets " <+++ status <+++ " in Section " <+++ alarmLoc <+++ " to False.")
setSectionStatus :: !Coord3D !SectionStatus !(Shared (SectionStatusMap SectionStatus)) -> Task ()
setSectionStatus :: !Coord3D !SectionStatus !(sds () (SectionStatusMap SectionStatus) (SectionStatusMap SectionStatus)) -> Task () | RWShared sds
setSectionStatus roomNumber status statusMap
= upd ('DM'.put roomNumber status) statusMap @! ()
......
......@@ -16,23 +16,22 @@ from C2.Framework.ContactPosition import :: ContactMapPerspective
derive class iTask MapState
mapState :: RWShared () MapState MapState
mapState :: SDSLens () MapState MapState
entityMap :: RWShared () EntityMap EntityMap
entityMap :: SDSLens () EntityMap EntityMap
registerEntity :: (Int -> Entity) -> Task Entity
updateEntity :: Int (Entity -> Entity) -> Task ()
contactWithId :: RWShared Int (Maybe Entity) Entity
contactWithId :: SDSLens Int (Maybe Entity) Entity
selectedContactShare :: RWShared () (Maybe Entity) Entity
selectedContactShare :: SDSLens () (Maybe Entity) Entity
resetMapState :: Task ()
periodicallyUpdateEntity :: !Int -> Task ()
mapView :: (RWShared () r w) (r -> Bool) User [Entity] -> Task () | iTask r & iTask w
mapView :: (sds () r w) (r -> Bool) User [Entity] -> Task () | iTask r & iTask w & RWShared sds
userMapState :: User -> Shared MapState
userMapState :: User -> SDSLens () MapState MapState
......@@ -23,11 +23,11 @@ defSettings =
, selection = -1
}
mapState :: RWShared () MapState MapState
mapState :: SDSLens () MapState MapState
mapState = sharedStore "mapState" defSettings
selectedContactShare :: RWShared () (Maybe Entity) Entity
selectedContactShare = sdsLens "selectedContactShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) mapState
selectedContactShare :: SDSLens () (Maybe Entity) Entity
selectedContactShare = sdsLens "selectedContactShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing mapState
where
read :: () MapState -> MaybeError TaskException (Maybe Entity)
read _ {selection, entities} = Ok ('DIS'.get selection entities)
......@@ -38,10 +38,10 @@ selectedContactShare = sdsLens "selectedContactShare" (const ()) (SDSRead read)
notify :: () MapState Entity -> SDSNotifyPred ()
notify _ _ _ = \_ _ -> False
userMapState :: User -> Shared MapState
userMapState :: User -> SDSLens () MapState MapState
userMapState u = sharedStore ("userMapState" +++ toString u) defSettings
entityMap :: RWShared () EntityMap EntityMap
entityMap :: SDSLens () EntityMap EntityMap
entityMap = sharedStore "entityMap" 'DIS'.newMap
registerEntity :: (Int -> Entity) -> Task Entity
......@@ -60,8 +60,8 @@ updateEntity n f
Just e -> set (f e) focus @! ()
_ -> return ()
contactWithId :: RWShared Int (Maybe Entity) Entity
contactWithId = sdsLens "contactWithId" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) mapState
contactWithId :: SDSLens Int (Maybe Entity) Entity
contactWithId = sdsLens "contactWithId" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing mapState
where
read :: Int MapState -> MaybeError TaskException (Maybe Entity)
read idx {entities} = Ok ('DIS'.get idx entities)
......@@ -79,7 +79,7 @@ periodicallyUpdateEntity :: !Int -> Task ()
periodicallyUpdateEntity n = updateEntity n moveEntity // TODO FIXME PERFORMANCE doTaskPeriodically 1 (updateEntity n moveEntity) <<@ NoUserInterface
mapView` :: User [Entity] -> Task ()
mapView` currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (userMapState currentUser >+< entityMap) @! ())
mapView` currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (userMapState currentUser >*< entityMap) @! ())
where
toMap :: (MapState, EntityMap) -> LeafletMap
toMap ({MapState | perspective}, markers)
......@@ -104,7 +104,7 @@ mapView` currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (
_ = (markers, st)
mapView :: (RWShared () r w) (r -> Bool) User [Entity] -> Task () | iTask r & iTask w
mapView :: (sds () r w) (r -> Bool) User [Entity] -> Task () | iTask r & iTask w & RWShared sds
mapView sh radarWorks currentUser es = (updateSharedInformation () [UpdateAs toMap fromMap] (mapState >*| sh) @! ())
where
toMap ({perspective, entities = markers}, shval)
......
......@@ -31,6 +31,6 @@ addCancebleTaskForUser :: String User TaskPrio (User -> Task a) -> Task (Maybe
// creates a watch on a store: task is added to the side panel tasks of user as soon as condition is met
// if priority is Immediate the task is started in the main workspace
makeWatchTask :: String User TaskPrio (RWShared () r w) (r -> Bool) (r -> Task ()) -> Task () | iTask r
makeWatchTask :: String User TaskPrio (sds () r w) (r -> Bool) (r -> Task ()) -> Task () | iTask r & RWShared sds & TC w
addNotification :: String -> Task ()
......@@ -121,22 +121,22 @@ addTaskForUserAndReport des user sender prio task = addTaskForUser des user prio
extask user = task user >>= \res -> addTaskForUser ("Result: " +++ des) sender prio (\_ -> viewRes res)
viewRes res = viewInformation "Result" [] res
makeWatchTask :: String User TaskPrio (RWShared () r w) (r -> Bool) (r -> Task ()) -> Task () | iTask r
makeWatchTask :: String User TaskPrio (sds () r w) (r -> Bool) (r -> Task ()) -> Task () | iTask r & RWShared sds & TC w
makeWatchTask des executer prio store cond task
= addTaskForUser des executer prio (watchTask store cond task)
where
watchTask :: (RWShared () r w) (r -> Bool) (r -> Task ()) User -> Task () | iTask r
watchTask :: (sds () r w) (r -> Bool) (r -> Task ()) User -> Task () | iTask r & RWShared sds & TC w
watchTask store cond task user = watch store >>* [OnValue (ifValue cond task)] @! ()
makeWorkspaceTab :: String (Workspace -> Task a) Workspace -> Task () | iTask a
makeWorkspaceTab title t ws = t ws <<@ (Title title) @! ()
//Notifications are stored newest first
notifications :: Shared [(DateTime,String)]
notifications :: SDSLens () [(DateTime,String)] [(DateTime,String)]
notifications = sharedStore "notifications" []
//Only show notifications added in the last 5 seconds
currentNotifications :: ReadOnlyShared [String]
currentNotifications :: SDSLens () [String] ()
currentNotifications = mapRead prj (currentDateTime |*| notifications)
where
prj :: (DateTime,[(DateTime, String)]) -> [String]
......@@ -151,12 +151,12 @@ addNotification msg
viewNotifications :: Task ()
viewNotifications = viewSharedInformation () [ViewAs (join ", ")] currentNotifications @! ()
tasksToDo :: ROShared () [(TaskId, WorklistRow)]
tasksToDo :: SDSLens () [(TaskId, WorklistRow)] ()
tasksToDo = taskForCurrentUser isToDo
where
isToDo {TaskListItem|attributes} = fmap (\x -> toInt x == toInt Immediate) ('DM'.get "priority" attributes) == Just True
incomingTasks :: ROShared () [(TaskId, WorklistRow)]
incomingTasks :: SDSLens () [(TaskId, WorklistRow)] ()
incomingTasks = taskForCurrentUser isIncoming
where
isIncoming {TaskListItem|attributes} = fmap (\x -> toInt x /= toInt Immediate) ('DM'.get "priority" attributes) == Just True
......
......@@ -12,7 +12,7 @@ derive class iTask Log
// shared store for logging events
myLog :: Shared [Log]
myLog :: SDSLens () [Log] [Log]
// tasks for logging:
......
......@@ -4,7 +4,7 @@ import iTasks
derive class iTask Log
myLog :: Shared [Log] // logging events
myLog :: SDSLens () [Log] [Log] // logging events
myLog = sharedStore "myLog" []
addLog :: !a !b !c -> Task () | toString a & toString b & toString c
......
......@@ -80,8 +80,8 @@ instance == Border
}
:: UserActorMap objType actorStatus :== Map User (Actor objType actorStatus)
:: UserActorShare objType actorStatus :== RWShared () (UserActorMap objType actorStatus) (UserActorMap objType actorStatus)
:: FocusedUserActorShare objType actorStatus :== RWShared User (Maybe (Actor objType actorStatus)) (Actor objType actorStatus)
:: UserActorShare objType actorStatus :== SDSLens () (UserActorMap objType actorStatus) (UserActorMap objType actorStatus)
:: FocusedUserActorShare objType actorStatus :== SDSLens User (Maybe (Actor objType actorStatus)) (Actor objType actorStatus)
:: SectionStatusMap roomStatus :== Map Coord3D roomStatus // [Coord3D |-> roomStatus]
:: SectionInventoryMap objType :== Map Coord3D (IntMap (Object objType)) // [Coord3D |-> [ObjId |-> Object]]
......@@ -90,39 +90,39 @@ instance == Border
:: SectionHopLockMap :== Map Coord3D [Coord3D]
:: SectionStatusShare roomStatus :== RWShared () (SectionStatusMap roomStatus) (SectionStatusMap roomStatus) // [Coord3D |-> roomStatus]
:: SectionInventoryShare objType :== RWShared () (SectionInventoryMap objType) (SectionInventoryMap objType) // [Coord3D |-> [ObjId |-> Object]]
:: SectionUsersShare :== RWShared () SectionUsersMap SectionUsersMap
:: FocusedSectionStatusShare roomStatus :== RWShared Coord3D roomStatus roomStatus // [Coord3D |-> roomStatus]
:: FocusedSectionInventoryShare objType :== RWShared Coord3D (IntMap (Object objType)) (IntMap (Object objType)) // [Coord3D |-> [ObjId |-> Object]]
:: FocusedSectionUsersShare :== RWShared Coord3D [User] [User]
:: SectionStatusShare roomStatus :== SDSLens () (SectionStatusMap roomStatus) (SectionStatusMap roomStatus) // [Coord3D |-> roomStatus]
:: SectionInventoryShare objType :== SDSLens () (SectionInventoryMap objType) (SectionInventoryMap objType) // [Coord3D |-> [ObjId |-> Object]]
:: SectionUsersShare :== SDSLens () SectionUsersMap SectionUsersMap
:: FocusedSectionStatusShare roomStatus :== SDSLens Coord3D roomStatus roomStatus // [Coord3D |-> roomStatus]
:: FocusedSectionInventoryShare objType :== SDSLens Coord3D (IntMap (Object objType)) (IntMap (Object objType)) // [Coord3D |-> [ObjId |-> Object]]
:: FocusedSectionUsersShare :== SDSLens Coord3D [User] [User]
:: DrawMapForActor r o a :== User (Shared (SectionStatusMap r)) (UserActorShare o a) (Shared (SectionInventoryMap o)) -> Task ()
:: DrawMapForActor r o a :== User (SDSLens () (SectionStatusMap r) (SectionStatusMap r)) (UserActorShare o a) (SDSLens () (SectionInventoryMap o) (SectionInventoryMap o)) -> Task ()
instance == (Actor o a)
instance == (Object obj) | == obj
maps2DShare :: RWShared () Maps2D Maps2D
maps2DShare :: SDSLens () Maps2D Maps2D
sharedGraph :: RWShared () Graph ()
sharedGraph :: SDSLens () Graph ()
sectionUsersShare :: SectionUsersShare
sectionForUserShare :: User -> RWShared () (Maybe Coord3D) SectionUsersMap
sectionForUserShare :: User -> SDSLens () (Maybe Coord3D) SectionUsersMap
focusedSectionUsersShare :: FocusedSectionUsersShare
lockedExitsShare :: RWShared () SectionExitLockMap SectionExitLockMap
lockedExitsShare :: SDSLens () SectionExitLockMap SectionExitLockMap
lockStatusForExit :: RWShared Coord3D [Dir] [Dir]
lockStatusForExit :: SDSLens Coord3D [Dir] [Dir]
lockedHopsShare :: RWShared () SectionHopLockMap SectionHopLockMap
lockedHopsShare :: SDSLens () SectionHopLockMap SectionHopLockMap
lockStatusForHop :: RWShared Coord3D [Coord3D] [Coord3D]
lockStatusForHop :: SDSLens Coord3D [Coord3D] [Coord3D]
sectionForUser :: !User !SectionUsersMap -> Maybe Coord3D
actorsInSectionShare :: (UserActorShare o a) -> RWShared Coord3D [Actor o a] [Actor o a] | iTask o & iTask a
actorsInSectionShare :: (UserActorShare o a) -> SDSLens Coord3D [Actor o a] [Actor o a] | iTask o & iTask a
actorForUserShare :: (UserActorShare o a) -> FocusedUserActorShare o a | iTask o & iTask a
......@@ -165,8 +165,8 @@ maps2DToGraph :: !Maps2D -> Graph
autoMove :: !Coord3D !Coord3D
!(Coord3D Coord3D (SectionStatusMap r) SectionExitLockMap SectionHopLockMap Graph -> Maybe ([Coord3D], Distance))
!User !(Shared (SectionStatusMap r)) !(UserActorShare o a)
-> Task Bool | iTask r & iTask o & iTask a
!User !(sds () (SectionStatusMap r) (SectionStatusMap r)) !(UserActorShare o a)
-> Task Bool | iTask r & iTask o & iTask a & RWShared sds
pickupObject :: !Coord3D !(Object o) !User !(UserActorShare o a) !(FocusedSectionInventoryShare o)
-> Task () | iTask o & iTask a
dropObject :: !Coord3D !(Object o) !User !(UserActorShare o a) !(FocusedSectionInventoryShare o)
......
......@@ -70,11 +70,11 @@ instance == Border where
infinity =: 67108864
maps2DShare :: RWShared () Maps2D Maps2D
maps2DShare :: SDSLens () Maps2D Maps2D
maps2DShare = sharedStore "maps2DShare" []
sharedGraph :: RWShared () Graph ()
sharedGraph = sdsLens "sharedGraph" (const ()) (SDSRead read) (SDSWriteConst write) (SDSNotifyConst notify) maps2DShare
sharedGraph :: SDSLens () Graph ()
sharedGraph = sdsLens "sharedGraph" (const ()) (SDSRead read) (SDSWriteConst write) (SDSNotifyConst notify) Nothing maps2DShare
where
read _ m = Ok (maps2DToGraph m)
......@@ -85,13 +85,13 @@ sharedGraph = sdsLens "sharedGraph" (const ()) (SDSRead read) (SDSWriteConst wri
sectionUsersShare :: SectionUsersShare
sectionUsersShare = sharedStore "sectionUsersShare" 'DM'.newMap
sectionForUserShare :: User -> RWShared () (Maybe Coord3D) SectionUsersMap
sectionForUserShare :: User -> SDSLens () (Maybe Coord3D) SectionUsersMap
sectionForUserShare user = mapRead (sectionForUser user) sectionUsersShare
focusedSectionUsersShare :: FocusedSectionUsersShare
focusedSectionUsersShare = mapLens "focusedSectionUsersShare" sectionUsersShare (Just [])
inventoryForUserSection :: !User !(FocusedSectionInventoryShare o) -> RWShared () (IntMap (Object o)) (IntMap (Object o)) | iTask o
inventoryForUserSection :: !User !(FocusedSectionInventoryShare o) -> SDSSequence () (IntMap (Object o)) (IntMap (Object o)) | iTask o
inventoryForUserSection user inventoryForSectionShare = sdsSequence ("inventoryForUserSection" +++ toString user) id mkP2 (\_ _ -> Right mkr) (SDSWrite write1) (SDSWrite write2) (sectionForUserShare user) inventoryForSectionShare
where
mkP2 p (Just c3d) = c3d
......@@ -100,16 +100,16 @@ inventoryForUserSection user inventoryForSectionShare = sdsSequence ("inventoryF
write1 p r1 w = Ok Nothing
write2 p r2 w = Ok (Just w)
lockedExitsShare :: RWShared () SectionExitLockMap SectionExitLockMap
lockedExitsShare :: SDSLens () SectionExitLockMap SectionExitLockMap
lockedExitsShare = sharedStore "lockedExitsShare" 'DM'.newMap
lockStatusForExit :: RWShared Coord3D [Dir] [Dir]
lockStatusForExit :: SDSLens Coord3D [Dir] [Dir]
lockStatusForExit = mapLens "lockStatusForExit" lockedExitsShare (Just [])
lockedHopsShare :: RWShared () SectionHopLockMap SectionHopLockMap
lockedHopsShare :: SDSLens () SectionHopLockMap SectionHopLockMap
lockedHopsShare = sharedStore "lockedHopsShare" 'DM'.newMap
lockStatusForHop :: RWShared Coord3D [Coord3D] [Coord3D]
lockStatusForHop :: SDSLens Coord3D [Coord3D] [Coord3D]
lockStatusForHop = mapLens "lockStatusForHop" lockedHopsShare (Just [])
maps2DToGraph :: !Maps2D -> Graph
......@@ -457,16 +457,16 @@ moveAround viewDeck user inventoryForSectionShare
prettyPrintHops = ChooseFromGrid prettyHop
prettyPrintItems = ChooseFromGrid prettyItem
nearbyHops :: ReadOnlyShared [(Coord3D, Coord3D)]
nearbyHops :: SDSLens () [(Coord3D, Coord3D)] ()
nearbyHops = toReadOnly (mapRead getHops (roomNoForCurrentUserShare |*| maps2DShare))
roomNoForCurrentUserShare :: ReadOnlyShared (Maybe Coord3D)
roomNoForCurrentUserShare :: SDSLens () (Maybe Coord3D) ()
roomNoForCurrentUserShare = toReadOnly (sectionForUserShare user)
inventoryShare :: (UserActorShare o a) -> ReadOnlyShared [Object o] | iTask o & iTask a
inventoryShare :: (UserActorShare o a) -> SDSLens () [Object o] () | iTask o & iTask a
inventoryShare userToActorShare = toReadOnly (mapRead carriedObjects (sdsFocus user (actorForUserShare userToActorShare)))
nearbyItemsShare :: (FocusedSectionInventoryShare o) -> ReadOnlyShared [Object o] | iTask o
nearbyItemsShare :: (FocusedSectionInventoryShare o) -> SDSLens () [Object o] () | iTask o
nearbyItemsShare inventoryForSectionShare = toReadOnly (mapRead 'DIS'.elems (inventoryForUserSection user inventoryForSectionShare))
getHops :: (Maybe Coord3D, Maps2D) -> [(Coord3D, Coord3D)]
......@@ -515,8 +515,8 @@ moveAround viewDeck user inventoryForSectionShare
_ = False
changeDeck _ = Nothing
sectionForSectionNumberShare :: RWShared Coord3D (Maybe Section) Section
sectionForSectionNumberShare = sdsLens "sectionForSectionNumberShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) maps2DShare
sectionForSectionNumberShare :: SDSLens Coord3D (Maybe Section) Section
sectionForSectionNumberShare = sdsLens "sectionForSectionNumberShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing maps2DShare
where
read :: Coord3D Maps2D -> MaybeError TaskException (Maybe Section)
read c3d ms2d = Ok (getSectionFromMap c3d ms2d)
......@@ -587,8 +587,8 @@ getObjectOfType {Actor | carrying} objType` = case [obj \\ obj <- carrying | obj
autoMove :: !Coord3D !Coord3D
!(Coord3D Coord3D (SectionStatusMap r) SectionExitLockMap SectionHopLockMap Graph -> Maybe ([Coord3D], Distance))
!User !(Shared (SectionStatusMap r)) !(UserActorShare o a)
-> Task Bool | iTask r & iTask o & iTask a
!User !(sds () (SectionStatusMap r) (SectionStatusMap r)) !(UserActorShare o a)
-> Task Bool | iTask r & iTask o & iTask a & RWShared sds
autoMove thisSection target pathFun user shipStatusShare userToActorShare
| thisSection == target = return True
| otherwise
......@@ -622,8 +622,8 @@ updActorStatus user upd userToActorShare
sectionForUser :: !User !SectionUsersMap -> Maybe Coord3D
sectionForUser u sectionUsersMap = listToMaybe [k \\ (k, us) <- 'DM'.toList sectionUsersMap, u` <- us | u` == u]
actorsInSectionShare :: (UserActorShare o a) -> RWShared Coord3D [Actor o a] [Actor o a] | iTask o & iTask a
actorsInSectionShare userActorShare = sdsLens "actorsInSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) (sectionUsersShare >*< userActorShare)
actorsInSectionShare :: (UserActorShare o a) -> SDSLens Coord3D [Actor o a] [Actor o a] | iTask o & iTask a
actorsInSectionShare userActorShare = sdsLens "actorsInSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing (sectionUsersShare >*< userActorShare)
where
read :: Coord3D (SectionUsersMap, UserActorMap o a) -> MaybeError TaskException [Actor o a]
read c3d (sectionUsersMap, userActorMap) = Ok [a \\ Just us <- ['DM'.get c3d sectionUsersMap], u <- us, Just a <- ['DM'.get u userActorMap]]
......
......@@ -24,15 +24,15 @@ derive class iTask Location
/* Utility tasks */
editSharedList :: (Shared [a]) -> Task () | iTask a
editSharedList :: (sds () [a] [a]) -> Task () | iTask a & RWShared sds
editSharedListWithTask :: (a -> Task a) (Shared [a]) -> Task () | iTask a
editSharedListWithTask :: (a -> Task a) (sds () [a] [a]) -> Task () | iTask a & RWShared sds
editSharedListWithTaskTask :: (Task a) (a -> Task a) (Shared [a]) -> Task () | iTask a
editSharedListWithTaskTask :: (Task a) (a -> Task a) (sds () [a] [a]) -> Task () | iTask a & RWShared sds
editSharedListGeneric :: [EditSharedListOption a] (Shared [a]) -> Task () | iTask a
editSharedListGeneric :: [EditSharedListOption a] (sds () [a] [a]) -> Task () | iTask a & RWShared sds
updateItemInSharedList :: a (a -> Bool) (Shared [a]) -> Task [a] | iTask a
updateItemInSharedList :: a (a -> Bool) (sds () [a] [a]) -> Task [a] | iTask a & RWShared sds
doOrClose :: (Task a) -> Task (Maybe a) | iTask a
......@@ -56,11 +56,11 @@ chatDialog :: User [Entity] -> Task ()
editChats :: Task ()
chats :: Shared [ChatMessage]
chats :: SDSLens () [ChatMessage] [ChatMessage]
viewChats :: Int -> Task ()
debugstore :: Shared [String]
debugstore :: SDSLens () [String] [String]
addDebug :: String -> Task ()
......
......@@ -16,22 +16,22 @@ derive class iTask Location
/* Utility tasks */
editSharedList :: (Shared [a]) -> Task () | iTask a
editSharedList :: (sds () [a] [a]) -> Task () | iTask a & RWShared sds
editSharedList list
= editSharedListWithTask (updateInformation "Item Info" []) list
editSharedListWithTask :: (a -> Task a) (Shared [a]) -> Task () | iTask a
editSharedListWithTask :: (a -> Task a) (sds () [a] [a]) -> Task () | iTask a & RWShared sds
editSharedListWithTask tupdate list
= editSharedListWithTaskTask (enterInformation "Enter new item" []) tupdate list
editSharedListWithTaskTask :: (Task a) (a -> Task a) (Shared [a])-> Task () | iTask a
editSharedListWithTaskTask :: (Task a) (a -> Task a) (sds () [a] [a])-> Task () | iTask a & RWShared sds