Commit 45d2ef43 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

changed tasknr in trace to more space efficient string representation

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@304 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 9756d03d
......@@ -32,7 +32,8 @@ mkTask :: to promote a function of proper type to a task
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
toStringTaskNr :: convert TaskNr to more compact string representation
parseTaskNr :: convert string representation back to TaskNr
deleteAllSubTasks :: collects all related tasks
*/
......@@ -41,7 +42,8 @@ mkTask :: !String !(Task a) -> Task a | iCreateAndPrint a
mkParSubTask :: !String !Int (Task a) -> (Task a) | iCreateAndPrint a // two shifts are needed
iTaskId :: !Int !TaskNr !String -> String
showTaskNr :: !TaskNr -> String
toStringTaskNr :: !TaskNr -> String
parseTaskNr :: !String -> TaskNr
deleteAllSubTasks :: ![TaskNr] TSt -> TSt
// general iTask store, session store, page store, store but no form generation
......
......@@ -15,19 +15,37 @@ import DrupBasic
:: TCl a = TCl !.(Task a) // task closure, container for a task used for higher order tasks (task which deliver a task)
showTaskNr :: !TaskNr -> String
showTaskNr [] = ""
showTaskNr [i] = toString i
showTaskNr [i:is] = showTaskNr is <+++ "." <+++ toString i
toStringTaskNr :: !TaskNr -> String
toStringTaskNr [] = ""
toStringTaskNr [i] = toString i
toStringTaskNr [i:is] = toStringTaskNr is <+++ "." <+++ toString i
parseTaskNr :: !String -> TaskNr
parseTaskNr "" = []
parseTaskNr string = reverse (parseTaskNr` [char \\ char <-: string])
where
parseTaskNr` :: ![Char] -> TaskNr
parseTaskNr` [] = []
parseTaskNr` list
# (front,end) = span (\c -> c <> '.') list
= [toInt (toString front) : parseTaskNr` (stl end)]
toString :: [Char] -> String
toString list = {c \\ c <- list}
stl :: [Char] -> [Char]
stl [] = []
stl xs = tl xs
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
| postfix == ""
| userid < 0 = "iLog_" <+++ (showTaskNr tasknr)
| otherwise = "iTask_" <+++ (showTaskNr tasknr)
| userid < 0 = "iLog_" <+++ (showTaskNr tasknr) <+++ "-" <+++ postfix
| otherwise = "iTask_" <+++ (showTaskNr tasknr) <+++ "-" <+++ postfix // MJP:info removed to allow dynamic realloc of users: <+++ "+" <+++ userid
| userid < 0 = "iLog_" <+++ (toStringTaskNr tasknr)
| otherwise = "iTask_" <+++ (toStringTaskNr tasknr)
| userid < 0 = "iLog_" <+++ (toStringTaskNr tasknr) <+++ "-" <+++ postfix
| otherwise = "iTask_" <+++ (toStringTaskNr tasknr) <+++ "-" <+++ postfix // MJP:info removed to allow dynamic realloc of users: <+++ "+" <+++ userid
deleteAllSubTasks :: ![TaskNr] TSt -> TSt
deleteAllSubTasks [] tst = tst
......@@ -66,7 +84,7 @@ where
# (val,tst=:{activated,html}) = appTaskTSt mytask tst // active, so perform task and get its result
# tst = {tst & tasknr = tasknr, options = options, userId = userId}
| 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}
# tst = {tst & html = TaskTrace {trTaskNr = toStringTaskNr 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
......
......@@ -337,7 +337,7 @@ where
| activated // thread is finished, delete the entry...
# tst = deleteThreads thrTaskNr {tst & html = html +|+ nhtml} // remove thread from administration
= (a,{tst & tasknr = tasknr, options = options, userId = userId}) // remove entry from table
= (a,{tst & tasknr = tasknr, options = options, userId = userId,html = html +|+ DivCode (showTaskNr thrTaskNr) nhtml})
= (a,{tst & tasknr = tasknr, options = options, userId = userId,html = html +|+ DivCode (toStringTaskNr thrTaskNr) nhtml})
administrateNewThread :: !UserId !*TSt -> *TSt
......@@ -461,7 +461,7 @@ where
lookupThread tableKey n []
= -1 // no, cannot find thread
lookupThread tasknrToFind n [entry:next]
| (showTaskNr tasknrToFind == showTaskNr entry.thrTaskNr && foundThread threadkind entry.thrKind) = n // yes, thread is administrated
| (toStringTaskNr tasknrToFind == toStringTaskNr entry.thrTaskNr && foundThread threadkind entry.thrKind) = n // yes, thread is administrated
= lookupThread tasknrToFind (inc n) next
// TODO foundThread kan niet kloppen !!!
......@@ -662,8 +662,8 @@ where
showThreadNr :: !TaskNr -> String
showThreadNr [-1] = "Root"
showThreadNr [-1:is] = showTaskNr is
showThreadNr else = "*" <+++ showTaskNr else
showThreadNr [-1:is] = toStringTaskNr is
showThreadNr else = "*" <+++ toStringTaskNr else
// ******************************************************************************************************
// Global Effects Storage Management
......
......@@ -120,7 +120,7 @@ where
= (a,{tst & userId = userId // restore user Id
, html = ohtml +|+ ( { delegatorId = userId
, taskWorkerId = nuserId
, taskNrId = showTaskNr tasknr
, taskNrId = toStringTaskNr tasknr
, processNr = processNr
, worflowLabel = workflowLabel
, taskPriority = NormalPriority
......
......@@ -46,7 +46,7 @@ import HSt
| 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
:: TraceInfo = { trTaskNr :: !TaskNr // tasknr
:: TraceInfo = { trTaskNr :: !TaskNrId // 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)
......
......@@ -140,15 +140,15 @@ filterTaskTreeOfTask userId taskNrId tree
= filterTaskTree (fromJust mbtree)
insertTrace :: !TraceInfo ![Trace] -> [Trace]
insertTrace info trace = insertTrace` (reverse info.trTaskNr) trace
insertTrace info trace = insertTrace` (reverse (parseTaskNr info.trTaskNr)) trace
where
insertTrace` :: !TaskNr ![Trace] -> [Trace]
insertTrace` [i] traces
| i < 0 = abort ("negative task numbers:" <+++ showTaskNr info.trTaskNr <+++ "," <+++ info.trUserId <+++ "," <+++ info.trTaskName)
| i < 0 = abort ("negative task numbers:" <+++ 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)
| i < 0 = abort ("negative task numbers:" <+++ info.trTaskNr <+++ "," <+++ info.trUserId <+++ "," <+++ info.trTaskName)
# (Trace ni itraces) = select i traces
# nistraces = insertTrace` is itraces
= updateAt` i (Trace ni nistraces) traces
......@@ -187,7 +187,7 @@ where
showTask att c1 c2 c3 c4 info
= [STable doneBackground
[ [font c1 (toString info.trUserId),font c2 ("T" <+++ showTaskNr info.trTaskNr)]
[ [font c1 (toString info.trUserId),font c2 ("T" <+++ info.trTaskNr)]
, [showStorage info.trOptions.tasklife, font c3 info.trTaskName]
, [EmptyBody, font c4 info.trValue]
]
......
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