Commit 35764df6 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

bug in multiple choice task / pull down meny is verwijderd

algemenere multiple coice gemaakt


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@106 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent fb4f0f3d
...@@ -19,6 +19,9 @@ derive write Void, TCl ...@@ -19,6 +19,9 @@ derive write Void, TCl
:: *TSt // abstract task state :: *TSt // abstract task state
:: Task a :== St *TSt a // an interactive task :: Task a :== St *TSt a // an interactive task
:: LabeledTask a :== !(!String,!Task a) // a Task with a label used for labeling buttons, pull down menu, and the like
:: HtmlCode :== [BodyTag] // most programmers will only write bodytags
:: Void = Void // for tasks returning non interesting results, won't show up in editors either :: Void = Void // for tasks returning non interesting results, won't show up in editors either
...@@ -61,19 +64,21 @@ workFlowTask :: ![StartUpOptions] !(Task (Int,a)) ...@@ -61,19 +64,21 @@ workFlowTask :: ![StartUpOptions] !(Task (Int,a))
| ThreadStorage Lifespan // for Ajax: where to store threadinformation: default = TxtFile | ThreadStorage Lifespan // for Ajax: where to store threadinformation: default = TxtFile
| ShowUsers Int // for multiUserTask, toggle between given maximum number of users, default: ShowUser 5 | ShowUsers Int // for multiUserTask, toggle between given maximum number of users, default: ShowUser 5
| VersionCheck | VersionNoCheck // for single & multiUser: default = VersionNoCheck | VersionCheck | VersionNoCheck // for single & multiUser: default = VersionNoCheck
| MyHeader [BodyTag] // wil replace standard iTask information line | MyHeader HtmlCode // wil replace standard iTask information line
// ********************************************************************************************************************************* // *********************************************************************************************************************************
// Here follow the iTasks combinators: // Here follow the iTasks combinators:
/* promote any iData editor to the iTask domain /* 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 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 editTask :: create a task editor (with submit button) to edit a value of given type, finish only if predicate holds
*/ */
editTask :: !String !a -> Task a | iData a editTask :: !String !a -> Task a | iData a
editTaskPred :: !a !(a -> (Bool, [BodyTag])) -> Task a | iData a editTaskPred :: !a !(a -> (Bool, HtmlCode)) -> Task a | iData a
/* standard monadic combinators on iTasks: /* standard monadic combinators on iTasks:
(=>>) :: for sequencing: bind (=>>) :: for sequencing: bind
(#>>) :: for sequencing: bind, but no argument passed (#>>) :: for sequencing: bind, but no argument passed
return_V :: lift a value to the iTask domain and return it return_V :: lift a value to the iTask domain and return it
...@@ -84,6 +89,7 @@ return_V :: lift a value to the iTask domain and return it ...@@ -84,6 +89,7 @@ return_V :: lift a value to the iTask domain and return it
return_V :: !a -> Task a | iCreateAndPrint a return_V :: !a -> Task a | iCreateAndPrint a
/* prompting variants: /* prompting variants:
(?>>) :: prompt as long as task is active but not finished (?>>) :: prompt as long as task is active but not finished
(!>>) :: prompt when task is activated (!>>) :: prompt when task is activated
(<<?) :: same as ?>>, except that prompt is displayed *after* task (<<?) :: same as ?>>, except that prompt is displayed *after* task
...@@ -94,25 +100,27 @@ return_VF :: return the value and show the Html code specified ...@@ -94,25 +100,27 @@ return_VF :: return the value and show the Html code specified
return_D :: return the value and show it in iData display format return_D :: return the value and show it in iData display format
*/ */
(?>>) infixr 5 :: ![BodyTag] !(Task a) -> Task a | iCreate a (?>>) infixr 5 :: !HtmlCode !(Task a) -> Task a | iCreate a
(!>>) infixr 5 :: ![BodyTag] !(Task a) -> Task a | iCreate a (!>>) infixr 5 :: !HtmlCode !(Task a) -> Task a | iCreate a
(<<?) infixl 5 :: !(Task a) ![BodyTag] -> Task a | iCreate a (<<?) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
(<<!) infixl 5 :: !(Task a) ![BodyTag] -> Task a | iCreate a (<<!) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
(<|) infixl 6 :: !(Task a) !(a -> (Bool, [BodyTag])) -> Task a | iCreate a (<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iCreate a
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a (<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a
return_VF :: ![BodyTag] !a -> Task a | iCreateAndPrint a return_VF :: !HtmlCode !a -> Task a | iCreateAndPrint a
return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a
/* Assign tasks to user with indicated id: /* Assign tasks to user with indicated id:
(@:) :: will prompt who is waiting for task with give name (@:) :: will prompt who is waiting for task with give name
(@::) :: same, default task name given (@::) :: same, default task name given
*/ */
//(@:) infix 3 :: !(!String,!Int) (Task a) -> (Task a) | iCreateAndPrint a //(@:) infix 3 :: !(!String,!Int) (Task a) -> (Task a) | iCreateAndPrint a
//(@::) infix 3 :: !Int (Task a) -> (Task a) | iCreate a //(@::) infix 3 :: !Int (Task a) -> (Task a) | iCreate a
(@:) infix 3 :: !(!String,!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 (@::) infix 3 :: !Int !(Task a) -> Task a | iData a
/* Handling recursion and loops: /* Handling recursion and loops:
newTask :: use the to promote a (recursively) defined user function to as task newTask :: use the to promote a (recursively) defined user function to as task
foreverTask :: infinitely repeating Task foreverTask :: infinitely repeating Task
repeatTask :: repeat Task until predicate is valid repeatTask :: repeat Task until predicate is valid
...@@ -122,27 +130,36 @@ foreverTask :: !(Task a) -> Task a | iData a ...@@ -122,27 +130,36 @@ foreverTask :: !(Task a) -> Task a | iData a
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
/* Sequencing Tasks: /* Sequencing Tasks:
seqTasks :: do all iTasks one after another, task completed when all done seqTasks :: do all iTasks one after another, task completed when all done
*/ */
seqTasks :: ![(String,Task a)] -> Task [a] | iCreateAndPrint a seqTasks :: ![LabeledTask a] -> Task [a] | iCreateAndPrint a
/* Choose out one or more Tasks sequentially before they are executed sequentially:
/* Choose Tasks:
buttonTask :: Choose the iTask when button pressed buttonTask :: Choose the iTask when button pressed
chooseTask :: Choose one iTask from list, depending on button pressed, button horizontal displayed chooseTask :: Choose one iTask from list, depending on button pressed, button horizontal displayed
chooseTaskV :: Choose one iTask from list, depending on button pressed, buttons vertical displayed chooseTaskV :: Choose one iTask from list, depending on button pressed, buttons vertical displayed
chooseTask_pdm :: Choose one iTask from list, depending on pulldownmenu item selected chooseTask_pdm :: Choose one iTask from list, depending on pulldownmenu item selected
mchoiceTask :: Multiple Choice of iTasks, depending on marked checkboxes mchoiceTask :: Multiple Choice of iTasks, depending on marked checkboxes
mchoiceTask2 :: Multiple Choice of iTasks, depending on marked checkboxes, boolean used for initial checking mchoiceTask2 :: as mchoiceTask, boolean used for initial checking
mchoiceTask3 :: as mchoiceTask2, function can be used to (re)set the checkboxes
*/ */
buttonTask :: !String !(Task a) -> Task a | iCreateAndPrint a buttonTask :: !String !(Task a) -> Task a | iCreateAndPrint a
chooseTask :: ![BodyTag] ![(String,Task a)] -> Task a | iCreateAndPrint a chooseTask :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTaskV :: ![BodyTag] ![(String,Task a)] -> Task a | iCreateAndPrint a chooseTaskV :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_pdm :: ![BodyTag] ![(String,Task a)] -> Task a | iCreateAndPrint a chooseTask_pdm :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
mchoiceTasks :: ![BodyTag] ![(String,Task a)] -> (Task [a]) | iCreateAndPrint a
mchoiceTasks2 :: ![BodyTag] ![(!(!Bool,!String),Task a)] -> Task [a] | iCreateAndPrint a mchoiceTasks :: !HtmlCode ![LabeledTask a] -> Task [a] | iCreateAndPrint a
mchoiceTasks3 :: ![BodyTag] ![((Bool,Bool [Bool] -> Bool,String),Task a)] -> (Task [a]) | iCreateAndPrint a mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iCreateAndPrint a
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiseUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iCreateAndPrint a
:: ChoiseUpdate :== !Bool [Bool] -> [Bool] // changed checkbox + current settings -> new settings
/* Do m Tasks parallel / interleaved and FINISH as soon as SOME Task completes: /* 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 orTask :: do both iTasks in any order, combined task completed as any subtask is done
(-||-) :: same, now as infix combinator (-||-) :: same, now as infix combinator
orTask2 :: do both iTasks in any order, combined task completed as any subtask is done orTask2 :: do both iTasks in any order, combined task completed as any subtask is done
...@@ -152,7 +169,7 @@ orTask :: !(Task a,Task a) -> Task a | iCreateAndPrint a ...@@ -152,7 +169,7 @@ orTask :: !(Task a,Task a) -> Task a | iCreateAndPrint a
(-||-) infixr 3 :: !(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) orTask2 :: !(Task a,Task b) -> Task (EITHER a b)
| iCreateAndPrint a & iCreateAndPrint b | iCreateAndPrint a & iCreateAndPrint b
orTasks :: ![(String,Task a)] -> Task a | iData a orTasks :: ![LabeledTask a] -> Task a | iData a
/* Do Tasks parallel / interleaved and FINISH when ALL Tasks done: /* Do Tasks parallel / interleaved and FINISH when ALL Tasks done:
andTask :: do both iTasks in any order (interleaved), task completed when both done andTask :: do both iTasks in any order (interleaved), task completed when both done
...@@ -163,12 +180,12 @@ andTasks_mu :: assign task to indicated users, task completed when all done ...@@ -163,12 +180,12 @@ andTasks_mu :: assign task to indicated users, task completed when all done
*/ */
andTask :: !(Task a,Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b 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 (-&&-) infixr 4 :: !(Task a) !(Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b
andTasks :: ![(String,Task a)] -> Task [a] | iData a andTasks :: ![LabeledTask a] -> Task [a] | iData a
andTasksCond :: !([a] -> Bool) ![(String,Task a)] -> Task [a] | iData a andTasksCond :: !([a] -> Bool) ![LabeledTask a] -> Task [a] | iData a
andTasks_mu :: !String ![(Int,Task a)] -> Task [a] | iData a andTasks_mu :: !String ![(Int,Task a)] -> Task [a] | iData a
/* Time and Date management: /* Time and Date management:
waitForTimeTask :: Task is done when time has come waitForTimeTask :: Task is done when time has come
waitForTimerTask:: Task is done when specified amount of time has passed waitForTimerTask:: Task is done when specified amount of time has passed
waitForDateTask :: Task is done when date has come waitForDateTask :: Task is done when date has come
...@@ -178,6 +195,7 @@ waitForTimerTask:: !HtmlTime -> Task HtmlTime ...@@ -178,6 +195,7 @@ waitForTimerTask:: !HtmlTime -> Task HtmlTime
waitForDateTask :: !HtmlDate -> Task HtmlDate waitForDateTask :: !HtmlDate -> Task HtmlDate
/* Experimental department: /* Experimental department:
Will not work when the tasks are garbage collected to soon !! Will not work when the tasks are garbage collected to soon !!
-!> :: a task, either finished or interrupted (by completion of the first task) is returned in the closure -!> :: a task, either finished or interrupted (by completion of the first task) is returned in the closure
if interrupted, the work done so far is returned (!) which can be continued somewhere else if interrupted, the work done so far is returned (!) which can be continued somewhere else
...@@ -198,6 +216,7 @@ closureTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a ...@@ -198,6 +216,7 @@ closureTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a
closureLzTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a closureLzTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a
/* Exception Handling: /* Exception Handling:
<^> :: Evaluate the task; An exception of type e raised by this task, will be catched by the closest handler. <^> :: Evaluate the task; An exception of type e raised by this task, will be catched by the closest handler.
One can use the function 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 Raise :: Raises an exception of type e which will be catched by the closest parent handler for this type
...@@ -205,8 +224,8 @@ Raise :: Raises an exception of type e which will be catched by the closest p ...@@ -205,8 +224,8 @@ Raise :: Raises an exception of type e which will be catched by the closest p
(<^>) infix 1 :: !(e -> a) !(Task a) -> Task a | iData a & TC e // assigns an exception Handler (<^>) 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 Raise :: e -> Task a | iCreate a & TC e // rases an exception
/* Lifting to iTask domain /* Lifting to iTask domain
(*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain (*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain
(@>>) :: lift functions of (TSt -> TSt) to iTask domain (@>>) :: lift functions of (TSt -> TSt) to iTask domain
appIData :: lift iData editors to iTask domain appIData :: lift iData editors to iTask domain
...@@ -235,5 +254,5 @@ addHtml :: add html code ...@@ -235,5 +254,5 @@ addHtml :: add html code
taskId :: TSt -> (Int,TSt) taskId :: TSt -> (Int,TSt)
userId :: TSt -> (Int,TSt) userId :: TSt -> (Int,TSt)
addHtml :: [BodyTag] TSt -> TSt addHtml :: HtmlCode TSt -> TSt
...@@ -29,7 +29,7 @@ derive write Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, Glob ...@@ -29,7 +29,7 @@ derive write Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, Glob
} }
:: UserId :== !Int :: UserId :== !Int
:: TaskNr :== [Int] // task nr i.j is adminstrated as [j,i] :: TaskNr :== [Int] // task nr i.j is adminstrated as [j,i]
:: HtmlTree = BT [BodyTag] // simple code :: HtmlTree = BT HtmlCode // simple code
| (@@:) infix 0 (Int,String) HtmlTree// code with id of user attached to it | (@@:) infix 0 (Int,String) HtmlTree// code with id of user attached to it
| (-@:) infix 0 Int HtmlTree// skip code with this id if it is the id of the user | (-@:) infix 0 Int HtmlTree// skip code with this id if it is the id of the user
| (+-+) infixl 1 HtmlTree HtmlTree // code to be placed next to each other | (+-+) infixl 1 HtmlTree HtmlTree // code to be placed next to each other
...@@ -72,7 +72,7 @@ derive write Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, Glob ...@@ -72,7 +72,7 @@ derive write Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, Glob
, threadStorageLoc :: !Lifespan , threadStorageLoc :: !Lifespan
, showUsersOn :: !Maybe Int , showUsersOn :: !Maybe Int
, versionCheckOn :: !Bool , versionCheckOn :: !Bool
, headerOff :: !Maybe [BodyTag] , headerOff :: !Maybe HtmlCode
} }
// Initial values // Initial values
...@@ -227,7 +227,7 @@ workFlowTask startUpOptions taska iataskb hst ...@@ -227,7 +227,7 @@ workFlowTask startUpOptions taska iataskb hst
# (exception,body,hst) = startTstTask i True (False,[]) userOptions (iataskb (i,a)) tst # (exception,body,hst) = startTstTask i True (False,[]) userOptions (iataskb (i,a)) tst
= mkHtmlExcep "workFlow" exception body hst = mkHtmlExcep "workFlow" exception body hst
where where
noFilter :: HtmlTree -> [BodyTag] noFilter :: HtmlTree -> HtmlCode
noFilter (BT body) = body noFilter (BT body) = body
noFilter (_ @@: html) = noFilter html noFilter (_ @@: html) = noFilter html
noFilter (_ -@: html) = noFilter html noFilter (_ -@: html) = noFilter html
...@@ -241,7 +241,7 @@ where ...@@ -241,7 +241,7 @@ where
// Main routine for the creation of the workflow page // Main routine for the creation of the workflow page
// ****************************************************************************************************** // ******************************************************************************************************
startTstTask :: !Int !Bool !(!Bool,![BodyTag]) UserStartUpOptions !(Task a) !*TSt -> (!Bool,![BodyTag],!*HSt) //| iCreate a startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) //| iCreate a
startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff} taska tst=:{hst,tasknr,staticInfo} startTstTask thisUser multiuser (userchanged,multiuserform) {traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff} taska tst=:{hst,tasknr,staticInfo}
// prologue // prologue
...@@ -350,7 +350,7 @@ where ...@@ -350,7 +350,7 @@ where
[Br,Hr []] [Br,Hr []]
mkSTable2 :: [[BodyTag]] -> BodyTag mkSTable2 :: [HtmlCode] -> BodyTag
mkSTable2 table mkSTable2 table
= Table [] (mktable table) = Table [] (mktable table)
where where
...@@ -390,7 +390,7 @@ where ...@@ -390,7 +390,7 @@ where
| thisuser == taskuser = (mkDiv id html,accu) | thisuser == taskuser = (mkDiv id html,accu)
= ([],accu) = ([],accu)
showThreadTable :: *TSt -> ([BodyTag],*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !! showThreadTable :: *TSt -> (HtmlCode,*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
showThreadTable tst=:{staticInfo} showThreadTable tst=:{staticInfo}
# thisUser = staticInfo.currentUserId # thisUser = staticInfo.currentUserId
# (tableS,tst) = ThreadTableStorage id tst // read thread table from server # (tableS,tst) = ThreadTableStorage id tst // read thread table from server
...@@ -431,7 +431,7 @@ where ...@@ -431,7 +431,7 @@ where
] ]
= (bodyS ++ bodyC,tst) = (bodyS ++ bodyC,tst)
mkTaskButtons :: !String !String !Int !TaskNr !Options ![String] *HSt -> ((Int,[BodyTag],[BodyTag]),*HSt) mkTaskButtons :: !String !String !Int !TaskNr !Options ![String] *HSt -> ((Int,HtmlCode,HtmlCode),*HSt)
mkTaskButtons header myid userId tasknr info btnnames hst mkTaskButtons header myid userId tasknr info btnnames hst
# btnsId = iTaskId userId tasknr (myid <+++ "genBtns") # btnsId = iTaskId userId tasknr (myid <+++ "genBtns")
# myidx = length btnnames # myidx = length btnnames
...@@ -1011,7 +1011,7 @@ editTask` prompt a tst=:{tasknr,html,hst,userId} ...@@ -1011,7 +1011,7 @@ editTask` prompt a tst=:{tasknr,html,hst,userId}
| taskdone.value = editTask` prompt a {tst & hst = hst} // task is now completed, handle as previously | taskdone.value = editTask` prompt a {tst & hst = hst} // task is now completed, handle as previously
= (editor.value,{tst & activated = taskdone.value, html = html +|+ BT (editor.form ++ finbut.form), hst = hst}) = (editor.value,{tst & activated = taskdone.value, html = html +|+ BT (editor.form ++ finbut.form), hst = hst})
editTaskPred :: !a !(a -> (Bool, [BodyTag]))-> (Task a) | iData a editTaskPred :: !a !(a -> (Bool, HtmlCode))-> (Task a) | iData a
editTaskPred a pred = mkTask "editTask" (editTaskPred` a) editTaskPred a pred = mkTask "editTask" (editTaskPred` a)
where where
editTaskPred` a tst=:{tasknr,html,hst,userId} editTaskPred` a tst=:{tasknr,html,hst,userId}
...@@ -1061,7 +1061,7 @@ where ...@@ -1061,7 +1061,7 @@ where
return_Display` tst return_Display` tst
= (a,{tst & html = tst.html +|+ BT [toHtml a ]}) // return result task = (a,{tst & html = tst.html +|+ BT [toHtml a ]}) // return result task
return_VF :: ![BodyTag] !a -> (Task a) | iCreateAndPrint a return_VF :: !HtmlCode !a -> (Task a) | iCreateAndPrint a
return_VF bodytag a = mkTask "return_VF" return_VF` return_VF bodytag a = mkTask "return_VF" return_VF`
where where
return_VF` tst return_VF` tst
...@@ -1070,7 +1070,7 @@ where ...@@ -1070,7 +1070,7 @@ where
// ****************************************************************************************************** // ******************************************************************************************************
// adding Html code for prompting and feedback // adding Html code for prompting and feedback
(?>>) infixr 5 :: ![BodyTag] !(Task a) -> Task a | iCreate a (?>>) infixr 5 :: !HtmlCode !(Task a) -> Task a | iCreate a
(?>>) prompt task = doTask (?>>) prompt task = doTask
where where
doTask tst=:{html=ohtml,activated} doTask tst=:{html=ohtml,activated}
...@@ -1079,7 +1079,7 @@ where ...@@ -1079,7 +1079,7 @@ where
| activated = (a,{tst & html = ohtml}) | activated = (a,{tst & html = ohtml})
= (a,{tst & html = ohtml +|+ BT prompt +|+ nhtml}) = (a,{tst & html = ohtml +|+ BT prompt +|+ nhtml})
(<<?) infixl 5 :: !(Task a) ![BodyTag] -> Task a | iCreate a (<<?) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
(<<?) task prompt = doTask (<<?) task prompt = doTask
where where
doTask tst=:{html=ohtml,activated} doTask tst=:{html=ohtml,activated}
...@@ -1088,7 +1088,7 @@ where ...@@ -1088,7 +1088,7 @@ where
| activated = (a,{tst & html = ohtml}) | activated = (a,{tst & html = ohtml})
= (a,{tst & html = ohtml +|+ nhtml +|+ BT prompt}) = (a,{tst & html = ohtml +|+ nhtml +|+ BT prompt})
(!>>) infixr 5 :: ![BodyTag] !(Task a) -> (Task a) | iCreate a (!>>) infixr 5 :: !HtmlCode !(Task a) -> (Task a) | iCreate a
(!>>) prompt task = doTask (!>>) prompt task = doTask
where where
doTask tst=:{html=ohtml,activated=myturn} doTask tst=:{html=ohtml,activated=myturn}
...@@ -1096,7 +1096,7 @@ where ...@@ -1096,7 +1096,7 @@ where
# (a,tst=:{html=nhtml}) = task {tst & html = BT []} # (a,tst=:{html=nhtml}) = task {tst & html = BT []}
= (a,{tst & html = ohtml +|+ BT prompt +|+ nhtml}) = (a,{tst & html = ohtml +|+ BT prompt +|+ nhtml})
(<<!) infixl 5 :: !(Task a) ![BodyTag] -> (Task a) | iCreate a (<<!) infixl 5 :: !(Task a) !HtmlCode -> (Task a) | iCreate a
(<<!) task prompt = doTask (<<!) task prompt = doTask
where where
doTask tst=:{html=ohtml,activated=myturn} doTask tst=:{html=ohtml,activated=myturn}
...@@ -1104,7 +1104,7 @@ where ...@@ -1104,7 +1104,7 @@ where
# (a,tst=:{html=nhtml}) = task {tst & html = BT []} # (a,tst=:{html=nhtml}) = task {tst & html = BT []}
= (a,{tst & html = ohtml +|+ nhtml +|+ BT prompt}) = (a,{tst & html = ohtml +|+ nhtml +|+ BT prompt})
(<|) infixl 6 :: !(Task a) !(a -> (Bool, [BodyTag])) -> Task a | iCreate a (<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iCreate a
(<|) taska pred = doTask (<|) taska pred = doTask
where where
doTask tst=:{html = ohtml,activated} doTask tst=:{html = ohtml,activated}
...@@ -1178,8 +1178,8 @@ where ...@@ -1178,8 +1178,8 @@ where
// ****************************************************************************************************** // ******************************************************************************************************
// Assigning tasks to users, each user has to be identified by an unique number >= 0 // Assigning tasks to users, each user has to be identified by an unique number >= 0
(@:) infix 3 :: !(!String,!Int) !(Task a) -> (Task a) | iData a // force thread if Ajax is used (@:) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:) (taskname,nuserId) taska = \tst=:{userId} -> assignTaskTo False taskname userId taska {tst & userId = nuserId} (@:) 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 (@::) 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} (@::) nuserId taska = \tst=:{userId} -> assignTaskTo False ("Task for " <+++ userId) userId taska {tst & userId = nuserId}
...@@ -1213,7 +1213,7 @@ administrateNewThread ouserId tst =: {tasknr,userId,options} ...@@ -1213,7 +1213,7 @@ administrateNewThread ouserId tst =: {tasknr,userId,options}
// ****************************************************************************************************** // ******************************************************************************************************
// sequencingtasks // sequencingtasks
seqTasks :: ![(String,Task a)] -> (Task [a])| iCreateAndPrint a seqTasks :: ![LabeledTask a] -> (Task [a])| iCreateAndPrint a
seqTasks options = mkTask "seqTasks" seqTasks` seqTasks options = mkTask "seqTasks" seqTasks`
where where
seqTasks` tst=:{tasknr} seqTasks` tst=:{tasknr}
...@@ -1235,13 +1235,13 @@ buttonTask s task = iCTask_button "buttonTask" [(s,task)] ...@@ -1235,13 +1235,13 @@ buttonTask s task = iCTask_button "buttonTask" [(s,task)]
iCTask_button tracename options = mkTask tracename (dochooseTask True [] options) iCTask_button tracename options = mkTask tracename (dochooseTask True [] options)
chooseTask :: ![BodyTag] ![(String,Task a)] -> (Task a) | iCreateAndPrint a chooseTask :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTask prompt options = mkTask "chooseTask" (dochooseTask True prompt options) chooseTask prompt options = mkTask "chooseTask" (dochooseTask True prompt options)
chooseTaskV :: ![BodyTag] ![(String,Task a)] -> (Task a) | iCreateAndPrint a chooseTaskV :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTaskV prompt options = mkTask "chooseTask" (dochooseTask False prompt options) chooseTaskV prompt options = mkTask "chooseTask" (dochooseTask False prompt options)
dochooseTask :: !Bool ![BodyTag] ![(String,Task a)] *TSt-> *(a,*TSt) | iCreateAndPrint a dochooseTask :: !Bool !HtmlCode ![LabeledTask a] *TSt-> *(a,*TSt) | iCreateAndPrint a
dochooseTask _ _ [] tst = return createDefault tst dochooseTask _ _ [] tst = return createDefault tst
dochooseTask horizontal prompt taskOptions tst=:{tasknr,html,options,userId} // choose one subtask out of the list dochooseTask horizontal prompt taskOptions tst=:{tasknr,html,options,userId} // choose one subtask out of the list
# taskId = iTaskId userId tasknr ("ChoSt" <+++ length taskOptions) # taskId = iTaskId userId tasknr ("ChoSt" <+++ length taskOptions)
...@@ -1263,7 +1263,7 @@ dochooseTask horizontal prompt taskOptions tst=:{tasknr,html,options,userId} ...@@ -1263,7 +1263,7 @@ dochooseTask horizontal prompt taskOptions tst=:{tasknr,html,options,userId}
but i = iTaskButton i but i = iTaskButton i
chooseTask_pdm :: ![BodyTag] ![(String,Task a)] -> (Task a) |iCreateAndPrint a chooseTask_pdm :: !HtmlCode ![LabeledTask a] -> (Task a) |iCreateAndPrint a
chooseTask_pdm prompt taskOptions = mkTask "chooseTask_pdm" (dochooseTask_pdm taskOptions) chooseTask_pdm prompt taskOptions = mkTask "chooseTask_pdm" (dochooseTask_pdm taskOptions)
where where
dochooseTask_pdm [] tst = return createDefault tst dochooseTask_pdm [] tst = return createDefault tst
...@@ -1287,30 +1287,14 @@ where ...@@ -1287,30 +1287,14 @@ where
= chosenTask {tst & activated = True, html = BT [], tasknr = [0:tasknr]} = chosenTask {tst & activated = True, html = BT [], tasknr = [0:tasknr]}
= (a,{tst & activated = adone, html = html +|+ ahtml, tasknr = tasknr}) = (a,{tst & activated = adone, html = html +|+ ahtml, tasknr = tasknr})
mchoiceTasks :: ![BodyTag] ![(String,Task a)] -> (Task [a]) | iCreateAndPrint a mchoiceTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iCreateAndPrint a
mchoiceTasks prompt taskOptions = mchoiceTasks2 prompt [((True,label),task) \\ (label,task) <- taskOptions] mchoiceTasks prompt taskOptions = mchoiceTasks3 prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceTasks2 :: ![BodyTag] ![(!(!Bool,!String),Task a)] -> (Task [a]) | iCreateAndPrint a mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iCreateAndPrint a
mchoiceTasks2 prompt taskOptions = mkTask "mchoiceTask" (domchoiceTasks taskOptions) mchoiceTasks2 prompt taskOptions = mchoiceTasks3 prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
where
domchoiceTasks [] tst = ([],{tst& activated = True})
domchoiceTasks taskOptions tst=:{tasknr,html,options,userId} // choose one subtask out of the list
# seltaskId = iTaskId userId tasknr ("MtpChSel" <+++ length taskOptions)
# donetaskId = iTaskId userId tasknr "MtpChSt"
# (cboxes,tst) = LiftHst (ListFuncCheckBox (Init,cFormId options seltaskId initCheckboxes)) tst
# (done,tst) = LiftHst (mkStoreForm (Init,storageFormId options donetaskId False) id) tst
# optionsform = cboxes.form <=|> [Txt text \\ ((_,text),_) <- taskOptions]
| done.value = seqTasks [(label,task) \\ ((_,label),task) <- taskOptions & True <- snd cboxes.value] {tst & tasknr = [0:tasknr]}
# (_,tst=:{html=ahtml,activated = adone})
= (internEditSTask "" "OK" Void) {tst & activated = True, html = BT [], tasknr = [-1:tasknr]}
| not adone = ([],{tst & html = html +|+ BT prompt +|+ BT [optionsform] +|+ ahtml})
# (_,tst) = LiftHst (mkStoreForm (Init,storageFormId options donetaskId False) (\_ -> True)) tst
= domchoiceTasks taskOptions {tst & tasknr = tasknr, html = html, options = options, userId =userId, activated = True} // choose one subtask out of the list
initCheckboxes = mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiseUpdate,!HtmlCode),LabeledTask a)]
[(if checked CBChecked CBNotChecked text, \ b bs id -> id) \\ ((checked,text),_) <- taskOptions] -> Task [a] | iCreateAndPrint a
mchoiceTasks3 :: ![BodyTag] ![((Bool,Bool [Bool] -> Bool,String),Task a)] -> (Task [a]) | iCreateAndPrint a
mchoiceTasks3 prompt taskOptions = mkTask "mchoiceTask" (domchoiceTasks taskOptions) mchoiceTasks3 prompt taskOptions = mkTask "mchoiceTask" (domchoiceTasks taskOptions)
where where
domchoiceTasks [] tst = ([],{tst& activated = True}) domchoiceTasks [] tst = ([],{tst& activated = True})
...@@ -1322,8 +1306,8 @@ where ...@@ -1322,8 +1306,8 @@ where
# nsettings = fun nblist # nsettings = fun nblist
# (cboxes,tst) = LiftHst (ListFuncCheckBox (Set ,cFormId options seltaskId (setCheckboxes nsettings))) tst # (cboxes,tst) = LiftHst (ListFuncCheckBox (Set ,cFormId options seltaskId (setCheckboxes nsettings))) tst
# (done,tst) = LiftHst (mkStoreForm (Init,storageFormId options donetaskId False) id) tst # (done,tst) = LiftHst (mkStoreForm (Init,storageFormId options donetaskId False) id) tst
# optionsform = cboxes.form <=|> [Txt text \\ ((_,_,text),_) <- taskOptions] # optionsform = cboxes.form <=|> [[CTxt Yellow label] <||> htmlcode \\ ((_,_,htmlcode),(label,_)) <- taskOptions]
| done.value = seqTasks [(label,task) \\ ((_,_,label),task) <- taskOptions & True <- snd cboxes.value] {tst & tasknr = [0:tasknr]} | done.value = seqTasks [labeledTask \\ (_,labeledTask) <- taskOptions & True <- snd cboxes.value] {tst & tasknr = [0:tasknr]}
# (_,tst=:{html=ahtml,activated = adone}) # (_,tst=:{html=ahtml,activated = adone})
= (internEditSTask "" "OK" Void) {tst & activated = True, html = BT [], tasknr = [-1:tasknr]} = (internEditSTask "" "OK" Void) {tst & activated = True, html = BT [], tasknr = [-1:tasknr]}
| not adone = ([],{tst & html = html +|+ BT prompt +|+ BT [optionsform] +|+ ahtml}) | not adone = ([],{tst & html = html +|+ BT prompt +|+ BT [optionsform] +|+ ahtml})
...@@ -1331,13 +1315,12 @@ where ...@@ -1331,13 +1315,12 @@ where
= domchoiceTasks taskOptions {tst & tasknr = tasknr, html = html, options = options, userId =userId, activated = True} // choose one subtask out of the list = domchoiceTasks taskOptions {tst & tasknr = tasknr, html = html, options = options, userId =userId, activated = True} // choose one subtask out of the list