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
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -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)
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -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