IncidentManagementTasks.icl 17.7 KB
Newer Older
1
implementation module Incidone.OP.IncidentManagementTasks
2
import iTasks, iTasks.Internal.HtmlUtil, iTasks.Extensions.SQLDatabase
3
import iTasks.Extensions.DateTime
4 5 6 7 8 9 10 11
import Incidone.Configuration
import Incidone.OP.Concepts, Incidone.OP.SDSs, Incidone.OP.Conversions
import Incidone.OP.ContactManagementTasks
import Incidone.Util.TaskPatterns
import Incidone.Util.Differences
import Incidone.Util.Notification
import Incidone.DeviceBased.VideoWall
import Incidone.ActionManagementTasks
12
import Data.List, Data.Either
13
import qualified Data.Map as DM
14
import Data.Map.GenJSON
15
import Text.HTML
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

openIncidentInWorkspace :: Workspace IncidentNo -> Task ()
openIncidentInWorkspace ws incidentNo
    =   addOnceToWorkspace ("incident-"<+++incidentNo) (doOrClose (manageIncidentInformation ws incidentNo)) ws @! ()

//View and add/update all information known about the incident
//Summary in body, and special parts in separate detached tasks
manageIncidentInformation :: Workspace IncidentNo  -> Task ()
manageIncidentInformation ws incidentNo
	=	withHeader (viewSharedTitle (sdsFocus incidentNo incidentTitleByNo))
		(parallel
		    [(Embedded, \_ -> manageIncidentSituationInfo incidentNo )
		    ,(Embedded, \_ -> manageIncidentContacts ws incidentNo)
		    ,(Embedded, \_ -> manageIncidentActions incidentNo)
		    ,(Embedded, \_ -> manageIncidentWeather incidentNo)
31
		    ,(Embedded, \_ -> manageIncidentLog incidentNo)
Bas Lijnse's avatar
Bas Lijnse committed
32
		    ] [] <<@ ArrangeWithTabs False)
33 34 35 36 37 38
    @! ()

//Basic incident information (title, summary, type, phase etc..)
manageIncidentSituationInfo :: IncidentNo -> Task ()
manageIncidentSituationInfo incidentNo
    =	viewOrEdit (Icon "basic-information","General","The following general information is known about the situation") situation log
Bas Lijnse's avatar
Bas Lijnse committed
39 40
    >^* [OnAction (Action "/Share to wall") (always (shareIncident incidentNo))
        ,OnAction (Action "/Close incident") (always (confirmCloseIncident incidentNo <<@ InWindow))
41 42
        ]
where
43
    situation = mapReadWrite (toPrj,fromPrj) (Just \_ w. Ok (toPrj w)) (sdsFocus incidentNo incidentByNo)
44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
    where
        toPrj {Incident|title,summary,type,phase}
	        = {IncidentBasic|title,summary,type,phase}
        fromPrj {IncidentBasic|title,summary,type,phase} incident
	        = Just {Incident|incident&title = title, summary = summary, type = type, phase = phase}

    log = logIncidentBasicsUpdated incidentNo

    shareIncident incidentNo = set (WallIncidentSummary (Just incidentNo)) wallContent @! ()
    confirmCloseIncident incidentNo
        =  viewInformation ("Close incident","Are you sure you want to close this incident?") [] ()
        >>* [OnAction ActionYes (always (closeIncident incidentNo))
            ,OnAction ActionNo (always (return ()))
            ]

manageIncidentContacts :: Workspace IncidentNo -> Task ()
manageIncidentContacts ws incidentNo
    =   manageContacts <<@ (Icon "contacts") <<@ (Title "Involved Contacts")
    @! ()
where
	contacts        = sdsFocus incidentNo contactsByIncident
	manageContacts  = ((withShared Nothing (\sel -> (chooseFromList sel -||- chooseFromMap sel) <<@ (ArrangeWithSideBar 0 LeftSide 250 True))))
Bas Lijnse's avatar
Bas Lijnse committed
66 67 68 69 70
                    >^* [(OnAction (Action "/Add contact") (always (add <<@ InWindow @! ())))
                        ,(OnAction (Action "/Remove contact") (ifValue (\c -> c=:(Left _)) (\(Left c) -> (remove c <<@ InWindow @! ()))))
                        ,(OnAction (Action "/Update position") (ifValue (\c -> c=:(Left _)) (\(Left c) -> updateContactPosition c <<@ InWindow @! ())))
                        ,(OnAction (Action "/Update status") (ifValue (\c -> c=:(Left _)) (\(Left c) -> updateContactStatus c <<@ InWindow @! ())))
                        ,(OnAction (Action "/Open contact") (ifValue (\c -> c=:(Left _)) (\(Left c) -> openContactInWorkspace ws c)))
71
                        ]
72
    chooseFromList sel = editSharedChoiceWithSharedAs () [ChooseFromList listView] contacts (Left o contactIdentity) sel
73 74 75 76 77 78
    chooseFromMap sel = viewContactsOnMap (sdsFocus incidentNo contactsByIncidentGeo) sel

    listView c=:{Contact|name,type,status,photos}
        = ">" <+++ type <+++ ": " <+++ name <+++ " (" <+++ status <+++ ")"

    add	= oneOrAnother (Title "Add contact..")
79
            ("Known contact",enterChoiceWithSharedAs () [ChooseFromDropdown id] allContactsShort contactNo)
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
            ("Add new contact",enterInformation () [])
		>>? \contact ->
            createContactIfNew contact
            >>- \contactNo ->
		        upd (\cs -> map contactIdentity cs ++ [contactNo]) contacts
            >>| logContactAdded incidentNo contactNo
    where
        contactNo {ContactShort|contactNo} = contactNo

        createContactIfNew (Left no) = return no
        createContactIfNew (Right c) = createContact c

	remove sel
        = viewSharedInformation ("Remove contact from incident","Are your sure you want to remove this contact?") [] (mapRead contactTitle (sdsFocus sel contactByNo)) //TODO: Create contactTitle share
	    >>* [OnAction ActionNo (always (return ()))
	        ,OnAction ActionYes (always (upd (\cs -> [c \\ c <- map contactIdentity cs | c <> sel]) contacts >>| logContactRemoved incidentNo sel))
		    ]

manageIncidentActions :: IncidentNo -> Task ()
manageIncidentActions incidentNo
	=	selectAndWorkOnPlannedActions
Bas Lijnse's avatar
Bas Lijnse committed
101
    >^* [OnAction (Action "/Add action") (always (addTopActionItem [] [incidentNo]))]
102 103 104
	@!  ()
where
    selectAndWorkOnPlannedActions
105
        = (feedForward (chooseActionItem (Title "Overview") False True (sdsFocus incidentNo actionStatusesByIncident) /* <<@ AfterLayout (tweakUI fill) */)
106 107 108 109 110
        (\s -> whileUnchanged s
            (\t -> case t of
              Just taskId    = workOnActionItem taskId
              Nothing        = viewInformation () [] ()
            )
111
        )) <<@ (ArrangeWithSideBar 0 LeftSide 250 True) <<@ (Icon "actions") <<@ (Title "Incident Actions") //FIXME
112 113 114 115 116 117 118 119 120 121 122 123

manageIncidentWeather :: IncidentNo -> Task ()
manageIncidentWeather incidentNo
    =   (get webLinksConfig
    >>- \webConfig -> case webConfig.weatherWidgets of
        Just widgets = (viewWebWeather widgets ||- viewOrEdit (Title "Weather on scene") weather log) <<@ (ArrangeWithSideBar 0 RightSide 300 True)
        Nothing      = viewOrEdit (Title "Weather on scene") weather log

    ) <<@ Title "Weather" <<@ Icon "weather"
where
    weather = sdsFocus incidentNo incidentWeather
    log     = logIncidentWeatherUpdated incidentNo
124
    viewWebWeather widgets = viewInformation (Title "Web weather info") [] (Html widgets)
125 126 127 128 129 130 131 132

manageIncidentLog :: IncidentNo -> Task ()
manageIncidentLog incidentNo
    =     addMessages incidentNo
    ||-   viewIncidentLog incidentNo <<@ ArrangeWithSideBar 0 TopSide 100 False <<@ Title "Log" <<@ Icon "Log"
    @! ()
where
    viewIncidentLog :: IncidentNo -> Task [LogEntry]
133
    viewIncidentLog incident = viewSharedInformation () [ViewAs toView] (sdsFocus incidentNo incidentLog)
134 135 136 137 138 139 140 141 142 143 144 145 146
    where
        toView log = DivTag [ClassAttr "incident-log"] (flatten [[vizDate date:map vizEntry entries] \\ (date,entries) <- groupByDate log])

        vizDate date = H2Tag [ClassAttr "incident-log-date"] [Text (toString date)]
        vizEntry entry = DivTag [ClassAttr "incident-log-entry"]
                                (vizAvatar entry.loggedBy ++ vizName entry.loggedBy ++ vizTime entry.eventAt ++ vizMessage entry.message)
        vizName (Just {ContactAvatar|name=Just name})
            = [DivTag [ClassAttr "incident-log-name"] [Text name]]
        vizName _
            = [DivTag [ClassAttr "incident-log-name"] [Text "System message"]]
        vizAvatar (Just {ContactAvatar|photos=[p:_]})
            = [DivTag [ClassAttr "incident-log-avatar"] [ImgTag [SrcAttr p.ContactPhoto.avatar.contentUrl,HeightAttr "50",WidthAttr "50"]]]
        vizAvatar _ = []
Bas Lijnse's avatar
Bas Lijnse committed
147
        vizTime (datetime) = [DivTag [ClassAttr "incident-log-time"] [Text (toString (toTime datetime))]]
148 149
        vizMessage message = [DivTag [ClassAttr "incident-log-message"] [nl2br (toString message)]]

Bas Lijnse's avatar
Bas Lijnse committed
150
        groupByDate log = [(toDate e.eventAt,es) \\ es=:[e:_] <-  groupBy (\e1 e2 -> toDate e1.eventAt == toDate e2.eventAt) log]
151 152

    addMessages incidentNo = forever
Bas Lijnse's avatar
Bas Lijnse committed
153 154
        (   enterInformation () [] @ string
        >>* [OnAction (Action "Add log message") (hasValue (\msg -> addLogMessage msg incidentNo))]
155
        )
156

Bas Lijnse's avatar
Bas Lijnse committed
157 158
	string :: String -> String
	string x = x
159 160 161 162 163 164 165 166 167

viewIncidentDetails :: IncidentNo -> Task ()
viewIncidentDetails incidentNo
	= withHeader (viewSharedTitle (sdsFocus incidentNo incidentTitleByNo))
	    (viewSharedInformation () [] (mapRead incidentDetails incident)) //TODO: Create a more efficient share for the details
	@! ()
where
    incident = sdsFocus incidentNo incidentByNo

168
updateSharedIncidentRefList     :: d Bool (Shared sds [IncidentNo]) -> Task [IncidentNo] | toPrompt d & RWShared sds
169 170
updateSharedIncidentRefList d compact refs
    =   manageCurrentItems
Bas Lijnse's avatar
Bas Lijnse committed
171
    >^* [OnAction (Action "Add") (always (addItem <<@ InWindow))]
172 173
where
    manageCurrentItems
174
        = updateSharedInformation d [UpdateAs toPrj fromPrj] items @ map incidentIdentity
175 176
    where
        items = sdsDeref refs id incidentsByNosShort (\_ is -> is)
Bas Lijnse's avatar
Bas Lijnse committed
177 178
        toPrj l = [(incidentIdentity i,incidentTitle i) \\i <-l]
        fromPrj _ items = map fst items
179 180 181 182 183 184 185 186 187 188 189 190

    addItem
        =   selectKnownOrDefineNewIncident
        >>? (\def -> createIncidentIfNew def >>- \incidentNo -> upd (\r -> r ++ [incidentNo]) refs)

selectKnownOrDefineNewIncident :: Task (Either IncidentNo NewIncident)
selectKnownOrDefineNewIncident
    = oneOrAnother ("Add incident...","You can either select an open incident, or define a new one.")
        ("Known incident", chooseKnownIncident)
        ("Add new incident",enterNewIncident)
where
    chooseKnownIncident
191
        = enterChoiceWithSharedAs () [ChooseFromDropdown id] openIncidentsShort incidentIdentity
192 193 194 195 196 197 198 199 200 201 202
    enterNewIncident
        = enterInformation () []

createIncidentIfNew :: (Either IncidentNo NewIncident) -> Task IncidentNo
createIncidentIfNew (Left no) = return no
createIncidentIfNew (Right incident) = createIncident incident

addLogMessage :: msg IncidentNo -> Task IncidentNo | toString msg
addLogMessage message incidentNo
	=	get currentUserAvatar -&&- get currentDateTime
	>>- \(user,now) ->
Bas Lijnse's avatar
Bas Lijnse committed
203
        set {LogEntry|incident = incidentNo,eventAt = now, loggedAt = now, loggedBy = user, message = toString message}
204 205 206 207 208 209 210 211 212 213 214
            (sdsFocus incidentNo incidentLog)
    >>| addNotification (toString message)
	@!	incidentNo

addLogMessageForContact :: msg ContactNo -> Task [IncidentNo] | toString msg
addLogMessageForContact msg contactNo
    =   get (sdsFocus contactNo incidentsByContactShort) @ (\shorts -> [incidentNo \\{IncidentShort|incidentNo} <- shorts])
    >>- \incidentNos ->
        allTasks [addLogMessage msg incidentNo \\ incidentNo <- incidentNos]

derive gDifferences IncidentBasic, IncidentType, ContactBasic, ContactType, ContactPosition, WeatherData, Maybe, Feet, Temperature, Meters, Degrees, WeatherType, Knots
Bas Lijnse's avatar
Bas Lijnse committed
215
derive gDifferences PersonDetails, SurferDetails, VesselDetails, DiverDetails, AirplaneDetails, HelicopterDetails, EmergencyPhase, ContactStatus, Gender, Miles, VesselType
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353

logCommunicationResponded :: CommunicationNo -> Task ()
logCommunicationResponded communicationNo
    =   get (sdsFocus communicationNo communicationDetailsByNo)
    >>- \communication=:{CommunicationDetails|aboutIncidents} ->
        allTasks [addLogMessage (message communication) incidentNo \\ {IncidentShort|incidentNo} <- aboutIncidents]
    @!  ()
where
    message {CommunicationDetails|type,withContact,handledBy}
        = "Communication: " <+++ handledBy <+++ " responded to " <+++ type <+++ " with contact " <+++ withContact

logIncidentCreated :: IncidentNo NewIncident -> Task ()
logIncidentCreated incidentNo incident
    = addLogMessage (message incident) incidentNo @! ()
where
    message {NewIncident|type,title,summary}
        = "New incident: " <+++ title <+++ "\nType: " <+++ type <+++ "\nSummary:\n" <+++ summary

logIncidentBasicsUpdated :: IncidentNo IncidentBasic IncidentBasic -> Task ()
logIncidentBasicsUpdated incidentNo old new
    = addLogMessage (message old new) incidentNo @! ()
where
    message old new
        = "Situation information updated:\n" +++ showDifferences old new

logIncidentWeatherUpdated :: IncidentNo WeatherData WeatherData -> Task ()
logIncidentWeatherUpdated incidentNo old new
    = addLogMessage (message old new) incidentNo @! ()
where
    message old new
        = "Weather on scene information updated:\n" +++ showDifferences old new

logContactAdded :: IncidentNo ContactNo -> Task ()
logContactAdded incidentNo contactNo
    =   get (sdsFocus contactNo contactByNo)
    >>- \contact ->
        addLogMessage (message contact) incidentNo @! ()
where
    message {Contact|name,type} = "Added contact to incident\nName: " <+++ name <+++ "\nType: " <+++ type

logContactRemoved :: IncidentNo ContactNo -> Task ()
logContactRemoved incidentNo contactNo
    =   get (sdsFocus contactNo contactByNo)
    >>- \contact ->
        addLogMessage (message contact) incidentNo @! ()
where
    message {Contact|name,type} = "Removed contact from incident\nName: " <+++ name <+++ "\nType: " <+++ type

logContactBasicsUpdated :: ContactNo ContactBasic ContactBasic -> Task ()
logContactBasicsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Basic contact info updated:\n" +++ showDifferences old new

logContactPhotoAdded :: ContactNo ContactPhoto -> Task ()
logContactPhotoAdded contactNo photo
    = addLogMessageForContact (message photo) contactNo @! ()
where
    message {ContactPhoto|original={Document|name}}
        = "Contact photo added: " +++ name

logContactPositionUpdated :: ContactNo (Maybe ContactPosition) (Maybe ContactPosition) -> Task ()
logContactPositionUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Contact position updated:\n" +++ showDifferences old new

logContactStatusUpdated :: ContactNo (Maybe ContactStatus) (Maybe ContactStatus) -> Task ()// Updated status (add to all incidents in which involved)
logContactStatusUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Contact status updated:\n" +++ showDifferences old new


logPersonDetailsUpdated :: ContactNo PersonDetails PersonDetails -> Task ()
logPersonDetailsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Person details updated:\n" +++ showDifferences old new

logVesselDetailsUpdated :: ContactNo VesselDetails VesselDetails -> Task ()
logVesselDetailsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Vessel details updated:\n" +++ showDifferences old new

logSurferDetailsUpdated :: ContactNo SurferDetails SurferDetails -> Task ()
logSurferDetailsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Surfer details updated:\n" +++ showDifferences old new

logDiverDetailsUpdated :: ContactNo DiverDetails DiverDetails -> Task ()
logDiverDetailsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Diver details updated:\n" +++ showDifferences old new

logAirplaneDetailsUpdated :: ContactNo AirplaneDetails AirplaneDetails -> Task ()
logAirplaneDetailsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Airplane details updated:\n" +++ showDifferences old new

logHelicopterDetailsUpdated :: ContactNo HelicopterDetails HelicopterDetails -> Task ()
logHelicopterDetailsUpdated contactNo old new
    = addLogMessageForContact (message old new) contactNo @! ()
where
    message old new
        = "Helicopter details updated:\n" +++ showDifferences old new

logActionAdded :: ActionStatus -> Task ()
logActionAdded {ActionStatus|title,progress,incidents}
    = allTasks [addLogMessage (message title progress) incidentNo \\ incidentNo <- incidents] @! ()
where
    message name status = "Action added to incident\nName: " <+++ name <+++ "\nInitial status: " <+++ status

logActionUpdated :: ActionStatus -> Task ()
logActionUpdated {ActionStatus|title,progress,incidents}
    = allTasks [addLogMessage (message title progress) incidentNo \\ incidentNo <- incidents] @! ()
where
    message name status = "Action status updated\nName: " <+++ name <+++ "\nNew status: " <+++ status

createIncident :: NewIncident -> Task IncidentNo
createIncident incident
	=	create incident
	>>- \incidentNo ->
		logIncidentCreated incidentNo incident
	@! 	incidentNo
where
354
	create :: NewIncident -> Task IncidentNo
355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376
	create {NewIncident|type,title,summary}
		=	get databaseDef
		>>- \db -> sqlExecute db ["allIncidents"] (execInsert "INSERT INTO Incident (type,title,summary) VALUES (?,?,?)"
			(flatten [mbToSQL type, mbToSQL title, mbToSQL summary]))


deleteIncident :: IncidentNo -> Task ()
deleteIncident incidentNo
	= 		delete incidentNo
	-&&-	upd (\m -> 'DM'.put incidentNo [] m) (sdsFocus (Just [incidentNo]) contactNosByIncidentNosIndexed)
	-&&-	upd (\m -> 'DM'.put incidentNo [] m) (sdsFocus (Just [incidentNo]) communicationNosByIncidentNosIndexed)
	@!  ()
where
	delete :: IncidentNo -> Task ()
	delete incidentNo
		= get databaseDef
		>>= \db -> sqlExecute db ["allIncidents"] (execDelete "DELETE FROM Incident WHERE incidentNo = ?" (toSQL incidentNo)) @! ()

closeIncident :: IncidentNo -> Task ()
closeIncident incidentNo
	=	upd (\i -> {Incident|i & closed = True}) (sdsFocus incidentNo incidentByNo)
	>>- \i ->
Bas Lijnse's avatar
Bas Lijnse committed
377
		addLogMessage "Incident closed" (incidentIdentity i)
378 379 380 381 382 383 384 385 386
    @!  ()

linkContactsToIncident  :: [ContactNo] IncidentNo -> Task IncidentNo
linkContactsToIncident contactNos incidentNo
    = upd update (sdsFocus incidentNo contactsByIncidentShort) @! incidentNo
where
    update links = removeDup (contactNos ++ map (\{ContactShort|contactNo} -> contactNo) links)