Commit 946848f4 authored by Mart Lubbers's avatar Mart Lubbers

Merge branch 'fully-async-share-trees' into 'master'

Asynchronous share evaluation

Closes #156

See merge request !201
parents fce9cfa0 08ec2877
Pipeline #18767 passed with stage
in 5 minutes and 28 seconds
Version: 1.0
Environment
EnvironmentName: iTasks-dist
EnvironmentPaths
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Dynamics
Path: {Application}/lib/TCPIP
Path: {Application}/lib/Sapl
Path: {Application}/lib/GraphCopy
Path: {Application}/lib/Platform
Path: {Application}/lib/Platform/Deprecated/Generics
Path: {Application}/lib/Platform/Deprecated/StdLib
Path: {Application}/Development/iTasks-SDK/Libraries
EnvironmentCompiler: lib/exe/cocl::-dynamics -sapl -d
EnvironmentCodeGen: lib/exe/cg
EnvironmentLinker: /usr/bin/gcc::-g|lib/exe/sapl-collector-linker|lib/exe/itasks-web-collector
EnvironmentDynLink: lib/exe/cclinker
EnvironmentVersion: 920
EnvironmentRedirect: False
EnvironmentCompileMethod: Pers
EnvironmentProcessor: I386
Environment64BitProcessor: True
\ No newline at end of file
Version: 1.0
Environment
EnvironmentName: iTasks
EnvironmentPaths
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Dynamics
Path: {Application}/lib/TCPIP
Path: {Application}/lib/Platform
Path: {Application}/lib/Platform/Deprecated/Generics
Path: {Application}/lib/Platform/Deprecated/StdLib
Path: {Application}/lib/Sapl
Path: {Application}/lib/GraphCopy
Path: {Application}/lib/iTasks
EnvironmentCompiler: lib/exe/cocl:-dynamics -sapl -desc -exl -d
EnvironmentCodeGen: lib/exe/cg
EnvironmentLinker: lib/exe/cclinker|lib/exe/sapl-collector-linker|lib/exe/itasks-web-collector
EnvironmentDynLink: lib/exe/cclinker
EnvironmentVersion: 920
EnvironmentRedirect: False
EnvironmentCompileMethod: Pers
EnvironmentProcessor: I386
Environment64BitProcessor: True
Version: 1.0
Environments
Environment
EnvironmentName: iTasks-dist
EnvironmentPaths
Path: {Application}\Libraries\StdEnv
Path: {Application}\Libraries\Dynamics
Path: {Application}\Libraries\Dynamics\extension
Path: {Application}\Libraries\Dynamics\general
Path: {Application}\Libraries\Dynamics\implementation
Path: {Application}\Libraries\Dynamics\implementation\windows
Path: {Application}\Libraries\TCPIP
Path: {Application}\Libraries\Platform
Path: {Application}\Libraries\Platform\Deprecated\Generics
Path: {Application}\Libraries\Platform\Deprecated\StdLib
Path: {Application}\Libraries\Sapl
Path: {Application}\Libraries\GraphCopy
Path: {Application}\Development\iTasks-SDK\Libraries
EnvironmentCompiler: Tools\Clean System\CleanCompiler.exe : -h 64M : -sapl -dynamics -generics -desc -exl -d
EnvironmentCodeGen: Tools\Clean System\CodeGenerator.exe
EnvironmentLinker: Tools\Clean System\StaticLinker.exe : -h 64M | Tools\Clean System\SaplCollectorLinker.exe | Tools\Clean System\WebResourceCollector.exe
EnvironmentDynLink: Tools\Clean System\DynamicLinker.exe
EnvironmentVersion: 920
EnvironmentRedirect: False
EnvironmentCompileMethod: Pers
EnvironmentProcessor: I386
Environment64BitProcessor: False
......@@ -18,8 +18,9 @@ import Incidone.OP.Concepts
:: ActionDefinition c
= { identity :: String
, meta :: ItemMeta
, task :: c (Shared ActionStatus) -> Task ()
, task :: c (SimpleSDSLens ActionStatus) -> Task ()
}
//Wrapped action for storage in the action catalog
:: CatalogAction =
{ identity :: String //Identifying string, such that you can track which actions have been done
......@@ -33,9 +34,9 @@ import Incidone.OP.Concepts
}
:: ActionTasks
= E.c: ActionTasks
= E.c sds: ActionTasks
([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) //Configuration task
(c (Shared ActionStatus) -> Task ()) & iTask c //An action item that needs to be configured before it can be deployed
(c (SimpleSDSLens ActionStatus) -> Task ()) & iTask c //An action item that needs to be configured before it can be deployed
:: ActionProgress
= ActionPlanned
......@@ -144,7 +145,7 @@ derive gDefault CatalogAction
derive gText CatalogAction
derive gEditor CatalogAction
toInstantAction :: c ActionProgress [ContactNo] [IncidentNo] (ActionDefinition c) -> CatalogAction | iTask c
toInstantAction :: c ActionProgress [ContactNo] [IncidentNo] (ActionDefinition c) -> CatalogAction | iTask c
toConfigurableAction :: ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (ActionDefinition c) -> CatalogAction | iTask c
toContactAction :: (Maybe String) (ActionDefinition ContactNo) -> CatalogAction
toIncidentAction :: (ActionDefinition IncidentNo) -> CatalogAction
......@@ -155,34 +156,34 @@ forIncident :: IncidentNo (ActionDefinition (ContactNo,IncidentN
addDefaultStatus :: (Task c) -> ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) | iTask c
//Shared catalog of predefined action items
actionCatalog :: ReadOnlyShared [CatalogAction]
builtinActionCatalog :: ReadOnlyShared [CatalogAction]
userActionCatalog :: Shared [UserCatalogAction]
actionCatalog :: SDSLens () [CatalogAction] ()
builtinActionCatalog :: SDSSource () [CatalogAction] ()
userActionCatalog :: SimpleSDSLens [UserCatalogAction]
//Shares providing filtered views on iTasks task instances.
//They select only those detached tasks that are tagged to be action items
actionStatuses :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)] //(Instance no, parent instance no, status)
actionStatusesByIncident :: ROShared IncidentNo [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesByContact :: ROShared ContactNo [(InstanceNo,InstanceNo,ActionStatus)]
actionStatusesOfCurrentContact :: ROShared () [(InstanceNo,InstanceNo,ActionStatus)]
actionStatuses :: SDSLens () [(InstanceNo,InstanceNo,ActionStatus)] () //(Instance no, parent instance no, status)
actionStatusesByIncident :: SDSLens IncidentNo [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatusesByContact :: SDSLens ContactNo [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatusesOfCurrentContact :: SDSSequence () [(InstanceNo,InstanceNo,ActionStatus)] ()
actionStatusByNo :: RWShared InstanceNo ActionStatus ActionStatus
actionStatusByNo :: SDSLens InstanceNo ActionStatus ActionStatus
numActionsByContact :: ROShared ContactNo Int
numActionsByContact :: SDSLens ContactNo Int ()
//Todo items
todoItemTask :: () (Shared ActionStatus) -> Task ()
todoItemTask :: () (Shared sds ActionStatus) -> Task () | RWShared sds
blankTodoItem :: CatalogAction
predefinedTodoItem :: String ItemMeta -> CatalogAction
predefinedInstantItem :: String ItemMeta ActionProgress ((Shared ActionStatus) -> Task a) -> CatalogAction| iTask a
predefinedConfigurableItem :: String ItemMeta ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (c (Shared ActionStatus) -> Task a) -> CatalogAction | iTask a & iTask c
predefinedInstantItem :: String ItemMeta ActionProgress ((SimpleSDSLens ActionStatus) -> Task a) -> CatalogAction
predefinedConfigurableItem :: String ItemMeta ([ContactNo] [IncidentNo] -> Task (c,ActionStatus)) (c (SimpleSDSLens ActionStatus) -> Task a) -> CatalogAction | iTask a & iTask c
//Contact or incident
predefinedIncidentItem :: String ItemMeta (IncidentNo (Shared ActionStatus) -> Task a) -> CatalogAction | iTask a
predefinedContactItem :: String ItemMeta (Maybe String) (ContactNo (Shared ActionStatus) -> Task a) -> CatalogAction | iTask a
predefinedIncidentItem :: String ItemMeta (IncidentNo (SimpleSDSLens ActionStatus) -> Task a) -> CatalogAction | iTask a
predefinedContactItem :: String ItemMeta (Maybe String) (ContactNo (SimpleSDSLens ActionStatus) -> Task a) -> CatalogAction | iTask a
//Action lists items
listItemTask :: (String,ActionPlan) (Shared ActionStatus) -> Task ()
listItemTask :: (String,ActionPlan) (Shared sds ActionStatus) -> Task () | RWShared sds
blankListItem :: CatalogAction
predefinedListItem :: String ItemMeta ActionPlan -> CatalogAction
configurableListItem :: String ItemMeta (Task c) (c -> ActionPlan) -> CatalogAction | iTask c
......@@ -192,7 +193,7 @@ configurableListItem :: String ItemMeta (Task c) (c -> ActionPlan)
* @param Group by incidents
* @param Use 'my actions' group for current user
*/
chooseActionItem :: d Bool Bool (ROShared () [(InstanceNo,InstanceNo,ActionStatus)]) -> Task InstanceNo | toPrompt d
chooseActionItem :: d Bool Bool (sds () [(InstanceNo,InstanceNo,ActionStatus)] ()) -> Task InstanceNo | toPrompt d & RWShared sds
workOnActionItem :: InstanceNo -> Task ()
editActionItem :: InstanceNo -> Task (Maybe ActionStatus)
deleteActionItem :: InstanceNo -> Task (Maybe ActionStatus)
......
......@@ -34,15 +34,15 @@ from iTasks.Extensions.Web import :: URL
derive class iTask DBConfig, AISConfig, AsteriskConfig, SMTPConfig, WebLinksConfig, WebLink
//Master configuration shares
databaseConfig :: Shared DBConfig
aisLinkConfig :: Shared AISConfig
asteriskLinkConfig :: Shared AsteriskConfig
smtpConfig :: Shared SMTPConfig
webLinksConfig :: Shared WebLinksConfig
adminPassword :: Shared Password
databaseConfig :: SimpleSDSLens DBConfig
aisLinkConfig :: SimpleSDSLens AISConfig
asteriskLinkConfig :: SimpleSDSLens AsteriskConfig
smtpConfig :: SimpleSDSLens SMTPConfig
webLinksConfig :: SimpleSDSLens WebLinksConfig
adminPassword :: SimpleSDSLens Password
//Derived configuration shares
databaseDef :: RWShared () SQLDatabaseDef SQLDatabaseDef
databaseDef :: SimpleSDSLens SQLDatabaseDef
//Conversion functions
toDatabaseDef :: DBConfig -> SQLDatabaseDef
......
......@@ -4,27 +4,27 @@ import iTasks, iTasks.Extensions.SQLDatabase, iTasks.Extensions.Web
derive class iTask DBConfig, AISConfig, AsteriskConfig, SMTPConfig, WebLinksConfig, WebLink
//Shared stores
databaseConfig :: Shared DBConfig
databaseConfig :: SimpleSDSLens DBConfig
databaseConfig = sharedStore "databaseConfig" InternalSQLiteDB
aisLinkConfig :: Shared AISConfig
aisLinkConfig :: SimpleSDSLens AISConfig
aisLinkConfig = sharedStore "aisLinkConfig" {AISConfig|host="localhost",port=2000}
asteriskLinkConfig :: Shared AsteriskConfig
asteriskLinkConfig :: SimpleSDSLens AsteriskConfig
asteriskLinkConfig = sharedStore "asteriskLinkConfig" {AsteriskConfig|host="localhost",port=5038,username="admin",password="secret"}
smtpConfig :: Shared SMTPConfig
smtpConfig :: SimpleSDSLens SMTPConfig
smtpConfig = sharedStore "smtpConfig" {SMTPConfig|host="localhost",port=25}
webLinksConfig :: Shared WebLinksConfig
webLinksConfig :: SimpleSDSLens WebLinksConfig
webLinksConfig = sharedStore "webLinksConfig" {WebLinksConfig|weatherWidgets=Nothing,vesselLinks=[]}
adminPassword :: Shared Password
adminPassword :: SimpleSDSLens Password
adminPassword = sharedStore "adminPassword" (Password "admin")
//Derived configuration shares
databaseDef :: RWShared () SQLDatabaseDef SQLDatabaseDef
databaseDef = mapReadWrite (toDatabaseDef,\_ _ -> Nothing) (toReadOnly databaseConfig)
databaseDef :: SimpleSDSLens SQLDatabaseDef
databaseDef = mapReadWrite (toDatabaseDef,\_ r -> Nothing) Nothing (toReadOnly databaseConfig)
//Conversion functions
toDatabaseDef :: DBConfig -> SQLDatabaseDef
......
......@@ -74,8 +74,8 @@ fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID]
//Standard layers available to use in all map views
standardPerspective :: Shared ContactMapPerspective
standardMapLayers :: Shared [ContactMapLayer]
standardPerspective :: SimpleSDSLens ContactMapPerspective
standardMapLayers :: SimpleSDSLens [ContactMapLayer]
derive JSONEncode ContactPosition, ContactMapPerspective
derive JSONDecode ContactPosition, ContactMapPerspective
......
......@@ -225,9 +225,9 @@ fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng)
fromLeafletBounds :: !LeafletBounds -> (!(!Real,!Real),!(!Real,!Real))
fromLeafletBounds {LeafletBounds|southWest,northEast} = (fromLeafletLatLng southWest,fromLeafletLatLng northEast)
standardPerspective :: Shared ContactMapPerspective
standardPerspective :: SimpleSDSLens ContactMapPerspective
standardPerspective = sharedStore "standardPerspective" defaultValue
standardMapLayers :: Shared [ContactMapLayer]
standardMapLayers :: SimpleSDSLens [ContactMapLayer]
standardMapLayers = sharedStore "standardMapLayers" [{ContactMapLayer|title="Local OSM tiles",def=CMTileLayer "/tiles/{z}/{x}/{y}.png"}]
......@@ -13,7 +13,7 @@ where
header
= viewInformation () [] ("REMOTE CONTROL") //<<@ (AfterLayout (uiDefSetHalign AlignRight o uiDefSetBaseCls "wall-header")) //FIXME
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |*| contactsProvidingHelpGeo)
selectContent
= (switchContent >&> withSelection viewNoSelection configureContent) <<@ (ArrangeWithSideBar 0 LeftSide 300 False)
......@@ -27,10 +27,10 @@ where
where
title = "Configure Content"
configure "Overview"
= get (standardMapLayers |+| standardPerspective)
= get (standardMapLayers |*| standardPerspective)
>>- \(baseLayers,perspective) ->
withShared perspective
\p -> updateSharedInformation (Title title) [UpdateAs (toMap baseLayers) fromMap] (p >+| mapContacts) @ fst
\p -> updateSharedInformation (Title title) [UpdateAs (toMap baseLayers) fromMap] (p >*| mapContacts) @ fst
//<<@ AfterLayout (tweakUI fill) //FIXME
@ WallOverview
where
......
......@@ -14,7 +14,7 @@ import Incidone.OP.Concepts
derive class iTask WallContent
//Current content of the video wall
wallContent :: Shared WallContent
wallContent :: SimpleSDSLens WallContent
//View content that was selected for viewing on the video wall
viewVideoWallContent :: Task WallContent
......@@ -7,7 +7,7 @@ import Text, Text.HTML, Data.List, iTasks.Internal.HtmlUtil
derive class iTask WallContent
wallContent :: Shared WallContent
wallContent :: SimpleSDSLens WallContent
wallContent = sharedStore "WallContent" (WallOverview defaultValue)
viewVideoWallContent :: Task WallContent
......@@ -15,7 +15,7 @@ viewVideoWallContent
= (header ||- content) <<@ (ArrangeWithSideBar 0 TopSide 30 False) //<<@ AfterLayout plainLayoutFinal //FIXME
where
header
= viewSharedInformation () [ViewAs view] (currentTime |+| currentUTCTime) //<<@ (AfterLayout (uiDefSetHalign AlignRight o uiDefSetBaseCls "wall-header")) //FIXME
= viewSharedInformation () [ViewAs view] (currentTime |*| currentUTCTime) //<<@ (AfterLayout (uiDefSetHalign AlignRight o uiDefSetBaseCls "wall-header")) //FIXME
where
view (local,utc) = "LOCAL: " + lpad (toString local.Time.hour) 2 '0' + ":" + lpad (toString local.Time.min) 2 '0' + " "
+ "UTC: " + lpad (toString utc.Time.hour) 2 '0' + ":" + lpad (toString utc.Time.min) 2 '0'
......@@ -31,7 +31,7 @@ where
formatTime time = DivTag [StyleAttr "font-size: 80pt; text-align: center; padding-top: 200px;"] [Text (toString time)]
formatDateTime time = DivTag [StyleAttr "font-size: 80pt; text-align: center; padding-top: 200px;"] [Text (toString time)]
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |*| contactsProvidingHelpGeo)
viewWallOverview perspective
= ((viewSharedInformation (Title "Open Incidents") [ViewAs formatIncidents] openIncidentsDetails)
......
......@@ -10,10 +10,10 @@ import qualified Data.Map as DM
//This module provides an add-on that keeps track of the deployed crew of a rescue vessel
//Data storage
crewListsStore :: RWShared ContactNo [ContactNo] [ContactNo]
crewListsStore :: SDSLens ContactNo [ContactNo] [ContactNo]
crewListsStore = indexedStore "crewLists" []
crewAliasListsStore :: RWShared ContactNo [(Int,ContactNo)] [(Int,ContactNo)]
crewAliasListsStore :: SDSLens ContactNo [(Int,ContactNo)] [(Int,ContactNo)]
crewAliasListsStore = indexedStore "crewAliasLists" []
//Manage the crew information for a specific contact
......
......@@ -133,7 +133,7 @@ relateMessageToIncidents communicationNo
= manageSharedListWithDetails details add aboutIncidents
where
aboutIncidents = sdsFocus communicationNo communicationAboutIncidents
communicationAboutIncidents = mapReadWrite (toPrj,fromPrj) communicationByNo
communicationAboutIncidents = mapReadWrite (toPrj,fromPrj) Nothing communicationByNo
where
toPrj {Communication|aboutIncidents} = aboutIncidents
fromPrj aboutIncidents c = Just {Communication|c & aboutIncidents = aboutIncidents}
......@@ -195,27 +195,27 @@ updateMessageMeta communicationNo
) <<@ ArrangeSplit Horizontal False
@ \(_,(status,_)) -> status
phoneCallExternalNo = mapReadWrite (toExternalNo,fromExternalNo) phoneCallByNo
phoneCallExternalNo = mapReadWrite (toExternalNo,fromExternalNo) Nothing phoneCallByNo
where
toExternalNo {PhoneCall|externalNo} = externalNo
fromExternalNo nexternalNo c=:{PhoneCall|externalNo} = if (nexternalNo =!= externalNo) (Just {PhoneCall|c & externalNo = nexternalNo}) Nothing
radioCallChannel = mapReadWrite (toChannel,fromChannel) radioCallByNo
radioCallChannel = mapReadWrite (toChannel,fromChannel) Nothing radioCallByNo
where
toChannel {RadioCall|channel} = channel
fromChannel nchannel c=:{RadioCall|channel} = if (nchannel =!= channel) (Just {RadioCall|c & channel = nchannel}) Nothing
communicationTime = mapReadWrite (toTime,fromTime) communicationByNo
communicationTime = mapReadWrite (toTime,fromTime) Nothing communicationByNo
where
toTime {Communication|time} = time
fromTime ntime c=:{Communication|time} = if (ntime =!= time) (Just {Communication|c & time = ntime}) Nothing
communicationStatus = mapReadWrite (toStatus,fromStatus) communicationByNo
communicationStatus = mapReadWrite (toStatus,fromStatus) Nothing communicationByNo
where
toStatus {Communication|status} = status
fromStatus nstatus c=:{Communication|status} = if (nstatus =!= status) (Just {Communication|c & status = nstatus}) Nothing
communicationHandledBy = mapReadWrite (toHandledBy,fromHandledBy) communicationByNo
communicationHandledBy = mapReadWrite (toHandledBy,fromHandledBy) Nothing communicationByNo
where
toHandledBy {Communication|handledBy} = handledBy
fromHandledBy nhandledBy c=:{Communication|handledBy} = if (nhandledBy =!= handledBy) (Just {Communication|c & handledBy = nhandledBy}) Nothing
......@@ -296,12 +296,12 @@ where
= updateSharedInformation (Title "Notes") [] (callNotes type) //<<@ FillNotes //FIXME
@! ()
callNotes PhoneCall = sdsFocus communicationNo (mapReadWrite (toPrj,fromPrj) phoneCallByNo)
callNotes PhoneCall = sdsFocus communicationNo (mapReadWrite (toPrj,fromPrj) Nothing phoneCallByNo)
where
toPrj {PhoneCall|callNotes} = callNotes
fromPrj callNotes c = Just {PhoneCall|c & callNotes = callNotes}
callNotes RadioCall = sdsFocus communicationNo (mapReadWrite (toPrj,fromPrj) radioCallByNo)
callNotes RadioCall = sdsFocus communicationNo (mapReadWrite (toPrj,fromPrj) Nothing radioCallByNo)
where
toPrj {RadioCall|callNotes} = callNotes
fromPrj callNotes c = Just {RadioCall|c & callNotes = callNotes}
......@@ -327,7 +327,7 @@ createP2000Message direction = createCommunication P2000Message direction Nothin
createCommunication :: CommunicationType CommunicationDirection (Maybe ContactNo)-> Task CommunicationNo
createCommunication type direction mbWithContact
= get (currentDateTime |+| databaseDef)
= get (currentDateTime |*| databaseDef)
>>- \(datetime,db) ->
sqlExecute db ["allCommunications"] (execInsert "INSERT INTO Communication (time,type,direction,withContact) VALUES (?,?,?,?)" (flatten [toSQL datetime,toSQL type,toSQL direction,mbToSQL mbWithContact]))
>>- \communicationNo -> case type of
......
......@@ -27,7 +27,7 @@ viewContactCommunicationMeans :: ContactNo -> Task [CommunicationMean]
updateContactPosition :: ContactNo -> Task (Maybe (Maybe ContactPosition))
updateContactStatus :: ContactNo -> Task (Maybe (Maybe ContactStatus))
updateSharedContactRefList :: d (RWShared () [ContactNo] [ContactNo]) -> Task [ContactNo] | toPrompt d
updateSharedContactRefList :: d (Shared sds [ContactNo]) -> Task [ContactNo] | toPrompt d & RWShared sds
selectKnownOrDefineNewContact :: Task (Either ContactNo NewContact)
createContactIfNew :: (Either ContactNo NewContact) -> Task ContactNo
......@@ -36,7 +36,7 @@ createContact :: NewContact -> Task ContactNo
deleteContact :: ContactNo -> Task ()
addContactPhoto :: ContactNo Document -> Task ContactPhoto
updatePosition :: ContactPosition String (Shared Contact) -> Task Contact
updatePosition :: ContactPosition String (Shared sds Contact) -> Task Contact | RWShared sds
createCommunicationMean :: ContactNo NewCommunicationMean -> Task CommunicationMeanId
deleteCommunicationMean :: CommunicationMeanId -> Task ()
......@@ -44,4 +44,4 @@ deleteCommunicationMean :: CommunicationMeanId -> Task ()
//Check credentials for contacts that can log in
verifyContactCredentials :: Credentials -> Task (Maybe User)
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
viewContactsOnMap :: (sds1 () [ContactGeo] w) (Shared sds2 (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w & RWShared sds1 & RWShared sds2
......@@ -27,9 +27,9 @@ selectContact = withShared Nothing
<<@ ArrangeWithTabs True
)
where
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |+| contactsProvidingHelpGeo)
mapContacts = mapRead (\(x,y) -> x++y) (contactsOfOpenIncidentsGeo |*| contactsProvidingHelpGeo)
selectContactFromLists :: (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI)
selectContactFromLists :: (Shared sds (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | RWShared sds
selectContactFromLists sel
= anyTask [editSharedSelectionWithShared (Title "Involved in open incidents") False
(SelectInTree groupByIncident select) contactsOfOpenIncidentsShort (selIds sel)
......@@ -44,7 +44,8 @@ where
fromOpenOption [{ContactShortWithIncidents|contactNo}] = contactNo
selIds sel = mapReadWrite (toPrj,fromPrj) sel
selIds :: (Shared sds (Maybe (Either ContactNo MMSI))) -> SimpleSDSLens [Int] | RWShared sds
selIds sel = mapReadWrite (toPrj,fromPrj) (Just \p w. Ok (toPrj w)) sel
where
toPrj Nothing = []
toPrj (Just (Left contactNo)) = [contactNo]
......@@ -112,7 +113,7 @@ manageContactBasics contactNo = (
] @! ()) <<@ Title "General" <<@ (ApplyAttribute "icon" "basic-information")
where
contactBasics contactNo = mapReadWrite (toPrj,fromPrj) (sdsFocus contactNo contactByNo)
contactBasics contactNo = mapReadWrite (toPrj,fromPrj) (Just \p w. Ok (toPrj w)) (sdsFocus contactNo contactByNo)
where
toPrj {Contact|type,name,group,position,heading,needsHelp,providesHelp,status,notes}
= {ContactBasic|type=type,name=name,group=group,position=position,heading=heading,needsHelp=needsHelp,providesHelp=providesHelp,status=status,notes=notes}
......@@ -387,7 +388,7 @@ where
updateContactPosition :: ContactNo -> Task (Maybe (Maybe ContactPosition))
updateContactPosition contactNo
= get (sdsFocus contactNo contactByNo |+| standardMapLayers)
= get (sdsFocus contactNo contactByNo |*| standardMapLayers)
>>- \({Contact|name,type,position},baseLayers) ->
withShared (position,initPerspective position)
\tmpInfo ->
......@@ -434,7 +435,7 @@ updateContactStatus contactNo
>>| logContactStatusUpdated contactNo status newStatus
@! newStatus
updateSharedContactRefList :: d (RWShared () [ContactNo] [ContactNo]) -> Task [ContactNo] | toPrompt d
updateSharedContactRefList :: d (Shared sds [ContactNo]) -> Task [ContactNo] | toPrompt d & RWShared sds
updateSharedContactRefList d refs
= manageCurrentItems
>^* [OnAction (Action "Add") (always (addItem <<@ InWindow))]
......@@ -540,7 +541,7 @@ deleteCommunicationMean id
["CommunicationMean","Telephone","VHFRadio","EmailAccount","P2000Receiver"]]
@! ()
updatePosition :: ContactPosition String (Shared Contact) -> Task Contact
updatePosition :: ContactPosition String (Shared sds Contact) -> Task Contact | RWShared sds
updatePosition newposition src contact
= upd (update newposition src) contact
where
......@@ -552,9 +553,9 @@ verifyContactCredentials credentials
= get (sdsFocus credentials contactByCredentials)
@ fmap contactUser
viewContactsOnMap :: (ReadWriteShared [ContactGeo] w) (Shared (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w
viewContactsOnMap :: (sds1 () [ContactGeo] w) (Shared sds2 (Maybe (Either ContactNo MMSI))) -> Task (Either ContactNo MMSI) | iTask w & RWShared sds1 & RWShared sds2
viewContactsOnMap sharedContacts sel
= get (standardMapLayers |+| standardPerspective)
= get (standardMapLayers |*| standardPerspective)
>>- \(baseLayers,perspective) ->
withShared (False,perspective)
\localState ->
......@@ -565,11 +566,11 @@ viewContactsOnMap sharedContacts sel
]
@? selection
where
mapState :: (Shared (Bool,ContactMapPerspective))
(ReadWriteShared [ContactGeo] w)
(Shared (Maybe (Either ContactNo MMSI))) ->
ReadWriteShared ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective) | iTask w
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >+< sel) mapContacts
mapState :: (Shared sds1 (Bool,ContactMapPerspective))
(sds2 () [ContactGeo] w)
(Shared sds3 (Maybe (Either ContactNo MMSI))) ->
SDSSequence () ([(Bool,ContactGeo)], Maybe (Either ContactNo MMSI), ContactMapPerspective) (Maybe (Either ContactNo MMSI), ContactMapPerspective) | iTask w & RWShared sds1 & RWShared sds2 & RWShared sds3
mapState local contacts sel = sdsSequence "mapState" id (\_ r -> r) (\_ _ -> Right read) writel writer (local >*< sel) mapContacts
where
mapContacts = sdsSelect "mapContacts" choose (SDSNotifyConst (\_ _ _ _-> False)) (SDSNotifyConst (\_ _ _ _-> False)) withoutAISContacts withAISContacts
where
......@@ -580,7 +581,7 @@ where
aisContacts = mapRead (\cs -> [(True,c)\\c=:{ContactGeo|position=Just position}<-map aisToContactGeo cs]) (toReadOnly boundedAISContacts)
withoutAISContacts = sdsFocus () baseContacts
withAISContacts = mapRead (\(a,b) -> a++b) (aisContacts |+| sdsFocus () baseContacts)
withAISContacts = mapRead (\(a,b) -> a++b) (aisContacts |*| sdsFocus () baseContacts)
read (((showAis,perspective),mbSel),contacts) = (contacts,mbSel,perspective)
writel = SDSWrite (\_ ((showAis,_),_) (mbSel,perspective) -> Ok (Just ((showAis,perspective),mbSel)))
......
......@@ -12,7 +12,7 @@ manageIncidentLog :: IncidentNo -> Task ()
viewIncidentDetails :: IncidentNo -> Task ()
//Reusable task fragments
updateSharedIncidentRefList :: d Bool (RWShared () [IncidentNo] [IncidentNo]) -> Task [IncidentNo] | toPrompt d
updateSharedIncidentRefList :: d Bool (Shared sds [IncidentNo]) -> Task [IncidentNo] | toPrompt d & RWShared sds
selectKnownOrDefineNewIncident :: Task (Either IncidentNo NewIncident)
createIncidentIfNew :: (Either IncidentNo NewIncident) -> Task IncidentNo
......
......@@ -39,7 +39,7 @@ manageIncidentSituationInfo incidentNo
,OnAction (Action "/Close incident") (always (confirmCloseIncident incidentNo <<@ InWindow))
]
where
situation = mapReadWrite (toPrj,fromPrj) (sdsFocus incidentNo incidentByNo)
situation = mapReadWrite (toPrj,fromPrj) (Just \_ w. Ok (toPrj w)) (sdsFocus incidentNo incidentByNo)
where
toPrj {Incident|title,summary,type,phase}
= {IncidentBasic|title,summary,type,phase}
......@@ -164,7 +164,7 @@ viewIncidentDetails incidentNo
where
incident = sdsFocus incidentNo incidentByNo
updateSharedIncidentRefList :: d Bool (RWShared () [IncidentNo] [IncidentNo]) -> Task [IncidentNo] | toPrompt d
updateSharedIncidentRefList :: d Bool (Shared sds [IncidentNo]) -> Task [IncidentNo] | toPrompt d & RWShared sds
updateSharedIncidentRefList d compact refs
= manageCurrentItems
>^* [OnAction (Action "Add") (always (addItem <<@ InWindow))]
......
......@@ -238,7 +238,7 @@ configureWebLinks
where
exportConfig
= doOrClose (
get (webLinksConfig |+| currentDateTime)
get (webLinksConfig |*| currentDateTime)
>>- \(config,now) -> createJSONFile ("Incidone-weblinks-" +++ paddedDateTimeString now +++ ".json") config
>>- viewInformation "An export file has been created" []
@! ()
......
......@@ -5,11 +5,11 @@ import Text, System.Time
import Incidone.Util.TaskPatterns
//Notifications are stored newest first
notifications :: Shared [(DateTime,String)]
notifications :: SimpleSDSLens [(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 (now,notifications) = [toString dt +++ msg \\ (dt,msg) <- notifications | limit now dt ]
......
......@@ -56,12 +56,12 @@ toOrderBySQL :: [RowOrderDef] -> String
fromSQLWithId :: [SQLValue] -> (Int,a) | mbFromSQL a
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p & TC r & TC w
(>++>) infixl 6 :: (Shared sds1 SQLDatabaseDef) (sds2 (SQLDatabaseDef,p) r w) -> SDSSequence p r w | iTask p & TC r & TC w & RWShared sds1 & RWShared sds2
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadWriteOneSDS :: String -> RWShared (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlLinkSDS :: String String String String-> RWShared (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
sqlReadSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) [r] () | mbFromSQL r
sqlReadWriteOneSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlLinkSDS :: String String String String-> SDSSource (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
groupByFst :: [(a,b)] -> Map a [b] | Eq a & Ord a
ungroupByFst :: (Map a [b]) -> [(a,b)]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
roMaybe :: (sds p (Maybe r) ()) -> SDSSelect (Maybe p) (Maybe r) () | iTask p & TC r & RWShared sds
......@@ -147,10 +147,10 @@ fromSQLWithId :: [SQLValue] -> (Int,a) | mbFromSQL a
fromSQLWithId row = (fromSQL [last row],fromSQL (init row))
//UTIL SDS Combinators
(>++>) infixl 6 :: (RWShared () SQLDatabaseDef SQLDatabaseDef) (RWShared (SQLDatabaseDef,p) r w) -> RWShared p r w | iTask p & TC r & TC w
(>++>) infixl 6 :: (Shared sds1 SQLDatabaseDef) (sds2 (SQLDatabaseDef,p) r w) -> SDSSequence p r w | iTask p & TC r & TC w & RWShared sds1 & RWShared sds2
(>++>) db sds = sdsSequence ">++>" id (\p db -> (db,p)) (\_ _ -> Right snd) (SDSWriteConst (\_ _ -> Ok Nothing)) (SDSWriteConst (\_ w -> Ok (Just w))) (sdsFocus () db) sds
sqlReadSDS :: String -> ROShared (SQLDatabaseDef,QueryDef) [r] | mbFromSQL r
sqlReadSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) [r] () | mbFromSQL r
sqlReadSDS notifyId = sqlShare notifyId readFun writeFun
where
readFun query cur
......@@ -163,7 +163,7 @@ where
writeFun _ _ cur = (Ok (), cur)
sqlReadWriteOneSDS :: String -> RWShared (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlReadWriteOneSDS :: String -> SDSSource (SQLDatabaseDef,QueryDef) r r | mbFromSQL, mbToSQL r & gDefault{|*|} r
sqlReadWriteOneSDS notifyId = sqlShare notifyId readFun writeFun
where
readFun query cur
......@@ -197,7 +197,7 @@ where
= (Ok (), cur)
*/
sqlLinkSDS :: String String String String-> RWShared (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
sqlLinkSDS :: String String String String-> SDSSource (SQLDatabaseDef,Maybe [Int]) [(Int,Int)] [(Int,Int)]
sqlLinkSDS notifyId table col1 col2 = sqlShare notifyId readFun writeFun
where
query match
......@@ -231,7 +231,7 @@ where
ungroupByFst :: (Map a [b]) -> [(a,b)]
ungroupByFst index = flatten [[(a,b) \\ b <- bs] \\ (a,bs) <- 'DM'.toList index]
roMaybe :: (RWShared p (Maybe r) ()) -> RWShared (Maybe p) (Maybe r) () | iTask p & TC r
roMaybe :: (sds p (Maybe r) ()) -> SDSSelect (Maybe p) (Maybe r) () | iTask p & TC r & RWShared sds
roMaybe sds = sdsSelect "roMaybe" choose (SDSNotifyConst (\_ _ _ _ -> False)) (SDSNotifyConst (\_ _ _ _-> False)) (constShare Nothing) sds
where
choose Nothing = Left ()
......
......@@ -13,20 +13,20 @@ import qualified Data.Map
createNewIncident :: Task (Maybe IncidentNo)
createNewContact :: Task (Maybe ContactNo)
indexedStore :: String v -> RWShared k v v | Eq k & Ord k & iTask k & iTask v
sdsDeref :: (RWShared p [a] [a]) (a -> Int) (RWShared [Int] [b] x) ([a] [b] -> [c]) -> (RWShared p [c] [a]) | iTask p & TC a & TC b & TC c & TC x
indexedStore :: String v -> SDSLens k v v | Eq k & Ord k & iTask k & iTask v
sdsDeref :: (sds1 p [a] [a]) (a -> Int) (sds2 [Int] [b] x) ([a] [b] -> [c]) -> (SDSSequence p [c] [a]) | iTask p & TC a & TC b & TC c & TC x & RWShared sds1 & RWShared sds2
// Information management
viewDetails :: !d (ReadOnlyShared (Maybe i)) (RWShared i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c
viewDetails :: !d (sds1 () (Maybe i) ()) (sds2 i c c) (c -> v) -> Task (Maybe v) | toPrompt d & iTask i & iTask v & iTask c & RWShared sds1 & RWShared sds2