Commit eb5b6fba authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

trace information is now part of the html task tree

some operators do not store the information as they should


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@296 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 99741333
......@@ -11,11 +11,11 @@ import iDataForms, iDataState
*/
handleProcessTableRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleProcessTableRequest mainTask request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeTrace, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# processTable = if (isNothing maybeProcessTable) [] (fromJust maybeProcessTable)
# content = toString (DivTag [IdAttr "itasks-processtable", ClassAttr "trace"] processTable)
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# processTable = if (isNothing maybeProcessTable) [] (fromJust maybeProcessTable)
# content = toString (DivTag [IdAttr "itasks-processtable", ClassAttr "trace"] processTable)
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
......@@ -12,11 +12,11 @@ import iDataForms, iDataState
*/
handleTaskTreeForestRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleTaskTreeForestRequest mainTask request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeTrace, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# taskTreeTrace = showTaskTree maybeTrace // TEMP fix to show taskTree
# content = toString (DivTag [IdAttr "itasks-tasktreeforest",ClassAttr "trace"] [taskTreeTrace])
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# taskTreeTrace = filterTaskTree htmlTree // calculate Task Tree
# content = toString (DivTag [IdAttr "itasks-tasktreeforest",ClassAttr "trace"] [taskTreeTrace])
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
......@@ -11,9 +11,9 @@ import iDataForms, iDataState
*/
handleThreadTableRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleThreadTableRequest mainTask request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeTrace, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# threadTable = if (isNothing maybeThreadTable) [] (fromJust maybeThreadTable)
# content = toString (DivTag [IdAttr "itasks-threadtable", ClassAttr "trace"] threadTable) // create tab data record
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst)
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# threadTable = if (isNothing maybeThreadTable) [] (fromJust maybeThreadTable)
# content = toString (DivTag [IdAttr "itasks-threadtable", ClassAttr "trace"] threadTable) // create tab data record
= ({http_emptyResponse & rsp_data = content}, hst) // create the http response
......@@ -21,7 +21,7 @@ derive JSONEncode WorkListItem, TaskPriority
handleWorkListRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse, !*HSt) | iData a
handleWorkListRequest mainTask request session hst
# thisUserId = session.Session.userId
# (toServer, htmlTree, maybeError, maybeTrace, maybeProcessTable, maybeThreadTable,hst)
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable,hst)
= calculateTaskTree thisUserId False False False mainTask hst // Calculate the TaskTree given the id of the current user
# worklist = [ { taskid = mytaskdescr.taskNrId
, delegator = toString mytaskdescr.delegatorId
......
......@@ -27,7 +27,7 @@ handleWorkTabRequest :: !(Task a) !HTTPRequest !Session *HSt -> (!HTTPResponse,
handleWorkTabRequest mainTask request session hst
# thisUserId = session.Session.userId // fetch user id from the session
# taskId = http_getValue "taskid" request.arg_get "error" // fetch task id of the tab selecetd
# (toServer, htmlTree, maybeError, maybeTrace, maybeProcessTable, maybeThreadTable, hst =:{states,world})
# (toServer, htmlTree, maybeError, maybeProcessTable, maybeThreadTable, hst =:{states,world})
= calculateTaskTree thisUserId True True True mainTask hst // calculate the TaskTree given the id of the current user
# (taskDone,html,inputs) = determineTaskForTab thisUserId taskId htmlTree // filter out the code and inputs to display in this tab
# (htmlstates,states) = getHtmlStates states // Collect states that must be temporarily stored in the browser
......@@ -36,7 +36,7 @@ handleWorkTabRequest mainTask request session hst
//Tracing
# (stateTrace,states) = mbStateTrace request states
# (updateTrace,states) = mbUpdateTrace request states
# subTreeTrace = mbSubTreeTrace request taskId maybeTrace
# subTreeTrace = mbSubTreeTrace request thisUserId taskId htmlTree
# activeTasks = if taskDone
(Just [ mytaskdescr.taskNrId
......@@ -71,9 +71,9 @@ where
= (Just (toString trace), states)
| otherwise
= (Nothing, states)
mbSubTreeTrace req taskId maybeTrace
mbSubTreeTrace req thisUserId taskId htmlTree
| http_getValue "traceSubTrees" req.arg_get "" == "1"
= Just (toString (showTaskTreeOfTask taskId maybeTrace))
= Just (toString (filterTaskTreeOfTask thisUserId taskId htmlTree))
| otherwise
= Nothing
......@@ -34,8 +34,6 @@ mkParSubTask :: create a subtask with indicated task nr
iTaskId :: generate an id based on the task nr, important for garbage collection and family relation
showTaskNr :: for identifier generation
deleteAllSubTasks :: collects all related tasks
printTrace2 :: show task tree trace
*/
incNr :: !TaskNr -> TaskNr
......
......@@ -62,11 +62,12 @@ mkTaskNoInc :: !String !(Task a) -> (Task a) | iCreateAndPrint a // common sec
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}) = appTaskTSt 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,html}) = 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
| options.trace || taskname == "" = (val,tst) // no trace, just return value
# tst = {tst & html = TaskTrace {trTaskNr = tasknr, trTaskName = taskname, trActivated = activated, trUserId = userId, trValue = printToString val, trOptions = options} html}
= (val,tst)
mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed
mkParSubTask name i task = Task mkParSubTask`
......@@ -77,46 +78,6 @@ where
where
mysubtask tst=:{tasknr} = appTaskTSt task {tst & tasknr = [-1:tasknr], activated = True} // shift once again!
// ******************************************************************************************************
// Trace Insertion ...
// ******************************************************************************************************
InsertTrace :: !Bool !TaskNr !Int !Options String !String ![Trace] -> [Trace]
InsertTrace finished idx who options taskname val trace = InsertTrace` ridx who val trace
where
InsertTrace` :: !TaskNr !Int !String ![Trace] -> [Trace]
InsertTrace` [i] who str traces
| i < 0 = abort ("negative task numbers:" <+++ showTaskNr idx <+++ "," <+++ who <+++ "," <+++ taskname)
# (Trace _ itraces) = select i traces
= updateAt` i (Trace (Just (finished,(who,show,options,taskname,str))) itraces) traces
InsertTrace` [i:is] who str traces
| i < 0 = abort ("negative task numbers:" <+++ showTaskNr idx <+++ "," <+++ who <+++ "," <+++ taskname)
# (Trace ni itraces) = select i traces
# nistraces = InsertTrace` is who str itraces
= updateAt` i (Trace ni nistraces) traces
select :: !Int ![Trace] -> Trace
select i list
| i < length list = list!!i
= Trace Nothing []
show = idx //showTaskNr idx
ridx = reverse idx
updateAt`:: !Int !Trace ![Trace] -> [Trace]
updateAt` n x list
| n < 0 = abort "negative numbers not allowed"
= updateAt` n x list
where
updateAt`:: !Int !Trace ![Trace] -> [Trace]
updateAt` 0 x [] = [x]
updateAt` 0 x [y:ys] = [x:ys]
updateAt` n x [] = [Trace Nothing [] : updateAt` (n-1) x []]
updateAt` n x [y:ys] = [y : updateAt` (n-1) x ys]
// ******************************************************************************************************
// iTask Storage Utilities
// ******************************************************************************************************
......
......@@ -133,7 +133,7 @@ where
// Watch it: the Client cannot create new Server threads
startAjaxApplication :: !Int !GlobalInfo !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),!*TSt) // determines which threads to execute and calls them..
startAjaxApplication thisUser versioninfo maintask tst=:{tasknr,options,html,trace,userId}
startAjaxApplication thisUser versioninfo maintask tst=:{tasknr,options,html,userId}
# tst = copyThreadTableFromClient versioninfo tst // synchronize thread tables of client and server, if applicable
// first determine whether we should start calculating the task tree from scratch starting at the root
......@@ -377,25 +377,26 @@ where
ServerThreadTableStorage:: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ServerThreadTableStorage fun = Task handleTable
where
handleTable tst=:{staticInfo} = appTaskTSt (ThreadTableStorageGen serverThreadTableId staticInfo.threadTableLoc fun) tst
handleTable tst=:{staticInfo,options} = appTaskTSt (ThreadTableStorageGen serverThreadTableId staticInfo.threadTableLoc options.trace fun) tst
serverThreadTableId = "Application" +++ "-ThreadTable"
ClientThreadTableStorage:: !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ClientThreadTableStorage fun = Task handleTable
where
handleTable tst=:{staticInfo} = appTaskTSt (ThreadTableStorageGen (clientThreadTableId staticInfo.currentUserId) LSClient fun) tst
handleTable tst=:{staticInfo,options} = appTaskTSt (ThreadTableStorageGen (clientThreadTableId staticInfo.currentUserId) LSClient options.trace 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 = Task handleTable // to handle the table on server as well as on client
ThreadTableStorageGen :: !String !Lifespan !Bool !(ThreadTable -> ThreadTable) -> (Task ThreadTable) // used to store Tasknr of callbackfunctions / threads
ThreadTableStorageGen tableid lifespan trace fun = Task handleTable // to handle the table on server as well as on client
where
handleTable tst
# (table,tst) = liftHst (mkStoreForm (Init,storageFormId
{ tasklife = lifespan
, taskstorage = PlainString
, taskmode = NoForm
, trace = trace
, gc = Collect} tableid []) fun) tst
= (table.Form.value,tst)
......
......@@ -27,9 +27,9 @@ derive gParse Time
(=>>) taska taskb = Task mybind
where
mybind tst=:{options}
# (a,tst=:{activated}) = appTaskTSt taska tst
| activated = appTaskTSt (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" (Task dotask)
......@@ -46,11 +46,11 @@ 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
# (taskdone,taskvalue) = taskval.Form.value // select values
| taskdone = (taskvalue,tst) // if rewritten return stored value
# (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 = 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
= (val,{tst & tasknr = tasknr, options = options})
......@@ -113,7 +113,7 @@ where
| not activated = (createDefault,tst)
# (currtime,tst) = appTaskTSt (appWorldOnce ("Task: " +++ taskname +++ " For: " +++ toString nuserId) time) tst
# tst = IF_Ajax (administrateNewThread userId tst) tst
# (a,tst=:{html=nhtml,activated}) = appTaskTSt (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 NEWTRACE
| activated = (a,{tst & activated = True // work is done
, userId = userId // restore previous user id
, html = ohtml }) // plus new one tagged
......
......@@ -28,7 +28,7 @@ where
doTask tst=:{html=ohtml,activated}
| not activated = (createDefault,tst)
# (a,tst=:{activated,html=nhtml}) = appTaskTSt task {tst & html = BT [] []}
| activated = (a,{tst & html = ohtml})
| activated = (a,{tst & html = ohtml +|+ nhtml}) // NEWTRACE
= (a,{tst & html = ohtml +|+ BT prompt [] +|+ nhtml})
(<<?) infixl 5 :: !(Task a) ![HtmlTag] -> Task a | iCreate a
......@@ -37,7 +37,7 @@ where
doTask tst=:{html=ohtml,activated}
| not activated = (createDefault,tst)
# (a,tst=:{activated,html=nhtml}) = appTaskTSt task {tst & html = BT [] []}
| activated = (a,{tst & html = ohtml})
| activated = (a,{tst & html = ohtml +|+ nhtml}) // NEWTRACE
= (a,{tst & html = ohtml +|+ nhtml +|+ BT prompt []})
(!>>) infixr 5 :: ![HtmlTag] !(Task a) -> (Task a) | iCreate a
......
......@@ -15,7 +15,6 @@ import HSt
, staticInfo :: !StaticInfo // info which does not change during a run
, html :: !HtmlTree // accumulator for html code
, options :: !Options // iData lifespan and storage format
, trace :: !Maybe [Trace] // for displaying task trace
, hst :: !HSt // iData state
}
......@@ -33,6 +32,7 @@ import HSt
, taskstorage :: !StorageFormat // default: PlainString
, taskmode :: !Mode // default: Edit
, gc :: !GarbageCollect // default: Collect
, trace :: !Bool // default: False
}
:: GarbageCollect
= Collect // garbage collect iTask administration
......@@ -44,11 +44,15 @@ import HSt
| (+-+) infixl 1 !HtmlTree !HtmlTree // code to be placed next to each other
| (+|+) infixl 1 !HtmlTree !HtmlTree // code to be placed below each other
| DivCode !String !HtmlTree // code that should be labeled with a div, used for Ajax and Client technology
| TaskTrace TraceInfo !HtmlTree // trace information used for displaying the task tree
// Trace information
:: Trace = Trace !TraceInfo ![Trace] // traceinfo with possibly subprocess
:: TraceInfo :== Maybe (!Bool,!(!UserId,!TaskNr,!Options,!String,!String)) // Task finished? who did it, task nr, task name (for tracing) value produced
:: TraceInfo = { trTaskNr :: !TaskNr // tasknr
, trTaskName :: !String // name of the combinator
, trActivated :: !Bool // is the task finshed or not
, trUserId :: !UserId // who is performing the task (can also be determined from the contect)
, trValue :: !String // what is the current value of task (serialized to string)
, trOptions :: !Options // options of this task
}
// Task meta information
:: TaskDescription
......
......@@ -12,7 +12,6 @@ mkTst thisUser itaskstorage threadstorage hst
, userId = if (thisUser >= 0) defaultUser thisUser
, workflowLink = (0,(defaultUser,0,defaultWorkflowName))
, html = BT [] []
, trace = Just []
, hst = hst
, options = initialOptions thisUser itaskstorage
}
......@@ -29,6 +28,7 @@ initialOptions thisUser location
, taskstorage = PlainString
, taskmode = Edit
, gc = Collect
, trace = False
}
......
......@@ -9,4 +9,4 @@ definition module TaskTree
import iTasksTypes
calculateTaskTree :: !UserId !Bool !Bool !Bool !(Task a) !*HSt
-> (!Bool,!HtmlTree,!Maybe String,!Maybe [Trace],!Maybe [HtmlTag],!Maybe [HtmlTag],!*HSt) | iData a
-> (!Bool,!HtmlTree,!Maybe String,!Maybe [HtmlTag],!Maybe [HtmlTag],!*HSt) | iData a
......@@ -14,7 +14,7 @@ import iTasksProcessHandling
import TSt
calculateTaskTree :: !UserId !Bool !Bool !Bool !(Task a) !*HSt
-> (!Bool,!HtmlTree,!Maybe String,!Maybe [Trace],!Maybe [HtmlTag],!Maybe [HtmlTag],!*HSt) | iData a
-> (!Bool,!HtmlTree,!Maybe String,!Maybe [HtmlTag],!Maybe [HtmlTag],!*HSt) | iData a
calculateTaskTree thisUser traceOn showProcessTable showCurrThreadTable mainTask hst
# (pversion,hst) = setPUserNr thisUser id hst // fetch global settings of this user
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{activated})
......@@ -22,7 +22,7 @@ calculateTaskTree thisUser traceOn showProcessTable showCurrThreadTable mainTask
# (processTable,tst)
= if showProcessTable (showWorkflows activated {tst & activated = activated}) ([],{tst & activated = activated})
# (threadTable,tst=:{html,hst,trace,activated})
# (threadTable,tst=:{html,hst,activated})
= if showCurrThreadTable (showThreadTable {tst & activated = activated}) ([],{tst & activated = activated})
# showCompletePage = IF_Ajax (hd threads == [-1]) True
= (toServer,html,Nothing,trace,if showProcessTable (Just processTable) Nothing,if showCurrThreadTable (Just threadTable) Nothing,hst)
\ No newline at end of file
= (toServer,html,Nothing,if showProcessTable (Just processTable) Nothing,if showCurrThreadTable (Just threadTable) Nothing,hst)
\ No newline at end of file
......@@ -2,14 +2,13 @@ definition module TaskTreeFilters
import iTasksTypes
determineTaskList :: !UserId !HtmlTree -> [TaskDescription]
determineTaskForTab :: !UserId !TaskNrId !HtmlTree -> (!Bool,![HtmlTag],![InputId])
determineTaskList :: !UserId !HtmlTree -> [TaskDescription]
determineTaskForTab :: !UserId !TaskNrId !HtmlTree -> (!Bool,![HtmlTag],![InputId])
mkFilteredTaskTree :: !UserId !UserId !HtmlTree -> (![HtmlTag],![InputId])
mkUnfilteredTaskTree :: !HtmlTree -> (![HtmlTag],![InputId])
mkFilteredTaskTree :: !UserId !UserId !HtmlTree -> (![HtmlTag],![InputId])
mkUnfilteredTaskTree :: !HtmlTree -> (![HtmlTag],![InputId])
filterTaskTree :: !HtmlTree -> HtmlTag
filterTaskTreeOfTask :: !UserId !TaskNrId !HtmlTree -> HtmlTag
//TODO: merge trace information into the task tree
showTaskTreeOfTask :: !TaskNrId !(Maybe [Trace]) -> HtmlTag
showTaskTree :: !(Maybe [Trace]) -> HtmlTag
......@@ -23,6 +23,8 @@ determineTaskList thisuser (BT html inputs)
= []
determineTaskList thisuser (DivCode id tree)
= determineTaskList thisuser tree
determineTaskList thisuser (TaskTrace traceinfo tree)
= determineTaskList thisuser tree
determineTaskForTab :: !UserId !TaskNrId !HtmlTree -> (!Bool,![HtmlTag],![InputId])
determineTaskForTab thisuser thistaskid tree
......@@ -52,6 +54,8 @@ determineTaskTree thisuser thistaskid (BT bdtg inputs)
= Nothing
determineTaskTree thisuser thistaskid (DivCode id tree)
= determineTaskTree thisuser thistaskid tree
determineTaskTree thisuser thistaskid (TaskTrace traceinfo tree)
= determineTaskTree thisuser thistaskid tree
mkFilteredTaskTree :: !UserId !UserId !HtmlTree -> (![HtmlTag],![InputId])
mkFilteredTaskTree thisuser taskuser (description @@: tree)
......@@ -77,78 +81,119 @@ mkFilteredTaskTree thisuser taskuser (DivCode id tree)
# (html,inputs) = mkFilteredTaskTree thisuser taskuser tree
| thisuser == taskuser = ([DivTag [IdAttr id, ClassAttr "itasks-thread"] html],inputs)
| otherwise = ([],[])
mkFilteredTaskTree thisuser taskuser (TaskTrace traceinfo tree)
# (html,inputs) = mkFilteredTaskTree thisuser taskuser tree
| thisuser == taskuser = (html,inputs)
| otherwise = ([],[])
mkUnfilteredTaskTree :: !HtmlTree -> (![HtmlTag],![InputId])
mkUnfilteredTaskTree (BT body inputs) = (body, inputs)
mkUnfilteredTaskTree (_ @@: html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (_ -@: html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (DivCode str html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (nodeL +-+ nodeR) = ([htmlL <=> htmlR],inpL ++ inpR)
mkUnfilteredTaskTree (BT body inputs) = (body, inputs)
mkUnfilteredTaskTree (_ @@: html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (_ -@: html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (DivCode str html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (TaskTrace traceinfo html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (nodeL +-+ nodeR) = ([htmlL <=> htmlR],inpL ++ inpR)
where
(htmlL,inpL) = mkUnfilteredTaskTree nodeL
(htmlR,inpR) = mkUnfilteredTaskTree nodeR
mkUnfilteredTaskTree (nodeL +|+ nodeR) = (htmlL <|.|> htmlR, inpL ++ inpR)
mkUnfilteredTaskTree (nodeL +|+ nodeR) = (htmlL <|.|> htmlR, inpL ++ inpR)
where
(htmlL,inpL) = mkUnfilteredTaskTree nodeL
(htmlR,inpR) = mkUnfilteredTaskTree nodeR
// ******************************************************************************************************
// Trace Printing ...
// Trace Calculation
// ******************************************************************************************************
showTaskTreeOfTask :: !TaskNrId !(Maybe [Trace]) -> HtmlTag // This can be done much more efficiently, taken the ordening of tasknrs into account
showTaskTreeOfTask tasknr Nothing = Text ("Tracing enabled, cannot determine task tree of task " +++ tasknr)
showTaskTreeOfTask tasknr (Just []) = Text ("Cannot find task tree of task " +++ tasknr)
showTaskTreeOfTask tasknr (Just trace) = showTaskTree (snd (findTaskInTrace tasknr trace))
findTaskInTrace :: !TaskNrId ![Trace] -> (!Bool,!Maybe [Trace])
findTaskInTrace tasknr []
= (False, Just [])
findTaskInTrace tasknr mytrace=:[Trace Nothing traces:mtraces]
# (found,tags) = findTaskInTrace tasknr traces
| found = (found,tags)
= findTaskInTrace tasknr mtraces
findTaskInTrace tasknr mytrace=:[Trace (Just (dtask,(w,i,op,tn,s))) traces:mtraces]
| showTaskNr (repair i) == tasknr = (True, Just mytrace)
# (found,tags) = findTaskInTrace tasknr traces
| found = (found,tags)
= findTaskInTrace tasknr mtraces
:: Trace = Trace !(Maybe !TraceInfo) ![Trace] // traceinfo with possibly subprocess
filterTaskTree :: !HtmlTree -> HtmlTag
filterTaskTree html
# traceInfos = collectTraceInfo html
# traces = insertTraces traceInfos []
= showTaskTree (Just traces)
where
repair [0:tnrs] = [-1:tnrs] // The task numbers obtained from client are one to low: this has to be made global consistent, very ughly
repair other = other
collectTraceInfo :: !HtmlTree -> [TraceInfo]
collectTraceInfo (TaskTrace traceinfo html) = [traceinfo : collectTraceInfo html]
collectTraceInfo (BT body inputs) = []
collectTraceInfo (_ @@: html) = collectTraceInfo html
collectTraceInfo (_ -@: html) = collectTraceInfo html
collectTraceInfo (DivCode str html) = collectTraceInfo html
collectTraceInfo (nodeL +-+ nodeR) = traceLeft ++ traceRight
where
traceLeft = collectTraceInfo nodeL
traceRight = collectTraceInfo nodeR
collectTraceInfo (nodeL +|+ nodeR) = traceLeft ++ traceRight
where
traceLeft = collectTraceInfo nodeL
traceRight = collectTraceInfo nodeR
insertTraces [] traces = traces
insertTraces [i:is] traces = insertTraces is (insertTrace i traces)
filterTaskTreeOfTask :: !UserId !TaskNrId !HtmlTree -> HtmlTag
filterTaskTreeOfTask userId taskNrId tree
# mbtree = determineTaskTree userId taskNrId tree
| isNothing mbtree = Text "Error: Cannot find task tree !"
= filterTaskTree (fromJust mbtree)
insertTrace :: !TraceInfo ![Trace] -> [Trace]
insertTrace info trace = insertTrace` (reverse info.trTaskNr) trace
where
insertTrace` :: !TaskNr ![Trace] -> [Trace]
insertTrace` [i] traces
| i < 0 = abort ("negative task numbers:" <+++ showTaskNr info.trTaskNr <+++ "," <+++ info.trUserId <+++ "," <+++ info.trTaskName)
# (Trace _ itraces) = select i traces
= updateAt` i (Trace (Just info) itraces) traces
insertTrace` [i:is] traces
| i < 0 = abort ("negative task numbers:" <+++ showTaskNr info.trTaskNr <+++ "," <+++ info.trUserId <+++ "," <+++ info.trTaskName)
# (Trace ni itraces) = select i traces
# nistraces = insertTrace` is itraces
= updateAt` i (Trace ni nistraces) traces
select :: !Int ![Trace] -> Trace
select i list
| i < length list = list!!i
= Trace Nothing []
updateAt`:: !Int !Trace ![Trace] -> [Trace]
updateAt` n x list
| n < 0 = abort "negative numbers not allowed"
= updateAt` n x list
where
updateAt`:: !Int !Trace ![Trace] -> [Trace]
updateAt` 0 x [] = [x]
updateAt` 0 x [y:ys] = [x:ys]
updateAt` n x [] = [Trace Nothing [] : updateAt` (n-1) x []]
updateAt` n x [y:ys] = [y : updateAt` (n-1) x ys]
showTaskTree :: !(Maybe [Trace]) -> HtmlTag
showTaskTree Nothing = Text "No task tree trace " // SpanTag [] []
showTaskTree Nothing = Text "No task tree trace "
showTaskTree (Just a) = DivTag [] [showLabel "Task Tree Forest:", BrTag [] , STable emptyBackground (print False a),HrTag []]
where
print _ [] = []
print b trace = [pr b x ++ [STable emptyBackground (print (isDone x||b) xs)]\\ (Trace x xs) <- trace]
pr _ Nothing = []
pr dprev (Just (dtask,(w,i,op,tn,s)))
| dprev && (not dtask) = pr False Nothing // subtask not important anymore (assume no milestone tasks)
| not dtask && tn%(0,4) == "Ajax " = showTask cellattr1b White Navy Aqua Silver (w,i,op,tn,s)
| not dtask && tn%(0,6) == "Server " = showTask cellattr1b White Navy Aqua Silver (w,i,op,tn,s)
| not dtask && tn%(0,6) == "Client " = showTask cellattr1b White Navy Aqua Silver (w,i,op,tn,s)
| not dtask = showTask cellattr1b White Navy Maroon Silver (w,i,op,tn,s)
= showTask cellattr1a White Yellow Red White (w,i,op,tn,s)
pr dprev (Just info=:{trTaskName, trActivated})
| dprev && (not trActivated) = pr False Nothing // subtask not important anymore (assume no milestone tasks)
| not trActivated && trTaskName%(0,4) == "Ajax " = showTask cellattr1b White Navy Aqua Silver info