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) ...@@ -192,8 +192,8 @@ handleAlarm (me, (alarmLoc, detector), (actorLoc, actor), priority)
isFailed (MoveFailed _) = True isFailed (MoveFailed _) = True
isFailed _ = False isFailed _ = False
taskToDo :: !(!Coord3D, !SectionStatus) !User !(Shared MySectionStatusMap) !(UserActorShare o a) !(Shared MySectionInventoryMap) taskToDo :: !(!Coord3D, !SectionStatus) !User !(sds1 () MySectionStatusMap MySectionStatusMap) !(UserActorShare o a) !(sds2 () MySectionInventoryMap MySectionInventoryMap)
-> Task (MoveSt String) -> Task (MoveSt String) | RWShared sds1 & RWShared sds2
taskToDo (alarmLoc, status) user shStatusMap shUserActor shInventoryMap taskToDo (alarmLoc, status) user shStatusMap shUserActor shInventoryMap
= viewSharedInformation ("Handle " <+++ toString status <+++ " in Section: " <+++ alarmLoc) [ViewAs todoTable] (sectionForUserShare user |*| myUserActorMap |*| shStatusMap |*| shInventoryMap |*| lockedExitsShare |*| lockedHopsShare |*| sharedGraph) = 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)) >>* [ OnAction (Action "Use Fire Extinguisher") (ifValue (mayUseExtinguisher status) (withUser useExtinquisher))
......
...@@ -5,4 +5,4 @@ import C2.Framework.MapEnvironment ...@@ -5,4 +5,4 @@ import C2.Framework.MapEnvironment
import C2.Apps.ShipAdventure.Types import C2.Apps.ShipAdventure.Types
shipEditorTabs :: Task () shipEditorTabs :: Task ()
sharedMapAction :: RWShared () (MapAction SectionStatus) (MapAction SectionStatus) sharedMapAction :: SDSLens () (MapAction SectionStatus) (MapAction SectionStatus)
...@@ -53,7 +53,7 @@ importShip ...@@ -53,7 +53,7 @@ importShip
doImport :: !String -> Task () doImport :: !String -> Task ()
doImport mapName doImport mapName
= getMap mapName = getMap mapName
>>- \data -> set data (myInventoryMap >+< myNetwork >+< myCables >+< myDevices >+< maps2DShare) >>- \data -> set data (myInventoryMap >*< myNetwork >*< myCables >*< myDevices >*< maps2DShare)
>>| viewInformation "Ship imported" [] "Ship imported" >>| viewInformation "Ship imported" [] "Ship imported"
>>| importShip @! () >>| importShip @! ()
...@@ -101,11 +101,11 @@ mapTitleFontSize =: 10.0 ...@@ -101,11 +101,11 @@ mapTitleFontSize =: 10.0
********************************************************************************************************************/ ********************************************************************************************************************/
viewLayout = updateMapStatus EditMode @! () 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) sharedMapAction = sharedStore "sharedMapAction" (FocusOnMap 0) // start at the top-level (all maps)
sharedEditShip :: RWShared () (Maps2D,MapAction SectionStatus) (Maps2D,MapAction SectionStatus) sharedEditShip :: SDSParallel () (Maps2D,MapAction SectionStatus) (Maps2D,MapAction SectionStatus)
sharedEditShip = maps2DShare >+< sharedMapAction sharedEditShip = maps2DShare >*< sharedMapAction
manageDevices :: Task () manageDevices :: Task ()
manageDevices manageDevices
...@@ -170,7 +170,7 @@ derive class iTask EditDeviceType, EditDevice ...@@ -170,7 +170,7 @@ derive class iTask EditDeviceType, EditDevice
manageCables :: Task () manageCables :: Task ()
manageCables = intMapCrudWith "Cables" [ChooseFromGrid id] [] [] [] (\cable -> cable.Cable.cableId) myCables @! () 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 intMapCrud descr mkId share = crud descr 'DIS'.elems (putItem mkId) (delItem mkId) share
where where
putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
...@@ -178,7 +178,7 @@ intMapCrud descr mkId share = crud descr 'DIS'.elems (putItem mkId) (delItem mkI ...@@ -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 :: !(r -> Int) !r !(IntMap r) -> IntMap r
delItem mkId item allItems = 'DIS'.del (mkId item) allItems 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 intMapCrudWith descr cos eos vos uos mkId share = crudWith descr cos eos vos uos 'DIS'.elems (putItem mkId) (delItem mkId) share
where where
putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r putItem :: !(r -> Int) !r !(IntMap r) -> IntMap r
...@@ -261,17 +261,17 @@ editSectionContents ...@@ -261,17 +261,17 @@ editSectionContents
\mid c2d -> let focusedShare = sdsFocus (mid, c2d) devicesInSectionShare \mid c2d -> let focusedShare = sdsFocus (mid, c2d) devicesInSectionShare
in updateSectionEditor (mkDesc mid c2d "Devices") in updateSectionEditor (mkDesc mid c2d "Devices")
[ChooseFromCheckGroup (\d -> d.Device.description)] [ChooseFromCheckGroup (\d -> d.Device.description)]
(mapRead mrf (myDevices |+< focusedShare)) focusedShare (mapRead mrf (myDevices |*< focusedShare)) focusedShare
) )
, withSelectedSection ( , withSelectedSection (
\mid c2d -> let focusedShare = sdsFocus (mid, c2d) cablesInSectionShare \mid c2d -> let focusedShare = sdsFocus (mid, c2d) cablesInSectionShare
in updateSectionEditor (mkDesc mid c2d "Cables") in updateSectionEditor (mkDesc mid c2d "Cables")
[ChooseFromCheckGroup (\d -> d.Cable.description)] [ChooseFromCheckGroup (\d -> d.Cable.description)]
(mapRead ('DIS'.elems o fst) (myCables |+< focusedShare)) focusedShare (mapRead ('DIS'.elems o fst) (myCables |*< focusedShare)) focusedShare
) )
] @! () //TODO <<@ ApplyLayout layout @! () ] @! () //TODO <<@ ApplyLayout layout @! ()
where 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 updateSectionEditor d updOpts listShare focusedShare
= editSharedMultipleChoiceWithShared (Title d) updOpts listShare focusedShare = editSharedMultipleChoiceWithShared (Title d) updOpts listShare focusedShare
......
...@@ -25,9 +25,9 @@ import C2.Apps.ShipAdventure.Types ...@@ -25,9 +25,9 @@ import C2.Apps.ShipAdventure.Types
derive class iTask Target, Script, Condition derive class iTask Target, Script, Condition
handleFireScript :: Shared [Script] handleFireScript :: SDSLens () [Script] [Script]
handleFloodScript :: Shared [Script] handleFloodScript :: SDSLens () [Script] [Script]
handleSmokeScript :: Shared [Script] handleSmokeScript :: SDSLens () [Script] [Script]
changeFireScript :: Task () changeFireScript :: Task ()
changeFloodScript :: Task () changeFloodScript :: Task ()
......
...@@ -12,13 +12,13 @@ import qualified Data.Map as DM ...@@ -12,13 +12,13 @@ import qualified Data.Map as DM
derive class iTask Target, Script, Condition derive class iTask Target, Script, Condition
handleFireScript :: Shared [Script] handleFireScript :: SDSLens () [Script] [Script]
handleFireScript = sharedStore "handleFireScript" [] handleFireScript = sharedStore "handleFireScript" []
handleFloodScript :: Shared [Script] handleFloodScript :: SDSLens () [Script] [Script]
handleFloodScript = sharedStore "handleFloodScript" [] handleFloodScript = sharedStore "handleFloodScript" []
handleSmokeScript :: Shared [Script] handleSmokeScript :: SDSLens () [Script] [Script]
handleSmokeScript = sharedStore "handleSmokeScript" [] handleSmokeScript = sharedStore "handleSmokeScript" []
changeFireScript :: Task () changeFireScript :: Task ()
...@@ -30,7 +30,7 @@ changeFloodScript = changeScript "Handling Flood" handleFloodScript ...@@ -30,7 +30,7 @@ changeFloodScript = changeScript "Handling Flood" handleFloodScript
changeSmokeScript :: Task () changeSmokeScript :: Task ()
changeSmokeScript = changeScript "Handling Smoke" handleSmokeScript changeSmokeScript = changeScript "Handling Smoke" handleSmokeScript
changeScript :: !String !(Shared [Script]) -> Task () changeScript :: !String !(sds () [Script] [Script]) -> Task () | RWShared sds
changeScript prompt script changeScript prompt script
= viewSharedInformation ("Current Script: " <+++ prompt) [ViewAs (\script -> [toString i +++ " : " +++ line \\ line <- map toSingleLineText script & i <- [1..]])] script = viewSharedInformation ("Current Script: " <+++ prompt) [ViewAs (\script -> [toString i +++ " : " +++ line \\ line <- map toSingleLineText script & i <- [1..]])] script
>>* [ OnAction (Action "Fine") (always (return ())) >>* [ OnAction (Action "Fine") (always (return ()))
......
...@@ -149,32 +149,32 @@ instance toString Device ...@@ -149,32 +149,32 @@ instance toString Device
// shared stores: // shared stores:
myUserActorMap :: UserActorShare ObjectType ActorStatus myUserActorMap :: UserActorShare ObjectType ActorStatus
myStatusMap :: RWShared () MySectionStatusMap MySectionStatusMap myStatusMap :: SDSLens () MySectionStatusMap MySectionStatusMap
myInventoryMap :: RWShared () MySectionInventoryMap MySectionInventoryMap myInventoryMap :: SDSLens () MySectionInventoryMap MySectionInventoryMap
myNetwork :: RWShared () Network Network myNetwork :: SDSLens () Network Network
myCables :: RWShared () (IntMap Cable) (IntMap Cable) myCables :: SDSLens () (IntMap Cable) (IntMap Cable)
myDevices :: RWShared () (IntMap Device) (IntMap Device) myDevices :: SDSLens () (IntMap Device) (IntMap Device)
commandAims :: RWShared () [CommandAim] [CommandAim] commandAims :: SDSLens () [CommandAim] [CommandAim]
capabilityMap :: RWShared () CapabilityToDeviceKindMap CapabilityToDeviceKindMap capabilityMap :: SDSLens () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
disabledSections :: RWShared () (Set Coord3D) (Set Coord3D) disabledSections :: SDSLens () (Set Coord3D) (Set Coord3D)
deviceKindsForCapability :: RWShared Capability CapabilityExpr CapabilityExpr deviceKindsForCapability :: SDSLens Capability CapabilityExpr CapabilityExpr
statusInSectionShare :: RWShared Coord3D SectionStatus SectionStatus statusInSectionShare :: SDSLens Coord3D SectionStatus SectionStatus
inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType
deviceIdInNetworkSectionShare :: RWShared Coord3D [DeviceId] [DeviceId] deviceIdInNetworkSectionShare :: SDSLens Coord3D [DeviceId] [DeviceId]
devicesInSectionShare :: RWShared Coord3D [Device] [Device] devicesInSectionShare :: SDSSequence Coord3D [Device] [Device]
deviceWithIdShare :: RWShared DeviceId Device Device deviceWithIdShare :: SDSLens DeviceId Device Device
cableWithIdShare :: RWShared CableId Cable Cable cableWithIdShare :: SDSLens CableId Cable Cable
cablesInSectionShare :: RWShared Coord3D [Cable] [Cable] cablesInSectionShare :: SDSLens Coord3D [Cable] [Cable]
cablesForSection :: !Coord3D !Network -> [Cable] cablesForSection :: !Coord3D !Network -> [Cable]
allActiveAlarms :: ReadOnlyShared [(!Coord3D, !SectionStatus)] allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allAvailableActors :: ReadOnlyShared [(!Coord3D, !MyActor)] allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
// setting and resetting of the detection systems: // 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 // making images from a map
......
...@@ -88,17 +88,17 @@ instance == Capability where ...@@ -88,17 +88,17 @@ instance == Capability where
myUserActorMap :: UserActorShare ObjectType ActorStatus myUserActorMap :: UserActorShare ObjectType ActorStatus
myUserActorMap = sharedStore "myUserActorMap" 'DM'.newMap myUserActorMap = sharedStore "myUserActorMap" 'DM'.newMap
myStatusMap :: RWShared () MySectionStatusMap MySectionStatusMap myStatusMap :: SDSLens () MySectionStatusMap MySectionStatusMap
myStatusMap = sharedStore "myStatusMap" 'DM'.newMap myStatusMap = sharedStore "myStatusMap" 'DM'.newMap
statusInSectionShare :: RWShared Coord3D SectionStatus SectionStatus statusInSectionShare :: SDSLens Coord3D SectionStatus SectionStatus
statusInSectionShare = mapLens "statusInSectionShare" myStatusMap (Just NormalStatus) statusInSectionShare = mapLens "statusInSectionShare" myStatusMap (Just NormalStatus)
deviceKindsForCapability :: RWShared Capability CapabilityExpr CapabilityExpr deviceKindsForCapability :: SDSLens Capability CapabilityExpr CapabilityExpr
deviceKindsForCapability deviceKindsForCapability
= mapLens "deviceKindsForCapability" capabilityMap Nothing = mapLens "deviceKindsForCapability" capabilityMap Nothing
myInventoryMap :: RWShared () MySectionInventoryMap MySectionInventoryMap myInventoryMap :: SDSLens () MySectionInventoryMap MySectionInventoryMap
myInventoryMap = sharedStore "myInventoryMap" 'DM'.newMap myInventoryMap = sharedStore "myInventoryMap" 'DM'.newMap
viewDisabledDevices :: Task () viewDisabledDevices :: Task ()
...@@ -279,11 +279,11 @@ mkAllSensors sd hs ws ...@@ -279,11 +279,11 @@ mkAllSensors sd hs ws
// my physical mapping of the devices in a network // my physical mapping of the devices in a network
deviceWithIdShare :: RWShared DeviceId Device Device deviceWithIdShare :: SDSLens DeviceId Device Device
deviceWithIdShare = intMapLens "deviceWithIdShare" myDevices Nothing deviceWithIdShare = intMapLens "deviceWithIdShare" myDevices Nothing
deviceIdInNetworkSectionShare :: RWShared Coord3D [DeviceId] [DeviceId] deviceIdInNetworkSectionShare :: SDSLens Coord3D [DeviceId] [DeviceId]
deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) myNetwork deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing myNetwork
where where
read :: !Coord3D !Network -> MaybeError TaskException [DeviceId] read :: !Coord3D !Network -> MaybeError TaskException [DeviceId]
read c3d network = Ok (fromMaybe [] ('DM'.get c3d network.devices)) read c3d network = Ok (fromMaybe [] ('DM'.get c3d network.devices))
...@@ -294,7 +294,7 @@ deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const ( ...@@ -294,7 +294,7 @@ deviceIdInNetworkSectionShare = sdsLens "deviceIdInNetworkSectionShare" (const (
notify :: !Coord3D !Network ![DeviceId] -> SDSNotifyPred Coord3D notify :: !Coord3D !Network ![DeviceId] -> SDSNotifyPred Coord3D
notify c3d network devIds = \_ idx` -> c3d == idx` notify c3d network devIds = \_ idx` -> c3d == idx`
devicesInSectionShare :: RWShared Coord3D [Device] [Device] devicesInSectionShare :: SDSSequence Coord3D [Device] [Device]
devicesInSectionShare devicesInSectionShare
= sdsSequence "devicesInSectionShare" id mkP2 (\_ _ -> Right mkR) (SDSWrite write1) (SDSWrite write2) deviceIdInNetworkSectionShare myDevices = sdsSequence "devicesInSectionShare" id mkP2 (\_ _ -> Right mkR) (SDSWrite write1) (SDSWrite write2) deviceIdInNetworkSectionShare myDevices
where where
...@@ -307,7 +307,7 @@ devicesInSectionShare ...@@ -307,7 +307,7 @@ devicesInSectionShare
write2 :: Coord3D !(IntMap Device) ![Device] -> MaybeError TaskException (Maybe (IntMap Device)) 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)) 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 myDevices = sharedStore "myDevices" devices
where where
devices = 'DIS'.fromList [ f dt devices = 'DIS'.fromList [ f dt
...@@ -316,10 +316,10 @@ myDevices = sharedStore "myDevices" devices ...@@ -316,10 +316,10 @@ myDevices = sharedStore "myDevices" devices
f :: !Device -> (!DeviceId, !Device) f :: !Device -> (!DeviceId, !Device)
f dev = (dev.Device.deviceId, dev) f dev = (dev.Device.deviceId, dev)
commandAims :: RWShared () [CommandAim] [CommandAim] commandAims :: SDSLens () [CommandAim] [CommandAim]
commandAims = sharedStore "commandAims" [] commandAims = sharedStore "commandAims" []
capabilityMap :: RWShared () CapabilityToDeviceKindMap CapabilityToDeviceKindMap capabilityMap :: SDSLens () CapabilityToDeviceKindMap CapabilityToDeviceKindMap
capabilityMap = sharedStore "capabilityMap" ('DM'.fromList defaultList) capabilityMap = sharedStore "capabilityMap" ('DM'.fromList defaultList)
where where
defaultList defaultList
...@@ -339,7 +339,7 @@ instance * CapabilityExpr where ...@@ -339,7 +339,7 @@ instance * CapabilityExpr where
cap :: DeviceKind -> CapabilityExpr cap :: DeviceKind -> CapabilityExpr
cap k = DeviceExpr k cap k = DeviceExpr k
myNetwork :: RWShared () Network Network myNetwork :: SDSLens () Network Network
myNetwork = sharedStore "myNetwork" myNetwork = sharedStore "myNetwork"
{ Network { Network
| devices = 'DM'.newMap | devices = 'DM'.newMap
...@@ -347,16 +347,16 @@ myNetwork = sharedStore "myNetwork" ...@@ -347,16 +347,16 @@ myNetwork = sharedStore "myNetwork"
, cableMapping = 'DIS'.newMap , cableMapping = 'DIS'.newMap
} }
myCables :: RWShared () (IntMap Cable) (IntMap Cable) myCables :: SDSLens () (IntMap Cable) (IntMap Cable)
myCables = sdsProject (SDSLensRead read) (SDSLensWrite write) myNetwork myCables = sdsProject (SDSLensRead read) (SDSLensWrite write) Nothing myNetwork
where where
read :: !Network -> MaybeError TaskException (IntMap Cable) read :: !Network -> MaybeError TaskException (IntMap Cable)
read { Network | cables } = Ok cables read { Network | cables } = Ok cables
write :: !Network !(IntMap Cable) -> MaybeError TaskException (Maybe Network) write :: !Network !(IntMap Cable) -> MaybeError TaskException (Maybe Network)
write network cables = Ok (Just {network & cables = cables}) write network cables = Ok (Just {network & cables = cables})
cablesInSectionShare :: RWShared Coord3D [Cable] [Cable] cablesInSectionShare :: SDSLens Coord3D [Cable] [Cable]
cablesInSectionShare = sdsLens "cablesInSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) myNetwork cablesInSectionShare = sdsLens "cablesInSectionShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing myNetwork
where where
read :: !Coord3D !Network -> MaybeError TaskException [Cable] read :: !Coord3D !Network -> MaybeError TaskException [Cable]
read c3d network = Ok (cablesForSection c3d network) read c3d network = Ok (cablesForSection c3d network)
...@@ -375,7 +375,7 @@ cablesForSection c3d { Network | cables, cableMapping } ...@@ -375,7 +375,7 @@ cablesForSection c3d { Network | cables, cableMapping }
[] -> [] [] -> []
xs -> [cable \\ Just cable <- (map (\cid -> 'DIS'.get cid cables) xs)] 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 cableWithIdShare = intMapLens "cableWithIdShare" myCables Nothing
cutCable :: !Coord3D !CableId !Network -> Network cutCable :: !Coord3D !CableId !Network -> Network
...@@ -387,9 +387,9 @@ patchCable roomNo cableId network = { network & cableMapping = 'DIS'.alter (fmap ...@@ -387,9 +387,9 @@ patchCable roomNo cableId network = { network & cableMapping = 'DIS'.alter (fmap
inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType inventoryInSectionShare :: FocusedSectionInventoryShare ObjectType
inventoryInSectionShare = mapLens "inventoryInSectionShare" myInventoryMap (Just 'DIS'.newMap) inventoryInSectionShare = mapLens "inventoryInSectionShare" myInventoryMap (Just 'DIS'.newMap)
allAvailableActors :: ReadOnlyShared [(!Coord3D, !MyActor)] allAvailableActors :: SDSLens () [(!Coord3D, !MyActor)] ()
allAvailableActors allAvailableActors
= /*toReadOnly */ (sdsProject (SDSLensRead readActors) SDSNoWrite (sectionUsersShare |*| myUserActorMap)) = /*toReadOnly */ (sdsProject (SDSLensRead readActors) (SDSLensWrite \_ _. Ok Nothing) Nothing (sectionUsersShare |*| myUserActorMap))
where where
readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(!Coord3D, !MyActor)] readActors :: !(SectionUsersMap, UserActorMap ObjectType ActorStatus) -> MaybeError TaskException [(!Coord3D, !MyActor)]
readActors (sectionUsersMap, userActorMap) readActors (sectionUsersMap, userActorMap)
...@@ -398,9 +398,9 @@ allAvailableActors ...@@ -398,9 +398,9 @@ allAvailableActors
, Just (c3d, a) <- [findUser u sectionUsersMap userActorMap] , Just (c3d, a) <- [findUser u sectionUsersMap userActorMap]
| a.actorStatus.occupied === Available] | a.actorStatus.occupied === Available]
allActiveAlarms :: ReadOnlyShared [(!Coord3D, !SectionStatus)] allActiveAlarms :: SDSLens () [(!Coord3D, !SectionStatus)] ()
allActiveAlarms allActiveAlarms
= /*toReadOnly */ (sdsProject (SDSLensRead readAlarms) SDSNoWrite myStatusMap) = /*toReadOnly */ (sdsProject (SDSLensRead readAlarms) (SDSLensWrite \_ _. Ok Nothing) Nothing myStatusMap)
where where
readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(!Coord3D, !SectionStatus)] readAlarms :: !MySectionStatusMap -> MaybeError TaskException [(!Coord3D, !SectionStatus)]
readAlarms statusMap = Ok [ (number, status) \\ (number, status) <- 'DM'.toList statusMap readAlarms statusMap = Ok [ (number, status) \\ (number, status) <- 'DM'.toList statusMap
...@@ -437,7 +437,7 @@ where ...@@ -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`) , 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 disabledSections = sharedStore "disabledSections" 'DS'.newSet
updateSectionStatus :: !Coord3D -> Task (MapAction SectionStatus) updateSectionStatus :: !Coord3D -> Task (MapAction SectionStatus)
...@@ -456,12 +456,12 @@ where ...@@ -456,12 +456,12 @@ where
-> ((((((((ms2d`, exitLocks), hopLocks), inventoryMap), statusMap), actorMap), network), allDevices), cl`) -> ((((((((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 setAlarm user (alarmLoc, status) shStatusMap
= setSectionStatus alarmLoc status shStatusMap = setSectionStatus alarmLoc status shStatusMap
>>| addLog user "" ("Resets " <+++ status <+++ " in Section " <+++ alarmLoc <+++ " to False.") >>| 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 setSectionStatus roomNumber status statusMap
= upd ('DM'.put roomNumber status) statusMap @! () = upd ('DM'.put roomNumber status) statusMap @! ()
......
...@@ -16,23 +16,22 @@ from C2.Framework.ContactPosition import :: ContactMapPerspective ...@@ -16,23 +16,22 @@ from C2.Framework.ContactPosition import :: ContactMapPerspective
derive class iTask MapState 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 registerEntity :: (Int -> Entity) -> Task Entity
updateEntity :: Int (Entity -> Entity) -> Task () 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 () resetMapState :: Task ()
periodicallyUpdateEntity :: !Int -> 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 -> SDSLens () MapState MapState
userMapState :: User -> Shared MapState
...@@ -23,11 +23,11 @@ defSettings = ...@@ -23,11 +23,11 @@ defSettings =
, selection = -1 , selection = -1
} }
mapState :: RWShared () MapState MapState mapState :: SDSLens () MapState MapState
mapState = sharedStore "mapState" defSettings mapState = sharedStore "mapState" defSettings
selectedContactShare :: RWShared () (Maybe Entity) Entity selectedContactShare :: SDSLens () (Maybe Entity) Entity
selectedContactShare = sdsLens "selectedContactShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) mapState selectedContactShare = sdsLens "selectedContactShare" (const ()) (SDSRead read) (SDSWrite write) (SDSNotify notify) Nothing mapState