Commit 0937d506 authored by Bas Lijnse's avatar Bas Lijnse

Fixed form generation bugs and improved basic task examples a bit

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@708 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 830daed2
......@@ -4,5 +4,5 @@
, skin: "default"
, debug: true
, autoRefresh: true
, refreshRate: 2000
, refreshRate: 60000
}
\ No newline at end of file
......@@ -5,23 +5,47 @@ import CommonDomain
basicWorkflows :: [Workflow]
basicWorkflows =
[ workflow "Basic/Basic task" basicTask
, workflow "Basic/Information task" informationTask
[ {Workflow|name="Basic/Action task",label="New action task...",roles=[],mainTask=actionTask >>|return Void}
, {Workflow|name="Basic/Information task",label="New information task",roles=[],mainTask=informationTask >>| return Void}
, workflow "Basic/Decision task" decisionTask
, workflow "Basic/Notification task" notificationTask
]
basicTask :: Task Void
basicTask = define >>= perform >>| report
:: AssignTo = Yourself | OtherUser UserId
:: ActionTaskInfo =
{ taskDescription :: TaskDescription
, initialTaskProperties :: InitialTaskProperties
}
:: InitialTaskProperties =
{ assignTo :: AssignTo
, priority :: Maybe TaskPriority
, deadline :: Maybe Timestamp
}
derive gPrint ActionTaskInfo, InitialTaskProperties, AssignTo, TaskDescription
derive gParse ActionTaskInfo, InitialTaskProperties, AssignTo, TaskDescription
derive gVisualize ActionTaskInfo, InitialTaskProperties, AssignTo, TaskDescription
derive gUpdate ActionTaskInfo, InitialTaskProperties, AssignTo, TaskDescription
actionTask :: Task (ProcessRef Void)
actionTask = define >>= start
where
define :: Task Note
define = enterInformation "What needs to be done?"
define :: Task ActionTaskInfo
define = enterInformation "Define a new action"
perform :: Note -> Task Void
perform description = showMessage description
report :: Task Void
report = showMessage "The task has been done"
start :: ActionTaskInfo -> Task (ProcessRef Void)
start info
= case info.initialTaskProperties.assignTo of
(Yourself)
= getCurrentUser >>= \user -> spawnProcess user.userId True task
(OtherUser uid)
= spawnProcess uid True task
where
task = showMessage info.taskDescription.TaskDescription.title <<@ info.taskDescription
priority = case info.priority of (Just p) = p; Nothing = NormalPriority
deadline = info.deadline
informationTask :: Task Void
informationTask = define >>= perform >>= report
......
......@@ -14,11 +14,11 @@ where
//Crisis management data domain
:: Incident =
{ location :: Location
, type :: IncidentType
{ type :: IncidentType
, time :: Time
, nrInjured :: Int
, description :: String
, location :: Address
}
:: IncidentType = Accident | Fire | Fight | Other String
......@@ -28,7 +28,12 @@ where
, place :: String
, coordinates :: Maybe MapCoordinates
}
:: Address =
{ street :: String
, place :: String
}
:: MapCoordinates =
{ lat :: Real
, lon :: Real
......@@ -57,45 +62,59 @@ allproviders = [{name="Ambulance Post 0",id=30,location={street="Teststreet",pl
,{name="Ambulance Post 9",id=39,location={street="Teststreet",place="Testville",coordinates=Just{lat=9.0,lon=3.0}},capacity=2}
]
derive gPrint Incident, IncidentType, Location, MapCoordinates, Provider, Opinion
derive gParse Incident, IncidentType, Location, MapCoordinates, Provider, Opinion
derive gVisualize Incident, IncidentType, Location, MapCoordinates, Provider, Opinion
derive gUpdate Incident, IncidentType, Location, MapCoordinates, Provider, Opinion
derive gPrint Incident, IncidentType, Location, Address, MapCoordinates, Provider, Opinion
derive gParse Incident, IncidentType, Location, Address, MapCoordinates, Provider, Opinion
derive gVisualize Incident, IncidentType, Location, Address, MapCoordinates, Provider, Opinion
derive gUpdate Incident, IncidentType, Location, Address, MapCoordinates, Provider, Opinion
derive gEq IncidentType
// Crisis management procedure examples
reportIncident :: Task [Void]
reportIncident
= enterInformation "Please provide as many details about the incident as possible"
>>= \inc -> enterMultipleChoice "Which actions must be taken?"
(map fst (filter snd
[(requestAmbulances inc.Incident.nrInjured inc.Incident.location <<@ "Send ambulances", inc.Incident.nrInjured > 0)
,(requestFireBrigade <<@ "Request fire brigade", inc.Incident.type === Fire)
]))
>>= \tasks -> allTasks tasks
= enterIncident >>= chooseResponse >>= allTasks
where
enterIncident :: Task Incident
enterIncident = enterInformation "Describe the incident"
chooseResponse :: Incident -> Task [Task Void]
chooseResponse incident
= updateMultipleChoice "Choose response" options (suggestion incident.type)
where
//Generate the list of possible tasks to choose from
options = [f incident \\ f <- [sendPolice,sendMedics,sendFireBrigade]]
//Compute the indexes in the options list that are initially selected
suggestion Accident = [0,1]
suggestion Fire = [0,2]
suggestion Fight = [0]
suggestion _ = []
sendPolice :: Incident -> Task Void
sendPolice incident = "Send police" @>> showMessage "Please send police"
sendMedics :: Incident -> Task Void
sendMedics incident = "Send ambulances" @>> requestAmbulances incident.Incident.nrInjured incident.Incident.location
sendFireBrigade :: Incident -> Task Void
sendFireBrigade incident = "Send fire brigade" @>> showMessage "Please send fire brigade"
dispatchAmbulances :: Task Void
dispatchAmbulances
= enterInformation "How many ambulances do you need at what location?"
>>= \(nr,loc) -> requestAmbulances nr loc
requestFireBrigade :: Task Void
requestFireBrigade = return Void
// Request for amount ambulances from list of candidate providers
// First, from the list enough providers are selected that can in principle provide the needed amount
// They are asked in parallel
// But in case they do not provide enough, more providers are asked
// This is repeated until the requested amount can be fulfilled
// Nore: we assume there are enough providers to supply all ambulances
requestAmbulances :: Int Location -> Task Void
requestAmbulances amount location
| isJust location.coordinates = requestAmbulances` amount (sortProviders location allproviders) >>= showAmbulances
requestAmbulances :: Int Address -> Task Void
requestAmbulances amount address
//| isJust location.coordinates = requestAmbulances` amount (sortProviders location allproviders) >>= showAmbulances
| otherwise = requestAmbulances` amount allproviders >>= showAmbulances
requestAmbulances` amount providers
......
......@@ -5,8 +5,10 @@ import GenUpdate
import Void, Either
import Text, Html, JSON, TUIDefinition
MAX_CONS_RADIO :== 3 //When the number of constructors is upto this number, the choice is made
MAX_CONS_RADIO :== 3 //When the number of constructors is upto this number, the choice is made
//with radio buttons. When it exceeds this, a combobox is used.
RADIO_WIDTH :== 200 //The width of radio buttons
NEWLINE :== "\n" //The character sequence to use for new lines in text display visualization
mkVSt :: *VSt
......@@ -192,7 +194,7 @@ gVisualize{|CONS of d|} fx old new vst=:{vizType,idPrefix,currentPath,label,useL
//ADT's with only one constructor
| d.gcd_type_def.gtd_num_conses == 1
# (vizBody,vst=:{valid}) = fx ox nx {vst & label = Nothing, currentPath = shiftDataPath currentPath, optional = False}
# (vizBody,vst=:{valid}) = fx ox nx {vst & /*label = Nothing,*/ currentPath = shiftDataPath currentPath, optional = False}
= (vizBody, {VSt|vst & currentPath = stepDataPath currentPath, optional = optional})
//ADT's with multiple constructors
| otherwise
......@@ -222,14 +224,14 @@ gVisualize{|CONS of d|} fx old new vst=:{vizType,idPrefix,currentPath,label,useL
_ //Other visualizations
= case (old,new) of
(VValue (CONS ox) omask, VValue (CONS nx) nmask)
# useLabels = not (isEmpty d.gcd_fields) || useLabels
# (vizBody, vst=:{valid}) = fx (VValue ox omask) (VValue nx nmask) {vst & label = Nothing, currentPath = shiftDataPath currentPath, useLabels = useLabels, optional = False}
# labels = not (isEmpty d.gcd_fields) || useLabels
# (vizBody, vst=:{valid}) = fx (VValue ox omask) (VValue nx nmask) {vst & label = Nothing, currentPath = shiftDataPath currentPath, useLabels = labels, optional = False}
//No validity check is needed when there is only one constructor
| d.gcd_type_def.gtd_num_conses == 1
= (vizCons ++ vizBody, {VSt|vst & currentPath = stepDataPath currentPath, optional = optional})
= (vizCons ++ vizBody, {VSt|vst & currentPath = stepDataPath currentPath, optional = optional, useLabels = useLabels})
//A validity check is used
| otherwise
= (vizCons ++ vizBody, {VSt|vst & currentPath = stepDataPath currentPath, valid = stillValid currentPath old optional valid, optional = optional})
= (vizCons ++ vizBody, {VSt|vst & currentPath = stepDataPath currentPath, valid = stillValid currentPath old optional valid, optional = optional, useLabels = useLabels})
_
= ([], {VSt|vst & currentPath = stepDataPath currentPath})
where
......@@ -482,15 +484,16 @@ consSelector d idPrefix dp value label useLabels
= []
//Use radiogroup to choose a constructor
| d.gcd_type_def.gtd_num_conses <= MAX_CONS_RADIO
# items = [TUIRadio {TUIRadio|name = name, value = c.gcd_name, boxLabel = Just c.gcd_name, checked = (masked && c.gcd_index == index), fieldLabel = Nothing, hideLabel = True}
# items = [TUIRadio {TUIRadio|name = name, value = c.gcd_name, boxLabel = Just (formatLabel c.gcd_name), checked = (masked && c.gcd_index == index), fieldLabel = Nothing, hideLabel = True}
\\ c <- d.gcd_type_def.gtd_conses]
= [TUIFragment (TUIRadioGroup {TUIRadioGroup|name = name, id = id, items = items, fieldLabel = label, hideLabel = not useLabels})]
# cols = repeatn (length items) RADIO_WIDTH
= [TUIFragment (TUIRadioGroup {TUIRadioGroup|name = name, id = id, items = items, fieldLabel = label, hideLabel = not useLabels, columns = cols})]
//Use combobox to choose a constructor
| otherwise
= [TUIFragment (TUIComboBox {TUIComboBox|name = name, id = id, value = (if masked d.gcd_name ""), fieldLabel = label, hideLabel = not useLabels, store = store, triggerAction = "all", editable = False})]
where
store = [("","Select...") : [(c.gcd_name,c.gcd_name) \\ c <- d.gcd_type_def.gtd_conses]]
store = [("","Select...") : [(c.gcd_name,formatLabel c.gcd_name) \\ c <- d.gcd_type_def.gtd_conses]]
name = dp2s dp
id = dp2id idPrefix dp
index = d.gcd_index
......
......@@ -3,6 +3,8 @@ implementation module TSt
import StdEnv, StdMaybe
import Http, Util
import ProcessDB, DynamicDB, SessionDB, UserDB, TaskTree
import CommonDomain
import GenPrint, GenParse, GenEq, GenBimap
import GenVisualize, GenUpdate, Store, Config
......@@ -297,25 +299,25 @@ accWorldTSt f tst=:{TSt|world}
= (a, {TSt|tst & world = world})
mkInteractiveTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkInteractiveTask taskname taskfun = Task {TaskDescription| title = taskname, description = ""} Nothing mkInteractiveTask`
mkInteractiveTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInteractiveTask`
where
mkInteractiveTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTInteractiveTask taskInfo (abort "No interface definition given")}
mkInstantTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkInstantTask taskname taskfun = Task {TaskDescription| title = taskname, description = ""} Nothing mkInstantTask`
mkInstantTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInstantTask`
where
mkInstantTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTFinishedTask taskInfo} //We use a FinishedTask node because the task is finished after one evaluation
mkMonitorTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkMonitorTask taskname taskfun = Task {TaskDescription| title = taskname, description = ""} Nothing mkMonitorTask`
mkMonitorTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkMonitorTask`
where
mkMonitorTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTMonitorTask taskInfo []}
mkRpcTask :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask taskname rpce parsefun = Task {TaskDescription| title = taskname, description = ""} Nothing mkRpcTask`
mkRpcTask taskname rpce parsefun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkRpcTask`
where
mkRpcTask` tst=:{TSt | taskNr, taskInfo}
# rpce = {RPCExecute | rpce & taskId = taskNrToString taskNr}
......@@ -380,20 +382,20 @@ applyRpcDefault tst=:{TSt|world}
mkSequenceTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkSequenceTask taskname taskfun = Task {TaskDescription| title = taskname, description = ""} Nothing mkSequenceTask`
mkSequenceTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkSequenceTask`
where
mkSequenceTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTSequenceTask taskInfo [], taskNr = [0:taskNr]}
mkParallelTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkParallelTask taskname taskfun = Task {TaskDescription| title = taskname, description = ""} Nothing mkParallelTask`
mkParallelTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkParallelTask`
where
mkParallelTask` tst=:{TSt|taskNr,taskInfo}
# tst = {tst & tree = TTParallelTask taskInfo [], taskNr = [0:taskNr]}
= taskfun tst
mkMainTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkMainTask taskname taskfun = Task {TaskDescription| title = taskname, description = ""} Nothing mkMainTask`
mkMainTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkMainTask`
where
mkMainTask` tst=:{taskNr,taskInfo}
= taskfun {tst & tree = TTMainTask taskInfo undef []}
......
......@@ -112,6 +112,7 @@ derive JSONEncode TUIDef, TUIUpdate
, fieldLabel :: Maybe String
, hideLabel :: Bool
, items :: [TUIDef]
, columns :: [Int]
}
:: TUIDateField =
{ name :: String
......
......@@ -3,9 +3,10 @@ definition module Types
* This module provides types for all the globally shared concepts within
* the iTasks framework.
*/
from TSt import :: TSt
from Html import :: HtmlTag
from StdString import class toString
from TSt import :: TSt
from Html import :: HtmlTag
from CommonDomain import :: Note
from StdString import class toString
import GenPrint, GenParse, GenVisualize, GenUpdate
......@@ -40,7 +41,7 @@ import GenPrint, GenParse, GenVisualize, GenUpdate
:: Task a = Task !TaskDescription !(Maybe TaskNr) !(*TSt -> *(!a,!*TSt))
:: TaskDescription =
{ title :: !String
, description :: !String
, description :: !Note
}
:: TaskPriority = HighPriority // tasks can have three levels of priority
......@@ -50,9 +51,9 @@ import GenPrint, GenParse, GenVisualize, GenUpdate
:: EvaluationOption = OnClient // Evaluate a task on the client whenever possible
| OnServer // Always evaluate a task on the server
derive gPrint User, Session
derive gParse User, Session
derive gVisualize User, Session
derive gUpdate User, Session
derive gPrint Session
derive gParse Session
derive gVisualize Session
derive gUpdate Session
instance toString TaskPriority
\ No newline at end of file
......@@ -3,11 +3,12 @@ implementation module Types
import GenPrint, GenParse, GenVisualize, GenUpdate
import Html
import Util
import CommonDomain
derive gPrint User, Session
derive gParse User, Session
derive gVisualize User, Session
derive gUpdate User, Session
derive gPrint Session
derive gParse Session
derive gVisualize Session
derive gUpdate Session
instance toString TaskPriority
where
......
definition module Util
from TSt import :: Task
from Types import :: TaskNr
from Types import :: TaskNr, :: User
from Void import :: Void
import GenPrint, GenParse, GenVisualize, GenUpdate
//TODO: Create visualization and update for tasks
derive gPrint Task, Dynamic, Maybe, Void, (,), (,,), (,,,), (,,,,)
derive gParse Task, Dynamic, Maybe, Void, (,), (,,), (,,,), (,,,,)
derive gPrint Task, User, Dynamic, Maybe, Void, (,), (,,), (,,,), (,,,,)
derive gParse Task, User, Dynamic, Maybe, Void, (,), (,,), (,,,), (,,,,)
derive gVisualize Task
derive gUpdate Task
/* Task number is used to generate a unique id
iTaskId :: generate an id based on the task nr, important for garbage collection and family relation
*/
derive gVisualize Task, User
derive gUpdate Task, User
iTaskId :: !TaskNr !String -> String
......
......@@ -4,11 +4,13 @@ import StdBool, StdArray, StdOverloaded, StdList, StdTuple, StdMisc, StdFile
import Time
import TSt
import Types
import CommonDomain
import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
derive gPrint Maybe, Void, (,), (,,), (,,,), (,,,,)
derive gParse Maybe, Void, (,), (,,), (,,,), (,,,,)
derive gPrint Maybe, Void, (,), (,,), (,,,), (,,,,), User
derive gParse Maybe, Void, (,), (,,), (,,,), (,,,,), User
iTaskId :: !TaskNr !String -> String
iTaskId tasknr postfix
......@@ -77,7 +79,10 @@ gVisualize{|Task|} fx _ _ vst = ([],vst)
gUpdate{|Task|} fx _ ust=:{mode=UDCreate}
# (a,ust) = fx undef ust
= (Task {TaskDescription|title = "return", description = ""} Nothing (\tst -> (a,tst)), ust)
= (Task {TaskDescription|title = "return", description = Note ""} Nothing (\tst -> (a,tst)), ust)
gUpdate{|Task|} fx x ust = (x,ust)
derive gUpdate User
derive gVisualize User
......@@ -12,11 +12,11 @@ from Types import :: ProcessId, :: DynamicId, :: TaskId, :: TaskPriority(..), :
from Store import :: Store
from SessionDB import :: Session
from TaskTree import :: TaskTree
from CommonDomain import :: Note
import SystemTasks, InteractionTasks, UserDBTasks, CoreCombinators, TuningCombinators, LiftingCombinators
import Util, Either
import GenVisualize, GenUpdate
import Chat
derive gPrint Either
derive gParse Either
......
......@@ -2,7 +2,7 @@ definition module TuningCombinators
/**
* This module provides combinators for fine-tuning of workflows.
*/
from Types import :: Task
from Types import :: Task, :: TaskDescription
//Annotation combinator
class (<<@) infixl 2 b :: !(Task a) !b -> Task a
......@@ -11,4 +11,7 @@ class (@>>) infixr 2 b :: !b !(Task a) -> Task a
* Change the label of a task
*/
instance <<@ String
instance @>> String
\ No newline at end of file
instance @>> String
instance <<@ TaskDescription
instance @>> TaskDescription
\ No newline at end of file
......@@ -7,7 +7,11 @@ class (<<@) infixl 2 b :: !(Task a) !b -> Task a
instance <<@ String
where (<<@) (Task desc mbCxt tf) s = Task {TaskDescription| desc & title = s} mbCxt tf
instance <<@ TaskDescription
where (<<@) (Task _ mbCxt tf) td = Task td mbCxt tf
class (@>>) infixr 2 b :: !b !(Task a) -> Task a
instance @>> String
where (@>>) s (Task desc mbCxt tf) = Task {TaskDescription| desc & title = s} mbCxt tf
\ No newline at end of file
where (@>>) s (Task desc mbCxt tf) = Task {TaskDescription| desc & title = s} mbCxt tf
instance @>> TaskDescription
where (@>>) td (Task _ mbCxt tf) = Task td mbCxt tf
\ No newline at end of file
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment