diff --git a/iTasks/StdiTasks.dcl b/iTasks/StdiTasks.dcl new file mode 100644 index 0000000000000000000000000000000000000000..8f46f79d4aff3cf5eeb1241a3ee58bec46fc9fbe --- /dev/null +++ b/iTasks/StdiTasks.dcl @@ -0,0 +1,15 @@ +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 + diff --git a/iTasks/StdiTasks.icl b/iTasks/StdiTasks.icl new file mode 100644 index 0000000000000000000000000000000000000000..c46f04faa9f882f0622d5b914bf07c543d8b17e6 --- /dev/null +++ b/iTasks/StdiTasks.icl @@ -0,0 +1 @@ +implementation module StdiTasks \ No newline at end of file diff --git a/iTasks/iTasks.dcl b/iTasks/iTasks.dcl index c5a3d9fd76f2120894d4882ca9b6ac70f0634a4b..fab0b2cd12c4c2b82852fe8a82a7b13a9538a373 100644 --- a/iTasks/iTasks.dcl +++ b/iTasks/iTasks.dcl @@ -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 (<>, 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 ( 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 ( .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 + diff --git a/iTasks/iTasks.icl b/iTasks/iTasks.icl index b2ea66068e79a37123a76c5e73d33a03a86b733e..b48a57461996e8fb14b1f52bb9811319c4ce9d72 100644 --- a/iTasks/iTasks.icl +++ b/iTasks/iTasks.icl @@ -1,6 +1,6 @@ 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 +andTasksCond label pred taskCollection = mkTask "andTasksPred" (doandTasks taskCollection) where doandTasks [] tst = return [] tst doandTasks taskCollection tst=:{tasknr,html,options,userId} # (alist,tst=:{activated=finished}) = checkAllTasks label taskCollection (0,-1) True [] {tst & html = BT [], activated = True} # myalist = map snd alist - | finished = (myalist,{tst & html = html}) // stop, all andTasks are finished - | pred myalist = (myalist,{tst & html = html, activated = True}) // stop, all work done so far satisfies predicate - # ((chosen,buttons,chosenname),tst) // user can select one of the tasks to work on + | finished = (myalist,{tst & html = html}) // stop, all andTasks are finished + | pred myalist = (myalist,{tst & html = html, activated = True}) // stop, all work done so far satisfies predicate + # ((chosen,buttons,chosenname),tst) // user can select one of the tasks to work on = LiftHst (mkTaskButtons label "" userId tasknr options (map fst taskCollection)) tst # chosenTask = snd (taskCollection!!chosen) -// # chosenTaskName = fst (taskCollection!!chosen) - # (a,tst=:{activated=adone,html=ahtml}) // enable the selected task (finished or not) + # (a,tst=:{activated=adone,html=ahtml}) // enable the selected task (finished or not) = mkParSubTask label chosen chosenTask {tst & tasknr = tasknr, activated = True, html = BT []} - # (alist,tst=:{activated=finished,html=allhtml}) // check again whether all other tasks are now finished, collect their code + # (alist,tst=:{activated=finished,html=allhtml}) // check again whether all other tasks are now finished, collect their code = checkAllTasks label taskCollection (0,chosen) True [] {tst & tasknr = tasknr, html = BT [], activated = True} - | not adone = ([a],{tst & activated = False // not done, since chosen task not finished + | not adone = ([a],{tst & activated = False // not done, since chosen task not finished , html = html +|+ BT buttons +-+ (BT chosenname +|+ ahtml) +|+ - (userId -@: allhtml) // code for non selected alternatives are not shown for the owner of this task + (userId -@: allhtml) // code for non selected alternatives are not shown for the owner of this task }) # (alist,tst=:{activated=finished,html=allhtml}) = checkAllTasks label taskCollection (0,-1) True [] {tst & html = BT [],activated = True} # myalist = map snd alist - | finished = (myalist,{tst & html = html}) // stop, all andTasks are finished - | pred myalist = (myalist,{tst & html = html, activated = True}) // stop, all work done so far satisfies predicate + | finished = (myalist,{tst & html = html}) // stop, all andTasks are finished + | pred myalist = (myalist,{tst & html = html, activated = True}) // stop, all work done so far satisfies predicate = (map snd alist,{tst & activated = finished , html = html +|+ BT buttons +-+ (BT chosenname +|+ ahtml) +|+ (userId -@: allhtml) }) + checkAllTasks :: !String [(String,(*TSt -> *(a,*TSt)))] (Int,Int) Bool [(String,a)] *TSt -> *([(String,a)],*TSt) | iCreateAndPrint a checkAllTasks traceid options (ctasknr,skipnr) bool alist tst=:{tasknr} | ctasknr == length options = (reverse alist,{tst & activated = bool}) // all tasks tested @@ -1488,12 +1411,12 @@ checkAllTasks traceid options (ctasknr,skipnr) bool alist tst=:{tasknr} | adone = checkAllTasks traceid options (inc ctasknr,skipnr) bool [(taskname,a):alist] {tst & tasknr = tasknr, activated = True} = checkAllTasks traceid options (inc ctasknr,skipnr) False alist {tst & tasknr = tasknr, activated = True} - +/* andTasks_mu :: !String ![(Int,Task a)] -> (Task [a]) | iData a andTasks_mu taskid tasks = newTask "andTasks_mu" (domu_andTasks tasks) where domu_andTasks list = andTasks [(taskid <+++ " " <+++ i, i @:: task) \\ (i,task) <- list] - +*/ // ****************************************************************************************************** // Higher order tasks ! Experimental @@ -1612,13 +1535,6 @@ where | currtime < stime.value= (stime.value,{tst & activated = False,hst = hst}) = (currtime - stime.value,{tst & hst = hst}) -waitForTimerTask:: !HtmlTime -> (Task HtmlTime) -waitForTimerTask time = waitForTimerTask` -where - waitForTimerTask` tst=:{hst} - # ((ctime,_),hst) = getTimeAndDate hst - = waitForTimeTask (ctime + time) {tst & hst = hst} - waitForDateTask:: !HtmlDate -> (Task HtmlDate) waitForDateTask date = mkTask "waitForDateTask" waitForDateTask` where @@ -1683,7 +1599,7 @@ appHSt2 name fun = mkTask name doit where doit tst=:{hst} # (value,hst) = fun hst - = (value,{tst & hst = hst, activated = True}) // task is now completed, handle as previously + = (value,{tst & hst = hst}) // task is now completed, handle as previously appHSt :: !String (HSt -> (a,HSt)) -> (Task a) | iData a appHSt name fun = mkTask name doit @@ -1696,7 +1612,7 @@ where # (fvalue,hst) = fun hst # (store,hst) = mkStoreForm (Init,storageFormId options taskId (False,createDefault)) (\_ -> (True,fvalue)) hst // remember task status for next time # (_,nvalue) = store.value - = (nvalue,{tst & activated = True, hst = hst}) // task is now completed, handle as previously + = (nvalue,{tst & hst = hst}) // task is now completed, handle as previously Once :: (Task a) -> (Task a) | iData a Once fun = mkTask "Once" doit @@ -1997,7 +1913,6 @@ where // Html Printing Utilities... // ****************************************************************************************************** - mkDiv :: String HtmlCode -> HtmlCode mkDiv id bodytag = [normaldiv] where @@ -2008,5 +1923,3 @@ iTaskButton label = LButton defpixel label - - diff --git a/iTasks/iTasks2.dcl b/iTasks/iTasks2.dcl new file mode 100644 index 0000000000000000000000000000000000000000..a8378b547b35ad37989ae852bfa45e95e5d60270 --- /dev/null +++ b/iTasks/iTasks2.dcl @@ -0,0 +1,75 @@ +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 diff --git a/iTasks/iTasks2.icl b/iTasks/iTasks2.icl new file mode 100644 index 0000000000000000000000000000000000000000..057560a3fe06889b78ed9c9e41033bc2c76341f0 --- /dev/null +++ b/iTasks/iTasks2.icl @@ -0,0 +1,125 @@ +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) + diff --git a/iTasks/iTasksDB.dcl b/iTasks/iTasksDB.dcl new file mode 100644 index 0000000000000000000000000000000000000000..63ebebacea44734c10fdaf1b942e817bd4097e84 --- /dev/null +++ b/iTasks/iTasksDB.dcl @@ -0,0 +1,29 @@ +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 diff --git a/iTasks/iTasksDB.icl b/iTasks/iTasksDB.icl new file mode 100644 index 0000000000000000000000000000000000000000..3c932dd06f60386ef8e64d76241d9089bb670e95 --- /dev/null +++ b/iTasks/iTasksDB.icl @@ -0,0 +1,30 @@ +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) +