Commit a9156c2f authored by Bas Lijnse's avatar Bas Lijnse

Large refactoring including the following:

- New process/task forest calculation mechanism
- Moved several task operations to new task combinator modules
- Small bugfixes in the javascript client framework
- Started on new more explicit task tree datastructure

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@367 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 352242e0
......@@ -216,6 +216,7 @@ div.worktab .Trace {
padding-right:0;
}
/* TRACE STYLES */
div.trace {
border: #ccc 2px solid;
padding: 5px;
......@@ -235,6 +236,39 @@ div.trace th {
padding: 2px;
}
div.trace-node {
width: 150px;
border: solid 1px #666;
color: #666;
font-size: smaller;
margin-bottom: 5px;
}
div.trace-sequence {
border: 1px dotted #000;
padding: 5px;
}
div.trace-parallel {
text-align: center;
}
div.trace-node-title {
background-color: #666;
color: #fff;
padding: 2px;
text-align: center;
}
div.trace-node-active {
border-color: #000;
color: #000;
}
div.trace-node-active div.trace-node-title {
background-color: #000;
}
div.trace-node th {
width: 75px;
}
/* WELCOME SCREEN STYLES */
#welcome {
background: url('../img/welcome/bg.png') top repeat-x;
......
......@@ -49,6 +49,7 @@ itasks.NewWorkPanel = Ext.extend(Ext.Panel, {
var num = data.length;
for(var i = 0; i < num; i++) {
var name = data[i].name;
var label = data[i].label;
var icon = data[i].icon;
......@@ -58,9 +59,9 @@ itasks.NewWorkPanel = Ext.extend(Ext.Panel, {
//Attach click handler
li.on('click', function(el,evt,options) {
this.startWork(options.flowLabel);
this.startWork(options.flowName);
},this,{flowLabel : label});
},this,{flowName : name});
}
}
},
......
......@@ -42,7 +42,7 @@ itasks.ProcessTableTabPanel = Ext.extend(Ext.Panel, {
},
refresh: function() {
Ext.Ajax.request({
method: 'GET',
method: 'POST',
url: 'handlers/debug/processtable',
params: this.applicationPanel.addSessionParam({}),
callback: this.processResponse,
......
......@@ -42,7 +42,7 @@ itasks.TaskForestTabPanel = Ext.extend(Ext.Panel, {
},
refresh: function() {
Ext.Ajax.request({
method: 'GET',
method: 'POST',
url: 'handlers/debug/tasktreeforest',
params: this.applicationPanel.addSessionParam({}),
callback: this.processResponse,
......
......@@ -42,7 +42,7 @@ itasks.ThreadTableTabPanel = Ext.extend(Ext.Panel, {
},
refresh: function() {
Ext.Ajax.request({
method: 'GET',
method: 'POST',
url: 'handlers/debug/threadtable',
params: this.applicationPanel.addSessionParam({}),
callback: this.processResponse,
......
......@@ -152,10 +152,10 @@ itasks.WorkTabPanel = Ext.extend(Ext.Panel, {
if (data.error != null) {
this.autoClose(this.makeErrorMessage(data.error), 5);
} else if(data.status == 'TaskFinished') { //Check if the task is done
//this.fireEvent('taskfinished', this.id); //TEMPORARY
this.fireEvent('taskfinished', this.taskinfo.taskid);
this.autoClose(this.makeFinishedMessage(), 5);
} else if(data.status == 'TaskDeleted') {
this.fireEvent('taskdeleted', this.id);
this.fireEvent('taskdeleted', this.taskinfo.taskid);
this.autoClose(this.makeDeletedMessage(), 5);
} else {
//Fill the content and trace panels
......@@ -163,9 +163,6 @@ itasks.WorkTabPanel = Ext.extend(Ext.Panel, {
this.setupTracePanels(trace, data);
}
//TEMPORARY
this.fireEvent('taskfinished', this.id);
//Hide the current content panel and switch to new content
this.switchContentPanels(trace);
......@@ -441,7 +438,7 @@ itasks.WorkTabPanel = Ext.extend(Ext.Panel, {
//Send the data to the server
Ext.Ajax.request({
url: 'handlers/work/tab?taskid=' + this.id,
url: 'handlers/work/tab?taskid=' + this.taskinfo.taskid,
method: "POST",
params: params,
scripts: false,
......
......@@ -19,12 +19,15 @@ itasks.WorkTabsPanel = Ext.extend(Ext.TabPanel, {
*/
openWorkTab: function (taskid, taskinfo) {
//Id is prefixed with the string "worktab-"
var id = "worktab-" + taskid;
//Try to find an existing tab with the same id
var tab = this.getComponent(taskid);
var tab = this.getComponent(id);
if(tab == undefined) {
//Create new tab
tab = new itasks.WorkTabPanel({id: taskid, taskinfo: taskinfo});
tab = new itasks.WorkTabPanel({id: id, taskinfo: taskinfo});
//Add new tab
this.add(tab);
this.activate(tab);
......
......@@ -12,7 +12,7 @@ module bid
* - A confirmation is sent to the selected supplier
*/
import StdEnv, StdiTasks
import StdEnv, StdiTasks, iData
derive gForm []
derive gUpd []
......@@ -23,7 +23,14 @@ UID_SUPPLIER2 = 2
UID_SUPPLIER3 = 3
Start :: *World -> *World
Start world = startTaskEngine ("Purchase product", purchaseTask) UID_CUSTOMER world
Start world = startEngine [bidFlow] world
bidFlow :: Workflow
bidFlow = { name = "bid"
, label = "Purchase product"
, roles = []
, mainTask = purchaseTask
}
purchaseTask :: Task Void
purchaseTask =
......@@ -69,7 +76,7 @@ selectBid bids
( return_V cheapestBid)
( chooseTask
[Text "Please select a bid"]
[(name <+++ " " <+++ price, return_V bid) \\ bid =: ((uid,name),price) <- bids]
[(name +++ " " +++ toString price, return_V bid) \\ bid =: ((uid,name),price) <- bids]
)
where
determineCheapest bids = return_V (hd (sortBy (\(_,x) (_,y) -> x < y) bids))
......
......@@ -23,13 +23,13 @@ derive gUpd []
nmessage = 5
Start world = startTaskEngine (doWork 0 "Rinus") world
Start world = startEngine [{ name = "newsGroups", label = "Newsgroups example", roles = [], mainTask = (doWork 0 "Rinus") }] world
doWork 0 acc = newsManager 0 acc // for the root
doWork 0 acc = newsManager 0 acc // for the root
doWork i acc = newsReader i acc // all others
newsManager i name
= spawnWorkflow i True ("subscribe",newsReader i name)
= spawnProcess i True ("subscribe",newsReader i name)
#>> manageGroups
where
manageGroups
......@@ -68,7 +68,7 @@ where
subscribe groups
= [Text "Choose a group:", BrTag [],BrTag []] ?>> PDMenu groups
=>> \(_,group) -> addSubscription me (group,0)
#>> spawnWorkflow me True (group,readNews me group)
#>> spawnProcess me True (group,readNews me group)
#>> [Text "You have subscribed to news group ", BTag [] [Text group],BrTag [],BrTag []]
?>> OK
......@@ -82,7 +82,7 @@ where
,("update", return_V Void)
,(">>", readNextNewsItems me (group,index) nmessage (length news))
,("commitNews", commitItem group me)
,("unsubscribe",deleteMe)
,("unsubscribe",deleteCurrentProcess #>> return_V Void)
]
)
......
This source diff could not be displayed because it is too large. You can view the blob instead.
definition module EditTasks
import iTasksTypes
import TSt
/*
editTask :: create a task editor to edit a value of given type, and add a button with given name to finish the task
......
implementation module EditTasks
import StdList, StdTuple, StdFunc
import iTasksTypes
import iDataSettings, iDataForms, iDataWidgets, iDataFormlib, iDataTrivial
import TuningCombinators
import InternaliTasksCommon
editTaskLabel :: !String !String !a -> (Task a) | iData a
editTaskLabel tracename prompt task = Task (\tst =:{options} -> appTaskTSt (mkTask tracename ((Task (editTask` prompt task) <<@ (nPage options)) <<@ Edit)) tst)
editTaskLabel tracename prompt task = Task (\tst =:{options} -> accTaskTSt (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" (Task (editTask` prompt a))
editTask` prompt a tst=:{tasknr,html,hst,userId}
# taskId = iTaskId userId tasknr "EdFin"
# editId = iTaskId userId tasknr "EdVal"
# buttonId = iTaskId userId tasknr "EdBut"
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) id hst // determine if the task has been done previously
| taskdone.Form.value // test if task has completed
# (editor,hst) = (mkEditForm (Init,cFormId tst.options editId a <@ Display) hst) // yes, read out current value, make editor passive
= (editor.Form.value,{tst & activated = True, hst = hst}) // return result task
# (editor,hst) = mkEditForm (Init,cFormId tst.options editId a) hst // no, read out current value from active editor
# (finbut,hst) = mySimpleButton tst.options buttonId prompt (\_ -> True) hst // add button for marking task as done
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) finbut.Form.value hst // remember task status for next time
| taskdone.Form.value = editTask` prompt a {tst & hst = hst} // task is now completed, handle as previously
= (editor.Form.value,{tst & activated = taskdone.Form.value, html = html +|+ BT (editor.form ++ finbut.form) (editor.inputs ++ finbut.inputs), hst = hst})
editTask` prompt a tst=:{taskNr,html,hst,userId}
# taskId = iTaskId userId taskNr "EdFin"
# editId = iTaskId userId taskNr "EdVal"
# buttonId = iTaskId userId taskNr "EdBut"
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) id hst // determine if the task has been done previously
| taskdone.Form.value // test if task has completed
# (editor,hst) = (mkEditForm (Init,cFormId tst.options editId a <@ Display) hst) // yes, read out current value, make editor passive
= (editor.Form.value,{tst & activated = True, hst = hst}) // return result task
# (editor,hst) = mkEditForm (Init,cFormId tst.options editId a) hst // no, read out current value from active editor
# (finbut,hst) = mySimpleButton tst.options buttonId prompt (\_ -> True) hst // add button for marking task as done
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) finbut.Form.value hst // remember task status for next time
| taskdone.Form.value = editTask` prompt a {tst & hst = hst} // task is now completed, handle as previously
= (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" (Task (editTaskPred` a))
where
editTaskPred` a tst=:{tasknr,html,hst,userId}
# taskId = iTaskId userId tasknr "EdFin"
# editId = iTaskId userId tasknr "EdVal"
editTaskPred` a tst=:{taskNr,html,hst,userId}
# taskId = iTaskId userId taskNr "EdFin"
# editId = iTaskId userId taskNr "EdVal"
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId False) id hst // remember if the task has been done
| taskdone.Form.value // test if task has completed
# (editor,hst) = (mkEditForm (Init,cFormId tst.options editId a <@ Display) hst) // yes, read out current value, make editor passive
......
......@@ -2,7 +2,7 @@ definition module TimeAndDateTasks
/**
* iTasks for Time and Date Handling
*/
import iDataWidgets, iTasksTypes
import TSt, iDataWidgets
/*
waitForTimeTask :: Task is done when time has come
......
implementation module TimeAndDateTasks
import StdFunc
import iDataFormlib
import iTasksTypes
import iDataFormlib, iDataTrivial
import TSt
import InternaliTasksCommon
// Timer Tasks ending when timed out
waitForTimeTask:: !HtmlTime -> (Task HtmlTime)
waitForTimeTask time = mkTask "waitForTimeTask" (Task waitForTimeTask`)
where
waitForTimeTask` tst=:{tasknr,userId,hst}
# taskId = iTaskId userId tasknr "Time_"
waitForTimeTask` tst=:{taskNr,userId,hst}
# taskId = iTaskId userId taskNr "Time_"
# (stime,hst) = mkStoreForm (Init,storageFormId tst.options taskId time) id hst // remember time
# ((currtime,_),hst) = getTimeAndDate hst
| currtime < stime.Form.value= (stime.Form.value,{tst & activated = False,hst = hst})
......@@ -19,8 +20,8 @@ where
waitForDateTask:: !HtmlDate -> (Task HtmlDate)
waitForDateTask date = mkTask "waitForDateTask" (Task waitForDateTask`)
where
waitForDateTask` tst=:{tasknr,userId,hst}
# taskId = iTaskId userId tasknr "Date_"
waitForDateTask` tst=:{taskNr,userId,hst}
# taskId = iTaskId userId taskNr "Date_"
# (taskdone,hst) = mkStoreForm (Init,storageFormId tst.options taskId (False,date)) id hst // remember date
# ((_,currdate),hst) = getTimeAndDate hst
| currdate < date = (date,{tst & activated = False, hst = hst})
......
......@@ -6,7 +6,7 @@ definition module iTasksDB
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import iTasksTypes
import TSt
db_prefix :== "iDBase-"
......
definition module Engine
/**
* This module provides the iTasks engine.
* This is the primary function that creates the complete
* environment in which worfklow specifications can be executed.
*/
import StdEnv, StdGeneric, StdBimap
from TSt import :: Workflow
from iDataSettings import ThisExe
//Global settings
iTaskVersion :== "2.0 - Januari 2009 - "
traceId :== "User_Trace"
refreshId :== "User_refresh"
applicationVersionNr :== ThisExe +++ "_Version"
import iDataSettings, StdBimap
import BasicCombinators
userVersionNr thisUser :== "User" +++ toString thisUser +++ "_VersionPNr"
usersessionVersionNr thisUser :== "User" +++ toString thisUser +++ "_VersionSNr"
/**
* Starts the task engine with a single "main" workflow definition.
* Starts the task engine with a list of workflow definitions.
*
* @param A task which will be started as main task
* @param The user id of the user to whom the main task will be assigned
* @param A list of available workflows
* @param The world
* @return The world
*/
startTaskEngine :: !(LabeledTask a) !Int !*World -> *World | iData a
\ No newline at end of file
startEngine :: ![Workflow] !*World -> *World
\ No newline at end of file
implementation module Engine
import StdEnv
import StdEnv, StdBimap
import iDataSettings, iDataForms, iDataWidgets, iDataFormlib, iDataTrivial
import UserDB
import iTasksSettings, InternaliTasksCommon, InternaliTasksThreadHandling
import BasicCombinators, iTasksProcessHandling
import UserDB, ProcessDB
import InternaliTasksCommon, InternaliTasksThreadHandling
import BasicCombinators
import Http, HttpUtil, HttpServer, HttpTextUtil, sapldebug
import AuthenticationHandler, DeauthenticationHandler, NewListHandler, NewStartHandler, WorkListHandler, WorkTabHandler //iTasks.Framework.Handlers.*
import AuthenticationHandler, DeauthenticationHandler, NewListHandler, NewStartHandler, WorkListHandler, WorkTabHandler
import TaskTreeForestHandler, ProcessTableHandler, ThreadTableHandler
import TaskTree, TaskTreeFilters
import Session //iTasks.Framework.Session
import TSt, Session
import JSON
derive JSONDecode HtmlState, StorageFormat, Lifespan
// ******************************************************************************************************
// *** Server / Client startup
// * Server / Client startup
// ******************************************************************************************************
startTaskEngine :: !(LabeledTask a) !Int !*World -> *World | iData a
startTaskEngine mainTask mainUser world = doHtmlServer mainTask mainUser world
startEngine :: ![Workflow] !*World -> *World
startEngine flows world = doHtmlServer flows world
doHtmlServer :: (LabeledTask a) !Int !*World -> *World | iData a
doHtmlServer mainTask uid world
doHtmlServer :: [Workflow] !*World -> *World
doHtmlServer flows world
| ServerKind == Internal
# world = instructions world
= startServer mainTask uid world // link in the Clean http 1.0 server
//| ServerKind == CGI // build as CGI application
= startServer flows world // build as Clean http 1.0 server
//| ServerKind == CGI // build as CGI application
| otherwise
= unimplemented world
where
......@@ -47,18 +48,18 @@ where
# (_,world) = fclose console world
= world
startServer :: (LabeledTask a) !Int !*World -> *World | iData a
startServer mainTask mainUser world
startServer :: [Workflow] !*World -> *World
startServer flows world
# options = ServerOptions ++ (if TraceHTTP [HTTPServerOptDebug True] [])
= http_startServer options [((==) "/handlers/authenticate", handleAnonRequest handleAuthenticationRequest)
,((==) "/handlers/deauthenticate", handleSessionRequest handleDeauthenticationRequest)
,((==) "/handlers/new/list", handleSessionRequest (handleNewListRequest mainTask mainUser))
,((==) "/handlers/new/start", handleSessionRequest (handleNewStartRequest mainTask mainUser))
,((==) "/handlers/work/list", handleSessionRequest (handleWorkListRequest mainTask mainUser))
,((==) "/handlers/work/tab", handleSessionRequest (handleWorkTabRequest mainTask mainUser))
,((==) "/handlers/debug/tasktreeforest", handleSessionRequest (handleTaskTreeForestRequest mainTask mainUser))
,((==) "/handlers/debug/processtable", handleSessionRequest (handleProcessTableRequest mainTask mainUser))
,((==) "/handlers/debug/threadtable", handleSessionRequest (handleThreadTableRequest mainTask mainUser))
,((==) "/handlers/deauthenticate", handleSessionRequest flows handleDeauthenticationRequest)
,((==) "/handlers/new/list", handleSessionRequest flows handleNewListRequest)
,((==) "/handlers/new/start", handleSessionRequest flows handleNewStartRequest)
,((==) "/handlers/work/list", handleSessionRequest flows handleWorkListRequest)
,((==) "/handlers/work/tab", handleSessionRequest flows handleWorkTabRequest)
,((==) "/handlers/debug/tasktreeforest", handleSessionRequest flows handleTaskTreeForestRequest)
,((==) "/handlers/debug/processtable", handleSessionRequest flows handleProcessTableRequest)
,((==) "/handlers/debug/threadtable", handleSessionRequest flows handleThreadTableRequest)
,(\_ -> True, handleStaticResourceRequest)
] world
......@@ -85,7 +86,6 @@ handleStaticResourceRequest req world
,rsp_data = content}, world)
= http_notfoundResponse req world
handleAnonRequest :: (HTTPRequest *HSt -> (!HTTPResponse, !*HSt)) !HTTPRequest *World -> (!HTTPResponse, !*World)
handleAnonRequest handler request world
# hst = initHSt request world
......@@ -93,8 +93,8 @@ handleAnonRequest handler request world
# world = finalizeHSt hst
= (response, world)
handleSessionRequest :: (HTTPRequest Session *HSt -> (!HTTPResponse, !*HSt)) !HTTPRequest *World -> (!HTTPResponse, !*World)
handleSessionRequest handler request world
handleSessionRequest :: [Workflow] (HTTPRequest *TSt -> (!HTTPResponse, !*TSt)) !HTTPRequest *World -> (!HTTPResponse, !*World)
handleSessionRequest flows handler request world
# hst = initHSt request world
# sessionId = http_getValue "session" (request.arg_get ++ request.arg_post) ""
# (mbSession,timeout,hst) = restoreSession sessionId hst
......@@ -104,9 +104,13 @@ handleSessionRequest handler request world
# world = finalizeHSt hst
= ({http_emptyResponse & rsp_data = mkSessionFailureResponse timeout}, world)
(Just session)
# (response, hst) = handler request session hst
# hst = storeStates hst
# world = finalizeHSt hst
# (processdb, hst) = openProcessDB hst
# tst = mkTSt LSTxtFile LSTxtFile session flows hst processdb
# (response,tst =:{hst,processdb})
= handler request tst
# hst = closeProcessDB processdb hst
# hst = storeStates hst
# world = finalizeHSt hst
= (response, world)
where
mkSessionFailureResponse to = "{\"success\" : false, \"error\" : \"" +++ (if to "Your session timed out" "Failed to load session") +++ "\"}"
......@@ -147,7 +151,6 @@ finalizeHSt hst =:{HSt | nworld = nworld =: {NWorld | world = world, gerda, data
# world = closemDataFile datafile world // close the datafile if option chosen
= world
// Database OPTION
openDatabase database world
:== IF_Database (openGerda database world) (abort "Trying to open a relational database while this option is switched off",world)
......
definition module FIXMEDebug
/**
* FIXME: This module's name clashes with a module named Debug in the Esther
* libraries which we include for some reason
*
* This module provides functions for inspecting and visualizing
* the important datastructures of the iTasks framework
*/
import Html
from ProcessDB import :: Process
from TaskTree import :: HtmlTree, :: TaskTree
traceProcesses :: [Process] -> HtmlTag
traceTaskTree :: HtmlTree -> HtmlTag
traceTaskTree2 :: TaskTree -> HtmlTag
traceTaskForest :: [HtmlTree] -> HtmlTag
traceTaskForest2 :: [TaskTree] -> HtmlTag
\ No newline at end of file
implementation module FIXMEDebug
import Html
import ProcessDB
import TaskTree
traceProcesses :: [Process] -> HtmlTag
traceProcesses processes = DivTag [ClassAttr "trace"] (mkTable processes)
where
mkTable processes = [TableTag [] [mkHeader: [mkRow process \\ process <- processes]]]
mkHeader = TrTag [] [ThTag [] [Text "Id"],ThTag [] [Text "Owner"],ThTag [] [Text "Type"], ThTag [] [Text "Status"],ThTag [] [Text "Parent"] ]
mkRow process = TrTag [] [ TdTag [] [Text (toString process.Process.id)]
, TdTag [] [Text (toString process.Process.owner)]
, TdTag [] [Text (case process.Process.process of
(LEFT _) = "Static"
(RIGHT _) = "Dynamic"
)]
, TdTag [] [Text (toString process.Process.status)]
, TdTag [] (case process.Process.process of
(LEFT _) = []
(RIGHT dyn) = [Text (toString dyn.DynamicProcessEntry.parent)]
)
]
traceTaskTree :: HtmlTree -> HtmlTag
traceTaskTree tree = DivTag [ClassAttr "trace"] (mkTree tree)
where
//Visualize a task tree
mkTree (BT _ _)
= []
mkTree (_ @@: tree)
= mkTree tree
mkTree (tree1 +-+ tree2)
= [TableTag [ClassAttr "trace-split"] [TrTag [] [TdTag [] (mkTree tree1),TdTag [] (mkTree tree2)]]]
mkTree (tree1 +|+ tree2)
= [TableTag [ClassAttr "trace-split"] [TrTag [] [TdTag [] (mkTree tree1),TdTag [] (mkTree tree2)]]]
mkTree (CondAnd _ _ trees)
= flatten [mkTree tree \\ (_,tree) <- trees]
mkTree (DivCode _ tree)
= mkTree tree
mkTree (TaskTrace info tree)
= (visualizeTraceNode info) ++ (mkTree tree)
//Visualize a trace node in the tree
visualizeTraceNode info
= [DivTag [ClassAttr ("trace-node " +++ (if info.trActivated "trace-node-inactive" "trace-node-active"))] [
DivTag [ClassAttr "trace-node-title"] [Text info.trTaskNr, Text ": ", Text info.trTaskName],
DivTag [ClassAttr "trace-node-content"] [
TableTag [] [
TrTag [] [ThTag [] [Text "User id:"] , TdTag [] [Text (toString info.trUserId)] ],
TrTag [] [ThTag [] [Text "Value:"] , TdTag [] [Text info.trValue] ],
TrTag [] [ThTag [] [Text "Storage:"], TdTag [] [Text (showStorage info.trOptions.tasklife)] ]
]
]
]
]
showStorage LSTemp = "Tmp"
showStorage LSClient = "Cli"
showStorage LSPage = "Pag"
showStorage LSSession = "Ssn"
showStorage LSTxtFileRO = "TxF0"
showStorage LSTxtFile = "TxF"
showStorage LSDataFile = "DaF"
showStorage LSDatabase = "DaB"
traceTaskTree2 :: TaskTree -> HtmlTag
traceTaskTree2 tree = DivTag [ClassAttr "trace"] (mkTree tree)
where
mkTree (TTBasicTask info _ _)
= mkNode "Basic" info
mkTree (TTSequenceTask info trees)
= [DivTag [ClassAttr "trace-sequence"] [
DivTag [ClassAttr "trace-node-title"] [Text "Sequence: ", Text info.TaskInfo.taskId, Text ": ", Text info.TaskInfo.taskLabel]
: flatten (map mkTree (reverse trees))
]]
mkTree (TTParallelTask info _ _ trees)
= [TableTag [ClassAttr "trace-parallel"] [
TrTag [] [TdTag [ColspanAttr (toString (length trees))] [DivTag [ClassAttr "trace-node-title"] [Text "Parallel: ", Text info.TaskInfo.taskId, Text ": ", Text info.TaskInfo.taskLabel] ]],