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 ...@@ -25,7 +25,6 @@ derive write Void, TCl
:: 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
defaultUser :== 0 // default id of user
// ********************************************************************************************************************************* // *********************************************************************************************************************************
// Setting options for any collection of iTask workflows: // Setting options for any collection of iTask workflows:
...@@ -35,10 +34,10 @@ defaultUser :== 0 // default id of user ...@@ -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) class (<<@) infixl 3 b :: !(Task a) !b -> Task a // to set iData attribute globally for indicated (composition of) iTask(s)
instance <<@ Lifespan // default: Session instance <<@ Lifespan // default: Session
, StorageFormat // default: PlainString , StorageFormat // default: PlainString
, Mode // default: Edit , Mode // default: Edit
, GarbageCollect // default: Collect , GarbageCollect // default: Collect
:: SubPage = UseAjax // use Ajax technology to update part of a page, only works if Ajax enabled :: 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... | 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)) ...@@ -64,21 +63,13 @@ 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 | NoVersionCheck // for single & multiUser: default = VersionNoCheck | 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: // 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
*/ */
...@@ -86,18 +77,13 @@ editTask :: !String !a -> Task a | iData a ...@@ -86,18 +77,13 @@ editTask :: !String !a -> Task a | iData a
editTaskPred :: !a !(a -> (Bool, HtmlCode)) -> 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
return_V :: lift a value to the iTask domain and return it 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) !(a -> Task b) -> Task b | iCreateAndPrint b
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
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
(<<?) :: as ?>>, except that prompt is displayed *after* task (<<?) :: as ?>>, except that prompt is displayed *after* task
...@@ -114,119 +100,52 @@ return_VF :: !HtmlCode !a -> Task a | iCreateAndPrint a ...@@ -114,119 +100,52 @@ 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:
assignTaskTo :: assign task to indicated user, True for verbose reporting
(@:) :: 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 :: !Bool !Int !(LabeledTask 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 !(LabeledTask a) -> Task a | iData a
(@::>) infix 3 :: !Int !(Task a) -> Task a | iData a
/* Handling recursion and loops: /* Handling recursion and loops:
foreverTask :: infinitely repeating Task 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 (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) (<!) :: 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 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, 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
/* 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 :: ![LabeledTask a] -> Task [a] | iCreateAndPrint a 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_btn :: choose ONE task by pressing a button, True for horizontal buttons, else vertical
chooseTask :: choose ONE iTask from list, depending on button pressed, button horizontally displayed chooseTask_pdm :: as chooseTask_btn, depending on pulldownmenu item selected, Int for initial value
chooseTaskV :: as chooseTask, buttons vertically displayed chooseTask_radio:: as chooseTask_btn, depending on radio item selected, Int for initial value, htmlcode for option explanation
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
mchoice: choose tasks depending on the checkboxes set 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
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
*/ */
buttonTask :: !String !(Task a) -> Task a | iCreateAndPrint a chooseTask_btn :: !HtmlCode !Bool![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTaskV :: !HtmlCode ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_pdm :: !HtmlCode !Int ![LabeledTask a] -> Task a | iCreateAndPrint a chooseTask_pdm :: !HtmlCode !Int ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_radio:: !HtmlCode !Int ![(HtmlCode,LabeledTask a)] chooseTask_radio:: !HtmlCode !Int ![(HtmlCode,LabeledTask a)]
-> Task a | iCreateAndPrint a -> Task a | iCreateAndPrint a
mpchoiceTasks :: !([LabeledTask a] -> Task [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])
!HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a -> Task [a] | iData a
:: ChoiceUpdate :== !Bool [Bool] -> [Bool] // changed checkbox + current settings -> new settings :: ChoiceUpdate :== !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
(-||-) :: 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
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) orTask2 :: !(Task a,Task b) -> Task (EITHER a b)
| iCreateAndPrint a & iCreateAndPrint b | iCreateAndPrint a & iCreateAndPrint b
orTasks :: ![LabeledTask a] -> Task a | iData a andTask2 :: !(Task a,Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b
andTasksCond :: !String !([a] -> Bool) ![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
/* Experimental department: /* Experimental department:
...@@ -252,13 +171,32 @@ closureLzTask :: String (Task a) -> Task (TCl a) | iCreateAndPrint a ...@@ -252,13 +171,32 @@ 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 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 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 (<^>) 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 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 type (TSt -> (a,TSt)) to iTask domain
(@>>) :: lift functions of (TSt -> 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 ...@@ -274,13 +212,13 @@ appIData2 :: (String *HSt -> *(Form a,*HSt)) -> Task a | iData a
appHSt :: !String (HSt -> (a,HSt)) -> Task a | iData a appHSt :: !String (HSt -> (a,HSt)) -> Task a | iData a
appHSt2 :: !String (HSt -> (a,HSt)) -> Task a | iData a appHSt2 :: !String (HSt -> (a,HSt)) -> Task a | iData a
// *********************************************************************************************************************************
/* Operations on Task state /* Operations on Task state
taskId :: give id of user assigned to task taskId :: give id of user assigned to task
userId :: give id of application user userId :: give id of application user
addHtml :: add html code addHtml :: add html code
*/ */
taskId :: TSt -> (Int,TSt) taskId :: TSt -> (Int,TSt)
userId :: TSt -> (Int,TSt) userId :: TSt -> (Int,TSt)
addHtml :: HtmlCode TSt -> TSt addHtml :: HtmlCode TSt -> TSt
This diff is collapsed.
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 primitive iTask combinators
// *********************************************************************************************************************************
import iTasks
/* standard monadic combinators on iTasks:
(#>>) :: for sequencing: bind, but no argument passed
*/
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
/* 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 :: !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
/* Handling recursion and loops:
repeatTask :: repeat Task until predicate is valid
*/
repeatTask :: !(a -> Task a) !(a -> Bool) a -> Task a | iData a
/* 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 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
*/
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
/* 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 []
// ******************************************************************************************************
// monads for combining iTasks
(#>>) infixl 1 :: !(Task a) !(Task b) -> Task b | iCreateAndPrint b
(#>>) taska taskb
= taska
=>> \_ -> taskb
// ******************************************************************************************************
// 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
// ******************************************************************************************************
// 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 ltask = assignTaskTo True nuserId ltask
(@::) infix 3 :: !Int !(Task a) -> (Task a) | iData a
(@::) nuserId taska = assignTaskTo True nuserId ("Task for " <+++ nuserId,taska)
(@:>) infix 3 :: !Int !(LabeledTask a) -> Task a | iData a
(@:>) nuserId ltask = assignTaskTo False nuserId ltask
(@::>) infix 3 :: !Int !(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
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
= mpchoiceTasks seqTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceTasks2 prompt taskOptions
= mpchoiceTasks seqTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceTasks3 prompt taskOptions
= mpchoiceTasks seqTasks prompt taskOptions
mchoiceAndTasks :: !HtmlCode ![LabeledTask a] -> (Task [a]) | iData a
mchoiceAndTasks prompt taskOptions
= mpchoiceTasks andTasks prompt [((False,\b bs -> bs,[]),labeltask) \\ labeltask <- taskOptions]
mchoiceAndTasks2 :: !HtmlCode ![(!Bool,LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks2 prompt taskOptions
= mpchoiceTasks andTasks prompt [((set,\b bs -> bs,[]),labeltask) \\ (set,labeltask) <- taskOptions]
mchoiceAndTasks3 :: !HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)] -> Task [a] | iData a
mchoiceAndTasks3 prompt taskOptions
= mpchoiceTasks 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)
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`
= appHSt2 "getTimeAndDate" getTimeAndDate
=>> \(ctime,_) -> waitForTimeTask (ctime + time)
definition module iTasksDB
// super simple database creation and access based on iData
// (c) mjp 2007
// choose the kind of storage you want to use
db_prefix :== "iDBase-"
:: DBid a
import iTasks
/*
mkDBid :: create a typed database identificator
only Database and TxtFile are currently supported
readDB :: read the database
writeDB :: write the database
readDB2 :: read the database, each and everytime the application is evaluated
dangerous: not referential transparent, only use it if you know what you are doing !
*/
mkDBid :: String Lifespan -> (DBid a)
readDB :: (DBid a) -> Task a | iData a
writeDB :: (DBid a) a -> Task a | iData a
readDB2 :: (DBid a) -> Task a | iData a
implementation module iTasksDB
// super simple database creation and access based on iData
// (c) mjp 2007
import iTasks, iDataFormlib, StdEnv, iDataTrivial
::DBid a :== (String,Lifespan)
// Common db access
readDB :: (DBid a) -> Task a | iData a
readDB name=:(idn,_) = appHSt ("readDB " +++ idn) (DB name id)
writeDB :: (DBid a) a -> Task a | iData a
writeDB name=:(idn,_) value = appHSt ("writeDB " +++ idn) (DB name (const value))
readDB2 :: (DBid a) -> Task a | iData a
readDB2 name=:(idn,_) = appHSt2 ("readDB2 " +++ idn) (DB name id)
DB :: (DBid a) (a -> a) *HSt -> (a,*HSt) | iData a
DB (name,storageKind) fun hst
# (form,hst) = mkStoreForm (Init,nFormId (db_prefix +++ name) createDefault <@ storageKind <@ NoForm) fun hst
= (form.value,hst)
mkDBid :: String Lifespan -> (DBid a)
mkDBid s Database
| and (map isControl (mkList s)) = abort (s <+++ " contains control characters which is illegal!...\n\n")
mkDBid s attr = (s,attr)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution. </