Commit 7d1906ab authored by Thomas van Noort's avatar Thomas van Noort

*** empty log message ***


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@166 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent fac33850
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
definition module iTasks2
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
// *********************************************************************************************************************************
// a collection of handy iTasks combinators defined in terms of the basic iTask combinators defined in module iTasks
// with Thanks to Erik Zuurbier for suggesting: (=>>?), (-&&-?), multiAndTask
// *********************************************************************************************************************************
import iTasks
/* standard monadic combinators on iTasks:
(#>>) :: for sequencing: bind, but no argument passed
return_D :: return the value and show it in iData display format
return_VF :: return the value and show the Html code specified
*/
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
return_D :: !a -> Task a | gForm {|*|}, iCreateAndPrint a
return_VF :: !HtmlCode !a -> Task a | 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
*/
(@:) infix 3 :: !UserId !(LabeledTask a) -> Task a | iData a
(@::) infix 3 :: !UserId !(Task a) -> Task a | iData a
(@:>) infix 3 :: !UserId !(LabeledTask a) -> Task a | iData a
(@::>) infix 3 :: !UserId !(Task a) -> Task a | iData a
/* Handling recursion and loops:
repeatTask :: repeat Task until predicate is valid
(<|) :: repeat task (recursively) as long as predicate does not hold, and give error message otherwise
*/
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
(<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iData a
/* Choose out the tasks you want to do one forehand, labels are used to make the choice:
button :: return value when button pressed
buttonTask :: do the iTask when button pressed
chooseTask :: Choose ONE iTask from list, depending on button pressed, button horizontal displayed
chooseTaskV :: as chooseTask, buttons vertical displayed
mchoiceTask :: Checked tasks will be done SEQUENTIALLY
mchoiceTask2 :: as mchoiceTask, boolean used for initial setting of the checks
mchoiceTask3 :: as mchoiceTask2, function can be used to (re)set the checkboxes
mchoiceTask :: Checked tasks can be done in INTERLEAVED
mchoiceTask2 :: as mchoiceTask, boolean used for initial setting of the checks
mchoiceTask3 :: as mchoiceTask2, function can be used to (re)set the checkboxes
*/
button :: !String !a -> Task a | iCreateAndPrint a
buttonTask :: !String !(Task a) -> Task a | iCreateAndPrint a
chooseTask :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTaskV :: !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
/* Do m Tasks parallel / interleaved and FINISH as soon as SOME Task completes:
(-||-) :: do both iTasks in any order, combined task completed as soon as any subtask is done
(-&&-) :: do both iTasks in any order (interleaved), task completed when both done
orTasks :: do all iTasks in any order (interleaved), task completed as soon as any subtask is done
andTasks :: do all iTasks in any order (interleaved), task completed when all done
andTasks_mu :: assign task to indicated users, task completed when all done
*/
(-||-) infixr 3 :: !(Task a) !(Task a) -> Task a | iData a
(-&&-) infixr 4 :: !(Task a) !(Task b) -> Task (a,b) | iData a & iData b
orTasks :: ![LabeledTask a] -> (Task a) | iData a
andTasks :: ![LabeledTask a] -> Task [a] | iData a
andTasks_mu :: !String ![(Int,Task a)] -> Task [a] | iData a
/* convenient combinators for tasks that maybe return a result:
(=>>?) :: as bind, but do the second task only if the first one delivers a result
(-&&-?) :: do both tasks in any order, task completed when all done, or one of them delivers nothing
*/
(=>>?) infixl 1 :: !(Task (Maybe a)) !(a -> Task (Maybe b)) -> Task (Maybe b) | iCreateAndPrint a & iCreateAndPrint b
(-&&-?)infixr 4 :: !(Task (Maybe a)) !(Task (Maybe b)) -> Task (Maybe (a,b)) | iData a & iData b
/* Time and Date management:
waitForTimerTask:: Task is done when specified amount of time has passed
*/
waitForTimerTask:: !HtmlTime -> Task HtmlTime
implementation module iTasks2
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
// Definition of non-primitive iTask combinators defined in terms of primitive iTask combinators
import StdEnv
import iTasks
import iDataTrivial
derive gForm []
derive gUpd []
derive gUpd Maybe
derive gForm Maybe
derive gPrint Maybe
derive gParse Maybe
// ******************************************************************************************************
// monads for combining iTasks
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
(#>>) taska taskb
= taska
=>> \_ -> taskb
(=>>?) infixl 1 :: !(Task (Maybe a)) !(a -> Task (Maybe b)) -> Task (Maybe b) | iCreateAndPrint a & iCreateAndPrint b
(=>>?) t1 t2
= t1
=>> \r1 -> case r1 of
Nothing -> return_V Nothing
Just r`1 -> t2 r`1
return_VF :: !HtmlCode !a -> (Task a) | iCreateAndPrint a
return_VF bodytag a = return_V a <<! bodytag
return_D :: !a -> (Task a) | gForm {|*|}, iCreateAndPrint a
return_D a = return_V a <<! [toHtml a ]
// ******************************************************************************************************
// repetition
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
repeatTask task pred a = dorepeatTask a
where
dorepeatTask a
= newTask "doReapeatTask" dorepeatTask`
where
dorepeatTask` tst
| pred a = (a,tst)
# (na,tst) = task a tst
= dorepeatTask na tst
(<|) infixl 6 :: !(Task a) !(a -> (Bool, HtmlCode)) -> Task a | iData a
(<|) taska pred = mkTask "repeatTest" doTask
where
doTask
= taska
=>> \r -> case pred r of
(True,_) -> return_V r
(False,msg) -> msg ?>> doTask
// ******************************************************************************************************
// Assigning tasks to users, each user has to be identified by an unique number >= 0
(@:) infix 3 :: !UserId !(LabeledTask a) -> Task a | iData a
(@:) nuserId ltask = assignTaskTo True nuserId ltask
(@::) infix 3 :: !UserId !(Task a) -> (Task a) | iData a
(@::) nuserId taska = assignTaskTo True nuserId ("Task for " <+++ nuserId,taska)
(@:>) infix 3 :: !UserId !(LabeledTask a) -> Task a | iData a
(@:>) nuserId ltask = assignTaskTo False nuserId ltask
(@::>) infix 3 :: !UserId !(Task a) -> (Task a) | iData a
(@::>) nuserId taska = assignTaskTo False nuserId ("Task for " <+++ nuserId,taska)
// ******************************************************************************************************
// choose one or more tasks on forehand out of a set
button :: !String !a -> (Task a) | iCreateAndPrint a
button s a = mkTask "button" (chooseTask_btn [] True [(s,return_V a)])
buttonTask :: !String !(Task a) -> (Task a) | iCreateAndPrint a
buttonTask s task = mkTask "buttonTask" (chooseTask_btn [] True [(s,task)])
chooseTask :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTask prompt options = mkTask "chooseTask" (chooseTask_btn prompt True options)
chooseTaskV :: !HtmlCode ![LabeledTask a] -> (Task a) | iCreateAndPrint a
chooseTaskV prompt options = mkTask "chooseTask" (chooseTask_btn prompt False options)
mchoiceTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceTasks prompt taskOptions
= chooseTask_cbox seqTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceTasks2 prompt taskOptions
= chooseTask_cbox seqTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceTasks3 prompt taskOptions
= chooseTask_cbox seqTasks prompt taskOptions
mchoiceAndTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceAndTasks prompt taskOptions
= chooseTask_cbox andTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceAndTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks2 prompt taskOptions
= chooseTask_cbox andTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceAndTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks3 prompt taskOptions
= chooseTask_cbox andTasks prompt taskOptions
// ******************************************************************************************************
// Speculative OR-tasks: task ends as soon as one of its subtasks completes
(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iData a
(-||-) taska taskb = newTask "-||-" (doOrTask (taska,taskb))
where
doOrTask :: !(Task a,Task a) -> (Task a) | iCreateAndPrint a
doOrTask (taska,taskb)
= orTask2 (taska,taskb)
=>> \at -> case at of
(LEFT a) -> return_V a
(RIGHT b) -> return_V b
(-&&-) infixr 4 :: !(Task a) !(Task b) -> (Task (a,b)) | iData a & iData b
(-&&-) taska taskb = newTask "-&&-" (andTask2 (taska,taskb))
orTasks :: ![LabeledTask a] -> (Task a) | iData a
orTasks [] = return createDefault
orTasks taskCollection = newTask "orTasks" (andTasksCond "or Tasks" (\list -> length list >= 1) taskCollection)
=>> \list -> return (hd list)
andTasks :: ![LabeledTask a] -> (Task [a]) | iData a
andTasks taskCollection = newTask "andTasks" (andTasksCond "and Tasks" (\_ -> False) taskCollection)
(-&&-?) infixr 4 :: !(Task (Maybe a)) !(Task (Maybe b)) -> Task (Maybe (a,b)) | iData a & iData b
(-&&-?) t1 t2
= andTasksCond "Maybe Task" noNothing [("Maybe 1",left),("Maybe 2",right)]
=>> combineResult
where
left = t1 =>> \tres -> return_V (LEFT tres)
right = t2 =>> \tres -> return_V (RIGHT tres)
combineResult [LEFT (Just r1),RIGHT (Just r2)] = return_V (Just (r1,r2))
combineResult _ = return_V Nothing
noNothing [] = False
noNothing [LEFT Nothing:xs] = True
noNothing [RIGHT Nothing:xs] = True
noNothing [x:xs] = noNothing xs
andTasks_mu :: !String ![(Int,Task a)] -> (Task [a]) | iData a
andTasks_mu label tasks = newTask "andTasks_mu" (domu_andTasks tasks)
where
domu_andTasks list = andTasks [(label <+++ " " <+++ i, i @:: task) \\ (i,task) <- list]
// ******************************************************************************************************
// Timer Tasks ending when timed out
waitForTimerTask:: !HtmlTime -> (Task HtmlTime)
waitForTimerTask time = waitForTimerTask`
where
waitForTimerTask`
= appHStOnce "getTimeAndDate" getTimeAndDate
=>> \(ctime,_) -> waitForTimeTask (ctime + time)
...@@ -159,7 +159,7 @@ where ...@@ -159,7 +159,7 @@ where
andTasks_mu :: !String ![(Int,Task a)] -> (Task [a]) | iData a andTasks_mu :: !String ![(Int,Task a)] -> (Task [a]) | iData a
andTasks_mu label tasks = newTask "andTasks_mu" (domu_andTasks tasks) andTasks_mu label tasks = newTask "andTasks_mu" (domu_andTasks tasks)
where where
domu_andTasks list = andTasks [(label <+++ " " <+++ i, i @:: task) \\ (i,task) <- list] domu_andTasks list = andTasks [(label <+++ " " <+++ i, i @::> task) \\ (i,task) <- list]
// ****************************************************************************************************** // ******************************************************************************************************
// Timer Tasks ending when timed out // Timer Tasks ending when timed out
......
...@@ -67,7 +67,7 @@ mkTaskButtons :: !Bool !String !Int !TaskNr !Options ![String] !*HSt -> (!(!Int, ...@@ -67,7 +67,7 @@ mkTaskButtons :: !Bool !String !Int !TaskNr !Options ![String] !*HSt -> (!(!Int,
mkTaskButtons vertical myid userId tasknr info btnnames hst mkTaskButtons vertical myid userId tasknr info btnnames hst
# btnsId = iTaskId userId tasknr (myid <+++ "genBtns") # btnsId = iTaskId userId tasknr (myid <+++ "genBtns")
# myidx = length btnnames # myidx = length btnnames
//| myidx == 1 = ((0,[],[]),hst) // no task button if there is only one task to choose from | myidx == 1 = ((0,[],[]),hst) // no task button if there is only one task to choose from
# (chosen,hst) = SelectStore (myid,myidx) tasknr info id hst // which choice was made in the past # (chosen,hst) = SelectStore (myid,myidx) tasknr info id hst // which choice was made in the past
# (buttons,hst) = SelectButtons Init btnsId info (chosen,btnnames) hst // create buttons # (buttons,hst) = SelectButtons Init btnsId info (chosen,btnnames) hst // create buttons
# (chosen,hst) = SelectStore (myid,myidx) tasknr info buttons.value hst // maybe a new button was pressed # (chosen,hst) = SelectStore (myid,myidx) tasknr info buttons.value hst // maybe a new button was pressed
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment