implementation module SAR

import iTasks
import CommonDomain

derive bimap (,), Maybe

Start :: *World -> *World
Start world = startEngine searchAndRescueExample world

:: IncidentEntry =
	{ type        :: IncidentType
	, description :: Note
//	, location    :: MapCoordinates
	}

:: IncidentType = MedicRequest | MedicEvacuation | Evacuation | FireOnboard | Other String
	
:: MapCoordinates =
	{ lat			:: Real
	, lon			:: Real
	}

searchAndRescueExample :: [Workflow]
searchAndRescueExample
	= [workflow "New Incident" (manageIncident Nothing)
	  ,workflow "Logs/View log" viewLogWF
	  ]

:: IncidentNR :== Int
:: Incident =
	{ incidentNr	:: IncidentNR
	, details		:: Note
	}

:: LogEntry =
	{ logNr		:: Int
	, incident	:: IncidentNR
	, date		:: Date
	, time		:: Time
	, user		:: User
	, message	:: Note
	}

:: HeliFlightDetails =
	{ targetLocation	:: MapCoordinates
	, purpose			:: Note
	}

derive gPrint 		Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction
derive gParse		Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction
derive gVisualize	Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction
derive gUpdate		Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction
derive gHint		Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction
derive gError		Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction

derive gMakeLocalCopy	Incident, LogEntry, IncidentEntry, IncidentType, HeliFlightDetails, MapCoordinates, PAction

// Incident management
manageIncident :: (Maybe Note) -> Task Void
manageIncident mbDesc
= 	(if (isNothing mbDesc)
		(enterInformation "Enter Information about the Incident")
		(updateInformation "Enter Information about the Incident" {IncidentEntry|type = MedicRequest,description = (fromJust mbDesc)}) )
	>>= \incident -> createIncident
	>>= \icNR     -> addLogEntry icNR incident.IncidentEntry.description
	>>|              chooseInitialResponse icNR incident
	>>=              allTasks //parallelDeployment icNR
	>>| stop
where
  enterIncident :: Task Incident
  enterIncident = enterInformation "Describe the incident"

  chooseInitialResponse :: IncidentNR IncidentEntry -> Task [Task Void]
  chooseInitialResponse icNR incident 
  	= updateMultipleChoice "Choose response actions" options (suggestion incident.IncidentEntry.type)
  where
      options = [f icNR \\ f <- [deploySARHeli
      							,deploySalvageVessel
      							,deployMultiFunctionVessel
      							,deployPolicePatrolVessel
      							,deploySurveillancePlane] ]

      //Compute the indexes in the options list that are initially selected
      suggestion MedicRequest 	  = [0]
      suggestion MedicEvacuation  = [0]
      suggestion Evacuation       = [0,2]
      suggestion _                = []

/*
  parallelDeployment :: IncidentNR [Task Void] -> Task Void
  parallelDeployment icNR tasks
  	= 	getContextWorker
  	>>= \user ->
  		parallel Closed "Label1" "Label2" afun id Void [{AssignedTask| user = user, task = control user}:[{AssignedTask|user = user, task = t>>| return 0} \\ t <- tasks]]
  
  where
  	afun :: (Int,Int) Void -> (Void,PAction (AssignedTask Int))
  	afun (0,_) _ = (Void,Continue)
  	afun (1,_) _ = (Void,Stop)
  	
  	control :: UserName -> Task Int
  	control user	=	enterChoice "Additional options" [additionalDeployment,stopResponse]
  					>>= \t -> t
  	
  	additionalDeployment :: Task Int
 	additionalDeployment
 		= "Deploy additional resources" @>> return 2
 	stopResponse :: Task Int
 	stopResponse
 		= "Stop the complete response operation" @>> (requestConfirmation "Are you sure?" >>= \stop -> if stop (return 1) (return 0))
*/

// SAR Heli deployment
deploySARHeli :: IncidentNR -> Task Void
deploySARHeli incident
	= "Deploy Search and Rescue Helicopter (SAR-XZ)"
	@>> (
			//Request flight
				enterFlightDetails
			>>= \details ->
				showInstructionAbout "Flight request" "Request the following flight of SAR-XZ at airbase" details
			>>|
				addLogEntry incident (Note ("SAR-XZ: Flight requested with details: " +++ visualizeAsTextDisplay details))
			>>| waitForEvents ["Take-off at base","Arrival at scene","Take-off at scene","Arrival at base"]
			>>| addLogEntry incident (Note ("SAR-XZ: deployment completed"))
		)
where
	enterFlightDetails :: Task HeliFlightDetails
	enterFlightDetails = enterInformation "Enter flight details for (SAR XZ)"
	
	waitForEvents [] = return Void
	waitForEvents [e:es]
		= 	enterChoiceAbout "The next expected event of SAR-XZ is: " e [EVT_OK,EVT_OTHER]
		>>= \choice -> case choice of
			EVT_OK
				= (addLogEntry incident (Note ("SAR-XZ: " +++ e)) >>| waitForEvents es)
			EVT_OTHER
				= (
						addLogEntry incident (Note "SAR-XZ deviated from expected plan.")
					>>| enterInformation "What happened?"
					>>= \reason ->
						addLogEntry incident reason
					>>| requestConfirmation "Do you want to report this as a new incident?"
					>>= \newinc ->
						if newinc
							(newIncident reason)
							stop
				  )

	newIncident reason
		=	getContextWorker
		>>= \user ->
			spawnProcess user True ( "New Incident" @>> manageIncident (Just reason))
		>>| stop
		
EVT_OK :== "This happened, continue"
EVT_OTHER :== "Something else happened, abort normal plan"

// Dummy deployment options
deploySalvageVessel :: IncidentNR -> Task Void
deploySalvageVessel incident = deployUnit "Salvage vessel (Seagull)" "Seagull" incident

deployMultiFunctionVessel :: IncidentNR -> Task Void
deployMultiFunctionVessel incident = deployUnit "Multi-function vessel (Orca)" "Orca" incident

deployPolicePatrolVessel :: IncidentNR -> Task Void
deployPolicePatrolVessel incident = deployUnit "Police patrol vessel (P-23)" "P-23" incident

deploySurveillancePlane :: IncidentNR -> Task Void
deploySurveillancePlane incident = deployUnit "Surveillance plane (PH-234)" "PH-234" incident

deployUnit :: String String IncidentNR -> Task Void
deployUnit longName shortName incident
	=	("Deploy " +++ longName)
	@>> (	addLogEntry incident (Note (shortName +++ " deployed"))
	    >>| showInstruction (shortName +++ " deployment") ("Deploy the " +++ longName +++ ". This task is done when the " +++ shortName +++ " has returned.")
	    >>| addLogEntry incident (Note (shortName +++ " returned"))
		)

// Incident database
createIncident :: Task IncidentNR
createIncident = getDefaultValue >>= dbCreateItem >>= \i -> return i.incidentNr

// Logging
addLogEntry :: IncidentNR Note -> Task Void
addLogEntry incident message
	=	getContextWorker -&&- (getCurrentDate -&&- getCurrentTime)
	>>= \(user,(date,time)) ->
		dbCreateItem {LogEntry | logNr = 0, incident = incident, date = date, time = time, user = user, message = message}
	>>| stop

viewLog :: IncidentNR -> Task Void
viewLog incident
	= 	readDB databaseId
	>>= \logs ->
		showMessageAbout ("Log for incident " +++ toString incident) [l \\ l <- logs | l.LogEntry.incident == incident]

viewLogWF :: Task Void
viewLogWF
	=	readDB databaseId
	>>=	enterChoice "Of which incident do you want to view the log?"
	>>= \incident ->
		viewLog incident.Incident.incidentNr

// Databases
instance DB Incident
where
	databaseId				= mkDBid "Incidents"
	getItemId i				= DBRef i.Incident.incidentNr
	setItemId (DBRef r) i	= {Incident| i & incidentNr = r} 

instance DB LogEntry
where
	databaseId				= mkDBid "Log"
	getItemId l				= DBRef l.LogEntry.logNr
	setItemId (DBRef r) l	= {LogEntry| l & logNr = r}