Commit 97e970ce authored by Bas Lijnse's avatar Bas Lijnse

IMPORTANT

Cleanup of the interactive tasks API.
- All interactive tasks now have a parameter for a short subject/title and a larger description of the task.
- Messages and instructions no longer return Void but always yield a value that is supplied as the last parameter.
  This makes it easier to use them in a 'pipeline' of binded tasks.

All examples have been updated to these changes. Better use of the now mandatory subjects/titles of tasks in forms and window titles is still to be done. 

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1137 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent fb0f4324
......@@ -16,10 +16,9 @@ derive bimap (,), Maybe
BookTrip :: Task FlightHotel
BookTrip
= enterInformation "Please fill in trip information to make booking"
>>= \info -> assign info.delegateTo (enterInformationAbout "Please book the following trip" info)
>>= \booking -> showMessageAbout "The following trip has been booked" booking
>>| return booking
= enterInformation "Specify trip" "Please fill in trip information to make booking"
>>= \info -> assign info.delegateTo (enterInformationAbout "Book trip" "Please book the following trip" info)
>>= \booking -> showMessageAbout "Trip booked" "The following trip has been booked" booking
:: PlaceToGo
......@@ -37,44 +36,41 @@ BookTrip
travelBookingExample :: [Workflow]
travelBookingExample
= [ // workflow "Examples/Business/Book a trip" travel ,
workflow "Examples/Business/Delegate book a trip" BookTrip
]
travelBookingExample = [workflow "Examples/Business/Delegate book a trip" BookTrip]
:: Booking :== (String,String,String,Currency)
travel :: Task Void
travel
= sequence "travel" [ makeBookings <<@ Subject "Step 1: Make Bookings:"
, confirmBookings <<@ Subject "Step 2: Confirm Bookings:"
= sequence "travel" [ makeBookings
, confirmBookings
]
-||-
(showMessage "Cancel task?" >>| return [])
(showMessage "Cancel" "Cancel task?" [])
>>= \booking -> handleBookings booking
where
makeBookings :: Task [Booking]
makeBookings = enterMultipleChoice [Text "Choose Booking options:"]
[ (BookFlight <<@ Subject "Book Flight")
, (BookHotel <<@ Subject "Book Hotel")
, (BookCar <<@ Subject "Book Car")
]
>>= \tasks -> sequence "bookings" tasks
makeBookings
= Subject "Step 1: Make Bookings:"
@>> enterMultipleChoice "Booking options" "Choose Booking options:" [BookFlight,BookHotel,BookCar]
>>= sequence "Bookings"
confirmBookings :: Task [Booking]
confirmBookings = showMessage "Confirm" >>| return []
confirmBookings
= Subject "Step 2: Confirm Bookings:"
@>> showMessage "Confirmation" "Confirm" []
handleBookings :: [[Booking]] -> Task Void
handleBookings booking
| isEmpty booking = showMessage "Cancelled"
| otherwise = (updateInformation "Pay" (calcCosts booking) >>| showMessage "Paid")
| isEmpty booking = showMessage "Summary" "Cancelled" Void
| otherwise = (updateInformation "Payment" "Pay" (calcCosts booking) >>| showMessage "Summary" "Paid" Void)
where
calcCosts booked = sum [cost \\ (_,_,_,cost) <- hd booked]
BookFlight = updateInformation "BookFlight" ("Flight Number " ,"", "Costs ",DefCosts)
BookHotel = updateInformation "BookHotel" ("Hotel Name " ,"", "Costs ",DefCosts)
BookCar = updateInformation "BookCar" ("Car Brand " ,"", "Costs ",DefCosts)
BookFlight = updateInformation "Book Flight" "BookFlight" ("Flight Number " ,"", "Costs ",DefCosts)
BookHotel = updateInformation "Book Hotel" "BookHotel" ("Hotel Name " ,"", "Costs ",DefCosts)
BookCar = updateInformation "Book Car" "BookCar" ("Car Brand " ,"", "Costs ",DefCosts)
DefCosts = EUR 0
......@@ -17,7 +17,7 @@ changeExamples =
]
where
catch :: String -> Task Void
catch message = showMessage message
catch message = showMessage "Error!" message Void
//Simple change which will run once and change the priority of all tasks to high
changePriority :: TaskPriority -> ChangeDyn
......@@ -33,7 +33,7 @@ addWarning msg =
dynamic change :: A.a: Change a | iTask a
where
change :: TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change props t t0 = (Nothing, Just (((showStickyMessage (redText msg) >>| getDefaultValue) -||- t)), Just (addWarning msg))
change props t t0 = (Nothing, Just (((getDefaultValue >>= showStickyMessage "Warning!" (redText msg)) -||- t)), Just (addWarning msg))
redText msg = [DivTag [StyleAttr "color: red; font-size: 30px;"] [Text msg]]
......@@ -59,7 +59,7 @@ inform user procName =
dynamic change user :: A.a: Change a | iTask a
where
change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change user props t t0 = (Nothing, Just (t >>= \res -> spawnProcess user True True (showMessageAbout ("Process " +++ procName +++ " ended!") res) >>| return res), Nothing)
change user props t t0 = (Nothing, Just (t >>= \res -> spawnProcess user True True (showMessageAbout "Process ended" ("Process " +++ procName +++ " ended!") res) >>| return res), Nothing)
//check will pass the result to the indicated user who can change the result in an editor before it passed.
check :: User String -> ChangeDyn
......@@ -67,7 +67,7 @@ check user procName =
dynamic change user :: A.a: Change a | iTask a
where
change :: User TaskProperties (Task a) (Task a) -> (Maybe TaskProperties, Maybe (Task a), Maybe ChangeDyn) | iTask a
change user props t t0 = (Nothing, Just (t >>= \res -> assign user (HighPriority @>> (updateInformation ("Please verify result of " +++ procName) res))), Nothing)
change user props t t0 = (Nothing, Just (t >>= \res -> assign user (HighPriority @>> (updateInformation "Verification" ("Please verify result of " +++ procName) res))), Nothing)
//cancel stop the process, and give the indicated user the responsibility to fill in the result
cancel :: String ProcessId -> ChangeDyn
......@@ -100,12 +100,12 @@ where
changePrio :: Task Void
changePrio
= chooseProcess "Of which process do you want to change the priority?"
>>= \proc -> enterInformation "What should the new priority be?"
>>= \proc -> enterInformation "New priority" "What should the new priority be?"
>>= \priority ->applyChangeToProcess proc (changePriority priority) (CLPersistent "priority")
changeWarningTask :: Task Void
changeWarningTask
= enterInformation "Type in warning you want to show to all:"
= enterInformation "Warning" "Type in warning you want to show to all:"
>>= \warning -> chooseProcess "Which process do you want to change?"
>>= \proc -> applyChangeToProcess proc (addWarning warning) (CLPersistent "warning")
......@@ -155,7 +155,7 @@ restartTask
chooseUserA :: !question -> Task User | html question
chooseUserA question
= getUsers
>>= \users -> enterChoiceA question buttons users
>>= \users -> enterChoiceA "Choose user" question buttons users
>>= \(action,user) -> case action of
ActionCancel -> throw "choosing a user has been cancelled"
_ -> return user
......@@ -164,11 +164,12 @@ chooseProcess :: String -> Task ProcessId
chooseProcess question
= getCurrentProcessId
>>= \mypid -> getProcessesWithStatus [Active]
>>= \procs -> enterChoiceA question buttons [ ( proc.Process.taskId
, proc.Process.properties.managerProperties.subject
, proc.Process.properties.managerProperties.priority
, proc.Process.properties.managerProperties.ManagerProperties.worker)
\\ proc <- procs | proc.Process.taskId <> mypid]
>>= \procs -> enterChoiceA question question buttons
[ ( proc.Process.taskId
, proc.Process.properties.managerProperties.subject
, proc.Process.properties.managerProperties.priority
, proc.Process.properties.managerProperties.ManagerProperties.worker)
\\ proc <- procs | proc.Process.taskId <> mypid]
>>= \(action,(pid,_,_,_)) -> case action of
ActionCancel -> throw "choosing a process has been cancelled"
_ -> return pid
......
......@@ -114,7 +114,7 @@ editAppStateOptions desc get putback sid =
>>| stop
handleErrors :: !FileException -> Task Void
handleErrors (FileException path _) = showMessageAbout "Error" ("Could not open '" +++ path +++ "'!") <<@ ExcludeGroupActions
handleErrors (FileException path _) = (showMessageAbout "Error" "Error" ("Could not open '" +++ path +++ "'!") >>| return Void )<<@ ExcludeGroupActions
ActionCompile :== ActionLabel "compile"
ActionEditCodeGenOptions :== ActionLabel "codeGenOpts"
......@@ -207,15 +207,15 @@ where
compile` =
save sid
>>| compileToExe sid
>>= \exeDoc. showMessageAbout "Download Executable" exeDoc <<@ ExcludeGroupActions
>>= \exeDoc. (showMessageAbout "Download" "Download Executable" exeDoc >>| return Void )<<@ ExcludeGroupActions
handleCompilerExceptions e = showMessageAbout "Compiler Errors" msg <<@ ExcludeGroupActions
handleCompilerExceptions e = (showMessageAbout "Errors" "Compiler Errors" msg >>| return Void )<<@ ExcludeGroupActions
where
msg = case e of
CannotRunCompiler msg = ["Unable to run compiler: " +++ msg]
CompilerErrors errs = errs
handleFileExceptions (FileException path _) = showMessageAbout "Save Error" ("Unnable to write to '" +++ path +++ "'")
handleFileExceptions (FileException path _) = showMessageAbout "Save Error" "Save Error" ("Unnable to write to '" +++ path +++ "'") >>| return Void
openFile :: !Path !(DBid AppState) -> Task Void
openFile path sid =
......@@ -257,7 +257,7 @@ findAndReplace sid = findAndReplace` {searchFor = "", replaceWith = ""}
where
findAndReplace` replace =
ExcludeGroupActions @>>
updateInformationA "Find & Replace" [ButtonAction (ActionCancel, Always), ButtonAction (ActionReplaceAll, IfValid), ButtonAction (ActionFind, IfValid)] replace
updateInformationA "Find & Replace" "Find & Replace" [ButtonAction (ActionCancel, Always), ButtonAction (ActionReplaceAll, IfValid), ButtonAction (ActionFind, IfValid)] replace
>>= \(action, replace). case action of
ActionReplaceAll =
readDB sid
......
......@@ -4,8 +4,6 @@ import iTasks, JSON, GUI, AppState
derive class iTask IDEConfig
derive class SharedVariable IDEConfig
derive JSONDecode IDEConfig, Path, PathStep
derive JSONEncode IDEConfig, Path, PathStep
derive bimap Maybe, (,)
loadConfig :: Task (Maybe IDEConfig)
......@@ -48,10 +46,10 @@ where
True = return (config, GotoNext)
False =
pathToPDString config.projectsPath
>>= \prjPath. requestConfirmation ("Directory '" +++ prjPath +++ "' does not exist. Should it be created?")
>>= \prjPath. requestConfirmation "Create directory" ("Directory '" +++ prjPath +++ "' does not exist. Should it be created?")
>>= \create. if create
(let
handleException = (\CannotCreate -> showMessageAbout "Error" ("Could not create '" +++ prjPath +++ "'!") >>| return (config, GotoPrevious))
handleException = (\CannotCreate -> showMessageAbout "Error" "Error" ("Could not create '" +++ prjPath +++ "'!") >>| return (config, GotoPrevious))
in
(try (createDirectory config.projectsPath >>| return (config, GotoNext)) handleException)
)
......@@ -70,7 +68,7 @@ where
>>= \ok. if ok
(return (config, GotoNext))
( pathToPDString config.oldIDEPath
>>= \idePath. showMessageAbout "Error" ("'" +++ idePath +++ "' does not exist!")
>>= \idePath. showMessageAbout "Error" "Error" ("'" +++ idePath +++ "' does not exist!")
>>| return (config, GotoPrevious)
)
)
......
......@@ -51,7 +51,7 @@ where
editOptions :: !description !state !(state -> opts) !(opts state -> state) -> Task state | html description & iTask state & iTask opts
editOptions description st getOpts putbackOpts =
ExcludeGroupActions @>>
updateInformationA description [ButtonAction (ActionCancel, Always), ButtonAction (ActionOk, IfValid)] (getOpts st)
updateInformationA "Edit options" description [ButtonAction (ActionCancel, Always), ButtonAction (ActionOk, IfValid)] (getOpts st)
>>= \(action,opts). case action of
ActionOk = return (putbackOpts opts st)
ActionCancel = return st
\ No newline at end of file
......@@ -36,12 +36,7 @@ IclMod :== False
:: InfList
derive gPrint Project, CodeGenOptions, ApplicationOptions, LinkOptions
derive gParse Project, CodeGenOptions, ApplicationOptions, LinkOptions
derive gUpdate Project, CodeGenOptions, ApplicationOptions, LinkOptions
derive gVisualize Project, CodeGenOptions, ApplicationOptions, LinkOptions
derive gHint Project, CodeGenOptions, ApplicationOptions, LinkOptions
derive gError Project, CodeGenOptions, ApplicationOptions, LinkOptions
derive class iTask Project, CodeGenOptions, ApplicationOptions, LinkOptions
SaveProjectFile ::
!String // path to projectfile
......
......@@ -11,19 +11,8 @@ from StdSystem import dirseparator
import Platform
import UtilOptions, PmFiles
derive gPrint Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive gParse Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive gUpdate Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive gVisualize Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive gHint Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive gError Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive gPrint LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive gParse LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive gUpdate LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive gVisualize LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive gHint LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive gError LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive class iTask Project, CodeGenOptions, ProjectDynamicInfo, ProjectStaticInfo, StaticLibInfo, List, LinkOptions, ApplicationOptions, InfListItem, UndefModule, UndefSymbol
derive class iTask LinkMethod, Output, ModInfo, ABCLinkInfo, DATE, EditWdOptions, CompilerOptions, OptionalWindowPosAndSize, EditOptions, ListTypes, WindowPos_and_Size, NewlineConvention
derive bimap Maybe, (,)
......
......@@ -72,11 +72,11 @@ reportIncident
= enterIncident >>= chooseResponse >>= allTasks
where
enterIncident :: Task Incident
enterIncident = enterInformation "Describe the incident"
enterIncident = enterInformation "Incident" "Describe the incident"
chooseResponse :: Incident -> Task [Task Void]
chooseResponse incident
= updateMultipleChoice "Choose response" options (suggestion incident.Incident.type)
= updateMultipleChoice "Response" "Choose response" options (suggestion incident.Incident.type)
where
//Generate the list of possible tasks to choose from
......@@ -89,17 +89,17 @@ where
suggestion _ = []
sendPolice :: Incident -> Task Void
sendPolice incident = Subject "Send police" @>> showMessage "Please send police"
sendPolice incident = showMessage "Send police" "Please send police" Void
sendMedics :: Incident -> Task Void
sendMedics incident = Subject "Send ambulances" @>> requestAmbulances incident.Incident.nrInjured incident.Incident.location
sendFireBrigade :: Incident -> Task Void
sendFireBrigade incident = Subject "Send fire brigade" @>> showMessage "Please send fire brigade"
sendFireBrigade incident = showMessage "Send fire brigade" "Please send fire brigade" Void
dispatchAmbulances :: Task Void
dispatchAmbulances
= enterInformation "How many ambulances do you need at what location?"
= enterInformation "Dispatch ambulances" "How many ambulances do you need at what location?"
>>= \(nr,loc) -> requestAmbulances nr loc
// Request for amount ambulances from list of candidate providers
......@@ -130,7 +130,7 @@ where
lonDist l1 l2 = (fromJust l1.Location.coordinates).lon - (fromJust l2.Location.coordinates).lon
displayRequest :: [Provider] -> Task Void
displayRequest providers = showStickyMessage (flatten [[Text (p.Provider.name +++ " is asked for " <+ p.capacity),BrTag []]\\p <- providers])
displayRequest providers = showStickyMessage "Request" (flatten [[Text (p.Provider.name +++ " is asked for " <+ p.capacity),BrTag []]\\p <- providers]) Void
// Calculates for a needed amount (left,providers,remainder)
// left: is the amount that could not fulfilled (0 in case all can be supplied)
......@@ -182,15 +182,10 @@ timeOutTask task time
ambulanceTask :: Int -> Task Int
ambulanceTask amount
= updateInformation ("I need " <+ amount <+ " ambulances, how much can you provide?") amount
= updateInformation "Amount" ("I need " <+ amount <+ " ambulances, how much can you provide?") amount
showAmbulances :: [(Provider, Maybe Int)] -> Task Void
showAmbulances providers = showMessage "Ambulances are on their way"
/*
= showMessage (tableView [[p.Provider.name +++ ": ", case i of Nothing = "Timed out" ; (Just n) = ("Can send " <+ n <+ " ambulances")] \\ (p,i) <- providers])
where
tableView rows = [TableTag [] [TrTag [] [TdTag [] [Text cell] \\cell <- row] \\row <- rows]]
*/
showAmbulances providers = showMessage "Summary" "Ambulances are on their way" Void
//Utilities
(<+) infixl :: !String !a -> String | toString a
......
......@@ -34,7 +34,7 @@ reportIncident
markLocations :: Task GoogleMap
markLocations =
enterInformation "Mark all locations where incidents have occurred"
enterInformation "Locations" "Mark all locations where incidents have occurred"
specifiyIncidents :: GoogleMap -> Task [Incident]
specifiyIncidents map = sequence "Specify individual incident details" [ (addressLookup m) >>= \addr -> (specifyIncident addr m) \\ m <- (reverse map.GoogleMap.markers) ]
......@@ -42,7 +42,7 @@ specifiyIncidents map = sequence "Specify individual incident details" [ (addres
addressLookup :: GoogleMapMarker -> Task String
addressLookup marker
# (lat,lng) = marker.position
= showStickyMessage ("Address is being retrieved for coordinates: ("+++toString lat+++", "+++toString lng+++")")
= showStickyMessage "Address lookup" ("Address is being retrieved for coordinates: ("+++toString lat+++", "+++toString lng+++")") Void
||- reverse_geocoding (toString lat+++","+++toString lng) "json" False GOOGLE_API_KEY parseJSON
where
parseJSON info
......@@ -64,7 +64,7 @@ specifyIncident addr marker
, nrInjured = 0
, description = Note ""
}
= showStickyMessageAbout "Incident location:" smap ||- updateInformation "Specify incident details" incident
= showStickyMessageAbout "Location" "Incident location:" smap ||- updateInformation "Details" "Specify incident details" incident
//====
......@@ -72,4 +72,4 @@ showSources :: Task Void
showSources
= importDocument "Crisis Response\\AmbulanceDispatchMap.icl" >>=
\icl -> importDocument "Crisis Response\\AmbulanceDispatchMap.dcl" >>=
\dcl -> showStickyMessageAbout "Source Codes" [icl,dcl]
\ No newline at end of file
\dcl -> showStickyMessageAbout "Sources" "View the source code of this example" [icl,dcl] >>| stop
\ No newline at end of file
......@@ -55,9 +55,9 @@ where
mapMonad fun [d:ds] = fun d >>= \nd -> mapMonad fun ds >>= \nds -> return [nd:nds]
translate :: !FlowShape -> Task Dynamic
translate (Editor prompt) = return (dynamic DF0 (updateInformation prompt) :: A.a: DF0 a a | iTask a)
translate (Editor prompt) = return (dynamic DF0 (updateInformation "Edit" prompt) :: A.a: DF0 a a | iTask a)
translate (DisplayIt prompt) = return (dynamic DF0 (showMessageAbout prompt) :: A.a: DF0 a Void | iTask a)
translate (DisplayIt prompt) = return (dynamic DF0 (\v -> showMessageAbout "Display" prompt v >>| return Void) :: A.a: DF0 a Void | iTask a)
translate Return = return (dynamic DF0 (\v -> return v) :: A.a: DF0 a a | iTask a)
translate (Or (left, right)) = flowShapeToFlowDyn left >>= \leftflow -> flowShapeToFlowDyn right >>= \rightflow -> checkOr leftflow rightflow
......
......@@ -46,9 +46,10 @@ handleMenu
doMenu state=:((name,flow), mode)
= case mode of
False -> updateInformationA title1 (actions state) Void
False -> updateInformationA "No flow" title1 (actions state) Void
>>= \(action,_) -> return (action,state)
True -> updateInformationA title2 [ ButtonAction (ActionSave, ifValid (validFlow name flow.flowDyn))
True -> updateInformationA "Flow" title2
[ ButtonAction (ActionSave, ifValid (validFlow name flow.flowDyn))
, ButtonAction (ActionOk, IfValid)
: actions state
] flow.flowShape
......@@ -82,9 +83,9 @@ switchAction (action, (nameflow=:(name,flow),mode))
where
errorRaised :: [FlowShape] String -> Task Flow
errorRaised flowShape s
= showMessage ("Type Error: " +++ s) >>| return {flow & flowShape = flowShape}
= showMessage "Type error" ("Type Error: " +++ s) {flow & flowShape = flowShape}
showAbout
= showMessage "Flow editor 0.1 - feb 2010"
= showMessage "About" "Flow editor 0.1 - feb 2010" Void
......@@ -66,9 +66,10 @@ handleMenu
doMenu state=:((name,form), mode)
= case mode of
NoEdit -> updateInformationA title1 (actions state) Void
NoEdit -> updateInformationA "No edit" title1 (actions state) Void
>>= \(action,_) -> return (action,state)
EditType -> updateInformationA title2 [ ButtonAction (ActionEditValue, ifValid (not (isEmpty form.formShape)))
EditType -> updateInformationA "Edit" title2
[ ButtonAction (ActionEditValue, ifValid (not (isEmpty form.formShape)))
, ButtonAction (ActionOk, IfValid)
: actions state] form.formShape
>>= \(action,shape) -> return (action,((name,{form & formShape = shape}),mode))
......@@ -76,7 +77,8 @@ doMenu state=:((name,form), mode)
>>= switchAction
where
editValue state=:((name,form=:{formDyn = DV0 v :: DV0 a}), mode)
= updateInformationA title3 [ ButtonAction (ActionSave, ifValid (name <> ""))
= updateInformationA "Edit" title3
[ ButtonAction (ActionSave, ifValid (name <> ""))
, ButtonAction (ActionEditType, Always)
: actions state
] (Just v)
......@@ -111,5 +113,5 @@ switchAction (action, (nameform=:(name,form),mode))
ActionOk -> doMenu (nameform, mode)
showAbout
= showMessage "Form editor 0.1 - feb 2010"
= showMessage "About" "Form editor 0.1 - feb 2010" Void
......@@ -50,33 +50,33 @@ readAllFlows = dbReadAll
newFormName :: !Form -> Task (!String, !Form)
newFormName form
= enterInformation "Give name of new Form:"
= enterInformation "New form" "Give name of new Form:"
>>= \name -> readAllForms
>>= \allForms -> case [this \\ this <- allForms | this.formName == name] of
[] -> getDefaultValue
>>= \item -> dbCreateItem {item & form = form, formType = showDynType form.formDyn, formName = name}
>>| return (name,form)
found -> requestConfirmation ("Name already exists, do you want to overwrite" +++ (hd found).formType)
found -> requestConfirmation "Form exists" ("Name already exists, do you want to overwrite" +++ (hd found).formType)
>>= \ok -> if ok (return (name,form)) (newFormName form)
newFlowName :: !Flow -> Task (!String, !Flow)
newFlowName flow
= enterInformation "Give name of new flow:"
= enterInformation "New flow" "Give name of new flow:"
>>= \name -> readAllFlows
>>= \allFlows -> case [this \\ this <- allFlows | this.flowName == name] of
[] -> getDefaultValue
>>= \item -> dbCreateItem {item & flow = flow, flowType = showDynType flow.flowDyn, flowName = name}
>>| return (name,flow)
found -> requestConfirmation ("Name already exists, do you want to overwrite" +++ (hd found).flowType )
found -> requestConfirmation "Flow exists" ("Name already exists, do you want to overwrite" +++ (hd found).flowType )
>>= \ok -> if ok (return (name,flow)) (newFlowName flow)
chooseForm :: Task (!String, !Form)
chooseForm
= readAllForms
>>= \all -> let names = [showName this \\ this <- all] in
case names of
[] -> updateInformation "No Forms stored !" Void
[] -> updateInformation "No forms" "No Forms stored !" Void
>>| return ("", emptyForm)
names -> enterChoice "Choose Form you want to use:" names
names -> enterChoice "Choose form" "Choose Form you want to use:" names
>>= \choice -> return (hd [(this.formName, this.form) \\ this <- all | showName this == choice])
where
showName this = this.formName +++ " :: " +++ this.formType
......@@ -86,15 +86,15 @@ chooseFlow
= readAllFlows
>>= \all -> let names = [showName this \\ this <- all] in
case names of
[] -> updateInformation "No Flows stored !" Void
[] -> updateInformation "No flows" "No Flows stored !" Void
>>| return ("", emptyFlow)
names -> enterChoice "Choose Flow you want to use:" names
names -> enterChoice "Choose flow" "Choose Flow you want to use:" names
>>= \choice -> return (hd [(this.flowName, this.flow) \\ this <- all | showName this == choice])
where
showName this = this.flowName +++ " :: " +++ this.flowType
newName fun f
= enterInformation "Type in another name " >>= \name -> fun (name, f)
= enterInformation "New name" "Type in another name " >>= \name -> fun (name, f)
storeForm :: !(String, !Form) -> Task (!String, !Form) // item assumed to be in store
storeForm (name, form)
......
......@@ -29,7 +29,7 @@ handleMenu
= initMenu >>| doMenu
where
doMenu
= enterInformationA "Select \"File/Start Workflow... \" to run a stored workflow..." actions
= enterInformationA "Stored flow" "Select \"File/Start Workflow... \" to run a stored workflow..." actions
>>= \(actions,Void) -> doActions actions
doActions ActionStartFlow = startFlow >>| doMenu
......@@ -41,13 +41,13 @@ startFlow
>>= \(_,flow) -> try (evalFlow flow.flowDyn >>= taskFound) showTypeError
where
showTypeError :: !String -> Task Void
showTypeError s = showMessage s
showTypeError s = showMessage "Type error" s Void
taskFound :: Dynamic -> Task Void
taskFound d=:(DT t:: DT a)
= getCurrentUser
>>= \me -> requestConfirmation ("Workflow of type :: " +++ showDynType d +++ " can be started; Shall I ?")
>>= \ok -> if ok ( updateInformation "Name of this workflow: " "workflow"
>>= \me -> requestConfirmation "Start workflow" ("Workflow of type :: " +++ showDynType d +++ " can be started; Shall I ?")
>>= \ok -> if ok ( updateInformation "Name" "Name of this workflow: " "workflow"
>>= \name -> spawnProcess me True True (t <<@ Subject name)
>>| return Void)
(return Void)
......
......@@ -34,15 +34,15 @@ handleMenu
where
doMenu :: String a -> Task Void | iTask a
doMenu title val
= showMessageAboutA title [ButtonAction (Refresh, Always):actions] val
= showMessageAboutA title title [ButtonAction (Refresh, Always):actions] val
>>= \choice -> readAllForms
>>= \allForms -> readAllFlows
>>= \allFlows -> case choice of
ShowForms -> doMenu "Stored Forms" (myForm allForms)
ShowFlows -> doMenu "Stored Workflows" (myFlows allFlows)
ShowAll -> doMenu "Stored Forms and Workflows" (myForm allForms ++ myFlows allFlows)
Refresh -> doMenu title val
ActionQuit -> return Void
(ShowForms,_) -> doMenu "Stored Forms" (myForm allForms)
(ShowFlows,_) -> doMenu "Stored Workflows" (myFlows allFlows)
(ShowAll,_) -> doMenu "Stored Forms and Workflows" (myForm allForms ++ myFlows allFlows)
(Refresh,_) -> doMenu title val
(ActionQuit,_) -> return Void
myForm allForms = ["Forms:", "" : [form.formName +++ " :: " +++ form.formType \\ form <- allForms]]
myFlows allFlows = ["Workflows:", "" : [flow.flowName +++ " :: " +++ flow.flowType \\ flow <- allFlows]]
......
......@@ -18,33 +18,31 @@ deadlineTaskExample
= [ workflow "Examples/Higher order/Deadline task" (Subject "Do task before deadline" @>> (deadline trivialTask))]
trivialTask :: Task Int
trivialTask = enterInformation "Enter a number larger than 42" <| (\n -> if (n <= 42) (False,[Text ("Error " <+++ n <+++ " should be larger than 42")]) (True,[]))
trivialTask = enterInformation "Initial number" "Enter a number larger than 42" <| (\n -> if (n <= 42) (False,[Text ("Error " <+++ n <+++ " should be larger than 42")]) (True,[]))
deadline :: (Task a) -> Task a | iTask a
deadline task
= chooseUser "Choose person you want to delegate work to:"
>>= \whom -> enterInformation "How long do you want to wait?"
>>= \whom -> enterInformation "Wait time" "How long do you want to wait?"
>>= \time -> (delegateTask whom time task)
-||-
(showMessage "Cancel delegated work if you are getting impatient:" >>| return Nothing)
(showMessage "Cancel..." "Cancel delegated work if you are getting impatient:" Nothing)
>>= checkDone
where
checkDone (Just value)
= showMessageAbout "Result of task:" value >>| return value
= showMessageAbout "Task result" "Result of task:" value
checkDone Nothing
= showMessage "Task expired or canceled, you have to do it yourself!" >>| task
= showMessage "No result" "Task expired or canceled, you have to do it yourself!" Void >>| task
delegateTask who time task
= who @: (Subject "Timed Task" @>> mytask)
where
mytask
= // wait for timeout and return nothing
( waitForTimer time
>>| return Nothing
)
( waitForTimer time >>| return Nothing)
-||-
// do task and return its result
( showStickyMessage ("You have to complete the task in " <+++ time <+++ " time")
( showStickyMessage "Hurry!" ("You have to complete the task in " <+++ time <+++ " time") Void
||- task
>>= \v -> return (Just v)
)