Commit 185e35e9 authored by Bas Lijnse's avatar Bas Lijnse

Changed type of Task from state transition function to Task (state transition function).

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@294 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent a38d1ad4
Resources/img/loading.gif

3.13 KB | W: | H:

Resources/img/loading.gif

3.13 KB | W: | H:

Resources/img/loading.gif
Resources/img/loading.gif
Resources/img/loading.gif
Resources/img/loading.gif
  • 2-up
  • Swipe
  • Onion skin
......@@ -13,12 +13,12 @@ import iTasksTypes
import iDataSettings, iDataForms, iDataWidgets, iDataFormlib, iDataTrivial
editTaskLabel :: !String !String !a -> (Task a) | iData a
editTaskLabel tracename prompt task = \tst =:{options} -> mkTask tracename ((editTask` prompt task <<@ (nPage options)) <<@ Edit) tst
editTaskLabel tracename prompt task = Task (\tst =:{options} -> appTaskTSt (mkTask tracename ((Task (editTask` prompt task) <<@ (nPage options)) <<@ Edit)) tst)
where
nPage options = if (options.tasklife == LSClient) LSClient LSPage
editTask :: !String !a -> (Task a) | iData a
editTask prompt a = mkTask "editTask" (editTask` prompt a)
editTask prompt a = mkTask "editTask" (Task (editTask` prompt a))
editTask` prompt a tst=:{tasknr,html,hst,userId}
# taskId = iTaskId userId tasknr "EdFin"
......@@ -35,7 +35,7 @@ editTask` prompt a tst=:{tasknr,html,hst,userId}
= (editor.Form.value,{tst & activated = taskdone.Form.value, html = html +|+ BT (editor.form ++ finbut.form) (editor.inputs ++ finbut.inputs), hst = hst})
editTaskPred :: !a !(a -> (Bool, [HtmlTag]))-> (Task a) | iData a
editTaskPred a pred = mkTask "editTask" (editTaskPred` a)
editTaskPred a pred = mkTask "editTask" (Task (editTaskPred` a))
where
editTaskPred` a tst=:{tasknr,html,hst,userId}
# taskId = iTaskId userId tasknr "EdFin"
......
......@@ -13,7 +13,7 @@ import iTasksTypes
// Timer Tasks ending when timed out
waitForTimeTask:: !HtmlTime -> (Task HtmlTime)
waitForTimeTask time = mkTask "waitForTimeTask" waitForTimeTask`
waitForTimeTask time = mkTask "waitForTimeTask" (Task waitForTimeTask`)
where
waitForTimeTask` tst=:{tasknr,userId,hst}
# taskId = iTaskId userId tasknr "Time_"
......@@ -23,7 +23,7 @@ where
= (currtime - stime.Form.value,{tst & hst = hst})
waitForDateTask:: !HtmlDate -> (Task HtmlDate)
waitForDateTask date = mkTask "waitForDateTask" waitForDateTask`
waitForDateTask date = mkTask "waitForDateTask" (Task waitForDateTask`)
where
waitForDateTask` tst=:{tasknr,userId,hst}
# taskId = iTaskId userId tasknr "Date_"
......
......@@ -28,6 +28,7 @@ where
getUserInfo (Just username) (Just password) = getUserInfo` username password
getUserInfo _ _ = Nothing
getUserInfo` "root" _ = Just (0, ["president","manager","worker"], "Root")
getUserInfo` "president" _ = Just (1, ["president"], "Organization President")
getUserInfo` "manager" _ = Just (2, ["manager"], "Middle Manager")
getUserInfo` "worker1" _ = Just (3, ["worker"], "Office Worker 1")
......
......@@ -18,7 +18,7 @@ derive gParse TCl
derive read TCl
derive write TCl
:: Task a :== *TSt -> *(!a,!*TSt) // an iTask is state transition function
:: TCl a = TCl !.(Task a) // task closure, container for a task used for higher order tasks (task which deliver a task)
......
......@@ -56,26 +56,26 @@ incNr [i:is] = [i+1:is]
// If a task j is a subtask of task i, than it will get number i.j in reverse order
mkTask :: !String !(Task a) -> (Task a) | iCreateAndPrint a
mkTask taskname mytask = mkTaskNoInc taskname mytask o incTaskNr
mkTask taskname mytask = Task (appTaskTSt (mkTaskNoInc taskname mytask) o incTaskNr)
mkTaskNoInc :: !String !(Task a) -> (Task a) | iCreateAndPrint a // common second part of task wrappers
mkTaskNoInc taskname mytask = mkTaskNoInc`
mkTaskNoInc taskname mytask = Task mkTaskNoInc`
where
mkTaskNoInc` tst=:{activated,tasknr,userId,options}
| not activated = (createDefault,tst) // not active, don't call task, return default value
# (val,tst=:{activated,trace}) = mytask tst // active, so perform task and get its result
| not activated = (createDefault,tst) // not active, don't call task, return default value
# (val,tst=:{activated,trace}) = appTaskTSt mytask tst // active, so perform task and get its result
# tst = {tst & tasknr = tasknr, options = options, userId = userId}
| isNothing trace || taskname == "" = (val,tst) // no trace, just return value
= (val,{tst & trace = Just (InsertTrace activated tasknr userId options taskname (printToString val%(0,60)) (fromJust trace))}) // adjust trace, don't print to long values
mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed
mkParSubTask name i task = mkParSubTask`
mkParSubTask name i task = Task mkParSubTask`
where
mkParSubTask` tst=:{tasknr, options}
# (v,tst) = mkTaskNoInc (name <+++ "." <+++ i) mysubtask {tst & tasknr = [i:tasknr],activated = True} // shift task
# (v,tst) = appTaskTSt (mkTaskNoInc (name <+++ "." <+++ i) (Task mysubtask)) {tst & tasknr = [i:tasknr],activated = True} // shift task
= (v,{tst & tasknr = tasknr, options = options})
where
mysubtask tst=:{tasknr} = task {tst & tasknr = [-1:tasknr], activated = True} // shift once again!
mysubtask tst=:{tasknr} = appTaskTSt task {tst & tasknr = [-1:tasknr], activated = True} // shift once again!
// ******************************************************************************************************
// Trace Insertion ...
......@@ -169,7 +169,7 @@ 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) _
# (mode,default) = gc (UpdCreate l) undef
= (UpdCreate l, TCl (\tst -> (default,tst)))
= (UpdCreate l, TCl (Task (\tst -> (default,tst))))
gUpd{|TCl|} gc mode b = (mode, b)
gForm{|TCl|} gfa (init,formid) hst
......
......@@ -117,7 +117,7 @@ calculateTasks thisUser pversion maintask tst
where
startMainTask :: !(Task a) !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) // No threads, always start from scratch
startMainTask task tst
# (_,tst=:{activated}) = task tst
# (_,tst=:{activated}) = appTaskTSt task tst
= ((True,defaultUser,[0],if activated "iTask application has ended" "",[]),{tst & activated = activated})
// ******************************************************************************************************
......@@ -142,7 +142,7 @@ startAjaxApplication thisUser versioninfo maintask tst=:{tasknr,options,html,tra
| isNothing mbevent // no events
= startFromRoot versioninfo tasknr [tasknr] "No events, page refreshed" maintask tst
# event = fromJust mbevent // event found
# (table,tst) = ThreadTableStorage id tst // read thread table
# (table,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table
| isEmpty table // events, but no threads, evaluate main application from scratch
= startFromRoot versioninfo event [tasknr] "No threads, page refreshed" maintask tst
# (mbthread,tst) = findParentThread event tst // look for thread to evaluate
......@@ -161,7 +161,7 @@ startAjaxApplication thisUser versioninfo maintask tst=:{tasknr,options,html,tra
// ok, we have found a matching thread
# (_,tst=:{activated}) = evalTaskThread thread {tst & html = BT [] []} // evaluate the thread
# (_,tst=:{activated}) = appTaskTSt (evalTaskThread thread) {tst & html = BT [] []} // evaluate the thread
| not activated // thread / task not yet finished
# tst = copyThreadTableToClient tst // copy thread table to client
= ((False,thisUser,event,"",[thread.thrTaskNr]),tst) // no further evaluation, aks user for more input
......@@ -176,7 +176,7 @@ where
| parent.thrUserId <> thisUser // updating becomes too complicated
= startFromRoot versioninfo event [tasknr:accu] ("Parent thread of user " <+++ parent.thrUserId <+++ ", page refreshed") maintask {tst & html = BT [] []}
# (_,tst=:{activated}) = evalTaskThread parent {tst & html = BT [] []} // start parent
# (_,tst=:{activated}) = appTaskTSt (evalTaskThread parent) {tst & html = BT [] []} // start parent
| not activated // parent thread not yet finished
# tst = copyThreadTableToClient tst // copy thread table to client
= ((False,thisUser,event, "",[parent.thrTaskNr:accu]),tst) // no further evaluation, aks user for more input
......@@ -217,7 +217,7 @@ where
evaluateFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
evaluateFromRoot versioninfo eventnr tasknrs message maintask tst
# tst = deleteAllSubTasks versioninfo.deletedThreads tst // delete subtasks being obsolute
# (_,tst) = maintask tst // evaluate main application from scratch
# (_,tst) = appTaskTSt maintask tst // evaluate main application from scratch
# tst=:{activated} = copyThreadTableToClient tst // copy thread table to client, if applicable
# message = if activated "iTask application finished" message
= (((True,defaultUser,eventnr,message,tasknrs), {tst & activated = activated}))
......@@ -250,7 +250,7 @@ mkTaskThread OnClient taska
taska // no threads made at all
mkTaskThread2 :: !ThreadKind !(Task a) -> Task a // execute a thread
mkTaskThread2 threadkind task = evalTask
mkTaskThread2 threadkind task = Task evalTask
where
evalTask tst=:{tasknr,activated,options,userId,staticInfo,workflowLink} // thread - task is not yet finished
# (mbthread,tst) = findThreadInTable threadkind tasknr tst // look if there is an entry for this task
......@@ -277,7 +277,7 @@ where
(thread.thrOptions.tasklife <> LSClient || // but new thread is not to be stored on client
staticInfo.currentUserId <> userId)) // or new thread is for someone else
forceEvalutionOnServer id tst // storing on client is no longer possible
= evalTaskThread thread tst // and evaluate it
= appTaskTSt (evalTaskThread thread) tst // and evaluate it
forceEvalutionOnServer tst
= IF_ClientServer // we running both client and server
......@@ -305,14 +305,14 @@ where
changeLifespanThreadTable :: !TaskNr !Lifespan *TSt -> *TSt // change lifespan of of indicated thread in threadtable
changeLifespanThreadTable tasknr lifespan tst
# (table,tst) = ThreadTableStorage id tst // read thread table on server
# (table,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table on server
# revtasknr = reverse (tl tasknr)
# ntable = [{thread & thrOptions.tasklife = if (isChild revtasknr thread.thrTaskNr) lifespan thread.thrOptions.tasklife} \\ thread <- table]
# (_,tst) = ThreadTableStorage (\_ -> ntable) tst // store thread table
# (_,tst) = appTaskTSt (ThreadTableStorage (\_ -> ntable)) tst // store thread table
= tst
evalTaskThread :: !TaskThread -> Task a // execute the thread !!!!
evalTaskThread entry=:{thrTaskNr,thrUserId,thrOptions,thrCallback,thrCallbackClient,thrKind} = evalTaskThread`
evalTaskThread entry=:{thrTaskNr,thrUserId,thrOptions,thrCallback,thrCallbackClient,thrKind} = Task evalTaskThread`
where
evalTaskThread` tst=:{tasknr,options,userId,staticInfo,html}
# newThrOptions = if (thrOptions.tasklife == LSClient && thrUserId <> staticInfo.currentUserId)
......@@ -320,7 +320,7 @@ where
thrOptions
# (a,tst=:{activated,html=nhtml})
= IF_ClientTasks
= appTaskTSt (IF_ClientTasks
(case thrKind of // we are running on Client, assume that IF_ClientServer and IF_Ajax is set
ClientThread = deserializeThreadClient thrCallbackClient
ClientServerThread = deserializeThreadClient thrCallbackClient
......@@ -332,7 +332,7 @@ where
ClientServerThread = deserializeThread thrCallback
ServerThread = deserializeThread thrCallback
else = abort "Thread administration error in evalTaskThread"
)
))
{tst & tasknr = thrTaskNr, options = newThrOptions, userId = thrUserId,html = BT [] []}
| activated // thread is finished, delete the entry...
# tst = deleteThreads thrTaskNr {tst & html = html +|+ nhtml} // remove thread from administration
......@@ -359,37 +359,37 @@ administrateNewThread ouserId tst =: {tasknr,userId,options}
// TO DO: Put this stuf in another module
ThreadTableStorage :: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ThreadTableStorage fun = handleTable
ThreadTableStorage fun = Task handleTable
where
handleTable tst
= IF_Ajax // threads only used when Ajax is enabled
(IF_ClientServer // we running both client and server
(IF_ClientTasks
(appTaskTSt (IF_ClientTasks
ClientThreadTableStorage // thread table on client
ServerThreadTableStorage // threadtable on server
fun tst
fun) tst
)
(ServerThreadTableStorage fun tst) // thread table on server when ajax used
(appTaskTSt (ServerThreadTableStorage fun) tst) // thread table on server when ajax used
)
(ServerThreadTableStorage fun tst) // thread table used for exception handling only ???
(appTaskTSt (ServerThreadTableStorage fun) tst) // thread table used for exception handling only ???
// (abort "Thread table storage only used when Ajax enabled") // no threads made at all
ServerThreadTableStorage:: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ServerThreadTableStorage fun = handleTable
ServerThreadTableStorage fun = Task handleTable
where
handleTable tst=:{staticInfo} = ThreadTableStorageGen serverThreadTableId staticInfo.threadTableLoc fun tst
handleTable tst=:{staticInfo} = appTaskTSt (ThreadTableStorageGen serverThreadTableId staticInfo.threadTableLoc fun) tst
serverThreadTableId = "Application" +++ "-ThreadTable"
ClientThreadTableStorage:: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ClientThreadTableStorage fun = handleTable
ClientThreadTableStorage fun = Task handleTable
where
handleTable tst=:{staticInfo} = ThreadTableStorageGen (clientThreadTableId staticInfo.currentUserId) LSClient fun tst
handleTable tst=:{staticInfo} = appTaskTSt (ThreadTableStorageGen (clientThreadTableId staticInfo.currentUserId) LSClient fun) tst
clientThreadTableId userid = "User" <+++ userid <+++ "-ThreadTable"
ThreadTableStorageGen :: !String !Lifespan !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ThreadTableStorageGen tableid lifespan fun = handleTable // to handle the table on server as well as on client
ThreadTableStorageGen tableid lifespan fun = Task handleTable // to handle the table on server as well as on client
where
handleTable tst
# (table,tst) = liftHst (mkStoreForm (Init,storageFormId
......@@ -408,13 +408,13 @@ copyThreadTableToClient tst
copyThreadTableToClient` :: !*TSt -> *TSt // copies all threads for this user from server to client thread table
copyThreadTableToClient` tst
# ((mythreads,_),tst) = splitServerThreadsByUser tst // get thread table on server
# (clientThreads,tst) = ClientThreadTableStorage (\_ -> mythreads) tst // and store in client
# (clientThreads,tst) = appTaskTSt (ClientThreadTableStorage (\_ -> mythreads)) tst // and store in client
= tst
splitServerThreadsByUser :: !*TSt -> (!(!ThreadTable,!ThreadTable),!*TSt) // get all threads from a given user from the server thread table
splitServerThreadsByUser tst=:{staticInfo}
# userid = staticInfo.currentUserId
# (serverThreads,tst) = ServerThreadTableStorage id tst // get thread table on server
# (serverThreads,tst) = appTaskTSt (ServerThreadTableStorage id) tst // get thread table on server
# splitedthreads = filterZip (\thr -> thr.thrUserId == userid && // only copy relevant part of thread table to client
(thr.thrKind == ClientServerThread || thr.thrKind == ClientThread)) serverThreads ([],[])
= (splitedthreads,tst)
......@@ -435,24 +435,24 @@ copyThreadTableFromClient` {newThread,deletedThreads} tst
# ((clienttableOnServer,otherClientsTable),tst)
= splitServerThreadsByUser tst // get latest thread table stored on server
# (clienttableOnClient,tst)
= ClientThreadTableStorage id tst // get latest thread table stored on client
= appTaskTSt (ClientThreadTableStorage id) tst // get latest thread table stored on client
# clienttableOnClient = case deletedThreads of
[] -> clienttableOnClient // remove threads in client table which have been deleted by global effects
_ -> [client
\\ client <- clienttableOnClient | not (isChildOf client.thrTaskNr deletedThreads)
]
# (clienttableOnClient,tst)
= ClientThreadTableStorage (\_ -> []) tst // clear thread table stored on client
= appTaskTSt (ClientThreadTableStorage (\_ -> [])) tst // clear thread table stored on client
# tst = deleteAllSubTasks deletedThreads tst // remove corresponding tasks
# thrNrsActiveOnClient = [thread.thrTaskNr \\ thread <- clienttableOnClient] // all active thread numbers on client
# newClientsOnServer = [thread \\ thread <- clienttableOnServer | not (isMember (thread.thrTaskNr) thrNrsActiveOnClient)]
# newtable = newClientsOnServer ++ clienttableOnClient ++ otherClientsTable // determine new thread situation
# (serverThreads,tst) = ServerThreadTableStorage (\_ -> newtable) tst // store table on server
# (serverThreads,tst) = appTaskTSt (ServerThreadTableStorage (\_ -> newtable)) tst // store table on server
= tst
findThreadInTable :: !ThreadKind !TaskNr !*TSt -> *(Maybe (!Int,!TaskThread),!*TSt)// find thread that belongs to given tasknr
findThreadInTable threadkind tasknr tst
# (table,tst) = ThreadTableStorage id tst // read thread table
# (table,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table
# pos = lookupThread tasknr 0 table // look if there is an entry for this task
| pos < 0 = (Nothing, tst)
= (Just (pos,table!!pos),tst)
......@@ -477,12 +477,12 @@ where
foundThread ClientServerThread ClientThread = True
foundThread ExceptionHandler ExceptionHandler = True
foundThread AnyThread _ = True
foundThread _ _ = abort "ZOU NIET MOGEN\n" //False
foundThread _ _ = abort "NOT POSSIBLE\n" //False
insertNewThread :: !TaskThread !*TSt -> *TSt // insert new thread in table
insertNewThread thread tst
# (table,tst) = ThreadTableStorage id tst // read thread table
# (_,tst) = ThreadTableStorage (\_ -> [thread:table]) tst // insert the new thread
# (table,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table
# (_,tst) = appTaskTSt (ThreadTableStorage (\_ -> [thread:table])) tst // insert the new thread
= tst
deleteThreads :: !TaskNr !*TSt -> *TSt
......@@ -491,17 +491,17 @@ deleteThreads tasknr tst // delete a thread and all its children
# mytasknr = reverse tasknr
| isNothing mbthread = deleteChildren mytasknr tst // no entry, but delete children
# (pos,_) = fromJust mbthread
# (_,tst) = ThreadTableStorage (\table -> removeAt pos table) tst // remove entry
# (_,tst) = appTaskTSt (ThreadTableStorage (\table -> removeAt pos table)) tst // remove entry
= deleteChildren mytasknr tst // and all children
where
deleteChildren mytasknr tst=:{staticInfo}
# (table,tst) = ThreadTableStorage id tst // read thread table
# (table,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table
# allChildsPos = [pos \\ entry <- table & pos <- [0..] | isChild mytasknr entry.thrTaskNr ]
| isEmpty allChildsPos = tst
# otherUsersThreads = [ ((table!!entry).thrUserId,(table!!entry).thrTaskNr) \\ entry <- allChildsPos | (table!!entry).thrUserId <> staticInfo.currentUserId]
# tst = administrateDeletedThreads otherUsersThreads tst
# table = deleteChilds (reverse (sort allChildsPos)) table // delete highest entries first !
# (table,tst) = ThreadTableStorage (\_ -> table) tst // read thread table
# (table,tst) = appTaskTSt (ThreadTableStorage (\_ -> table)) tst // read thread table
= tst
deleteChilds [] table = table
......@@ -520,7 +520,7 @@ administrateDeletedThreads [(user,tasknr):users] tst=:{hst}
findParentThread :: !TaskNr !*TSt -> *([TaskThread],*TSt) // finds parent thread closest to given set of task numbers
findParentThread tasknr tst
# (table,tst) = ThreadTableStorage id tst // read thread table
# (table,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table
| isEmpty table = ([], tst) // nothing in table, no parents
| length tasknr <= 1 = ([], tst) // no tasks left up
# revtasknr = reverse (tl tasknr) // not relevant
......@@ -613,10 +613,10 @@ deleteAllSubTasksAndThreads [tx:txs] tst
showThreadTable :: !*TSt -> (![HtmlTag],!*TSt) // watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
showThreadTable tst=:{staticInfo}
# thisUser = staticInfo.currentUserId
# (tableS,tst) = ThreadTableStorage id tst // read thread table from server
# (tableS,tst) = appTaskTSt (ThreadTableStorage id) tst // read thread table from server
# tableS = sortBy (\e1=:{thrTaskNr = t1} e2=:{thrTaskNr =t2} = t1 < t2) tableS
# (tableC,tst) = IF_ClientServer
(\tst -> ClientThreadTableStorage id tst) // read thread table from client
(\tst -> appTaskTSt (ClientThreadTableStorage id) tst) // read thread table from client
(\tst -> ([],tst)) tst
# tableC = sortBy (\e1=:{thrTaskNr = t1} e2=:{thrTaskNr =t2} = t1 < t2) tableC
......
......@@ -24,15 +24,15 @@ derive gParse Time
// monads for combining iTasks
(=>>) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iCreateAndPrint b
(=>>) taska taskb = mybind
(=>>) taska taskb = Task mybind
where
mybind tst=:{options}
# (a,tst=:{activated}) = taska tst
| activated = taskb a {tst & options = options}
= (createDefault,tst)
# (a,tst=:{activated}) = appTaskTSt taska tst
| activated = appTaskTSt (taskb a) {tst & options = options}
= (createDefault,tst)
return_V :: !a -> (Task a) | iCreateAndPrint a
return_V a = mkTask "return_V" dotask
return_V a = mkTask "return_V" (Task dotask)
where
dotask tst = (a,tst)
......@@ -41,14 +41,14 @@ where
// newTask needed for recursive task creation
newTask :: !String !(Task a) -> (Task a) | iData a
newTask taskname mytask = mkTask taskname newTask`
newTask taskname mytask = mkTask taskname (Task newTask`)
where
newTask` tst=:{tasknr,userId,options}
# taskId = iTaskId userId tasknr taskname
# (taskval,tst) = liftHst (mkStoreForm (Init,storageFormId options taskId (False,createDefault)) id) tst // remember if the task has been done
# (taskdone,taskvalue) = taskval.Form.value // select values
| taskdone = (taskvalue,tst) // if rewritten return stored value
# (val,tst=:{activated}) = mytask {tst & tasknr = [-1:tasknr]} // do task, first shift tasknr
# (val,tst=:{activated}) = appTaskTSt mytask {tst & tasknr = [-1:tasknr]} // do task, first shift tasknr
| not activated = (createDefault,{tst & tasknr = tasknr, options = options}) // subtask not ready, return value of subtasks
# tst = deleteSubTasksAndThreads tasknr tst // task ready, garbage collect it
# (_,tst) = liftHst (mkStoreForm (Init,storageFormId options taskId (False,createDefault)) (\_ -> (True,val))) tst // remember if the task has been done
......@@ -56,14 +56,14 @@ where
Once :: !String !(Task a) -> (Task a) | iData a
Once label task = mkTask label doit
Once label task = mkTask label (Task doit)
where
doit tst=:{activated,html,tasknr,hst,userId,options}
# taskId = iTaskId userId tasknr (label +++ "_")
# (store,hst) = mkStoreForm (Init,storageFormId options taskId (False,createDefault)) id hst
# (done,value) = store.Form.value
| done = (value,{tst & hst = hst}) // if task has completed, don't do it again
# (value,tst=:{hst})= task {tst & hst = hst}
# (value,tst=:{hst})= appTaskTSt task {tst & hst = hst}
# (store,hst) = mkStoreForm (Init,storageFormId options taskId (False,createDefault)) (\_ -> (True,value)) hst // remember task status for next time
# (done,value) = store.Form.value
= (value,{tst & activated = done, hst = hst}) // task is now completed, handle as previously
......@@ -75,16 +75,16 @@ where
// otherwise, when task finshed it will remember the new tasknr to prevent checking of previously finished tasks
foreverTask :: !(Task a) -> Task a | iData a
foreverTask task = mkTask "foreverTask" foreverTask`
foreverTask task = mkTask "foreverTask" (Task foreverTask`)
where
foreverTask` tst=:{tasknr,activated,userId,options,html}
| options.gc == Collect // garbace collect everything when task finsihed
# (val,tst=:{activated})= task {tst & tasknr = [-1:tasknr]} // shift tasknr
# (val,tst=:{activated})= appTaskTSt task {tst & tasknr = [-1:tasknr]} // shift tasknr
| activated = foreverTask` (deleteSubTasksAndThreads tasknr {tst & tasknr = tasknr, options = options, html = html}) // loop
= (val,tst)
# taskId = iTaskId userId tasknr "ForSt" // create store id
# (currtasknr,tst) = liftHst (mkStoreForm (Init,storageFormId options taskId tasknr) id) tst // fetch actual tasknr
# (val,tst=:{activated}) = task {tst & tasknr = [-1:currtasknr.Form.value]}
# (val,tst=:{activated}) = appTaskTSt task {tst & tasknr = [-1:currtasknr.Form.value]}
| activated // task is completed
# ntasknr = incNr currtasknr.Form.value // incr tasknr
# (currtasknr,tst) = liftHst (mkStoreForm (Init,storageFormId options taskId tasknr) (\_ -> ntasknr)) tst // store next task nr
......@@ -92,10 +92,10 @@ where
= (val,tst)
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a
(<!) taska pred = mkTask "less!" doTask
(<!) taska pred = mkTask "less!" (Task doTask)
where
doTask tst=:{activated, tasknr}
# (a,tst=:{activated}) = taska {tst & tasknr = [-1:tasknr]}
# (a,tst=:{activated}) = appTaskTSt taska {tst & tasknr = [-1:tasknr]}
| not activated = (a,tst)
| not (pred a)
# tst = deleteSubTasksAndThreads [0:tasknr] tst
......@@ -107,13 +107,13 @@ where
// Assigning tasks to users, each user has to be identified by an unique number >= 0
assignTaskTo :: !UserId !(LabeledTask a) -> Task a | iData a
assignTaskTo nuserId (taskname,taska) = assignTaskTo`
assignTaskTo nuserId (taskname,taska) = Task assignTaskTo`
where
assignTaskTo` tst=:{html=ohtml,tasknr,activated,userId,workflowLink=(_,(_,processNr,workflowLabel))}
| not activated = (createDefault,tst)
# (currtime,tst) = appWorldOnce ("Task: " +++ taskname +++ " For: " +++ toString nuserId) time tst
# (currtime,tst) = appTaskTSt (appWorldOnce ("Task: " +++ taskname +++ " For: " +++ toString nuserId) time) 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
# (a,tst=:{html=nhtml,activated}) = appTaskTSt (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
......@@ -134,7 +134,7 @@ where
seqTasks :: ![LabeledTask a] -> (Task [a])| iCreateAndPrint a
seqTasks [(label,task)] = task =>> \na -> return_V [na]
seqTasks options = mkTask "seqTasks" seqTasks`
seqTasks options = mkTask "seqTasks" (Task seqTasks`)
where
seqTasks` tst=:{tasknr}
# (val,tst) = doseqTasks options [] {tst & tasknr = [-1:tasknr]}
......@@ -143,7 +143,7 @@ where
doseqTasks [] accu tst = (reverse accu,{tst & activated = True})
doseqTasks [(taskname,task):ts] accu tst=:{html,options}
# (a,tst=:{activated=adone,html=ahtml})
= task {tst & activated = True, html = BT [] []}
= appTaskTSt task {tst & activated = True, html = BT [] []}
| not adone = (reverse accu,{tst & html = html +|+ BT [showLabel taskname,BrTag [] ,BrTag []] [] +|+ ahtml})
= doseqTasks ts [a:accu] {tst & html = html +|+ ahtml, options = options}
......@@ -163,7 +163,7 @@ where
allTasksCond :: !String !(TasksToShow a) !(FinishPred a) ![LabeledTask a] -> Task [a] | iData a
allTasksCond label chooser pred taskCollection
= mkTask "andTasksCond" (doandTasks chooser taskCollection)
= mkTask "andTasksCond" (Task (doandTasks chooser taskCollection))
where
lengthltask = length taskCollection
......@@ -185,7 +185,7 @@ 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}) = mkParSubTask label chosen chosenTask {tst & tasknr = tasknr, activated = True, html = BT [] []}
# (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})
......@@ -195,7 +195,7 @@ where
| ctasknr == length taskCollection = ((reverse alist,reverse acode),{tst & activated = bool}) // all tasks tested
# (taskname,task) = taskCollection!!ctasknr
# (a,tst=:{activated = adone,html=html})
= mkParSubTask traceid ctasknr task {tst & tasknr = tasknr, activated = True, html = BT [] []} // check tasks
= 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}
......@@ -218,71 +218,71 @@ closureLZTask :: Same, but now the original task will not be done unless someone
*/
(-!>) infix 4 :: (Task s) (Task a) -> (Task (Maybe s,TCl a)) | iCreateAndPrint s & iCreateAndPrint a
(-!>) stoptask task = mkTask "-!>" stop`
(-!>) stoptask task = mkTask "-!>" (Task stop`)
where
stop` tst=:{tasknr,html,options,userId}
# (val,tst=:{activated = taskdone,html = taskhtml}) = task {tst & activated = True, html = BT [] [], tasknr = normalTaskId,options = options}
# (s, tst=:{activated = stopped, html = stophtml}) = stoptask {tst & activated = True, html = BT [] [], tasknr = stopTaskId, options = options}
| stopped = return_V (Just s, TCl (close task)) {tst & html = html, activated = True}
| taskdone = return_V (Nothing,TCl (return_V val)) {tst & html = html +|+ taskhtml, activated = True}
= return_V (Nothing,TCl (return_V val)) {tst & html = html +|+ taskhtml +|+ stophtml, activated = False}
# (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}
where
close t = \tst -> t {tst & tasknr = normalTaskId, options = options, userId = userId} // reset userId because it influences the task id
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 name task = mkTask "channel" (doSplit name task)