Commit ede8d05e authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

andTaskCond are displayed in a tab;

they task list is not displayed properly yet;
to be continued...

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@318 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 274443a1
......@@ -27,10 +27,7 @@ derive JSONDecode HtmlState, StorageFormat, Lifespan
// *** Server / Client startup
// ******************************************************************************************************
startTaskEngine :: !(Task a) !*World -> *World | iData a
startTaskEngine maintask world = doTaskWrapper maintask world
doTaskWrapper :: !(Task a) !*World -> *World | iData a // Combined wrapper which starts the server or client wrapper
doTaskWrapper mainTask world = doHtmlServer mainTask world
startTaskEngine maintask world = doHtmlServer maintask world
doHtmlServer :: (Task a) !*World -> *World | iData a
doHtmlServer mainTask world
......
......@@ -42,7 +42,7 @@ 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
toStringTaskNr :: !TaskNr -> String
toStringTaskNr :: !TaskNr -> TaskNrId
parseTaskNr :: !String -> TaskNr
deleteAllSubTasks :: ![TaskNr] TSt -> TSt
......
......@@ -16,7 +16,7 @@ import DrupBasic
:: TCl a = TCl !.(Task a) // task closure, container for a task used for higher order tasks (task which deliver a task)
toStringTaskNr :: !TaskNr -> String
toStringTaskNr :: !TaskNr -> TaskNrId
toStringTaskNr [] = ""
toStringTaskNr [i] = toString i
toStringTaskNr [i:is] = toStringTaskNr is <+++ "." <+++ toString i
......
......@@ -169,8 +169,34 @@ where
lengthltask = length ltasks
allTasksCond :: !String !(TasksToShow a) !(FinishPred a) ![LabeledTask a] -> Task [a] | iData a
allTasksCond label _ pred taskCollection
= mkTask "andTasksCond" (Task (doandTasks taskCollection))
where
lengthltask = length taskCollection
doandTasks [] tst = return [] tst
doandTasks taskCollection tst=:{tasknr,html,options,userId}
# ((alist,acode),tst=:{activated=finished,html=allhtml})
= checkAllTasks label taskCollection 0 True ([],[]) {tst & html = BT [] [],activated = True}
| finished || pred alist = (alist,{tst & html = html, activated = True}) // stop, all work done so far satisfies predicate
= (alist,{tst & activated = False
, html = html +|+ collectCode label acode // show previous code
})
where
collectCode :: !String ![HtmlTree] -> HtmlTree
collectCode label htmls = CondAnd label [(toStringTaskNr [0,i:tasknr],html) \\ html <- htmls & i <- [0..]]
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
= checkAllTasks traceid taskCollection (inc ctasknr) False (if adone [a:alist] alist,[html:acode]) {tst & tasknr = tasknr}
/*
allTasksCond :: !String !(TasksToShow a) !(FinishPred a) ![LabeledTask a] -> Task [a] | iData a
allTasksCond label chooser pred taskCollection
= mkTask "andTasksCond" (Task (doandTasks chooser taskCollection))
......@@ -209,6 +235,11 @@ where
| 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:
......
......@@ -40,9 +40,9 @@ import HSt
:: HtmlTree = BT [HtmlTag] [InputId] // simple code with possible event handler definitions
| (@@:) infix 0 !TaskDescription !HtmlTree // code with id of user attached to it
| (-@:) infix 0 !UserId !HtmlTree // skip code with this id if it is the id of the user
| (+-+) infixl 1 !HtmlTree !HtmlTree // code to be placed next to each other
| (+|+) infixl 1 !HtmlTree !HtmlTree // code to be placed below each other
| CondAnd !String [(!TaskNrId,!HtmlTree)] // list of subtasks to display in different tabs by worklist handler
| 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
......
......@@ -9,9 +9,6 @@ instance == TaskStatus
determineTaskList :: !UserId !HtmlTree -> [TaskDescription]
determineTaskForTab :: !UserId !TaskNrId !HtmlTree -> (!TaskStatus,![HtmlTag],![InputId])
mkFilteredTaskTree :: !UserId !UserId !HtmlTree -> (![HtmlTag],![InputId])
mkUnfilteredTaskTree :: !HtmlTree -> (![HtmlTag],![InputId])
// Showing Trace from Task Tree
getFullTraceFromTaskTree:: !HtmlTree -> HtmlTag
......
......@@ -14,28 +14,46 @@ where
(==) _ _ = False
determineTaskList :: !UserId !HtmlTree -> [TaskDescription]
determineTaskList thisuser (taskdescr @@: tree)
# collected = determineTaskList thisuser tree
| taskdescr.taskWorkerId == thisuser = [taskdescr:collected]
= collected
determineTaskList thisuser (ntaskuser -@: tree)
= determineTaskList thisuser tree
determineTaskList thisuser (tree1 +|+ tree2)
# collection1 = determineTaskList thisuser tree1
# collection2 = determineTaskList thisuser tree2
= collection1 ++ collection2
determineTaskList thisuser (tree1 +-+ tree2)
# collection1 = determineTaskList thisuser tree1
# collection2 = determineTaskList thisuser tree2
= collection1 ++ collection2
determineTaskList thisuser (BT html inputs)
= []
determineTaskList thisuser (DivCode id tree)
= determineTaskList thisuser tree
determineTaskList thisuser (TaskTrace traceinfo tree)
= determineTaskList thisuser tree
determineTaskList thisuser tree = determineTaskList` thisuser tree defaultTaskDescriptor
where
determineTaskList` thisuser (ntaskDescr @@: tree) taskDescr
# collected = determineTaskList` thisuser tree ntaskDescr
| ntaskDescr.taskWorkerId == thisuser = [ntaskDescr:collected]
= collected
determineTaskList` thisuser (CondAnd label []) taskDescr
= []
determineTaskList` thisuser (CondAnd label [t=:(taskNr,htmlTree):ts]) taskDescr
# collection = determineTaskList` thisuser htmlTree taskDescr
# collections = determineTaskList` thisuser (CondAnd label ts) taskDescr
= [{taskDescr & taskNrId = taskNr}] ++ collection ++ collections
determineTaskList` thisuser (tree1 +|+ tree2)taskDescr
# collection1 = determineTaskList` thisuser tree1 taskDescr
# collection2 = determineTaskList` thisuser tree2 taskDescr
= collection1 ++ collection2
determineTaskList` thisuser (tree1 +-+ tree2) taskDescr
# collection1 = determineTaskList` thisuser tree1 taskDescr
# collection2 = determineTaskList` thisuser tree2 taskDescr
= collection1 ++ collection2
determineTaskList` thisuser (BT html inputs) taskDescr
= []
determineTaskList` thisuser (DivCode id tree) taskDescr
= determineTaskList` thisuser tree taskDescr
determineTaskList` thisuser (TaskTrace traceinfo tree) taskDescr
= determineTaskList` thisuser tree taskDescr
defaultTaskDescriptor
= { delegatorId = 0
, taskWorkerId = 0
, taskNrId = ""
, processNr = 0
, worflowLabel = "Non-existing"
, taskLabel = "Non-existing"
, timeCreated = Time 0
, taskPriority = LowPriority
, curStatus = True
}
determineTaskForTab :: !UserId !TaskNrId !HtmlTree -> (!TaskStatus,![HtmlTag],![InputId])
determineTaskForTab :: !UserId !TaskNrId !HtmlTree -> (!TaskStatus,![HtmlTag],![InputId])
determineTaskForTab thisuser thistaskid tree
= case determineMyTaskTree thisuser thistaskid tree of //Find the subtree by task id
Nothing
......@@ -54,9 +72,12 @@ mkFilteredTaskTree thisuser taskuser (description @@: tree)
| thisuser == description.taskWorkerId
= (html,inputs)
| otherwise = ([],[])
mkFilteredTaskTree thisuser taskuser (nuser -@: tree)
| thisuser == nuser = ([],[])
| otherwise = mkFilteredTaskTree thisuser taskuser tree
mkFilteredTaskTree thisuser taskuser (CondAnd label [])
= ([],[])
mkFilteredTaskTree thisuser taskuser (CondAnd label [(nr,tree):trees])
# (tag,input) = mkFilteredTaskTree thisuser taskuser tree
# (tags,inputs) = mkFilteredTaskTree thisuser taskuser (CondAnd label trees)
= (tag ++ tags,input ++ inputs)
mkFilteredTaskTree thisuser taskuser (tree1 +|+ tree2)
# (lhtml,linputs) = mkFilteredTaskTree thisuser taskuser tree1
# (rhtml,rinputs) = mkFilteredTaskTree thisuser taskuser tree2
......@@ -80,7 +101,12 @@ mkFilteredTaskTree thisuser taskuser (TaskTrace traceinfo tree)
mkUnfilteredTaskTree :: !HtmlTree -> (![HtmlTag],![InputId])
mkUnfilteredTaskTree (BT body inputs) = (body, inputs)
mkUnfilteredTaskTree (_ @@: html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (_ -@: html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (CondAnd label []) = ([],[])
mkUnfilteredTaskTree (CondAnd label [(tn,tree):trees])
= (htmlL ++ htmlR,inpL ++ inpR)
where
(htmlL,inpL) = mkUnfilteredTaskTree tree
(htmlR,inpR) = mkUnfilteredTaskTree (CondAnd label trees)
mkUnfilteredTaskTree (DivCode str html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (TaskTrace traceinfo html) = mkUnfilteredTaskTree html
mkUnfilteredTaskTree (nodeL +-+ nodeR) = (htmlL <=> htmlR,inpL ++ inpR)
......@@ -97,30 +123,37 @@ where
// ******************************************************************************************************
determineMyTaskTree :: !UserId !TaskNrId !HtmlTree -> Maybe HtmlTree
determineMyTaskTree thisuser thistaskid (BT bdtg inputs)
= Nothing
determineMyTaskTree thisuser thistaskid (ntaskuser -@: tree)
= determineMyTaskTree thisuser thistaskid tree
determineMyTaskTree thisuser thistaskid (tree1 +-+ tree2)
# ntree1 = determineMyTaskTree thisuser thistaskid tree1
| isJust ntree1 = ntree1
= determineMyTaskTree thisuser thistaskid tree2
determineMyTaskTree thisuser thistaskid (tree1 +|+ tree2)
# ntree1 = determineMyTaskTree thisuser thistaskid tree1
| isJust ntree1 = ntree1
= determineMyTaskTree thisuser thistaskid tree2
determineMyTaskTree thisuser thistaskid (DivCode id tree)
= determineMyTaskTree thisuser thistaskid tree
determineMyTaskTree thisuser thistaskid (TaskTrace traceinfo tree)
= determineMyTaskTree thisuser thistaskid tree
determineMyTaskTree thisuser thistaskid (taskdescr @@: tree)
| taskdescr.taskNrId == thistaskid &&
taskdescr.taskWorkerId == thisuser= Just (taskdescr @@: (pruneTree tree))
= determineMyTaskTree thisuser thistaskid tree
determineMyTaskTree thisuser thistaskid tree = determineMyTaskTree` thisuser thistaskid tree defaultTaskDescriptor
where
determineMyTaskTree` thisuser thistaskid (BT bdtg inputs) taskDescr
= Nothing
determineMyTaskTree` thisuser thistaskid (CondAnd label []) taskDescr
= Nothing
determineMyTaskTree` thisuser thistaskid (CondAnd label [(taskid,tree):trees]) taskDescr
| thistaskid == taskid = Just ({taskDescr & taskNrId = taskid, taskLabel = label } @@: (pruneTree tree))
# mbTree = determineMyTaskTree` thisuser thistaskid tree taskDescr
| isNothing mbTree = determineMyTaskTree` thisuser thistaskid (CondAnd label trees) taskDescr
= mbTree
determineMyTaskTree` thisuser thistaskid (tree1 +-+ tree2) taskDescr
# ntree1 = determineMyTaskTree` thisuser thistaskid tree1 taskDescr
| isJust ntree1 = ntree1
= determineMyTaskTree` thisuser thistaskid tree2 taskDescr
determineMyTaskTree` thisuser thistaskid (tree1 +|+ tree2) taskDescr
# ntree1 = determineMyTaskTree` thisuser thistaskid tree1 taskDescr
| isJust ntree1 = ntree1
= determineMyTaskTree` thisuser thistaskid tree2 taskDescr
determineMyTaskTree` thisuser thistaskid (DivCode id tree) taskDescr
= determineMyTaskTree` thisuser thistaskid tree taskDescr
determineMyTaskTree` thisuser thistaskid (TaskTrace traceinfo tree) taskDescr
= determineMyTaskTree` thisuser thistaskid tree taskDescr
determineMyTaskTree` thisuser thistaskid (taskdescr @@: tree) taskDescr
| taskdescr.taskNrId == thistaskid &&
taskdescr.taskWorkerId == thisuser= Just (taskdescr @@: (pruneTree tree))
= determineMyTaskTree` thisuser thistaskid tree taskdescr
pruneTree :: !HtmlTree -> HtmlTree // delete all sub trees not belonging to this task
pruneTree (taskdescr @@: tree) = BT [] []
pruneTree (ntaskuser -@: tree) = ntaskuser -@: pruneTree tree
pruneTree (taskdescr @@: tree) = BT [] [] // this task will appear in another tab
pruneTree (CondAnd label trees) = BT [] [] // this task will appear in another tab as well
pruneTree (tree1 +|+ tree2) = pruneTree tree1 +|+ pruneTree tree2
pruneTree (tree1 +-+ tree2) = pruneTree tree1 +-+ pruneTree tree2
pruneTree (BT bdtg inputs) = BT bdtg inputs
......@@ -150,7 +183,7 @@ where
collectTraceInfo (TaskTrace traceinfo html) = [traceinfo : collectTraceInfo html]
collectTraceInfo (BT body inputs) = []
collectTraceInfo (_ @@: html) = collectTraceInfo html
collectTraceInfo (_ -@: html) = collectTraceInfo html
collectTraceInfo (CondAnd label html) = flatten (map collectTraceInfo (map snd html))
collectTraceInfo (DivCode str html) = collectTraceInfo html
collectTraceInfo (nodeL +-+ nodeR) = traceLeft ++ traceRight
where
......
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