Commit c57e56e6 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@115 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 6d79f9ef
definition module StdiTasks
// Main iTask pass thru module exporting all End User iTask modules
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
import
// iTask End User modules:
iTasks // iTask main module and core engine
, iTasks2 // commonly used iTask combinators
, iTasksDB // iTask simple DB access
, iTasksSettings // font settings
implementation module StdiTasks
\ No newline at end of file
......@@ -25,7 +25,6 @@ derive write Void, TCl
:: Void = Void // for tasks returning non interesting results, won't show up in editors either
defaultUser :== 0 // default id of user
// *********************************************************************************************************************************
// Setting options for any collection of iTask workflows:
......@@ -35,10 +34,10 @@ defaultUser :== 0 // default id of user
class (<<@) infixl 3 b :: !(Task a) !b -> Task a // to set iData attribute globally for indicated (composition of) iTask(s)
instance <<@ Lifespan // default: Session
, StorageFormat // default: PlainString
, Mode // default: Edit
, GarbageCollect // default: Collect
instance <<@ Lifespan // default: Session
, StorageFormat // default: PlainString
, Mode // default: Edit
, GarbageCollect // default: Collect
:: SubPage = UseAjax // use Ajax technology to update part of a page, only works if Ajax enabled
| OnClient // use SAPL to update part of a page on the client, only works if Client enabled and Sapl is running...
......@@ -64,21 +63,13 @@ workFlowTask :: ![StartUpOptions] !(Task (Int,a))
| ThreadStorage Lifespan // for Ajax: where to store threadinformation: default = TxtFile
| ShowUsers Int // for multiUserTask, toggle between given maximum number of users, default: ShowUser 5
| VersionCheck | NoVersionCheck // for single & multiUser: default = VersionNoCheck
| MyHeader HtmlCode // will replace standard iTask information line
| MyHeader HtmlCode // wil replace standard iTask information line
// *********************************************************************************************************************************
/* Important for optimizations
newTask :: promote a function to a task, final result will be remembered
Once :: task will be done only once, the value of the task will be remembered, maybe useful for some lifted iData
*/
newTask :: !String !(Task a) -> Task a | iData a
Once :: (Task a) -> Task a | iData a
// *********************************************************************************************************************************
// Here follow the iTasks combinators:
/* promote any iData editor to the iTask domain
editTask :: create a task editor to edit a value of given type, and add a button with given name to finish the task
editTask :: create a task editor (with submit button) to edit a value of given type, finish only if predicate holds
*/
......@@ -86,18 +77,13 @@ editTask :: !String !a -> Task a | iData a
editTaskPred :: !a !(a -> (Bool, HtmlCode)) -> Task a | iData a
/* standard monadic combinators on iTasks:
(=>>) :: for sequencing: bind
(#>>) :: for sequencing: bind, but no argument passed
return_V :: lift a value to the iTask domain and return it
*/
(=>>) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iCreateAndPrint b
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
return_V :: !a -> Task a | iCreateAndPrint a
/* prompting variants:
(?>>) :: prompt as long as task is active but not finished
(!>>) :: prompt when task is activated
(<<?) :: as ?>>, except that prompt is displayed *after* task
......@@ -114,119 +100,52 @@ return_VF :: !HtmlCode !a -> Task a | iCreateAndPrint a
return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a
/* Assign tasks to user with indicated id:
(@:) :: will prompt who is waiting for task with give name
(@::) :: as @:, a default task name is chosen as label
(@:>) :: as @:, no prompting
(@::>) :: as @::, no prompting
assignTaskTo :: assign task to indicated user, True for verbose reporting
*/
(@:) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@::) infix 3 :: !Int !(Task a) -> Task a | iData a
(@:>) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@::>) infix 3 :: !Int !(Task a) -> Task a | iData a
assignTaskTo :: !Bool !Int !(LabeledTask a) -> Task a | iData a
/* Handling recursion and loops:
foreverTask :: infinitely repeating Task
repeatTask :: repeat Task until predicate is valid
(<|) :: repeat task (recursively) as long as predicate does not hold, and give error message otherwise
(<!) :: repeat task (as a loop) as long as predicate does not hold; also works for tasks that don't require any user interactions (e.g. database access)
*/
foreverTask :: !(Task a) -> Task a | iData a
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
(<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iCreate a
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a
/* Sequencing Tasks:
seqTasks :: do all iTasks one after another, task completed when all done
*/
seqTasks :: ![LabeledTask a] -> Task [a] | iCreateAndPrint a
/* Choose the tasks you want to do one forehand, labels are used to make the choice:
/* Choose out the tasks you want to do one forehand, labels are used to make the choice:
buttonTask :: do the iTask when button pressed
chooseTask :: choose ONE iTask from list, depending on button pressed, button horizontally displayed
chooseTaskV :: as chooseTask, buttons vertically displayed
chooseTask_pdm :: as chooseTask, depending on pulldownmenu item selected, Int for initially selected task
chooseTask_pdm :: as chooseTask, depending on radio item selected, Int for initially selected task
chooseTask_btn :: choose ONE task by pressing a button, True for horizontal buttons, else vertical
chooseTask_pdm :: as chooseTask_btn, depending on pulldownmenu item selected, Int for initial value
chooseTask_radio:: as chooseTask_btn, depending on radio item selected, Int for initial value, htmlcode for option explanation
mchoice: choose tasks depending on the checkboxes set
mchoiceTasks :: checked tasks will be done SEQUENTIALLY
mchoiceTasks2 :: as mchoiceTask, boolean used for initial setting of the checks
mchoiceTasks3 :: as mchoiceTask2, function can be used to (re)set the checkboxes
mchoiceAndTasks :: checked tasks can be done INTERLEAVED
mchoiceAndTasks2:: as mchoiceTasks, boolean used for initial setting of the checks
mchoiceAndTasks3:: as mchoiceTasks2, function can be used to (re)set the checkboxes
gchoiceTasks :: most general mchoice function, can be used e.g. with andTasksCond
mpchoiceeTasks :: choice N tasks out of N, order of chosen task depending on first arg
(initial setting, effect for all when set, explanation) for each option
*/
buttonTask :: !String !(Task a) -> Task a | iCreateAndPrint a
chooseTask :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTaskV :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_btn :: !HtmlCode !Bool![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_pdm :: !HtmlCode !Int ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_radio:: !HtmlCode !Int ![(HtmlCode,LabeledTask a)]
-> Task a | iCreateAndPrint a
mchoiceTasks :: !HtmlCode ![LabeledTask a] -> Task [a] | iData a
mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a
mchoiceAndTasks :: !HtmlCode ![LabeledTask a] -> Task [a] | iData a
mchoiceAndTasks2:: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks3:: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a
gchoiceTasks :: !([LabeledTask a] -> Task [a])
mpchoiceTasks :: !([LabeledTask a] -> Task [a])
!HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a
:: ChoiceUpdate :== !Bool [Bool] -> [Bool] // changed checkbox + current settings -> new settings
/* Do m Tasks parallel / interleaved and FINISH as soon as SOME Task completes:
orTask :: do both iTasks in any order, combined task completed as any subtask is done
(-||-) :: same, now as infix combinator
orTask2 :: do both iTasks in any order, combined task completed as any subtask is done
orTasks :: do all iTasks in any order, combined task completed as any subtask is done
andTask2 :: do both iTasks in any order (interleaved), task completed when both done
andTasksCond :: do tasks in any order until pred holds for finished tasks, string used for naming group of task navigation buttons
*/
orTask :: !(Task a,Task a) -> Task a | iCreateAndPrint a
(-||-) infixr 3 :: !(Task a) !(Task a) -> Task a | iCreateAndPrint a
orTask2 :: !(Task a,Task b) -> Task (EITHER a b)
| iCreateAndPrint a & iCreateAndPrint b
orTasks :: ![LabeledTask a] -> Task a | iData a
/* Do Tasks parallel / interleaved and FINISH when ALL Tasks done:
andTask :: do both iTasks in any order (interleaved), task completed when both done
(-&&-) :: same, now as infix combinator
andTasks :: do all iTasks in any order (interleaved), task completed when all done
andTasksCond :: like andTasks, but completion forced as soon as predicate holds
andTasks_mu :: assign task to indicated users, task completed when all done
*/
andTask :: !(Task a,Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b
(-&&-) infixr 4 :: !(Task a) !(Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b
andTasks :: ![LabeledTask a] -> Task [a] | iData a
andTasksCond :: !([a] -> Bool) ![LabeledTask a] -> Task [a] | iData a
andTasks_mu :: !String ![(Int,Task a)] -> Task [a] | iData a
/* Time and Date management:
waitForTimeTask :: Task is done when time has come
waitForTimerTask:: Task is done when specified amount of time has passed
waitForDateTask :: Task is done when date has come
*/
waitForTimeTask :: !HtmlTime -> Task HtmlTime
waitForTimerTask:: !HtmlTime -> Task HtmlTime
waitForDateTask :: !HtmlDate -> Task HtmlDate
andTask2 :: !(Task a,Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b
andTasksCond :: !String !([a] -> Bool) ![LabeledTask a] -> (Task [a]) | iData a
/* Experimental department:
......@@ -252,13 +171,32 @@ closureLzTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a
/* Exception Handling:
<^> :: Evaluate the task; An exception of type e raised by this task, will be catched by the closest handler.
One can use the function to create a proper task value or signal the fact that an exception has occured.
One can use the function create a proper task value or signal the fact that an exception has occured.
Raise :: Raises an exception of type e which will be catched by the closest parent handler for this type
*/
(<^>) infix 1 :: !(e -> a) !(Task a) -> Task a | iData a & TC e // assigns an exception handler
Raise :: e -> Task a | iCreate a & TC e // raises an exception
(<^>) infix 1 :: !(e -> a) !(Task a) -> Task a | iData a & TC e // assigns an exception Handler
Raise :: e -> Task a | iCreate a & TC e // rases an exception
/* Lifting to iTask domain
/* Time and Date management:
waitForTimeTask :: Task is done when time has come
waitForDateTask :: Task is done when date has come
*/
waitForTimeTask :: !HtmlTime -> Task HtmlTime
waitForDateTask :: !HtmlDate -> Task HtmlDate
// *********************************************************************************************************************************
/* Support for user defined combinators
mkTask :: for making a user defined combinator, name will appear intrace
newTask :: same, but optimized: after completion only result will remembered
Once :: task will be done only once, the value of the task will be remembered, maybe useful for some lifted iData
*/
mkTask :: !String !(Task a) -> Task a | iCreateAndPrint a
newTask :: !String !(Task a) -> Task a | iData a
Once :: (Task a) -> Task a | iData a
// *********************************************************************************************************************************
/* Lifting of other domains to the iTask domain
(*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain
(@>>) :: lift functions of (TSt -> TSt) to iTask domain
......@@ -274,13 +212,13 @@ appIData2 :: (String *HSt -> *(Form a,*HSt)) -> Task a | iData a
appHSt :: !String (HSt -> (a,HSt)) -> Task a | iData a
appHSt2 :: !String (HSt -> (a,HSt)) -> Task a | iData a
// *********************************************************************************************************************************
/* Operations on Task state
taskId :: give id of user assigned to task
userId :: give id of application user
addHtml :: add html code
*/
taskId :: TSt -> (Int,TSt)
userId :: TSt -> (Int,TSt)
addHtml :: HtmlCode TSt -> TSt
implementation module iTasks
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006,2007 - MJP
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
// iTasks library for defining interactive multi-user workflow tasks (iTask) for the web.
// Defined on top of the iData library.
......@@ -78,6 +78,8 @@ derive write Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, Glob
// Initial values
defaultUser :== 0 // default id of user
initTst :: UserId !Lifespan !*HSt -> *TSt
initTst thisUser location hst
= { tasknr = [-1]
......@@ -259,7 +261,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor
# iTaskHeader = [Table [Tbl_Width (Percent 100)] [Tr []
[ Td [] [Img [Img_Src (ThisExe +++ "/scleanlogo.jpg"),Img_Align Alo_Middle]
,showHighLight "i -Task", showLabel " Workflow System "]
,showHighLight " i -Task", showLabel " Workflow System "]
, Td [Td_Align Aln_Right] (multiuserform ++ refresh.form ++ ifTraceOn traceAsked.form)] ]]++
[Hr []]
| versionconflict
......@@ -278,7 +280,7 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor
// epilogue
# newUserVersionNr = 1 + if (pversion.versionNr > sversion) pversion.versionNr sversion // increment user querie version number
# (_,hst) = clearIncPUser thisUser (\_ -> newUserVersionNr) hst // store in session
# (_,hst) = clearIncPUser thisUser (\_ -> newUserVersionNr) hst // store in session
# (sversion,hst) = setSVersionNr thisUser (\_ -> newUserVersionNr) hst // store in persistent memory
# showCompletePage = IF_Ajax (hd threads == [-1]) True
......@@ -295,10 +297,9 @@ startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStor
( IF_Ajax (IF_ClientServer (IF_ClientTasks [showLabel "Client: "] [showLabel "Server: "]) []) [] ++
if multiuser
[showText "User: " , showLabel thisUser, showText " - "] [] ++
[showLowLight thrinfo, showText " - "] ++
if multiuser
[showText "#User Queries: " , showTrace sversion, showText " - "] [] ++
if versionsOn [showText "#Server Queries: ", showTrace appversion] [] ++
if (thrinfo == "" ) [] [showLowLight thrinfo, showText " - "] ++
if (multiuser && versionsOn)
[showText "Query " , showTrace ((sversion +++> " / " )<+++ appversion)] [] ++
IF_Ajax
( [showText " - Task#: ", showTrace (showTaskNr event)] ++
if (isNil threads || showCompletePage) [] [showText " - Thread(s)#: ", showTrace threadsText]
......@@ -1043,14 +1044,6 @@ where
| activated = taskb a {tst & options = options}
= (createDefault,tst)
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
(#>>) taska taskb = mybind
where
mybind tst=:{options}
# (a,tst=:{activated}) = taska tst
| activated = taskb {tst & options = options}
= (createDefault,tst)
return_V :: !a -> (Task a) | iCreateAndPrint a
return_V a = mkTask "return_V" dotask
where
......@@ -1181,34 +1174,24 @@ where
// ******************************************************************************************************
// Assigning tasks to users, each user has to be identified by an unique number >= 0
(@:) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:) nuserId (taskname,taska) = \tst=:{userId} -> assignTaskTo True taskname userId taska {tst & userId = nuserId}
(@::) infix 3 :: !Int !(Task a) -> (Task a) | iData a // force thread if Ajax is used
(@::) nuserId taska = \tst=:{userId} -> assignTaskTo True ("Task for " <+++ userId) userId taska {tst & userId = nuserId}
(@:>) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:>) nuserId (taskname,taska) = \tst=:{userId} -> assignTaskTo False taskname userId taska {tst & userId = nuserId}
(@::>) infix 3 :: !Int !(Task a) -> (Task a) | iData a // force thread if Ajax is used
(@::>) nuserId taska = \tst=:{userId} -> assignTaskTo False ("Task for " <+++ userId) userId taska {tst & userId = nuserId}
assignTaskTo :: !Bool !String !Int !(Task a) !*TSt -> (a,!*TSt) | iData a
assignTaskTo verbose taskname userId taska tst=:{html=ohtml,activated,userId = nuserId}
| not activated = (createDefault,tst)
# tst = IF_Ajax (administrateNewThread userId tst) tst
# (a,tst=:{html=nhtml,activated}) = IF_Ajax (UseAjax @>> taska) taska {tst & html = BT [],userId = nuserId} // activate task of indicated user
| activated = (a,{tst & activated = True // work is done
, userId = userId // restore previous user id
, html = ohtml }) // plus new one tagged
= (a,{tst & userId = userId // restore user Id
, html = ohtml +|+ // show old code
if verbose
( BT [showText ("Waiting for Task "), showLabel taskname, showText " from ", showUser nuserId,Br] +|+ // show waiting for
((nuserId,taskname) @@: BT [showText "Requested by ", showUser userId,Br,Br] +|+ nhtml))
((nuserId,taskname) @@: nhtml)
})
assignTaskTo :: !Bool !Int !(LabeledTask a) -> Task a | iData a
assignTaskTo verbose nuserId (taskname,taska) = assignTaskTo`
where
assignTaskTo` tst=:{html=ohtml,activated,userId}
| not activated = (createDefault,tst)
# tst = IF_Ajax (administrateNewThread userId tst) tst
# (a,tst=:{html=nhtml,activated}) = IF_Ajax (UseAjax @>> taska) taska {tst & html = BT [],userId = nuserId} // activate task of indicated user
| activated = (a,{tst & activated = True // work is done
, userId = userId // restore previous user id
, html = ohtml }) // plus new one tagged
= (a,{tst & userId = userId // restore user Id
, html = ohtml +|+ // show old code
if verbose
( BT [showText ("Waiting for Task "), showLabel taskname, showText " from ", showUser nuserId,Br] +|+ // show waiting for
((nuserId,taskname) @@: BT [showText "Requested by ", showUser userId,Br,Br] +|+ nhtml))
((nuserId,taskname) @@: nhtml)
})
showUser nr = showLabel ("User " <+++ nr)
administrateNewThread ouserId tst =: {tasknr,userId,options}
......@@ -1241,36 +1224,27 @@ where
// ******************************************************************************************************
// choose one or more tasks on forehand out of a set
buttonTask :: !String !(Task a) -> (Task a) | iCreateAndPrint a
buttonTask s task = iCTask_button "buttonTask" [(s,task)]
iCTask_button tracename options = mkTask tracename (dochooseTask True [] options)
chooseTask :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTask prompt options = mkTask "chooseTask" (dochooseTask True prompt options)
chooseTaskV :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTaskV prompt options = mkTask "chooseTask" (dochooseTask False prompt options)
dochooseTask :: !Bool !HtmlCode ![LabeledTask a] *TSt-> *(a,*TSt) | iCreateAndPrint a
dochooseTask _ _ [] tst = return createDefault tst
dochooseTask horizontal prompt taskOptions tst=:{tasknr,html,options,userId} // choose one subtask out of the list
# taskId = iTaskId userId tasknr ("ChoSt" <+++ length taskOptions)
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) id) tst
| chosen.value == -1 // no choice made yet
# buttonId = iTaskId userId tasknr "ChoBut"
# allButtons = if horizontal
[[(but txt,\_ -> n) \\ txt <- map fst taskOptions & n <- [0..]]]
[[(but txt,\_ -> n)] \\ txt <- map fst taskOptions & n <- [0..]]
# (choice,tst) = LiftHst (TableFuncBut (Init,pageFormId options buttonId allButtons)) tst
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) choice.value) tst
| chosen.value == -1 = (createDefault,{tst & activated =False,html = html +|+ BT prompt +|+ BT choice.form})
# chosenTask = snd (taskOptions!!chosen.value)
chooseTask_btn :: !HtmlCode !Bool![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_btn htmlcode bool ltasks = chooseTask_btn` htmlcode bool ltasks
where
chooseTask_btn` _ _ [] tst = return createDefault tst
chooseTask_btn` prompt horizontal taskOptions tst=:{tasknr,html,options,userId} // choose one subtask out of the list
# taskId = iTaskId userId tasknr ("ChoSt" <+++ length taskOptions)
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) id) tst
| chosen.value == -1 // no choice made yet
# buttonId = iTaskId userId tasknr "ChoBut"
# allButtons = if horizontal
[[(but txt,\_ -> n) \\ txt <- map fst taskOptions & n <- [0..]]]
[[(but txt,\_ -> n)] \\ txt <- map fst taskOptions & n <- [0..]]
# (choice,tst) = LiftHst (TableFuncBut (Init,pageFormId options buttonId allButtons)) tst
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) choice.value) tst
| chosen.value == -1 = (createDefault,{tst & activated =False,html = html +|+ BT prompt +|+ BT choice.form})
# chosenTask = snd (taskOptions!!chosen.value)
# (a,tst=:{activated=adone,html=ahtml}) = chosenTask {tst & tasknr = [-1:tasknr], activated = True, html = BT []}
= (a,{tst & tasknr = tasknr, activated = adone, html = html +|+ ahtml})
# chosenTask = snd (taskOptions!!chosen.value)
# (a,tst=:{activated=adone,html=ahtml}) = chosenTask {tst & tasknr = [-1:tasknr], activated = True, html = BT []}
= (a,{tst & tasknr = tasknr, activated = adone, html = html +|+ ahtml})
# chosenTask = snd (taskOptions!!chosen.value)
# (a,tst=:{activated=adone,html=ahtml}) = chosenTask {tst & tasknr = [-1:tasknr], activated = True, html = BT []}
= (a,{tst & tasknr = tasknr, activated = adone, html = html +|+ ahtml})
but i = iTaskButton i
......@@ -1329,32 +1303,8 @@ where
= chosenTask {tst & activated = True, html = BT [], tasknr = [0:tasknr]}
= (a,{tst & activated = adone, html = html +|+ ahtml, tasknr = tasknr})
mchoiceTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceTasks prompt taskOptions
= gchoiceTasks seqTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceTasks2 prompt taskOptions
= gchoiceTasks seqTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceTasks3 prompt taskOptions
= gchoiceTasks seqTasks prompt taskOptions
mchoiceAndTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceAndTasks prompt taskOptions
= gchoiceTasks andTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceAndTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks2 prompt taskOptions
= gchoiceTasks andTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceAndTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks3 prompt taskOptions
= gchoiceTasks andTasks prompt taskOptions
gchoiceTasks :: !([LabeledTask a] -> Task [a]) !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
gchoiceTasks taskorderfun prompt taskOptions = mkTask "mchoiceTask" (domchoiceTasks taskOptions)
mpchoiceTasks :: !([LabeledTask a] -> Task [a]) !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mpchoiceTasks taskorderfun prompt taskOptions = mkTask "mchoiceTask" (domchoiceTasks taskOptions)
where
domchoiceTasks [] tst = ([],{tst& activated = True})
domchoiceTasks taskOptions tst=:{tasknr,html,options,userId} // choose one subtask out of the list
......@@ -1383,102 +1333,75 @@ where
// ******************************************************************************************************
// Speculative OR-tasks: task ends as soon as one of its subtasks completes
(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iCreateAndPrint a
(-||-) taska taskb = mkTask "-||-" (doOrTask (taska,taskb))
orTask :: !(Task a,Task a) -> (Task a) | iCreateAndPrint a
orTask (taska,taskb) = mkTask "orTask" (doOrTask (taska,taskb))
doOrTask :: !(Task a,Task a) *TSt -> *(a,*TSt) | iCreateAndPrint a
doOrTask (taska,taskb) tst=:{tasknr,options,html,userId}
# (at,tst) = doorTask2 (taska,taskb) tst
= case at of
(LEFT a) -> (a,tst)
(RIGHT b) -> (b,tst)
orTask2 :: !(Task a,Task b) -> (Task (EITHER a b)) | iCreateAndPrint a & iCreateAndPrint b
orTask2 (taska,taskb) = mkTask "orTask2" (doorTask2 (taska,taskb))
doorTask2 (taska,taskb) tst=:{tasknr,html,options,userId}
# taskId = iTaskId userId tasknr "orTask2St"
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) id) tst
| chosen.value == 0 // task a was finished first in the past
# (a,tst=:{html=ahtml}) = mkParSubTask "orTask" 0 taska {tst & tasknr = tasknr, html = BT []}
= (LEFT a,{tst & html = html})
| chosen.value == 1 // task b was finished first in the past
# (b,tst=:{html=bhtml}) = mkParSubTask "orTask" 1 taskb {tst & tasknr = tasknr, html = BT []}
= (RIGHT b,{tst & html = html})
# (a,tst=:{activated=adone,html=ahtml}) = mkParSubTask "orTask" 0 taska {tst & tasknr = tasknr, html = BT []}
# (b,tst=:{activated=bdone,html=bhtml}) = mkParSubTask "orTask" 1 taskb {tst & tasknr = tasknr, html = BT []}
| adone
# tst = deleteSubTasksAndThreads [1:tasknr] {tst & tasknr = tasknr}
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) (\_ -> 0)) {tst & html = BT []}
= (LEFT a,{tst & html = html, activated = True})
| bdone
# tst = deleteSubTasksAndThreads [0:tasknr] {tst & tasknr = tasknr}
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId tst.options taskId -1) (\_ -> 1)) {tst & html = BT []}
= (RIGHT b,{tst & html = html, activated = True})
= (LEFT a,{tst & activated = False, html = html +|+ ahtml +|+ bhtml})
orTasks :: ![LabeledTask a] -> (Task a) | iData a
orTasks [] = return createDefault
orTasks taskCollection = newTask "orTasks" (andTasksPredGen "or Tasks" (\list -> length list >= 1) taskCollection)
=>> \list -> return (hd list)
where
doorTask2 (taska,taskb) tst=:{tasknr,html,options,userId}
# taskId = iTaskId userId tasknr "orTask2St"
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) id) tst
| chosen.value == 0 // task a was finished first in the past
# (a,tst=:{html=ahtml}) = mkParSubTask "orTask" 0 taska {tst & tasknr = tasknr, html = BT []}
= (LEFT a,{tst & html = html})
| chosen.value == 1 // task b was finished first in the past
# (b,tst=:{html=bhtml}) = mkParSubTask "orTask" 1 taskb {tst & tasknr = tasknr, html = BT []}
= (RIGHT b,{tst & html = html})
# (a,tst=:{activated=adone,html=ahtml}) = mkParSubTask "orTask" 0 taska {tst & tasknr = tasknr, html = BT []}
# (b,tst=:{activated=bdone,html=bhtml}) = mkParSubTask "orTask" 1 taskb {tst & tasknr = tasknr, html = BT []}
| adone
# tst = deleteSubTasksAndThreads [1:tasknr] {tst & tasknr = tasknr}
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId options taskId -1) (\_ -> 0)) {tst & html = BT []}
= (LEFT a,{tst & html = html, activated = True})
| bdone
# tst = deleteSubTasksAndThreads [0:tasknr] {tst & tasknr = tasknr}
# (chosen,tst) = LiftHst (mkStoreForm (Init,storageFormId tst.options taskId -1) (\_ -> 1)) {tst & html = BT []}
= (RIGHT b,{tst & html = html, activated = True})
= (LEFT a,{tst & activated = False, html = html +|+ ahtml +|+ bhtml})
// ******************************************************************************************************
// Parallel task ends when all it subtask are ended as well
(-&&-) infixr 4 :: !(Task a) !(Task b) -> (Task (a,b)) | iCreateAndPrint a & iCreateAndPrint b
(-&&-) taska taskb = mkTask "-&&-" (doAndTask (taska,taskb))
andTask :: !(Task a,Task b) -> (Task (a,b)) | iCreateAndPrint a & iCreateAndPrint b
andTask (taska,taskb) = mkTask "andTask" (doAndTask (taska,taskb))
doAndTask (taska,taskb) tst=:{tasknr,html}
# (a,tst=:{activated=adone,html=ahtml}) = mkParSubTask "andTask" 0 taska {tst & html = BT []}
# (b,tst=:{activated=bdone,html=bhtml}) = mkParSubTask "andTask" 1 taskb {tst & tasknr = tasknr, html = BT []}
= ((a,b),{tst & activated = adone&&bdone, html = html +|+ ahtml +|+ bhtml})
andTasks :: ![LabeledTask a] -> (Task [a]) | iData a
andTasks taskCollection = newTask "andTasks" (andTasksPredGen "and Tasks" (\_ -> False) taskCollection)
andTasksCond :: !([a] -> Bool) ![LabeledTask a] -> (Task [a]) | iData a // predicate used to test whether tasks are finished
andTasksCond pred taskCollection = newTask "andTasksCond" (andTasksPredGen "cond Tasks" pred taskCollection)
andTask2 :: !(Task a,Task b) -> (Task (a,b)) | iCreateAndPrint a & iCreateAndPrint b
andTask2 (taska,taskb) = mkTask "andTask2" (doAndTask (taska,taskb))
where
doAndTask (taska,taskb) tst=:{tasknr,html}
# (a,tst=:{activated=adone,html=ahtml}) = mkParSubTask "andTask" 0 taska {tst & html = BT []}
# (b,tst=:{activated=bdone,html=bhtml}) = mkParSubTask "andTask" 1 taskb {tst & tasknr = tasknr, html = BT []}
= ((a,b),{tst & activated = adone&&bdone, html = html +|+ ahtml +|+ bhtml})
andTasksPredGen :: !String !([a] -> Bool) ![LabeledTask a] -> (Task [a]) | iData a // predicate used to test whether tasks are finished
andTasksPredGen label pred taskCollection = mkTask "andTasksPred" (doandTasks taskCollection)
andTasksCond :: !String !([a] -> Bool) ![LabeledTask a] -> (Task [a]) | iData a // predicate used to test whether tasks are finished