From 2ab02e34ba86dc06da315210a8af34e4700bab2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Haye=20B=C3=B6hm?= Date: Mon, 10 Sep 2018 13:44:01 +0200 Subject: [PATCH] Fix CI --- .../C2/Apps/ShipAdventure/Core.icl | 4 +- .../C2/Apps/ShipAdventure/Editor.dcl | 2 +- .../C2/Apps/ShipAdventure/Editor.icl | 18 +++---- .../C2/Apps/ShipAdventure/Scripting.dcl | 6 +-- .../C2/Apps/ShipAdventure/Scripting.icl | 8 ++-- .../C2/Apps/ShipAdventure/Types.dcl | 38 +++++++-------- .../C2/Apps/ShipAdventure/Types.icl | 48 +++++++++---------- .../ShipAdventure/C2/Framework/Common.dcl | 13 +++-- .../ShipAdventure/C2/Framework/Common.icl | 18 +++---- .../ShipAdventure/C2/Framework/Core.dcl | 2 +- .../ShipAdventure/C2/Framework/Core.icl | 12 ++--- .../ShipAdventure/C2/Framework/Logging.dcl | 2 +- .../ShipAdventure/C2/Framework/Logging.icl | 2 +- .../C2/Framework/MapEnvironment.dcl | 38 +++++++-------- .../C2/Framework/MapEnvironment.icl | 38 +++++++-------- .../ShipAdventure/C2/Framework/Util.dcl | 14 +++--- .../ShipAdventure/C2/Framework/Util.icl | 14 +++--- .../Applications/TheTaxMan/Cadastre/SDS.dcl | 2 +- .../Applications/TheTaxMan/Cadastre/SDS.icl | 2 +- .../TheTaxMan/ChamberOfCommerce/SDS.dcl | 4 +- .../TheTaxMan/ChamberOfCommerce/SDS.icl | 4 +- .../TheTaxMan/CivilAffairs/SDS.dcl | 2 +- .../TheTaxMan/CivilAffairs/SDS.icl | 2 +- .../TheTaxMan/Compensation/SDS.dcl | 24 +++++----- .../TheTaxMan/Compensation/SDS.icl | 26 +++++----- .../TheTaxMan/Task/Extensions.dcl | 4 +- .../TheTaxMan/Task/Extensions.icl | 12 ++--- Examples/Distributed/examples.icl | 19 ++++---- Examples/GIS/LeafletMapExample.icl | 8 ++-- Examples/Games/Ligretto/Ligretto/Tasks.icl | 10 ++-- .../Extensions/Development/Codebase.dcl | 8 ++-- .../Extensions/Development/Codebase.icl | 14 +++--- .../iTasks/Extensions/Development/Tools.dcl | 2 +- .../iTasks/Extensions/Development/Tools.icl | 2 +- .../iTasks/Extensions/Device/Features.dcl | 4 +- .../iTasks/Extensions/Device/Features.icl | 7 +-- .../iTasks/Extensions/Device/Location.dcl | 3 +- .../Distributed/InteractionTasks.dcl | 4 +- .../Distributed/InteractionTasks.icl | 4 +- .../iTasks/Extensions/Distributed/SDS.dcl | 10 ++-- .../iTasks/Extensions/Distributed/SDS.icl | 10 ++-- .../iTasks/Extensions/Distributed/iTasks.dcl | 8 ++-- .../iTasks/Extensions/FileCollection.dcl | 2 +- .../iTasks/Extensions/FileCollection.icl | 2 +- Libraries/iTasks/Util/Testing.icl | 4 +- Tools/CodeQualityMonitor.icl | 6 +-- 46 files changed, 241 insertions(+), 245 deletions(-) diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Core.icl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Core.icl index 1230eb729..2ae1cdefa 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Core.icl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Core.icl @@ -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)) diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.dcl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.dcl index 907d0cc3d..ced4fb648 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.dcl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.dcl @@ -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) diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.icl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.icl index e8d115971..b30278974 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.icl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Editor.icl @@ -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 diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.dcl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.dcl index 419cf01a6..683f71148 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.dcl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.dcl @@ -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 () diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.icl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.icl index d64e336e4..8c6fb2fff 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.icl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Scripting.icl @@ -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 ())) diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.dcl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.dcl index b3d583ef3..ebf4eb101 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.dcl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.dcl @@ -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 diff --git a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.icl b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.icl index 53416edbb..3ff0e53ab 100644 --- a/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.icl +++ b/Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Types.icl @@ -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 @! () diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Common.dcl b/Examples/Applications/ShipAdventure/C2/Framework/Common.dcl index a6a639c8d..455a31196 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Common.dcl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Common.dcl @@ -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 diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Common.icl b/Examples/Applications/ShipAdventure/C2/Framework/Common.icl index 5adc3f93c..8ddef083a 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Common.icl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Common.icl @@ -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) diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Core.dcl b/Examples/Applications/ShipAdventure/C2/Framework/Core.dcl index 833e6f7a3..18ac80b2c 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Core.dcl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Core.dcl @@ -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 () diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Core.icl b/Examples/Applications/ShipAdventure/C2/Framework/Core.icl index 90c95729c..3128d167d 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Core.icl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Core.icl @@ -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 diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Logging.dcl b/Examples/Applications/ShipAdventure/C2/Framework/Logging.dcl index 237fa00b5..37e172180 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Logging.dcl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Logging.dcl @@ -12,7 +12,7 @@ derive class iTask Log // shared store for logging events -myLog :: Shared [Log] +myLog :: SDSLens () [Log] [Log] // tasks for logging: diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Logging.icl b/Examples/Applications/ShipAdventure/C2/Framework/Logging.icl index 63e1c8bfd..11a59e84d 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Logging.icl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Logging.icl @@ -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 diff --git a/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.dcl b/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.dcl index 972aa847c..330cfac77 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.dcl +++ b/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.dcl @@ -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) diff --git a/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.icl b/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.icl index 1bca711f3..8e3cf6bbf 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.icl +++ b/Examples/Applications/ShipAdventure/C2/Framework/MapEnvironment.icl @@ -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]] diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Util.dcl b/Examples/Applications/ShipAdventure/C2/Framework/Util.dcl index 26cadedaa..107a5e015 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Util.dcl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Util.dcl @@ -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 () diff --git a/Examples/Applications/ShipAdventure/C2/Framework/Util.icl b/Examples/Applications/ShipAdventure/C2/Framework/Util.icl index 3c77161ac..aa2441c77 100644 --- a/Examples/Applications/ShipAdventure/C2/Framework/Util.icl +++ b/Examples/Applications/ShipAdventure/C2/Framework/Util.icl @@ -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 editSharedListWithTaskTask tenter tupdate list = editSharedListGeneric [ESLUpdate ("Edit Item",tupdate) ,ESLAdd ("Add Item",tenter) ,ESLDel ,ESLClearAll] list -editSharedListGeneric :: [EditSharedListOption a] (Shared [a]) -> Task () | iTask a +editSharedListGeneric :: [EditSharedListOption a] (sds () [a] [a]) -> Task () | iTask a & RWShared sds editSharedListGeneric options list = doOrClose (forever (enterChoiceWithShared "Choose an item" [ChooseFromGrid snd] @@ -64,7 +64,7 @@ where addItem tenter = tenter >>= \item -> upd (\us -> us ++ [item]) list @! ( doOrClose :: (Task a) -> Task (Maybe a) | iTask a doOrClose task = ((task @ Just) -||- chooseAction [(ActionClose,Nothing)]) >>- return -updateItemInSharedList :: a (a -> Bool) (Shared [a]) -> Task [a] | iTask a +updateItemInSharedList :: a (a -> Bool) (sds () [a] [a]) -> Task [a] | iTask a & RWShared sds updateItemInSharedList newitem cond share = upd f share where f [] = [] f [a:as] | cond a = [newitem : as] @@ -142,7 +142,7 @@ innersplitscreenview main left sidebar ts = allSideBar 0 TopSide 25 ts @! () -chats :: Shared [ChatMessage] +chats :: SDSLens () [ChatMessage] [ChatMessage] chats = sharedStore "chats" [] derive class iTask ChatMessage @@ -161,7 +161,7 @@ where editChats :: Task () editChats = editSharedList chats -debugstore :: Shared [String] +debugstore :: SDSLens () [String] [String] debugstore = sharedStore "debugstore" [] addDebug :: String -> Task () diff --git a/Examples/Applications/TheTaxMan/Cadastre/SDS.dcl b/Examples/Applications/TheTaxMan/Cadastre/SDS.dcl index 92c3ae2b6..af39e5b8d 100644 --- a/Examples/Applications/TheTaxMan/Cadastre/SDS.dcl +++ b/Examples/Applications/TheTaxMan/Cadastre/SDS.dcl @@ -5,4 +5,4 @@ import Cadastre.UoD /** cadastreRealEstate: this shared data source keeps track of the registered owners per address. */ -cadastreRealEstate :: Shared [CadastreRealEstate] +cadastreRealEstate :: SDSLens () [CadastreRealEstate] [CadastreRealEstate] diff --git a/Examples/Applications/TheTaxMan/Cadastre/SDS.icl b/Examples/Applications/TheTaxMan/Cadastre/SDS.icl index 374182508..c72e99b09 100644 --- a/Examples/Applications/TheTaxMan/Cadastre/SDS.icl +++ b/Examples/Applications/TheTaxMan/Cadastre/SDS.icl @@ -2,5 +2,5 @@ implementation module Cadastre.SDS import Cadastre.UoD -cadastreRealEstate :: Shared [CadastreRealEstate] +cadastreRealEstate :: SDSLens () [CadastreRealEstate] [CadastreRealEstate] cadastreRealEstate = sharedStore "cadastreRealEstate" [] diff --git a/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.dcl b/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.dcl index 1f4482e56..2bf2ead1a 100644 --- a/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.dcl +++ b/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.dcl @@ -5,9 +5,9 @@ import ChamberOfCommerce.UoD /** companies: this shared data source keeps track of all registered companies. */ -companies :: Shared [Company] +companies :: SDSLens () [Company] [Company] /** companiesOfType t: this shared data source is the subset of *companies* of type @t. */ -companiesOfType :: CompanyType -> Shared [Company] +companiesOfType :: CompanyType -> SDSLens () [Company] [Company] diff --git a/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.icl b/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.icl index 5af435e04..6e60c5516 100644 --- a/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.icl +++ b/Examples/Applications/TheTaxMan/ChamberOfCommerce/SDS.icl @@ -2,8 +2,8 @@ implementation module ChamberOfCommerce.SDS import ChamberOfCommerce.UoD -companies :: Shared [Company] +companies :: SDSLens () [Company] [Company] companies = sharedStore "companies" [] -companiesOfType :: CompanyType -> Shared [Company] +companiesOfType :: CompanyType -> SDSLens () [Company] [Company] companiesOfType type = mapRead (filter (companyHasType type)) companies diff --git a/Examples/Applications/TheTaxMan/CivilAffairs/SDS.dcl b/Examples/Applications/TheTaxMan/CivilAffairs/SDS.dcl index 45d626498..6d152faa9 100644 --- a/Examples/Applications/TheTaxMan/CivilAffairs/SDS.dcl +++ b/Examples/Applications/TheTaxMan/CivilAffairs/SDS.dcl @@ -5,4 +5,4 @@ import CivilAffairs.UoD /** citizens: this shared data source keeps track of all registered citizens. */ -citizens :: Shared [Citizen] +citizens :: SDSLens () [Citizen] [Citizen] diff --git a/Examples/Applications/TheTaxMan/CivilAffairs/SDS.icl b/Examples/Applications/TheTaxMan/CivilAffairs/SDS.icl index 71aaed1c0..d8f826828 100644 --- a/Examples/Applications/TheTaxMan/CivilAffairs/SDS.icl +++ b/Examples/Applications/TheTaxMan/CivilAffairs/SDS.icl @@ -2,5 +2,5 @@ implementation module CivilAffairs.SDS import CivilAffairs.UoD -citizens :: Shared [Citizen] +citizens :: SDSLens () [Citizen] [Citizen] citizens = sharedStore "citizens" [] diff --git a/Examples/Applications/TheTaxMan/Compensation/SDS.dcl b/Examples/Applications/TheTaxMan/Compensation/SDS.dcl index f89c672ce..a22ac9ee7 100644 --- a/Examples/Applications/TheTaxMan/Compensation/SDS.dcl +++ b/Examples/Applications/TheTaxMan/Compensation/SDS.dcl @@ -6,67 +6,67 @@ import Compensation.UoD this shared data source keeps track of the real estate that is owned by a registered *Owner*. The *Owner* serves as key. */ -realEstateOwners :: Shared [RealEstateOwner] +realEstateOwners :: SDSLens () [RealEstateOwner] [RealEstateOwner] /** decisions: this shared data source keeps track of all decisions regarding tax compensation requests. */ -decisions :: Shared [Decision] +decisions :: SDSLens () [Decision] [Decision] /** collectionPayments: this shared data source keeps track of all pending collections that need to be payed. */ -collectionPayments :: Shared [Collection] +collectionPayments :: SDSLens () [Collection] [Collection] /** collectionClaims: this shared data source keeps track of all pending collections that need to be claimed at citizens. */ -collectionClaims :: Shared [Collection] +collectionClaims :: SDSLens () [Collection] [Collection] /** collectionsProcessed: this shared data source keeps track of all collections that have payed or claimed. */ -collectionsProcessed :: Shared [Collection] +collectionsProcessed :: SDSLens () [Collection] [Collection] /** acceptedSolarPanels: this shared data source keeps track of all types of solar panels for which citizens can enter a tax compensation. */ -acceptedSolarPanels :: Shared [AcceptedSolarPanel] +acceptedSolarPanels :: SDSLens () [AcceptedSolarPanel] [AcceptedSolarPanel] /** solarPanelSubsidyRequests: this shared data source keeps track of all tax subsidy requests for solar panels. */ -solarPanelSubsidyRequests :: Shared [TaxSolarPanelDossier] +solarPanelSubsidyRequests :: SDSLens () [TaxSolarPanelDossier] [TaxSolarPanelDossier] /** currentDecisions ssn pred date: this shared data source is a subset of all *decisions* that have been requested by the citizen identified by @ssn after date @date, and for which @pred is valid, when applied to the status of the decision. */ -currentDecisions :: SSN (DecisionStatus -> Bool) Date -> Shared [Decision] +currentDecisions :: SSN (DecisionStatus -> Bool) Date -> SDSLens () [Decision] [Decision] /** currentPayments ssn date: this shared data source is a subset of all *collectionPayments* that have been requested by the citizen identified by @ssn after date @date. */ -currentPayments :: SSN Date -> Shared [Collection] +currentPayments :: SSN Date -> SDSLens () [Collection] [Collection] /** currentClaims ssn date: this shared data source is a subset of all *collectionClaims* that have been requested by the citizen identified by @ssn after date @date. */ -currentClaims :: SSN Date -> Shared [Collection] +currentClaims :: SSN Date -> SDSLens () [Collection] [Collection] /** currentProcessed ssn date: this shared date source is a subset of all *collectionsProcessed* that have been requested by the citizen identified by @ssn after date @date. */ -currentProcessed :: SSN Date -> Shared [Collection] +currentProcessed :: SSN Date -> SDSLens () [Collection] [Collection] /** currentRealEstate citizen: this shared data source extracts all registered owned properties of @citizen that is registered in *cadastreRealEstate*. */ -currentRealEstate :: Citizen -> ReadWriteShared [OwnedRealEstate] [CadastreRealEstate] +currentRealEstate :: Citizen -> SDSLens () [OwnedRealEstate] [CadastreRealEstate] diff --git a/Examples/Applications/TheTaxMan/Compensation/SDS.icl b/Examples/Applications/TheTaxMan/Compensation/SDS.icl index 63936caed..61544d195 100644 --- a/Examples/Applications/TheTaxMan/Compensation/SDS.icl +++ b/Examples/Applications/TheTaxMan/Compensation/SDS.icl @@ -6,41 +6,41 @@ import Task.Extensions //import iTasks.API.Extensions.Admin.TonicAdmin //import iTasks._Framework.Tonic -realEstateOwners :: Shared [RealEstateOwner] +realEstateOwners :: SDSLens () [RealEstateOwner] [RealEstateOwner] realEstateOwners = sharedStore "realEstateOwners" [] -decisions :: Shared [Decision] +decisions :: SDSLens () [Decision] [Decision] decisions = sharedStore "decisions" [] -collectionsProcessed :: Shared [Collection] +collectionsProcessed :: SDSLens () [Collection] [Collection] collectionsProcessed = sharedStore "collectionsProcessed" [] -collectionClaims :: Shared [Collection] +collectionClaims :: SDSLens () [Collection] [Collection] collectionClaims = sharedStore "collectionClaims" [] -collectionPayments :: Shared [Collection] +collectionPayments :: SDSLens () [Collection] [Collection] collectionPayments = sharedStore "collectionPayments" [] -acceptedSolarPanels :: Shared [AcceptedSolarPanel] +acceptedSolarPanels :: SDSLens () [AcceptedSolarPanel] [AcceptedSolarPanel] acceptedSolarPanels = sharedStore "acceptedSolarPanels" ["monocrystalline","polycrystalline","amorphous"] -solarPanelSubsidyRequests :: Shared [TaxSolarPanelDossier] +solarPanelSubsidyRequests :: SDSLens () [TaxSolarPanelDossier] [TaxSolarPanelDossier] solarPanelSubsidyRequests = sharedStore "SolarPanelSubsidyRequests" [] -currentDecisions :: SSN (DecisionStatus -> Bool) Date -> Shared [Decision] +currentDecisions :: SSN (DecisionStatus -> Bool) Date -> SDSLens () [Decision] [Decision] currentDecisions ssn pred date = mapRead (decisionsAfter ssn pred date) decisions -currentPayments :: SSN Date -> Shared [Collection] +currentPayments :: SSN Date -> SDSLens () [Collection] [Collection] currentPayments ssn date = mapReadCollections ssn date collectionPayments -currentClaims :: SSN Date -> Shared [Collection] +currentClaims :: SSN Date -> SDSLens () [Collection] [Collection] currentClaims ssn date = mapReadCollections ssn date collectionClaims -currentProcessed :: SSN Date -> Shared [Collection] +currentProcessed :: SSN Date -> SDSLens () [Collection] [Collection] currentProcessed ssn date = mapReadCollections ssn date collectionsProcessed -mapReadCollections :: SSN Date (Shared [Collection]) -> Shared [Collection] +mapReadCollections :: SSN Date (SDSLens () [Collection] [Collection]) -> SDSLens () [Collection] [Collection] mapReadCollections ssn date collectionStore = mapRead (collectionsAfter ssn date) collectionStore -currentRealEstate :: Citizen -> ReadWriteShared [OwnedRealEstate] [CadastreRealEstate] +currentRealEstate :: Citizen -> SDSLens () [OwnedRealEstate] [CadastreRealEstate] currentRealEstate citizen = mapRead (realEstatesOfCitizen citizen) cadastreRealEstate diff --git a/Examples/Applications/TheTaxMan/Task/Extensions.dcl b/Examples/Applications/TheTaxMan/Task/Extensions.dcl index 9813ef206..39b37c691 100644 --- a/Examples/Applications/TheTaxMan/Task/Extensions.dcl +++ b/Examples/Applications/TheTaxMan/Task/Extensions.dcl @@ -2,9 +2,9 @@ definition module Task.Extensions import iTasks -editStore :: String (Shared [a]) -> Task () | iTask a & Eq a & Ord a +editStore :: String (sds () [a] [a]) -> Task () | iTask a & Eq a & Ord a & RWShared sds -addToStore :: [a] !(Shared [a]) -> Task () | iTask a +addToStore :: [a] !(sds () [a] [a]) -> Task () | iTask a & RWShared sds appendTitledTopLevelTask :: String (Task a) -> Task TaskId | iTask a diff --git a/Examples/Applications/TheTaxMan/Task/Extensions.icl b/Examples/Applications/TheTaxMan/Task/Extensions.icl index 3522a72b4..fac32edb1 100644 --- a/Examples/Applications/TheTaxMan/Task/Extensions.icl +++ b/Examples/Applications/TheTaxMan/Task/Extensions.icl @@ -7,8 +7,8 @@ import iTasks.Extensions.DateTime crudWith :: !d ![ChoiceOption r] [EnterOption r] [ViewOption r] [UpdateOption r r] !((f r) -> [r]) !(r (f r) -> f` w) !(r (f r) -> f` w) - (RWShared () (f r) (f` w)) - -> Task () | toPrompt d & iTask r & iTask (f r) & iTask w & iTask (f` w) + (sds () (f r) (f` w)) + -> Task () | toPrompt d & iTask r & iTask (f r) & iTask w & iTask (f` w) & RWShared sds crudWith descr choiceOpts enterOpts viewOpts updateOpts toList putItem delItem sh = forever crud where crud @@ -34,15 +34,15 @@ where @! () crud` :: !d !((f r) -> [r]) !(r (f r) -> f` w) !(r (f r) -> f` w) - (RWShared () (f r) (f` w)) - -> Task () | toPrompt d & iTask r & iTask (f r) & iTask w & iTask (f` w) + (sds () (f r) (f` w)) + -> Task () | toPrompt d & iTask r & iTask (f r) & iTask w & iTask (f` w) & RWShared sds crud` descr toList putItem delItem sh = crudWith descr [] [] [] [] toList putItem delItem sh -editStore :: String (Shared [a]) -> Task () | iTask a & Eq a & Ord a +editStore :: String (sds () [a] [a]) -> Task () | iTask a & Eq a & Ord a & RWShared sds editStore prompt store = crud` (Title prompt) id (\item items -> sort [item:items]) (\item items -> removeMember item items) store -addToStore :: [a] !(Shared [a]) -> Task () | iTask a +addToStore :: [a] !(sds () [a] [a]) -> Task () | iTask a & RWShared sds addToStore new store = upd (\content -> content ++ new) store @! () diff --git a/Examples/Distributed/examples.icl b/Examples/Distributed/examples.icl index c2e9f25f9..f34304e8d 100755 --- a/Examples/Distributed/examples.icl +++ b/Examples/Distributed/examples.icl @@ -92,7 +92,7 @@ updateMyShared derive class iTask ServerRole -serverRoleShare :: Shared ServerRole +serverRoleShare :: SDSLens () ServerRole ServerRole serverRoleShare = sharedStore "serverRoleShare" NoneServer getDomain :: Task Domain @@ -106,7 +106,9 @@ startMode :: String -> Task () startMode executable = get serverRoleShare >>- \role = case role of - DomainServer domain -> startAuthEngine domain >>| loginAndManageWorkList "Service engineer application" (myTasks True) + DomainServer domain -> startAuthEngine domain + >>| installWorkflows (myTasks True) + >>| loginAndManageWork "Service engineer application" Server domain -> startAuthEngine domain >>| loginRemote (myTasks False) _ -> viewInformation "Welcome" [] "Chose what this iTasks instance is." >>* [ OnAction (Action "Domain server") (always (domainServer)) @@ -124,7 +126,8 @@ where = enterDomain >>= \domain -> set (DomainServer domain) serverRoleShare >>| startAuthEngine domain - >>| loginAndManageWorkList "Service engineer application" (myTasks True) + >>| installWorkflows (myTasks True) + >>| loginAndManageWork "Service engineer application" loginRemote :: ![Workflow] -> Task () loginRemote workflows @@ -137,14 +140,8 @@ where browseAuthenticated workflows {Credentials|username,password} = remoteAuthenticateUser username password >>= \mbUser -> case mbUser of - Just user = workAs user (manageWorklist workflows) + Just user = workAs user manageWorkOfCurrentUser Nothing = viewInformation (Title "Login failed") [] "Your username or password is incorrect" >>| return () Start :: *World -> *World -Start world - = startEngineWithOptions opts [ publish "/" (\_-> startMode (IF_WINDOWS "examples.exe" "examples")) - ] world -where - opts [] = \op->(Just {op&distributed=True}, ["Started server on port: " +++ toString op.serverPort]) - opts ["-p",p:as] = appFst (fmap (\o->{o & serverPort=toInt p})) o opts as - opts [a:as] = opts as +Start world = doTasks [ publish "/" (\_-> startMode (IF_WINDOWS "examples.exe" "examples"))] world diff --git a/Examples/GIS/LeafletMapExample.icl b/Examples/GIS/LeafletMapExample.icl index 7bd3f1bbe..ac5a5f26d 100644 --- a/Examples/GIS/LeafletMapExample.icl +++ b/Examples/GIS/LeafletMapExample.icl @@ -12,14 +12,14 @@ playWithMaps = withShared {defaultValue & icons = shipIcons} (\m -> manipulateMap m ) <<@ ArrangeWithSideBar 0 LeftSide 600 True @! () -manipulateMap :: (Shared LeafletMap) -> Task () +manipulateMap :: (sds () LeafletMap LeafletMap) -> Task () | RWShared sds manipulateMap m = updateSharedInformation () [] m <<@ ApplyLayout (layoutSubUIs (SelectByPath [1]) (setUIAttributes (sizeAttr FlexSize FlexSize))) @! () -managePerspective :: (Shared LeafletMap) -> Task () -managePerspective m = updateSharedInformation (Title "Perspective") [] (mapReadWrite (\x -> x.LeafletMap.perspective,\p x -> Just {x & perspective = p}) m) @! () +managePerspective :: (sds () LeafletMap LeafletMap) -> Task () | RWShared sds +managePerspective m = updateSharedInformation (Title "Perspective") [] (mapReadWrite (\x -> x.LeafletMap.perspective,\p x -> Just {x & perspective = p}) Nothing m) @! () -manageMapObjects :: (Shared LeafletMap) -> Task () +manageMapObjects :: (sds () LeafletMap LeafletMap) -> Task () | RWShared sds manageMapObjects m = updateSharedInformation (Title "Manage objects") [UpdateAs toPrj fromPrj] m -|| addDemoObjects m @! () diff --git a/Examples/Games/Ligretto/Ligretto/Tasks.icl b/Examples/Games/Ligretto/Ligretto/Tasks.icl index daf2fd169..e70baebaa 100644 --- a/Examples/Games/Ligretto/Ligretto/Tasks.icl +++ b/Examples/Games/Ligretto/Ligretto/Tasks.icl @@ -28,31 +28,31 @@ invite_friends (viewInformation "Oops" [] "number of friends must be 1, 2, or 3" >>| invite_friends) (return them) -play_game :: ![(Color,User)] !(Shared GameSt) -> Task (Color,String) +play_game :: ![(Color,User)] !(sds () GameSt GameSt) -> Task (Color,String) | RWShared sds play_game users game_st = anyTask [ (u,"Play Ligretto") @: play (c,toString u) game_st \\ (c,u) <- users ] -play :: !(!Color,!String) !(Shared GameSt) -> Task (Color,String) +play :: !(!Color,!String) !(sds () GameSt GameSt) -> Task (Color,String) | RWShared sds play (me,name) game_st = updateSharedInformation name [ligrettoEditor me] game_st >>* [OnValue (withValue (\gameSt -> determine_winner gameSt >>= \winner -> return (accolades winner me game_st >>| return winner)))] -show_winner :: Color (Shared GameSt) GameSt -> Task (Color,String) +show_winner :: Color (sds () GameSt GameSt) GameSt -> Task (Color,String) | RWShared sds show_winner me game_st gameSt = accolades winner me game_st >>| return winner where {color,name} = fromJust (and_the_winner_is gameSt) winner = (color,name) -game_over :: !Color !(Shared GameSt) !GameSt -> Maybe (Task (Color,String)) +game_over :: !Color !(sds () GameSt GameSt) !GameSt -> Maybe (Task (Color,String)) | RWShared sds game_over me game_st gameSt = and_the_winner_is gameSt >>= \{color,name} -> (let winner = (color,name) in return (accolades winner me game_st >>| return winner)) -accolades :: !(!Color,!String) !Color !(Shared GameSt) -> Task GameSt +accolades :: !(!Color,!String) !Color !(sds () GameSt GameSt) -> Task GameSt | RWShared sds accolades winner me game_st = updateSharedInformation ("The winner is " <+++ winner) [accoladesEditor me] game_st diff --git a/Libraries/iTasks/Extensions/Development/Codebase.dcl b/Libraries/iTasks/Extensions/Development/Codebase.dcl index dd40270d6..375b19351 100644 --- a/Libraries/iTasks/Extensions/Development/Codebase.dcl +++ b/Libraries/iTasks/Extensions/Development/Codebase.dcl @@ -37,12 +37,12 @@ instance toString Extension instance == Extension //List all modules in a directory on disk -moduleList :: SDS FilePath [(ModuleName,ModuleType)] () +moduleList :: SDSSource FilePath [(ModuleName,ModuleType)] () //Access the code and documentation for a module on disk -moduleDefinition :: SDS (FilePath,ModuleName) [String] [String] -moduleImplementation :: SDS (FilePath,ModuleName) [String] [String] -moduleDocumentation :: SDS (FilePath,ModuleName) [String] [String] +moduleDefinition :: SDSLens (FilePath,ModuleName) [String] [String] +moduleImplementation :: SDSLens (FilePath,ModuleName) [String] [String] +moduleDocumentation :: SDSLens (FilePath,ModuleName) [String] [String] //Convert a list of modules to a tree for choice tasks toModuleSelectTree :: [(ModuleName,ModuleType)] -> [(ChoiceNode)] diff --git a/Libraries/iTasks/Extensions/Development/Codebase.icl b/Libraries/iTasks/Extensions/Development/Codebase.icl index 4a89e9969..d926aa546 100644 --- a/Libraries/iTasks/Extensions/Development/Codebase.icl +++ b/Libraries/iTasks/Extensions/Development/Codebase.icl @@ -11,7 +11,7 @@ where toString Dcl = ".dcl" toString Icl = ".icl" -moduleList :: SDS FilePath [(ModuleName,ModuleType)] () +moduleList :: SDSSource FilePath [(ModuleName,ModuleType)] () moduleList = worldShare read write where read path world = case scanPaths [path] world of @@ -68,14 +68,14 @@ where moduleName p = replaceSubString {pathSeparator} "." p -moduleDefinition :: SDS (FilePath,ModuleName) [String] [String] -moduleDefinition = mapReadWrite mapToLines (sdsTranslate "moduleDefinition" (\(p,m) -> modulePath p m "dcl") (removeMaybe (Just "") fileShare)) +moduleDefinition :: SDSLens (FilePath,ModuleName) [String] [String] +moduleDefinition = mapReadWrite mapToLines Nothing (sdsTranslate "moduleDefinition" (\(p,m) -> modulePath p m "dcl") (removeMaybe (Just "") fileShare)) -moduleImplementation :: SDS (FilePath,ModuleName) [String] [String] -moduleImplementation = mapReadWrite mapToLines (sdsTranslate "moduleImplementation" (\(p,m) -> modulePath p m "icl") (removeMaybe (Just "") fileShare)) +moduleImplementation :: SDSLens (FilePath,ModuleName) [String] [String] +moduleImplementation = mapReadWrite mapToLines Nothing (sdsTranslate "moduleImplementation" (\(p,m) -> modulePath p m "icl") (removeMaybe (Just "") fileShare)) -moduleDocumentation :: SDS (FilePath,ModuleName) [String] [String] -moduleDocumentation = mapReadWrite mapToLines (sdsTranslate "moduleDocumentation" (\(p,m) -> modulePath p m "md") (removeMaybe (Just "") fileShare)) +moduleDocumentation :: SDSLens (FilePath,ModuleName) [String] [String] +moduleDocumentation = mapReadWrite mapToLines Nothing (sdsTranslate "moduleDocumentation" (\(p,m) -> modulePath p m "md") (removeMaybe (Just "") fileShare)) mapToLines = (split "\n",\w _ -> Just (join "\n" w)) diff --git a/Libraries/iTasks/Extensions/Development/Tools.dcl b/Libraries/iTasks/Extensions/Development/Tools.dcl index 4a886cda9..906a46ffd 100644 --- a/Libraries/iTasks/Extensions/Development/Tools.dcl +++ b/Libraries/iTasks/Extensions/Development/Tools.dcl @@ -5,4 +5,4 @@ definition module iTasks.Extensions.Development.Tools */ import iTasks -cpmExecutable :: ROShared () FilePath +cpmExecutable :: SDSSource () FilePath () diff --git a/Libraries/iTasks/Extensions/Development/Tools.icl b/Libraries/iTasks/Extensions/Development/Tools.icl index 6a02fb345..174bb7cbb 100644 --- a/Libraries/iTasks/Extensions/Development/Tools.icl +++ b/Libraries/iTasks/Extensions/Development/Tools.icl @@ -6,7 +6,7 @@ import System.OS CPM_EXE :== IF_POSIX_OR_WINDOWS "bin/cpm" "Tools\\cpm.exe" -cpmExecutable :: ROShared () FilePath +cpmExecutable :: SDSSource () FilePath () cpmExecutable = createReadOnlySDSError read where read _ iworld=:{IWorld|world} = case getEnvironmentVariable "CLEAN_HOME" world of diff --git a/Libraries/iTasks/Extensions/Device/Features.dcl b/Libraries/iTasks/Extensions/Device/Features.dcl index 41d836a72..69ab7fca9 100644 --- a/Libraries/iTasks/Extensions/Device/Features.dcl +++ b/Libraries/iTasks/Extensions/Device/Features.dcl @@ -2,7 +2,7 @@ definition module iTasks.Extensions.Device.Features from iTasks.WF.Definition import class iTask from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor -from iTasks.SDS.Definition import :: SDS, :: RWShared +from iTasks.SDS.Definition import :: SDSLens from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode from iTasks.Internal.Generic.Visualization import :: TextFormat(..) from Data.Maybe import :: Maybe @@ -13,6 +13,6 @@ derive class iTask DeviceFeatures hasCamera :: DeviceFeatures -> Bool -device :: RWShared () DeviceFeatures DeviceFeatures +device :: SDSLens () DeviceFeatures DeviceFeatures manageDeviceFeaturs :: Task DeviceFeatures diff --git a/Libraries/iTasks/Extensions/Device/Features.icl b/Libraries/iTasks/Extensions/Device/Features.icl index 54aecaccd..bed098ca6 100644 --- a/Libraries/iTasks/Extensions/Device/Features.icl +++ b/Libraries/iTasks/Extensions/Device/Features.icl @@ -1,7 +1,8 @@ implementation module iTasks.Extensions.Device.Features -from iTasks.SDS.Sources.Store import :: SDS, sharedStore -from iTasks.Internal.SDS import :: ReadWriteShared, :: RWShared, :: Shared +import iTasks.SDS.Definition +import iTasks.SDS.Sources.Store +import iTasks.Internal.SDS from iTasks.WF.Tasks.SDS import get, set from iTasks.WF.Definition import class iTask from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor, :: TaskId @@ -21,7 +22,7 @@ derive class iTask DeviceFeatures hasCamera :: DeviceFeatures -> Bool hasCamera {DeviceFeatures|camera} = camera -device :: RWShared () DeviceFeatures DeviceFeatures +device :: SDSLens () DeviceFeatures DeviceFeatures device = sharedStore "deviceFeaturs" {DeviceFeatures| camera = False } manageDeviceFeaturs :: Task DeviceFeatures diff --git a/Libraries/iTasks/Extensions/Device/Location.dcl b/Libraries/iTasks/Extensions/Device/Location.dcl index e69148bbf..c06dcb7a2 100644 --- a/Libraries/iTasks/Extensions/Device/Location.dcl +++ b/Libraries/iTasks/Extensions/Device/Location.dcl @@ -3,9 +3,8 @@ definition module iTasks.Extensions.Device.Location from iTasks.WF.Definition import class iTask from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor from iTasks.Internal.Generic.Visualization import :: TextFormat(..) -from iTasks.SDS.Definition import :: SDS, :: ReadWriteShared, :: RWShared from Data.Maybe import :: Maybe -from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode +from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode :: Coordinates = LatLon Real Real diff --git a/Libraries/iTasks/Extensions/Distributed/InteractionTasks.dcl b/Libraries/iTasks/Extensions/Distributed/InteractionTasks.dcl index 0bdeba3b8..30b39591a 100644 --- a/Libraries/iTasks/Extensions/Distributed/InteractionTasks.dcl +++ b/Libraries/iTasks/Extensions/Distributed/InteractionTasks.dcl @@ -1,11 +1,11 @@ definition module iTasks.Extensions.Distributed.InteractionTasks from iTasks.WF.Definition import class iTask -from iTasks.Internal.SDS import :: SDS, :: ReadWriteShared, :: RWShared +import iTasks.Internal.SDS from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor from Data.Maybe import :: Maybe from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode from iTasks.Internal.Generic.Visualization import :: TextFormat(..) from iTasks.WF.Tasks.Interaction import :: ViewOption(..) -viewSharedInformation :: String [ViewOption r] !(ReadWriteShared r w) -> Task r | iTask r & iTask w +viewSharedInformation :: String [ViewOption r] !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds diff --git a/Libraries/iTasks/Extensions/Distributed/InteractionTasks.icl b/Libraries/iTasks/Extensions/Distributed/InteractionTasks.icl index 468d0d014..5572754e8 100644 --- a/Libraries/iTasks/Extensions/Distributed/InteractionTasks.icl +++ b/Libraries/iTasks/Extensions/Distributed/InteractionTasks.icl @@ -2,13 +2,13 @@ implementation module iTasks.Extensions.Distributed.InteractionTasks import iTasks -viewSharedInformation :: String [ViewOption r] !(ReadWriteShared r w) -> Task r | iTask r & iTask w +viewSharedInformation :: String [ViewOption r] !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds viewSharedInformation title options share = watch share >>* [OnValue (hasValue return)] >>- \v -> loop v title options share where - loop :: r String [ViewOption r] (ReadWriteShared r w) -> Task r | iTask r & iTask w + loop :: r String [ViewOption r] (sds () r w) -> Task r | iTask r & iTask w & RWShared sds loop v title options share = (viewInformation title options v) ||- (watch share >>* [OnValue (ifValue ((=!=) v) return)]) diff --git a/Libraries/iTasks/Extensions/Distributed/SDS.dcl b/Libraries/iTasks/Extensions/Distributed/SDS.dcl index 47b7b2281..245328d4f 100644 --- a/Libraries/iTasks/Extensions/Distributed/SDS.dcl +++ b/Libraries/iTasks/Extensions/Distributed/SDS.dcl @@ -1,16 +1,16 @@ definition module iTasks.Extensions.Distributed.SDS from iTasks.WF.Definition import class iTask -from iTasks.Internal.SDS import :: SDS, :: ReadWriteShared, :: RWShared +import iTasks.Internal.SDS from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor from Data.Maybe import :: Maybe from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode from iTasks.Internal.Generic.Visualization import :: TextFormat(..) -get :: !(ReadWriteShared a w) -> Task a | iTask a & iTask w +get :: !(sds () a w) -> Task a | iTask a & iTask w& RWShared sds -upd :: !(r -> w) !(ReadWriteShared r w) -> Task w | iTask r & iTask w +upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds -set :: !a !(ReadWriteShared r a) -> Task a | iTask a & iTask r +set :: !a !(sds () r a) -> Task a | iTask a & iTask r & RWShared sds -watch :: !(ReadWriteShared r w) -> Task r | iTask r & iTask w +watch :: !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds diff --git a/Libraries/iTasks/Extensions/Distributed/SDS.icl b/Libraries/iTasks/Extensions/Distributed/SDS.icl index 732e38eed..a54528e5d 100644 --- a/Libraries/iTasks/Extensions/Distributed/SDS.icl +++ b/Libraries/iTasks/Extensions/Distributed/SDS.icl @@ -1,21 +1,21 @@ implementation module iTasks.Extensions.Distributed.SDS from iTasks.WF.Definition import class iTask -from iTasks.Internal.SDS import :: SDS, :: ReadWriteShared, :: RWShared from iTasks.WF.Definition import :: Task, generic gEq, generic gDefault, generic JSONDecode, generic JSONEncode, generic gText, generic gEditor, :: Editor from Data.Maybe import :: Maybe from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode from iTasks.Internal.Generic.Visualization import :: TextFormat(..) import qualified iTasks.Extensions.Distributed._SDS as R +import iTasks.SDS.Definition -get :: !(ReadWriteShared a w) -> Task a | iTask a & iTask w +get :: !(sds () a w) -> Task a | iTask a & iTask w & RWShared sds get share = 'R'.rr_get share -upd :: !(r -> w) !(ReadWriteShared r w) -> Task w | iTask r & iTask w +upd :: !(r -> w) !(sds () r w) -> Task w | iTask r & iTask w & RWShared sds upd func share = 'R'.rr_upd func share -set :: !a !(ReadWriteShared r a) -> Task a | iTask a & iTask r +set :: !a !(sds () r a) -> Task a | iTask a & iTask r & RWShared sds set val share = 'R'.rr_set val share -watch :: !(ReadWriteShared r w) -> Task r | iTask r & iTask w +watch :: !(sds () r w) -> Task r | iTask r & iTask w & RWShared sds watch share = 'R'.rr_watch share diff --git a/Libraries/iTasks/Extensions/Distributed/iTasks.dcl b/Libraries/iTasks/Extensions/Distributed/iTasks.dcl index 0ba779ac2..3467e190d 100644 --- a/Libraries/iTasks/Extensions/Distributed/iTasks.dcl +++ b/Libraries/iTasks/Extensions/Distributed/iTasks.dcl @@ -20,20 +20,20 @@ import qualified iTasks.Extensions.User as U from iTasks.WF.Combinators.Common import -&&-, >>- from iTasks.SDS.Sources.System import currentDateTime from iTasks.Extensions.User import currentUser, :: User(..), :: UserTitle, :: Role, :: UserId, assign, workerAttributes, :: Password, :: Username, workAs, :: Credentials{..}, users -from iTasks.SDS.Definition import :: ReadWriteShared, :: RWShared, :: ReadOnlyShared +from iTasks.SDS.Definition import class RWShared(..), class ROShared(..), class WOShared(..) from iTasks.WF.Tasks.Core import accWorld import iTasks.Internal.Distributed.Symbols from iTasks.Internal.Distributed.Instance import instanceServer, instanceClient, instanceFilter, instanceClameFilter from Data.Map import :: Map -from iTasks.Extensions.Admin.WorkflowAdmin import workflow, class toWorkflow(..), :: Workflow, publish, :: PublishedTask{..}, :: TaskWrapper(..), manageWorklist, instance toWorkflow (Task a), instance toWorkflow (WorkflowContainer a), instance toWorkflow (a -> Task b), instance toWorkflow (ParamWorkflowContainer a b), :: WorkflowContainer, :: ParamWorkflowContainer +from iTasks.Extensions.Admin.WorkflowAdmin import installWorkflows, loginAndManageWork,manageWorkOfCurrentUser, workflow, class toWorkflow(..), :: Workflow, publish, :: TaskWrapper(..), instance toWorkflow (Task a), instance toWorkflow (WorkflowContainer a), instance toWorkflow (a -> Task b), instance toWorkflow (ParamWorkflowContainer a b), :: WorkflowContainer, :: ParamWorkflowContainer from System.FilePath import :: FilePath, -from iTasks.Engine import startEngineWithOptions, :: EngineOptions(..), startEngine, class Publishable, instance Publishable [PublishedTask], :: WebTaskWrapper +from iTasks.Engine import doTasksWithOptions, doTasks, :: StartableTask, onRequestFromRequest, startEngineWithOptions, :: EngineOptions(..), startEngine, class Startable, instance Startable [StartableTask], :: WebTaskWrapper from Internet.HTTP import :: HTTPRequest(..), :: HTTPUpload, :: HTTPProtocol, :: HTTPMethod import iTasks.WF.Combinators.Common from iTasks.WF.Combinators.Common import :: TaskCont from iTasks.WF.Tasks.Interaction import enterInformation, :: EnterOption, :: ViewOption, enterChoice, :: ChoiceOption, viewInformation, enterChoiceWithShared, updateInformationWithShared, updateSharedInformation, :: UpdateOption from iTasks.Extensions.DateTime import :: DateTime, :: Time, waitForTimer -from iTasks.Extensions.Admin.UserAdmin import manageUsers, loginAndManageWorkList +from iTasks.Extensions.Admin.UserAdmin import manageUsers from iTasks.SDS.Sources.System import currentTime from iTasks.SDS.Sources.Store import sharedStore from iTasks.WF.Combinators.SDS import withShared diff --git a/Libraries/iTasks/Extensions/FileCollection.dcl b/Libraries/iTasks/Extensions/FileCollection.dcl index 946268d41..07618f653 100644 --- a/Libraries/iTasks/Extensions/FileCollection.dcl +++ b/Libraries/iTasks/Extensions/FileCollection.dcl @@ -25,7 +25,7 @@ derive class iTask FileCollectionItem * @param Delete flag: When this is true, files on disk that are not in the collection, but match the filter are deleted during a write. If it is false, entries on that are removed are only marked in a file called 'exclude.txt' but not deleted. */ -fileCollection :: FileFilter Bool -> SDS FilePath FileCollection FileCollection +fileCollection :: FileFilter Bool -> SDSSource FilePath FileCollection FileCollection //Access utilities: getStringContent:: String FileCollection -> Maybe String diff --git a/Libraries/iTasks/Extensions/FileCollection.icl b/Libraries/iTasks/Extensions/FileCollection.icl index 8330de993..695c226bd 100644 --- a/Libraries/iTasks/Extensions/FileCollection.icl +++ b/Libraries/iTasks/Extensions/FileCollection.icl @@ -19,7 +19,7 @@ EXCLUDE_FILE :== "exclude.txt" //Writes a map of key/value pairs to a directory with one file per key/value //It will ignore all files in the directory that don't match the filter -fileCollection :: FileFilter Bool -> SDS FilePath FileCollection FileCollection +fileCollection :: FileFilter Bool -> SDSSource FilePath FileCollection FileCollection fileCollection isFileInCollection deleteRemovedFiles = worldShare (read isFileInCollection) (write isFileInCollection) where read isFileInCollection dir world = case readDirectory dir world of diff --git a/Libraries/iTasks/Util/Testing.icl b/Libraries/iTasks/Util/Testing.icl index 750ae141b..5ba6a6250 100644 --- a/Libraries/iTasks/Util/Testing.icl +++ b/Libraries/iTasks/Util/Testing.icl @@ -130,11 +130,11 @@ where = case res of (Ok ()) //Collect output - # (res,iworld) = 'SDS'.read (sdsFocus instanceNo taskInstanceOutput) iworld + # (res,iworld) = 'SDS'.read (sdsFocus instanceNo taskInstanceOutput) 'SDS'.EmptyContext iworld # world = destroyIWorld iworld //Compare result # verdict = case res of - Ok queue = comparison exp (toList queue) + Ok ('SDS'.ReadResult queue _) = comparison exp (toList queue) (Error (_,e)) = Failed (Just Crashed) = (verdict,world) (Error e) diff --git a/Tools/CodeQualityMonitor.icl b/Tools/CodeQualityMonitor.icl index e07137d81..bf3d16e40 100644 --- a/Tools/CodeQualityMonitor.icl +++ b/Tools/CodeQualityMonitor.icl @@ -204,14 +204,14 @@ where hasExecutable {InspectState|executable} = (executable =: (Just _)) - editSourceCode :: (Shared InspectState) -> Task InspectState + editSourceCode :: (sds () InspectState InspectState) -> Task InspectState | RWShared sds editSourceCode state = updateSharedInformation (Title "Edit code") [UpdateUsing (\{InspectState|lines} -> join OS_NEWLINE lines) (\s c -> {InspectState|s & lines = split OS_NEWLINE c}) aceTextArea] state - buildExecutable :: FilePath (Shared InspectState) -> Task () + buildExecutable :: FilePath (sds () InspectState InspectState) -> Task () | RWShared sds buildExecutable temporaryDirectory state = get state @ (\{InspectState|moduleName,lines} -> (moduleName,join OS_NEWLINE lines)) >>- \(moduleName,sourceCode) -> @@ -232,7 +232,7 @@ where setExecutable directory moduleName state = upd (\s -> {InspectState|s & executable = Just (directory addExtension moduleName "exe")}) state - runProgram :: FilePath (Shared InspectState) -> Task () + runProgram :: FilePath (sds () InspectState InspectState) -> Task () | RWShared sds runProgram temporaryDirectory state = ( get state @ (\{InspectState|executable} -> executable) >>- maybe (throw "Cannot run the program. There is no executable yet") -- GitLab