Commit 81b1d0b4 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

removed TCl stuff.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@346 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 2aa340b8
......@@ -42,7 +42,7 @@ where
doDelegate
= orTasks [("Waiting for " <+++ who, who @:: buttonTask "I Will Do It" (return_V who)) \\ who <- people]
=>> \who -> who @:: stopTask2 who -!> task
=>> \(stopped,TCl task) -> if (isJust stopped) (delegateToSomeone task people) task
=>> \(stopped,task) -> if (isJust stopped) (delegateToSomeone task people) task
stopTask = buttonTask "Stop" (return_V True)
......
......@@ -11,15 +11,12 @@ import Time
import Html
import TSt
derive gForm TCl
derive gUpd TCl
derive gPrint TCl
derive gParse TCl
derive read TCl
derive write TCl
:: TCl a = TCl !.(Task a) // task closure, container for a task used for higher order tasks (task which deliver a task)
derive gForm Task
derive gUpd Task
derive gPrint Task
derive gParse Task
derive read Task
derive write Task
instance == GarbageCollect
......
......@@ -13,9 +13,6 @@ import TSt
import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
import DrupBasic
:: TCl a = TCl !.(Task a) // task closure, container for a task used for higher order tasks (task which deliver a task)
iTaskId :: !Int !TaskNr !String -> String
iTaskId userid tasknr postfix
# postfix = { c \\ c <-: postfix | not (isMember c ['\\\"/:*?<>|"']) } // throw away characters not allowed in a file name
......@@ -25,14 +22,10 @@ iTaskId userid tasknr postfix
| userid < 0 = "iLog_" <+++ (taskNrToString tasknr) <+++ "-" <+++ postfix
| otherwise = "iTask_" <+++ (taskNrToString tasknr) <+++ "-" <+++ postfix // MJP:info removed to allow dynamic realloc of users: <+++ "+" <+++ userid
// ******************************************************************************************************
// Task creation and printing
// ******************************************************************************************************
// mkTask is an important wrapper function which should be wrapped around any task
// It takes care of
// - deciding whether the task should be called (activated) or not
......@@ -94,37 +87,37 @@ where
(==) _ _ = False
// ******************************************************************************************************
// TCl specialization
// Task specialization
// ******************************************************************************************************
write{|TCl|} write_a (TCl task) wst
write{|Task|} write_a task wst
= write{|*|} (copy_to_string task) wst
read {|TCl|} read_a wst
read {|Task|} read_a wst
# (Read str i file) = read{|*|} wst
= Read (TCl (deserialize str)) i file
= Read (deserialize str) i file
where
deserialize :: .String -> .(Task .a)
deserialize str = fst (copy_from_string {c \\ c <-: str })
gPrint{|TCl|} ga (TCl task) ps = ps <<- copy_to_string task
gPrint{|Task|} ga task ps = ps <<- copy_to_string task
gParse{|TCl|} ga expr
gParse{|Task|} ga expr
# mbstring = parseString expr
| isNothing mbstring = Nothing
= Just (TCl (fst(copy_from_string {s` \\ s` <-: fromJust mbstring})))
= Just (fst(copy_from_string {s` \\ s` <-: fromJust mbstring}))
where
parseString :: Expr -> Maybe String
parseString expr = gParse{|*|} expr
gUpd{|TCl|} gc (UpdSearch 0 _) c = (UpdDone, c)
gUpd{|TCl|} gc (UpdSearch cntr val) c = (UpdSearch (cntr - 2) val,c)
gUpd{|TCl|} gc (UpdCreate l) _
gUpd{|Task|} gc (UpdSearch 0 _) c = (UpdDone, c)
gUpd{|Task|} gc (UpdSearch cntr val) c = (UpdSearch (cntr - 1) val,c)
gUpd{|Task|} gc (UpdCreate l) _
# (mode,default) = gc (UpdCreate l) undef
= (UpdCreate l, TCl (Task (\tst -> (default,tst))))
gUpd{|TCl|} gc mode b = (mode, b)
= (UpdCreate l, Task (\tst -> (default,tst)))
gUpd{|Task|} gc mode b = (mode, b)
gForm{|TCl|} gfa (init,formid) hst
gForm{|Task|} gfa (init,formid) hst
= ({value=formid.ival,changed=False,form=[], inputs = []},hst)
......@@ -86,8 +86,8 @@ channel :: splits a task in respectively a sender task closure and receiver ta
Important: Notice that a receiver will never finish if you don't activate the corresponding receiver somewhere.
*/
(-!>) infix 4 :: (Task stop) (Task a) -> Task (Maybe stop,TCl a) | iCreateAndPrint stop & iCreateAndPrint a
channel :: String (Task a) -> Task (TCl a,TCl a) | iCreateAndPrint a
(-!>) infix 4 :: (Task stop) (Task a) -> Task (Maybe stop,Task a) | iCreateAndPrint stop & iCreateAndPrint a
channel :: String (Task a) -> Task (Task a,Task a) | iCreateAndPrint a
closureTask :: (LabeledTask a) -> (Task (TCl a)) | iCreateAndPrint a
closureLzTask :: (LabeledTask a) -> (Task (TCl a)) | iCreateAndPrint a
closureTask :: (LabeledTask a) -> (Task (Task a)) | iCreateAndPrint a
closureLzTask :: (LabeledTask a) -> (Task (Task a)) | iCreateAndPrint a
......@@ -207,53 +207,6 @@ where
displayAll` label tasknr htmls
= foldl (+|+) (BT [] []) (map snd htmls)
/*
allTasksCond :: !String !(TasksToShow a) !(FinishPred a) ![LabeledTask a] -> Task [a] | iData a
allTasksCond label chooser pred taskCollection
= mkTask "andTasksCond" (Task (doandTasks chooser taskCollection))
where
lengthltask = length taskCollection
doandTasks chooser [] tst = return [] tst
doandTasks chooser taskCollection tst=:{tasknr,html,options,userId}
# ((alist,acode),tst=:{activated=finished,html=allhtml})
= checkAllTasks label taskCollection 0 True ([],[]) {tst & html = BT [] [],activated = True}
| finished = (alist,{tst & html = html}) // stop, all andTasks are finished
| pred alist = (alist,{tst & html = html, activated = True}) // stop, all work done so far satisfies predicate
# selectId = iTaskId userId tasknr "anTaskSelect"
# ((selected,shtml),tst) = chooser selectId taskCollection {tst & html = BT [] []}
# (_,tst=:{html=ashtml}) = showtasks label [(i,taskCollection!!i) \\ i <- selected | i >= 0 && i < lengthltask] {tst & html = BT [] [], activated = True}
= (alist,{tst & activated = finished
, html = html +|+ // show previous code
((BT shtml []) +-+ ashtml) +|+ // show selection button + selected itasks
(userId -@: foldl (+|+) (BT [] []) [htmlcode \\ htmlcode <- acode & i <- [0..] | not (isMember i selected)]) // dont show non selected itasks, but scan them for task tree info
})
where
showtasks :: !String ![(!Int,!LabeledTask a)] !*TSt -> *(![a],!*TSt) | iCreateAndPrint a
showtasks _ [] tst = ([],tst)
showtasks label [(chosen,(name,chosenTask)):tasks] tst=:{html=html}
# (a,tst=:{html=ahtml}) = appTaskTSt (mkParSubTask label chosen chosenTask) {tst & tasknr = tasknr, activated = True, html = BT [] []}
# (as,tst=:{html=ashtml}) = showtasks label tasks {tst & html = BT [] []}
= ([a:as],{tst & html = html +|+ ahtml +|+ ashtml})
checkAllTasks :: !String ![LabeledTask a] !Int !Bool !(![a],![HtmlTree]) !*TSt -> *(!(![a],![HtmlTree]),!*TSt) | iCreateAndPrint a
checkAllTasks traceid taskCollection ctasknr bool (alist,acode) tst=:{tasknr}
| ctasknr == length taskCollection = ((reverse alist,reverse acode),{tst & activated = bool}) // all tasks tested
# (taskname,task) = taskCollection!!ctasknr
# (a,tst=:{activated = adone,html=html})
= appTaskTSt (mkParSubTask traceid ctasknr task) {tst & tasknr = tasknr, activated = True, html = BT [] []} // check tasks
| adone = checkAllTasks traceid taskCollection (inc ctasknr) bool ([a:alist],[html:acode]) {tst & tasknr = tasknr, activated = True}
= checkAllTasks traceid taskCollection (inc ctasknr) False (alist,[html:acode]) {tst & tasknr = tasknr, activated = True}
*/
// ******************************************************************************************************
// Higher order tasks ! Experimental
/* Experimental department:
......@@ -265,33 +218,33 @@ where
channel :: splits a task in respectively a sender task closure and receiver taskclosure;
when the sender is evaluated, the original task is evaluated as usual;
when the receiver task is evaluated, it will wait upon completeion of the sender and then get's its result;
Important: Notice that a receiver will never finish if you don't activate the corresponding receiver somewhere.
Important: Notice that a receiver will never finish if you don't activate the corresponding sender somewhere.
closureTask :: The task is executed as usual, but a receiver closure is returned immediately.
When the closure is evaluated somewhere, one has to wait until the task is finished.
Handy for passing a result to several interested parties.
closureLZTask :: Same, but now the original task will not be done unless someone is asking for the result somewhere.
*/
(-!>) infix 4 :: (Task s) (Task a) -> (Task (Maybe s,TCl a)) | iCreateAndPrint s & iCreateAndPrint a
(-!>) infix 4 :: (Task s) (Task a) -> (Task (Maybe s,Task a)) | iCreateAndPrint s & iCreateAndPrint a
(-!>) stoptask task = mkTask "-!>" (Task stop`)
where
stop` tst=:{tasknr,html,options,userId}
# (val,tst=:{activated = taskdone,html = taskhtml}) = appTaskTSt task {tst & activated = True, html = BT [] [], tasknr = normalTaskId,options = options}
# (s, tst=:{activated = stopped, html = stophtml}) = appTaskTSt stoptask {tst & activated = True, html = BT [] [], tasknr = stopTaskId, options = options}
| stopped = appTaskTSt (return_V (Just s, TCl (Task (close task)))) {tst & html = html, activated = True}
| taskdone = appTaskTSt (return_V (Nothing,TCl (return_V val))) {tst & html = html +|+ taskhtml, activated = True}
= appTaskTSt (return_V (Nothing,TCl (return_V val))) {tst & html = html +|+ taskhtml +|+ stophtml, activated = False}
| stopped = appTaskTSt (return_V (Just s, Task (close task))) {tst & html = html, activated = True}
| taskdone = appTaskTSt (return_V (Nothing,return_V val)) {tst & html = html +|+ taskhtml, activated = True}
= appTaskTSt (return_V (Nothing,return_V val)) {tst & html = html +|+ taskhtml +|+ stophtml, activated = False}
where
close t = \tst -> appTaskTSt t {tst & tasknr = normalTaskId, options = options, userId = userId} // reset userId because it influences the task id
stopTaskId = [-1,0:tasknr]
normalTaskId = [-1,1:tasknr]
channel :: String (Task a) -> (Task (TCl a,TCl a)) | iCreateAndPrint a
channel :: String (Task a) -> (Task (Task a,Task a)) | iCreateAndPrint a
channel name task = mkTask "channel" (Task (doSplit name task))
doSplit name task tst=:{tasknr,options,userId}
= appTaskTSt (return_V (TCl (Task (sender (Task myTask))),TCl (Task (receiver (Task myTask))))) tst
= appTaskTSt (return_V (Task (sender (Task myTask)),Task (receiver (Task myTask)))) tst
where
myTask tst = appTaskTSt task {tst & tasknr = [-1:tasknr], options = options, userId = userId}
......@@ -306,24 +259,24 @@ where
| activated = (val,{tst & html = html, activated = True , tasknr = tasknr})
= (val,{tst & html = html /*+|+ BT [showText ("Waiting for completion of "<+++ name)]*/, tasknr = tasknr})
closureTask :: (LabeledTask a) -> (Task (TCl a)) | iCreateAndPrint a
closureTask :: (LabeledTask a) -> (Task (Task a)) | iCreateAndPrint a
closureTask (name, task) = mkTask ("closure " +++ name) (Task mkClosure)
where
mkClosure tst=:{tasknr,options,userId}
# ((TCl sa,ra),tst) = doSplit name task tst
# ((sa,ra),tst) = doSplit name task tst
# (_,tst) = appTaskTSt sa {tst & activated = True}
= (ra, {tst & activated = True})
closureLzTask :: (LabeledTask a) -> (Task (TCl a)) | iCreateAndPrint a
closureLzTask :: (LabeledTask a) -> (Task (Task a)) | iCreateAndPrint a
closureLzTask (name, task) = mkTask ("lazy closure " +++ name) (Task mkClosure)
where
mkClosure tst=:{tasknr,options,userId}
# ((TCl sa,ra),tst) = doSplit name task tst
# ((sa,ra),tst) = doSplit name task tst
# (_,tst) = appTaskTSt sa tst
= (ra, {tst & activated = True})
doSplit name task tst=:{tasknr,options,userId}
= appTaskTSt (return_V (TCl (Task (sender (Task myTask))),TCl (Task (receiver (Task myTask))))) tst
= appTaskTSt (return_V (Task (sender (Task myTask)), Task (receiver (Task myTask)))) tst
where
myTask tst = appTaskTSt task {tst & tasknr = [-1:tasknr], options = options, userId = userId}
......
......@@ -220,7 +220,7 @@ where
orTasks :: ![LabeledTask a] -> (Task a) | iData a
orTasks [] = Task (return createDefault)
orTasks taskCollection = newTask "orTasks" (andTasksCond "orTask" (\list -> length list >= 1) taskCollection)
orTasks taskCollection = newTask "orTasks" (allTasksCond "orTask" displayAll (\list -> length list >= 1) taskCollection)
=>> \list -> (Task (return (hd list)))
orTask2 :: !(Task a,Task b) -> Task (EITHER a b) | iData a & iData b
......@@ -234,7 +234,7 @@ orTask2 (taska,taskb)
andTasks :: ![LabeledTask a] -> (Task [a]) | iData a
andTasks taskCollection = newTaskTrace "andTasks" (andTasksCond "andTask" (\_ -> False) taskCollection)
andTasks taskCollection = newTaskTrace "andTasks" (allTasksCond "andTask" displayAsTab (\_ -> False) taskCollection)
(-&&-?) infixr 4 :: !(Task (Maybe a)) !(Task (Maybe b)) -> Task (Maybe (a,b)) | iData a & iData b
(-&&-?) t1 t2
......
......@@ -22,9 +22,9 @@ derive read Wid, WorkflowStatus
derive write Wid, WorkflowStatus
:: Wid a = Wid WorkflowLink // id of workflow process
:: WorkflowProcess = ActiveWorkflow ProcessIds !(TCl Dynamic)
| SuspendedWorkflow ProcessIds !(TCl Dynamic)
| FinishedWorkflow ProcessIds !Dynamic !(TCl Dynamic)
:: WorkflowProcess = ActiveWorkflow ProcessIds !(Task Dynamic)
| SuspendedWorkflow ProcessIds !(Task Dynamic)
| FinishedWorkflow ProcessIds !Dynamic !(Task Dynamic)
| DeletedWorkflow ProcessIds
instance == WorkflowStatus
......@@ -67,7 +67,7 @@ where
myread pst = read{|*|} pst
gerda{|Dynamic|} = abort "Cannot yet store a Dynamic in a Database\n"
gerda{|TCl|} ga = abort "Cannot yet store an iTask of type TCL in a Database\n"
gerda{|Task|} ga = abort "Cannot yet store an iTask of type TCL in a Database\n"
import DrupBasic
......@@ -95,9 +95,9 @@ setWorkflowUser nuserid (FinishedWorkflow (userid,procnr,wflab) dyn task) = (F
setWorkflowUser nuserid (DeletedWorkflow (userid,procnr,wflab)) = (DeletedWorkflow (nuserid,procnr,wflab))
getTask :: !WorkflowProcess -> Task Dynamic
getTask (ActiveWorkflow (_,_,_) (TCl task)) = task
getTask (SuspendedWorkflow (_,_,_) (TCl task)) = task
getTask (FinishedWorkflow (_,_,_) _ (TCl task)) = task
getTask (ActiveWorkflow (_,_,_) task) = task
getTask (SuspendedWorkflow (_,_,_) task) = task
getTask (FinishedWorkflow (_,_,_) _ task) = task
isDeletedWorkflow :: !WorkflowProcess -> Bool
isDeletedWorkflow (DeletedWorkflow _) = True
......@@ -140,12 +140,12 @@ where
= (a,{tst & activated = activated && done}) // whole application ends when all processes have ended
scheduleWorkflowTable done [] _ tst = (done,tst)
scheduleWorkflowTable done [ActiveWorkflow _ (TCl dyntask):wfls] procid tst
scheduleWorkflowTable done [ActiveWorkflow _ dyntask:wfls] procid tst
# (_,tst=:{activated}) = appTaskTSt dyntask {tst & activated = True}
= scheduleWorkflowTable (done && activated) wfls (inc procid) {tst & activated = activated}
scheduleWorkflowTable done [SuspendedWorkflow _ _:wfls] procid tst
= scheduleWorkflowTable done wfls (inc procid) tst
scheduleWorkflowTable done [FinishedWorkflow _ _ (TCl dyntask):wfls] procid tst // just to show result in trace..
scheduleWorkflowTable done [FinishedWorkflow _ _ dyntask:wfls] procid tst // just to show result in trace..
# (_,tst) = appTaskTSt dyntask tst
= scheduleWorkflowTable done wfls (inc procid) tst
scheduleWorkflowTable done [DeletedWorkflow _:wfls] procid tst
......@@ -161,8 +161,8 @@ where
# processid = processid + 1 // process id currently given by length list, used as offset in list
# wfl = mkdyntask options entry processid task // convert user task in a dynamic task
# nwfls = if found
(updateAt (entry - 1) (if active ActiveWorkflow SuspendedWorkflow (userid,processid,label) (TCl wfl)) wfls)
(wfls ++ [if active ActiveWorkflow SuspendedWorkflow (userid,processid,label) (TCl wfl)]) // turn task into a dynamic task
(updateAt (entry - 1) (if active ActiveWorkflow SuspendedWorkflow (userid,processid,label) wfl) wfls)
(wfls ++ [if active ActiveWorkflow SuspendedWorkflow (userid,processid,label) wfl]) // turn task into a dynamic task
# (wfls,tst) = workflowProcessStore (\_ -> (processid,nwfls)) tst // write workflow process administration
# (_,tst) = appTaskTSt (if active wfl (Task (\tst -> (undef,tst)))) tst // if new workflow is active, schedule it in
= (Wid (entry,(userid,processid,label)),{tst & activated = True})
......@@ -312,8 +312,8 @@ where
(ActiveWorkflow label acttask) -> (True,{tst & activated = True})
wfl -> (False,{tst & activated = True}) // in case of finished or deleted task
scheduleWorkflow label maxid (TCl wfl) wfls tst
# nwfls = updateAt (entry - 1) (ActiveWorkflow label (TCl wfl)) wfls // mark workflow as activated
scheduleWorkflow label maxid wfl wfls tst
# nwfls = updateAt (entry - 1) (ActiveWorkflow label wfl) wfls // mark workflow as activated
# (wfls,tst) = workflowProcessStore (\_ -> (maxid,nwfls)) tst // update workflow process administration
# (_,tst) = appTaskTSt wfl {tst & activated = True} // schedule workflow
= (True,tst) // done
......@@ -339,9 +339,9 @@ where
# (wfls,tst) = workflowProcessStore (\_ -> (maxid,nwfls)) tst // update workflow process administration
= (ok,tst) // if everything is fine it should always succeed
scheduleWorkflow label (TCl wfl) tst // schedule workflow
scheduleWorkflow label (Task wfl) tst // schedule workflow
# (_,tst) = wfl {tst & activated = True}
= (True,False,ActiveWorkflow label (TCl wfl),{tst & activated = True})
= (True,False,ActiveWorkflow label (Task wfl),{tst & activated = True})
*/
getWorkflowStatus :: !(Wid a) -> Task WorkflowStatus
......
......@@ -12,11 +12,11 @@ Start :: *World -> *World
Start world = startTaskEngine myTask5 world
myTask5
= chooseTask [Text "Choose product:",BrTag [],BrTag []]
[("Coffee: 100", return_V (100,"Coffee"))
,("Cappucino: 150", return_V (150,"Cappucino"))
,("Tea: 50", return_V (50, "Tea"))
,("Chocolate: 100", return_V (100,"Chocolate"))
= seqTasks
[("Coffee: 100", editTask "OK" (100,"Coffee"))
,("Cappucino: 150", editTask "OK" (150,"Cappucino"))
,("Tea: 50", editTask "OK" (50, "Tea"))
,("Chocolate: 100", editTask "OK" (100,"Chocolate"))
]
=>> \v -> editTask "OK" v
......
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