Commit 86a9d08d authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

Added a test handler / acheme for handling the new set up.

Filter has still to be written for determining tasks to do.
To be continued.

I had some work to program around a nasty bug in the compiler...

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@216 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 94ca5787
.comp 920 000110010
.start _nostart_
.depend "StdCharList" "20061218130200"
.depend "StdEnv" "20061218130200"
.depend "StdDynamic" "20061208183212"
.depend "StdOrdList" "20061218130200"
.depend "_SystemEnum" "20061218130200"
.depend "StdEnum" "20061218130200"
.depend "StdMisc" "20061218130200"
.depend "StdFunc" "20061218130200"
.depend "StdCharList" "20061218130200"
.depend "StdTuple" "20061218130200"
.depend "StdReal" "20061218130200"
.depend "StdInt" "20061218130200"
.depend "StdClass" "20061218130200"
.depend "StdOrdList" "20061218130200"
.depend "StdList" "20061218130200"
.depend "StdChar" "20061218130200"
.depend "StdClass" "20061218130200"
.depend "StdFile" "20061218130200"
.depend "StdString" "20061218130200"
.depend "_SystemArray" "20061218130200"
.depend "StdArray" "20061218130200"
.depend "StdString" "20061218130200"
.depend "StdChar" "20061218130200"
.depend "StdReal" "20061218130200"
.depend "StdInt" "20061218130200"
.depend "StdBool" "20061218130200"
.depend "StdFunc" "20061218130200"
.depend "StdMisc" "20061218130200"
.depend "StdFile" "20061218130200"
.depend "StdEnv" "20061218130200"
.depend "StdOverloaded" "20061218130200"
.depend "_SystemDynamic" "20061208183212"
.depend "StdCleanTypes" "20061208183212"
......
......@@ -5,6 +5,7 @@ import iDataHtmlDef, iDataSettings
import StdMaybe
import GenEq
// utility for creating FormId's
class (<@) infixl 4 att :: !(FormId d) !att -> FormId d
......
......@@ -11,7 +11,6 @@ generic gUpd a :: UpdMode a -> (UpdMode,a) // gUpd can simply be deri
derive gForm Int, Real, Bool, String, UNIT, PAIR, EITHER, OBJECT, CONS, FIELD
derive gUpd Int, Real, Bool, String, UNIT, PAIR, EITHER, OBJECT, CONS, FIELD
derive bimap Form, FormId
derive gForm Inline
derive gUpd Inline
......@@ -21,6 +20,8 @@ derive gerda Inline
derive read Inline
derive write Inline
derive bimap Form, FormId
:: *HSt = { cntr :: !Int // counts position in expression
, submits :: !Bool // True if we are in submitting mode
, issub :: !Bool // True if this form is a subform of another
......@@ -37,6 +38,13 @@ derive write Inline
doHtmlWrapper :: !UserPage !*World -> *World //Combined wrapper which starts the server or client wrapper
import InternaliTasksCommon
:: UserTaskPage a :== (!(Task a) -> .(*HSt -> .((!Bool,!String),Html,!*HSt)))
doTaskWrapper :: !(UserTaskPage a) !(Task a) !*World -> *World // Combined wrapper which starts the server or client wrapper
// mkViewForm is the *swiss army knife* function creating stateful interactive forms with a view v of data d.
// Make sure that all editors have a unique identifier!
......
......@@ -53,16 +53,20 @@ closemDataFile datafile world
//is selected.
doHtmlWrapper :: !UserPage !*World -> *World
doHtmlWrapper userpage world = IF_Client (doHtmlClient userpage world) (doHtmlServer userpage world)
doHtmlWrapper userpage world = IF_Client (doHtmlClient (\_ -> userpage) undef world) (doHtmlServer (\_ -> userpage) undef world)
doTaskWrapper :: !(UserTaskPage a) !(Task a) !*World -> *World // Combined wrapper which starts the server or client wrapper
doTaskWrapper userpageHandler mainTask world = IF_Client (doHtmlClient userpageHandler mainTask world) (doHtmlServer userpageHandler mainTask world)
// doHtmlServer: top level function given to end user.
// It sets up the communication with a (sub)server or client, depending on the option chosen.
doHtmlServer :: !UserPage !*World -> *World
doHtmlServer userpage world
//doHtmlServer :: !UserPage !*World -> *World
doHtmlServer :: !(UserTaskPage a) (Task a) !*World -> *World
doHtmlServer userpageHandler mainTask world
| ServerKind == Internal
# world = instructions world
= StartServer userpage world // link in the Clean http 1.0 server
= StartServer userpageHandler mainTask world // link in the Clean http 1.0 server
//| ServerKind == External // connect with http 1.1 server
//| ServerKind == CGI // build as CGI application
| otherwise
......@@ -84,15 +88,15 @@ where
# (_,world) = fclose console world
= world
StartServer :: !UserPage !*World -> *World
StartServer userpage world
StartServer :: !(UserTaskPage a) (Task a) !*World -> *World
StartServer userpageHandler mainTask world
# options = ServerOptions ++ (if TraceHTTP [HTTPServerOptDebug True] [])
= http_startServer options [((==) ("/" +++ ThisExe), IF_Ajax doAjaxInit (doDynamicResource userpage))
,((==) ("/" +++ ThisExe +++ "_ajax"), IF_Ajax (doDynamicResource userpage) http_notfoundResponse)
= http_startServer options [((==) ("/" +++ ThisExe), IF_Ajax doAjaxInit (doDynamicResource (userpageHandler mainTask)))
,((==) ("/" +++ ThisExe +++ "_ajax"), IF_Ajax (doDynamicResource (userpageHandler mainTask)) http_notfoundResponse)
,((==) ("/" +++ ThisExe +++ "/new"), handleIndexRequest)
,((==) ("/" +++ ThisExe +++ "/handlers/authenticate"), handleAuthenticationRequest)
,((==) ("/" +++ ThisExe +++ "/handlers/filters"), handleFilterListRequest)
,((==) ("/" +++ ThisExe +++ "/handlers/worklist"), handleWorkListRequest)
,((==) ("/" +++ ThisExe +++ "/handlers/worklist"), handleWorkListRequest mainTask)
,(\_ -> True, doStaticResource)
] world
......@@ -156,6 +160,8 @@ where
debugInput = if TraceInput (traceHtmlInput request.arg_post) EmptyBody
import iDataStylelib
mkPage :: [HeadAttr] [HeadTag] [BodyAttr] [BodyTag] -> Html
mkPage headattr headtags bodyattr bodytags = Html (Head headattr headtags) (Body bodyattr bodytags)
......
......@@ -29,3 +29,4 @@ TraceStyle :== Std_Class "Trace"
defsize :== 12 // size of inputfield
defpixel :== 107 // size in pixels for buttons, pull-down buttons
......@@ -2,8 +2,6 @@ definition module iDataTrivial
import StdMaybe, StdGeneric, StdOverloaded
//derive bimap Maybe, (,)
// utility
mkString :: ![Char] -> *String
......
......@@ -2,8 +2,6 @@ implementation module iDataTrivial
import StdMaybe, StdGeneric, StdArray, StdClass, StdInt, StdList, StdString
derive bimap Maybe, (,)
// converting strings to lists and backwards
mkString :: ![Char] -> *String
......
definition module WorkListHandler //iTasks.Handlers.WorkListHandler
import Http
import iDataHandler
/**
* Handles the ajax requests from the current work filter panel.
*/
handleWorkListRequest :: !HTTPRequest *World -> (!HTTPResponse, !*World)
\ No newline at end of file
handleWorkListRequest :: !(Task a) !HTTPRequest *World -> (!HTTPResponse, !*World)
\ No newline at end of file
......@@ -4,6 +4,8 @@ import StdEnv
import Http
import Text
import JSON
import iDataHandler
:: WorkListItem = { taskid :: String //Task id of the work item
, for :: String //Label of the user who issued the work
......@@ -12,8 +14,129 @@ import JSON
derive JSONEncode WorkListItem
handleWorkListRequest :: !HTTPRequest *World -> (!HTTPResponse, !*World)
handleWorkListRequest req world = ({http_emptyResponse & rsp_data = toJSON worklist},world)
handleWorkListRequest :: !(Task a) !HTTPRequest *World -> (!HTTPResponse, !*World)
handleWorkListRequest userpage req world = ({http_emptyResponse & rsp_data = toJSON worklist},world)
where
worklist :: [WorkListItem]
worklist = [{taskid = toString id, for = "Boss", subject = "Task with id " +++ toString id } \\ id <- [1 .. 5]]
\ No newline at end of file
worklist = [{taskid = toString id, for = "Boss", subject = "Task with id " +++ toString id } \\ id <- [1 .. 5]]
//handleTaskCalculationRequest :: !HTTPRequest !UserId !(Task a) !*World -> (!Bool,!HtmlTree,!Maybe String,!*HtmlStream,!*World)
import InternaliTasksThreadHandling, StdStrictLists
handleWorkListRequest2 :: !(Task a) !HTTPRequest *World -> (!HTTPResponse, !*World) | iData a
handleWorkListRequest2 mainTask request world
# (toServer,htmlTree,maybeError,world) = handleTaskCalculationRequest request 0 mainTask world
= ({http_emptyResponse & rsp_data = (toString ""/*html*/)}, world)
calculateTaskTree :: !UserId !(Task a) !*HSt -> (!Bool,!HtmlTree,!Maybe String,!*HSt) | iData a
calculateTaskTree thisUser mainTask hst
# (pversion,hst) = setPUserNr thisUser id hst // fetch global settings of this user
# (sversion,hst) = setSVersionNr thisUser id hst // fetch version number of session (not needed in new set up?)
# versionconflict = sversion > 0 && sversion < pversion.versionNr //&& not noNewVersion // test if there is a version conflict
| versionconflict = (True,BT [],Just "Version conflict detected!",hst) // Yes, return error message
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated})
= calculateTasks thisUser pversion False mainTask (initTst thisUser TxtFile TxtFile hst)
# newUserVersionNr = 1 + if (pversion.versionNr > sversion) pversion.versionNr sversion // increment user querie version number
# (_,hst) = clearIncPUser thisUser (\_ -> newUserVersionNr) hst // store in session
# (sversion,hst) = setSVersionNr thisUser (\_ -> newUserVersionNr) hst // store in persistent memory
# showCompletePage = IF_Ajax (hd threads == [-1]) True
= (toServer,html,Nothing,hst)
where
initTst :: !UserId !Lifespan !Lifespan !*HSt -> *TSt
initTst thisUser itaskstorage threadstorage hst
= { tasknr = [-1]
, activated = True
, staticInfo = initStaticInfo thisUser threadstorage
, userId = if (thisUser >= 0) defaultUser thisUser
, workflowLink = (0,(defaultUser,0,defaultWorkflowName))
, html = BT []
, trace = Nothing
, hst = hst
, options = initialOptions thisUser itaskstorage
}
initStaticInfo :: UserId !Lifespan -> StaticInfo
initStaticInfo thisUser location
= { currentUserId = thisUser
, threadTableLoc= location
}
initialOptions :: !UserId !Lifespan -> !Options
initialOptions thisUser location
= { tasklife = if (thisUser >= 0) location Session
, taskstorage = PlainString
, taskmode = Edit
, gc = Collect
}
handleTaskCalculationRequest :: !HTTPRequest !UserId !(Task a) !*World -> (!Bool,!HtmlTree,!Maybe String,!*World) | iData a
handleTaskCalculationRequest request thisUser mainTask world
# (gerda,world) = openDatabase ODCBDataBaseName world // open the relational database if option chosen
# (datafile,world) = openmDataFile DataFileName world // open the datafile if option chosen
# nworld = {worldC = world, inout = [|], gerda = gerda, datafile = datafile}
# (initforms,nworld) = retrieveFormStates request.arg_post nworld // Retrieve the state information stored in an html page, other state information is collected lazily
# hst = {(mkHSt initforms nworld) & request = request} // Create the HSt
# (toServer, htmlTree, maybeError, {states,world})
= calculateTaskTree thisUser mainTask hst // Callculate the TaskTree given the id of the current user
# (debugOutput,states) = if TraceOutput (traceStates states) (EmptyBody,states) // Optional show debug information
# (pagestate, focus, world=:{worldC,gerda,inout,datafile})
= storeFormStates "" states world // Store all state information
# worldC = closeDatabase gerda worldC // close the relational database if option chosen
# worldC = closemDataFile datafile worldC // close the datafile if option chosen
/*# inout = IF_Ajax
(print_to_stdout "" inout <+
(pagestate) <+ State_FormList_Separator <+ // state information
AjaxCombine bodytags [debugInput,debugOutput] // page, or part of a page
)
(print_to_stdout // Print out all html code
(Html (Head headattr [mkJsTag, mkCssTag : headtags])
(Body bodyattr [mkInfoDiv pagestate focus : bodytags ++ [debugInput,debugOutput]]))
inout
)
*/
= (toServer,htmlTree,maybeError,worldC)
where
AjaxCombine [Ajax bodytags:ys] [EmptyBody,EmptyBody] = [Ajax bodytags:ys]
AjaxCombine [Ajax bodytags:ys] debug = [Ajax [("debug",debug):bodytags]:ys]
AjaxCombine [] debug = abort "AjaxCombine cannot combine empty result"
debugInput = if TraceInput (traceHtmlInput request.arg_post) EmptyBody
// Database OPTION
openDatabase database world
:== IF_Database (openGerda database world) (abort "Trying to open a relational database while this option is switched off",world)
closeDatabase database world
:== IF_Database (closeGerda database world) world
// DataFile OPTION
openmDataFile datafile world
:== IF_DataFile (openDataFile datafile world) (abort "Trying to open a dataFile while this option is switched off",world)
closemDataFile datafile world
:== IF_DataFile (closeDataFile datafile world) world
mkHSt :: *FormStates *NWorld -> *HSt
mkHSt states nworld = {cntr=0, states=states, request= http_emptyRequest, world=nworld, submits = False, issub = False }
mkCssTag :: HeadTag
mkCssTag = Hd_Link [Lka_Type "text/css", Lka_Rel Docr_Stylesheet, Lka_Href ExternalCleanStyles]
mkJsTag :: HeadTag
mkJsTag = Hd_Script [Scr_Src (ThisExe +++ "/js/clean.js"), Scr_Type TypeJavascript ] (SScript "")
mkInfoDiv :: String String -> BodyTag
mkInfoDiv state focus =
Div [`Div_Std [Std_Style "display:none"]] [
Div [`Div_Std [Std_Id "GS"]] [Txt state],
Div [`Div_Std [Std_Id "FS"]] [Txt focus],
Div [`Div_Std [Std_Id "AN"]] [Txt ThisExe],
Div [`Div_Std [Std_Id "OPT-ajax"]] [Txt (IF_Ajax "true" "false")]
]
......@@ -6,10 +6,20 @@ definition module InternaliTasksCommon
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import iDataHandler, iDataFormData, StdBimap
import iTasksTypes, iTasksSettings, TaskTreeFilters
import iDataFormData
import iTasksSettings
derive gForm TCl
derive gUpd TCl
derive gPrint TCl
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)
:: Task a :== !*TSt -> *(!a,!*TSt) // an iTask is state transition function
:: *TSt = { tasknr :: !TaskNr // for generating unique form-id's
, activated :: !Bool // if true activate task, if set as result task completed
, userId :: !Int // id of user to which task is assigned
......@@ -35,16 +45,21 @@ import iTasksTypes, iTasksSettings, TaskTreeFilters
, taskmode :: !Mode // default: Edit
, gc :: !GarbageCollect // default: Collect
}
:: GarbageCollect
= Collect // garbage collect iTask administration
| NoCollect // no garbage collection
:: HtmlTree = BT HtmlCode // simple code
| (@@:) infix 0 TaskName 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
| DivCode String HtmlTree // code that should be labeled with a div, used for Ajax and Client technology
| (@@:) infix 0 !TaskName !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
| DivCode !String !HtmlTree // code that should be labeled with a div, used for Ajax and Client technology
:: 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
:: TaskName :== !(!UserId,!ProcessNr,!WorkflowLabel,!TaskLabel) // id of user, workflow process name, task name
:: TaskName :== !(!UserId,!ProcessNr,!WorkflowLabel,!String) // id of user, workflow process name, task name
:: HtmlCode :== ![BodyTag] // for prompting /inting html code
instance == GarbageCollect
// Here follow some commonly used internal functions
......@@ -78,4 +93,3 @@ pageFormId :: !Options !String !a -> FormId a
storageFormId :: !Options !String !a -> FormId a
......@@ -4,10 +4,14 @@ implementation module InternaliTasksCommon
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import StdList, StdArray, StdFunc
import StdList, StdArray, StdFunc, StdTuple
import iDataHandler, iDataFormData, iDataTrivial
import iTasksSettings
import InternaliTasksThreadHandling
import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
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 [] = ""
......@@ -179,4 +183,46 @@ pageFormId options s d = cFormId options s d <@ if (options.tasklife == Client)
storageFormId :: !Options !String !a -> FormId a
storageFormId options s d = cFormId options s d <@ NoForm
// ******************************************************************************************************
instance == GarbageCollect
where
(==) Collect Collect = True
(==) NoCollect NoCollect = True
(==) _ _ = False
// ******************************************************************************************************
// TCl specialization
// ******************************************************************************************************
write{|TCl|} write_a (TCl task) wst
= write{|*|} (copy_to_string task) wst
read {|TCl|} read_a wst
# (Read str i file) = read{|*|} wst
= Read (TCl (deserialize str)) i file
where
deserialize :: .String -> .(Task .a)
deserialize str = fst (copy_from_string {c \\ c <-: str })
gPrint{|TCl|} ga (TCl task) ps = ps <<- copy_to_string task
gParse{|TCl|} ga expr
# mbstring = parseString expr
| isNothing mbstring = Nothing
= Just (TCl (fst(copy_from_string {s` \\ s` <-: fromJust mbstring})))
where
parseString :: Expr -> Maybe String
parseString expr = gParse{|*|} expr
gUpd{|TCl|} gc (UpdSearch _ 0) c = (UpdDone, c)
gUpd{|TCl|} gc (UpdSearch val cnt) c = (UpdSearch val (cnt - 2),c)
gUpd{|TCl|} gc (UpdCreate l) _
# (mode,default) = gc (UpdCreate l) undef
= (UpdCreate l, TCl (\tst -> (default,tst)))
gUpd{|TCl|} gc mode b = (mode, b)
gForm{|TCl|} gfa (init,formid) hst
= ({value=formid.ival,changed=False,form=[]},hst)
......@@ -6,7 +6,7 @@ definition module InternaliTasksThreadHandling
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import InternaliTasksCommon
import iTasksTypes
:: ThreadTable :== [TaskThread] // thread table is used for Ajax and OnClient options
:: TaskThread = { thrTaskNr :: !TaskNr // task number to recover
......@@ -33,8 +33,11 @@ instance == ThreadKind
// *********************************************************************************************************************************
// calculateTasks calculates the task tree, either from the root of the task tree or from the root of the parent thread
// depending on the IF_Ajax setting
// parameters: id of the user, global info of user, trace on?, main task expression to calculate, initial state
// returns: toServer,thrOwner,event,thrinfo,threads
// *********************************************************************************************************************************
// calculateTasks :: currentUsserId pversion traceOn maintask ->
calculateTasks :: !Int !GlobalInfo !Bool !(Task a) !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) | iData a
// Setting of global information for a particular user
......@@ -42,6 +45,10 @@ calculateTasks :: !Int !GlobalInfo !Bool !(Task a) !*TSt -> ((!Bool,!Int,!TaskNr
setPUserNr :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
clearIncPUser :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
// Session version management
setSVersionNr :: !Int !(Int -> Int) !*HSt -> (!Int,!*HSt)
// Displaying thread information
showThreadNr :: !TaskNr -> String
......
......@@ -20,6 +20,7 @@ derive gerda Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo
derive read Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo, TaskThread, ThreadKind
derive write Lifespan, GarbageCollect, StorageFormat, Mode, Options, GlobalInfo, TaskThread, ThreadKind
:: ThreadTable :== [TaskThread] // thread table is used for Ajax and OnClient options
:: TaskThread = { thrTaskNr :: !TaskNr // task number to recover
, thrUserId :: !UserId // which user has to perform the task
......@@ -62,6 +63,8 @@ where
toString _ = "??? print error in thread"
// ******************************************************************************************************
// Storage Utilities for storing global information for each user
// ******************************************************************************************************
setPUserNr :: !Int !(Int -> Int) !*HSt -> (!GlobalInfo,!*HSt)
setPUserNr user f hst = setPUser user (\r -> {r & versionNr = f r.versionNr}) hst
......@@ -88,6 +91,17 @@ where
defaultGlobalInfo = { versionNr = 0, newThread = False, deletedThreads = []}
// ******************************************************************************************************
// Version number management for one user
// ******************************************************************************************************
setSVersionNr :: !Int !(Int -> Int) !*HSt -> (!Int,!*HSt)
setSVersionNr user f hst
# (form,hst) = mkStoreForm (Init, nFormId (usersessionVersionNr user) 0 <@ NoForm) f hst
= (form.value,hst)
// ******************************************************************************************************
// The calculateTasks function calculates the task tree, either from scratch (top down form root)
// or by evaluating the corresponding task sub tree using the stored threads
......
......@@ -8,7 +8,7 @@ definition module JSON
* For more info about JSON see: http://www.json.org/
*/
import StdGeneric, StdMaybe, GenBimap
import StdGeneric, StdMaybe
//Abstract token type which is the intermediary representation during JSON parsing
:: Token
......
......@@ -8,8 +8,19 @@ definition module TaskTreeFilters
import iTasksTypes
/*
noFilter :: Without applying any filter it fetches all html code out of the HtmlTree
Filter :: Filters out the html code for a specific user
Arguments: Bool True if a whole new page has to be generated,
First UserId is id of user logged in,
Second UserId is id of user that owns the thread (if it is a thread),
The HtmlTree to inspects,
The HSt for generating navigation buttons.
Returns: Whole new page html code for the task (if a whole page is demanded),
header indicating chosen task, buttons to choose a main task, buttons to choose a subtask)
Html code of a chosen task if not a whole page is demanded
*/
noFilter :: HtmlTree -> HtmlCode
Filter :: !Bool !UserId !UserId !HtmlTree !*HSt -> *(![BodyTag],![BodyTag],![BodyTag],![BodyTag],![BodyTag],!*HSt)
collect :: !UserId !UserId ![(!ProcessNr,!WorkflowLabel,!TaskLabel,![BodyTag])] !HtmlTree -> (![BodyTag],![(!ProcessNr,!WorkflowLabel,!TaskLabel,![BodyTag])])
noFilter :: !HtmlTree -> HtmlCode
Filter :: !Bool !UserId !UserId !HtmlTree !*HSt -> *(![BodyTag],![BodyTag],![BodyTag],![BodyTag],![BodyTag],!*HSt)
......@@ -10,6 +10,35 @@ import StdEnv
import iDataFormlib
import InternaliTasksCommon, iTasksHtmlSupport
/*
ncollect :: !UserId !UserId !HtmlTree -> (![BodyTag],![(!ProcessNr,!WorkflowLabel,!TaskLabel,![BodyTag])])
ncollect thisuser taskuser htmltree = ncollect` thisuser taskuser [] ((taskuser,0,defaultWorkflowName,"main") @@: htmltree)
where
ncollect` thisuser taskuser accu ((nuserid,processnr,workflowLabel,taskname) @@: tree) // collect returns the wanted code, and the remaining code
# (myhtml,accu) = ncollect` thisuser nuserid accu tree // collect all code of this user belonging to this task
| thisuser == nuserid && not (isEmpty myhtml)
= ([],[(processnr,workflowLabel,taskname,myhtml):accu])
| otherwise = ([],accu)
ncollect` thisuser taskuser accu (nuser -@: tree)
| thisuser == nuser = ([],accu)
| otherwise = ncollect` thisuser taskuser accu tree
ncollect` thisuser taskuser accu (tree1 +|+ tree2)
# (lhtml,accu) = ncollect` thisuser taskuser accu tree1
# (rhtml,accu) = ncollect` thisuser taskuser accu tree2
= (lhtml <|.|> rhtml,accu)
ncollect` thisuser taskuser accu (tree1 +-+ tree2)
# (lhtml,accu) = ncollect` thisuser taskuser accu tree1
# (rhtml,accu) = ncollect` thisuser taskuser accu tree2
= ([lhtml <=> rhtml],accu)
ncollect` thisuser taskuser accu (BT bdtg)
| thisuser == taskuser = (bdtg,accu)
| otherwise = ([],accu)
ncollect` thisuser taskuser accu (DivCode id tree)
# (html,accu) = ncollect` thisuser taskuser accu tree
| thisuser == taskuser = (mkDiv True id html,accu)
= ([],accu)
*/
initialOptions :: !UserId !Lifespan -> !Options
initialOptions thisUser location
= { tasklife = if (thisUser >= 0) location Session
......
......@@ -12,11 +12,13 @@ import DrupBasic
import iDataTrivial, iDataFormlib
import iTasksTypes, iTasksLiftingCombinators