Commit ae8623a2 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into 259-editors-need-refinement

parents 16e30a0c ef337e8b
Pipeline #19582 passed with stage
in 5 minutes and 35 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
......
......@@ -8,6 +8,7 @@ import Incidone.OP.CommunicationManagementTasks
import Incidone.Util.TaskPatterns
import Text, Data.Either
import qualified Data.Map as DM
import Data.Map.GenJSON
:: AsteriskEvent :== Map String String // Simple key/value mapping
......
......@@ -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
......@@ -9,6 +9,7 @@ import Incidone.DeviceBased.VideoWall
import Incidone.Extensions.CrewLists //For demo
import qualified Data.Map as DM
import Data.Map.GenJSON
import Text, Text.HTML, Data.Either, Data.Functor
import iTasks.UI.Editor.Controls
......@@ -27,9 +28,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 +45,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 +114,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 +389,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 +436,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 +542,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 +554,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) ->