Skip to content

GitLab

I
iTasks-SDK
Commit 7d1906ab authored by Thomas van Noort's avatar Thomas van Noort
Browse files
Options

*** empty log message *** 


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@166 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent fac33850
Hide whitespace changes
Inline Side-by-side
Showing with 2 additions and 2783 deletions
iTasks/iTasks.dcl deleted 100644 → 0
View file @ fac33850
definition module iTasks
// iTasks library for defining interactive multi-user workflow tasks (iTask) for the web.
// Defined on top of the iData library.
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006,2007,2008 - MJP
// This library is still under construction - MJP
iTaskVersion :== "0.99 - April 2008 - "
import iDataSettings, iDataButtons, StdBimap
derive gForm Void, Wid, TCl
derive gUpd Void, Wid, TCl
derive gPrint Void, Wid, TCl
derive gParse Void, Wid, TCl
derive gerda Void, Wid
derive read Void, Wid, TCl
derive write Void, Wid, TCl
// iTask types
:: Task a :== *TSt -> *(!a,!*TSt) // an iTask is state stransition
:: LabeledTask a :== !(!TaskLabel,!Task a) // a Task with a label used for labeling buttons, pull down menu, and the like
:: TCl a = TCl !.(Task a) // task closure, container for a task used for higher order tasks (task which deliver a task)
:: *TSt // TSt is abstract task state
:: TaskLabel :== !String // label name
:: UserId :== !Int // a user id of an iTask user must be a unique integer value
// iTask workflow processes types
:: Wid a // reference to a workflow process
:: WorkflowStatus = WflActive // iTask workflow process is still being processed
| WflSuspended // it is (temporally) suspended
| WflFinished // it is finshed
| WflDeleted // it does not exist anymore because it is deleted
instance == WorkflowStatus
// general types
:: HtmlCode :== ![BodyTag] // most programmers will only write bodytags
:: Void = Void // for tasks returning non interesting results, won't show up in editors either
// *********************************************************************************************************************************
// Setting global options for any collection of iTask workflows:
class (<<@) infixl 3 b :: !(Task a) !b -> Task a
class (@>>) infixl 7 b :: !b !(Task a) -> Task a | iData a
instance <<@ Lifespan // default: Session
, StorageFormat // default: PlainString
, Mode // default: Edit
, GarbageCollect // default: Collect
instance @>> SubPage // default: the *whole* page will be updated when a form has been modified
// Lifespan, StorageFormat, Mode are already defined in iTask library
:: GarbageCollect = Collect // garbage collect iTask administration
| NoCollect // no garbage collection
:: SubPage = UseAjax // use Ajax technology to update part of a page, only works if Ajax enabled
| OnClient // use SAPL to update part of a page on the client, only works if Client enabled and Sapl is running...
// *********************************************************************************************************************************
/* Initiate the iTask library with an iData server wrapper such as doHtmlServer in combination with one of the following functions:
singleUserTask :: iTask start function for defining tasks for one, single user
multiUserTask :: iTask start function for multi-users, with option in window to switch between [0..users - 1]
workFlowTask :: iTask start function for a real workflow
- the first arument has to be an itask which is used for login purposes; it should yield
Bool: True, is the user a new one: if so the second argument is spawned as a separate task for that user
UserId: the id of that user
- the second argument is workflow that will spawned as a task
(True if we have new user,user id of the user, has ) :
- the second one is the actual function for that user
a predefined login task is defined in iTaskLogin.dcl
*/
singleUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
multiUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a))
!(UserId a -> LabeledTask b) !*HSt -> (!Bool,Html,*HSt) | iData b
:: StartUpOptions = TraceOn | TraceOff // for single & multiUser: default = TraceOn
| ThreadStorage Lifespan // for Ajax: where to store threadinformation: default = TxtFile
| ShowUsers Int // for multiUserTask, toggle between given maximum number of users, default: ShowUser 5
| VersionCheck | NoVersionCheck // for single & multiUser: default = VersionNoCheck
| TestModeOn | TestModeOff // emties storages when starting from scratch: On for single and multi-user tasks
| MyHeader HtmlCode // wil replace standard iTask information line
// *********************************************************************************************************************************
/* iTask Workflow process management:
spawnWorkflow :: spawn an iTask workflow as a new separate process, Wid is a handle to that process, bool indicates whether it is active or suspended
waitForWorkflow :: wait until the indicated process is finished and obtain the resulting value; returns Nothing when process is deleted
getWorkflowStatus :: get status of workflow
deleteWorkflow :: delete iTask workflow; returns False if workflow does not exist anymore
suspendWorkflow :: suspend iTask workflow, all corresponding tasks will vanish temporally; returns False if workflow does not exist anymore
activateWorkflow :: activate the iTask workflow again; returns False if workflow does not exist anymore
suspendMe :: suspend current workflow process; no effect on start task
deleteMe :: delete current workflow process; no effect on start task
changeWorkflowUser :: transfer the workflow task to the indicated user; returns False if workflow does not exist anymore
*/
spawnWorkflow :: !UserId !Bool !(LabeledTask a) -> Task (Wid a) | iData a
waitForWorkflow :: !(Wid a) -> Task (Maybe a ) | iData a
getWorkflowStatus :: !(Wid a) -> Task WorkflowStatus
activateWorkflow :: !(Wid a) -> Task Bool
suspendWorkflow :: !(Wid a) -> Task Bool
deleteWorkflow :: !(Wid a) -> Task Bool
changeWorkflowUser :: !UserId !(Wid a) -> Task Bool
suspendMe :: (Task Void)
deleteMe :: (Task Void)
// *********************************************************************************************************************************
/* Here follow the iTasks combinators:
Basic editors:
editTask :: create a task editor to edit a value of given type, and add a button with given name to finish the task
editTask :: create a task editor (with submit button) to edit a value of given type, finish only if predicate holds
Standard monadic combinators on iTasks:
(=>>) :: for sequencing: bind
return_V :: lift a value to the iTask domain and return it
Prompting variants:
(?>>) :: prompt as long as task is active but not finished
(!>>) :: prompt when task is activated
(<<?) :: as ?>>, except that prompt is displayed *after* task
(<<!) :: as !>>, except that prompt is displayed *after* task
Assign tasks to user with indicated id:
assignTaskTo :: assign task to indicated user, True for verbose reporting
Repetition and loops:
foreverTask :: infinitely repeating Task
(<!) :: repeat task (as a loop) as long as predicate does not hold; also works for tasks that don't require any user interactions (e.g. database access)
Sequencing Tasks:
seqTasks :: do all iTasks one after another, task completed when all done
Choose the tasks you want to do one forehand:
chooseTask_btn :: choose ONE task by pressing a button, True for horizontal buttons, else vertical
chooseTask_pdm :: as chooseTask_btn, depending on pulldownmenu item selected, Int for initial value
chooseTask_radio:: as chooseTask_btn, depending on radio item selected, Int for initial value, htmlcode for option explanation
chooseTask_cb :: choice N tasks out of N, order of chosen task depending on first arg
(initial setting, effect for all when set, explanation) for each option
Do m Tasks parallel / interleaved and FINISH as soon as SOME Task completes:
orTask2 :: do both iTasks in any order, combined task completed as any subtask is done
andTask2 :: do both iTasks in any order (interleaved), task completed when both done
andTasksCond :: do tasks in any order until pred holds for finished tasks, string used for naming group of task navigation buttons
*/
editTask :: !String !a -> Task a | iData a
editTaskPred :: !a !(a -> (Bool, HtmlCode)) -> Task a | iData a
(=>>) infixl 1 :: !(Task a) !(a -> Task b) -> Task b | iCreateAndPrint b
return_V :: !a -> Task a | iCreateAndPrint a
(?>>) infixr 5 :: !HtmlCode !(Task a) -> Task a | iCreate a
(!>>) infixr 5 :: !HtmlCode !(Task a) -> Task a | iCreate a
(<<?) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
(<<!) infixl 5 :: !(Task a) !HtmlCode -> Task a | iCreate a
assignTaskTo :: !Bool !UserId !(LabeledTask a) -> Task a | iData a
foreverTask :: !(Task a) -> Task a | iData a
(<!) infixl 6 :: !(Task a) !(a -> .Bool) -> Task a | iCreateAndPrint a
seqTasks :: ![LabeledTask a] -> Task [a] | iCreateAndPrint a
chooseTask_btn :: !HtmlCode !Bool![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_pdm :: !HtmlCode !Int ![LabeledTask a] -> Task a | iCreateAndPrint a
chooseTask_radio:: !HtmlCode !Int ![(HtmlCode,LabeledTask a)]
-> Task a | iCreateAndPrint a
:: ChoiceUpdate :== !Bool [Bool] -> [Bool] // changed checkbox + current settings -> new settings
chooseTask_cbox :: !([LabeledTask a] -> Task [a])
!HtmlCode ![((!Bool,!ChoiceUpdate,!HtmlCode),LabeledTask a)]
-> Task [a] | iData a
orTask2 :: !(Task a,Task b) -> Task (EITHER a b)
| iCreateAndPrint a & iCreateAndPrint b
andTask2 :: !(Task a,Task b) -> Task (a,b) | iCreateAndPrint a & iCreateAndPrint b
andTasksCond :: !String !([a] -> Bool) ![LabeledTask a] -> (Task [a]) | iData a
/* Time and Date management:
waitForTimeTask :: Task is done when time has come
waitForDateTask :: Task is done when date has come
*/
waitForTimeTask :: !HtmlTime -> Task HtmlTime
waitForDateTask :: !HtmlDate -> Task HtmlDate
/* Experimental department:
May not work when the tasks are garbage collected !!
-!> :: a task, either finished or interrupted (by completion of the first task) is returned in the closure
if interrupted, the work done so far is returned (!) which can be continued somewhere else
channel :: splits a task in respectively a sender task closure and receiver taskclosure;
when the sender is evaluated, the original task is evaluated as usual;
when the receiver task is evaluated, it will wait upon completeion of the sender and then get's its result;
Important: Notice that a receiver will never finish if you don't activate the corresponding receiver somewhere.
*/
(-!>) infix 4 :: (Task stop) (Task a) -> Task (Maybe stop,TCl a) | iCreateAndPrint stop & iCreateAndPrint a
channel :: String (Task a) -> Task (TCl a,TCl a) | iCreateAndPrint a
/* Exception Handling:
<^> :: Evaluate the task; An exception of type e raised by this task, will be catched by the closest handler.
One can use the function create a proper task value or signal the fact that an exception has occured.
Raise :: Raises an exception of type e which will be catched by the closest parent handler for this type
*/
(<^>) infix 1 :: !(e -> a) !(Task a) -> Task a | iData a & TC e // assigns an exception Handler
Raise :: e -> Task a | iCreate a & TC e // rases an exception
// *********************************************************************************************************************************
/* Support for user defined combinators
mkTask :: for making a user defined combinator, name will appear intrace
newTask :: same, but optimized: after completion only result will remembered
Once :: task will be done only once, the value of the task will be remembered, important for side effecting functions lifted to iData domain
*/
mkTask :: !String !(Task a) -> Task a | iCreateAndPrint a
newTask :: !String !(Task a) -> Task a | iData a
Once :: !String !(Task a) -> Task a | iData a
// *********************************************************************************************************************************
/* Lifting of other domains to the iTask domain
(*>>) :: lift functions of type (TSt -> (a,TSt)) to iTask domain
(@>>) :: lift functions of (TSt -> TSt) to iTask domain
appIData :: lift iData editors to iTask domain
appIData2 :: lift iData editors to iTask domain, and pass iDataTasknumber for naming convenience
appHStOnce :: lift HSt domain to TSt domain, will be executed only once; string used for tracing
appHSt :: lift HSt domain to TSt domain, will be executed on each invocation; string used for tracing
*/
(*=>) infix 4 :: (TSt -> (a,TSt)) (a -> Task b) -> Task b
(*#>) infix 4 :: (TSt -> TSt) (Task a) -> Task a
appIData :: (IDataFun a) -> Task a | iData a
appIData2 :: (String *HSt -> *(Form a,*HSt)) -> Task a | iData a
appHStOnce :: !String (HSt -> (a,HSt)) -> Task a | iData a
appHSt :: !String (HSt -> (a,HSt)) -> Task a | iData a
appWorldOnce :: !String (*World -> *(a,*World)) -> Task a | iData a
appWorld :: !String (*World -> *(a,*World)) -> Task a | iData a
// *********************************************************************************************************************************
/* Operations on Task state
taskId :: give id of user assigned to task
userId :: give id of application user
addHtml :: add html code
*/
taskId :: TSt -> (Int,TSt)
userId :: TSt -> (Int,TSt)
addHtml :: HtmlCode TSt -> TSt
// *********************************************************************************************************************************
iTasks/iTasks.icl deleted 100644 → 0
View file @ fac33850
implementation module iTasks
// (c) iTask & iData Concept and Implementation by Rinus Plasmeijer, 2006-2008 - MJP
// iTasks library for defining interactive multi-user workflow tasks (iTask) for the web.
// Defined on top of the iData library.
import StdEnv, StdBimap, StdOrdList
import iDataSettings, iDataHandler, iDataTrivial, iDataButtons, iDataFormlib, iDataStylelib
import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
import DrupBasic
import iTasksSettings
derive gForm Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus, Maybe, []
derive gUpd Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus, Maybe, []
derive gParse Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus, Maybe
derive gPrint Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus, Maybe
derive gerda Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus
derive read Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus
derive write Void, Options, Lifespan, Mode, StorageFormat, GarbageCollect, GlobalInfo, TaskThread, ThreadKind, Wid, WorkflowStatus
:: *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
, workflowLink :: !WorkflowLink // process table entry information
, 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
}
:: UserId :== !Int
:: TaskNr :== [Int] // task nr i.j is adminstrated as [j,i]
:: 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
:: Options = { tasklife :: !Lifespan // default: Session
, taskstorage :: !StorageFormat // default: PlainString
, taskmode :: !Mode // default: Edit
, gc :: !GarbageCollect // default: Collect
}
:: StaticInfo = { currentUserId :: UserId // id of application user
, threadTableLoc:: !Lifespan // where to store the server thread table, default is Session
}
:: GarbageCollect = Collect | NoCollect
:: 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
:: 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
, thrWorkflowLink :: !WorkflowLink// what was the name of workflow process it was part off
, thrOptions :: !Options // options of the task
, thrCallback :: !String // serialized callback function for the server
, thrCallbackClient :: !String // serialized callback function for the client (optional, empty if not applicable)
, thrKind :: !ThreadKind // kind of thread
, thrVersionNr :: !Int // version number of application when thread was created
}
:: ThreadKind = ServerThread // Thread which can only be executed on Server
| ClientServerThread // Thread preferably to be executed on Client, but also runs on Server
| ClientThread // Thread which can only be executed on the Client
| ExceptionHandler // Exception handler only works on server
| AnyThread // Used for garbage collection
:: GlobalInfo = { versionNr :: !Int // latest querie number of a user
, newThread :: !Bool // is a new thread assigned to this user (used for Ajax)?
, deletedThreads :: ![TaskNr] // are there threads deleted (used for Ajax)?
}
:: UserStartUpOptions
= { traceOn :: !Bool
, threadStorageLoc :: !Lifespan
, showUsersOn :: !Maybe !Int
, versionCheckOn :: !Bool
, headerOff :: !Maybe HtmlCode
, testModeOn :: !Bool
}
:: Wid a = Wid WorkflowLink // id of workflow process
:: WorflowProcess = ActiveWorkflow ProcessIds !(TCl !Dynamic)
| SuspendedWorkflow ProcessIds !(TCl !Dynamic)
| FinishedWorkflow ProcessIds !Dynamic !(TCl !Dynamic)
| DeletedWorkflow ProcessIds
:: TaskName :== !(!UserId,!ProcessNr,!WorkflowLabel,!TaskLabel) // id of user, workflow process name, task name
:: WorkflowLink :== !(Entry,ProcessIds) // entry in table together with unique id which is used for checking whether the reference is still valid
:: ProcessIds :== !(!UserId,!ProcessNr,!WorkflowLabel) // user id, process id and name given to a workflow process; is used as unique identifier in process table
:: WorkflowLabel :== !String
:: Entry :== !Int
:: ProcessNr :== !Int
// Initial values
defaultUser :== 0 // default id of user
defaultWorkflowName :== "start" // name of initial workflow process
//defaultWid :== 0 // initial workflow process id
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
}
initialOptions :: !UserId !Lifespan -> !Options
initialOptions thisUser location
= { tasklife = if (thisUser >= 0) location Session
, taskstorage = PlainString
, taskmode = Edit
, gc = Collect
}
initStaticInfo :: UserId !Lifespan -> StaticInfo
initStaticInfo thisUser location
= { currentUserId = thisUser
, threadTableLoc= location
}
defaultStartUpOptions :: UserStartUpOptions
defaultStartUpOptions
= { traceOn = True
, threadStorageLoc = TxtFile // KLOPT DIT WEL ????
, showUsersOn = Just 5
, versionCheckOn = False
, headerOff = Nothing
, testModeOn = True
}
// ******************************************************************************************************
// Overloaded Functions on Tasks
// ******************************************************************************************************
class (<<@) infixl 3 b :: !(Task a) !b -> (Task a)
instance <<@ Lifespan
where (<<@) task lifespan = setTaskLifespan
where
setTaskLifespan tst=:{options}
= IF_Ajax
(IF_ClientServer // we running both client and server
(IF_ClientTasks
(if (options.tasklife == Client && (lifespan == TxtFile || lifespan == DataFile || lifespan == Database))
(abort "Cannot make persistent storage on Client\n")
(\tst -> task {tst & options.tasklife = lifespan})) // assign option on client
(\tst -> task {tst & options.tasklife = lifespan})tst // assign option on server
)
(task {tst & options.tasklife = lifespan}) // assign option on server
)
(task {tst & options.tasklife = lifespan}) // assign option on server
instance <<@ StorageFormat
where (<<@) task storageformat = \tst -> task {tst & options.taskstorage = storageformat}
instance <<@ Mode
where (<<@) task mode = \tst -> task {tst & options.taskmode = mode}
instance <<@ GarbageCollect
where (<<@) task gc = \tst -> task {tst & options.gc = gc}
class (@>>) infixl 7 b :: !b !(Task a) -> (Task a) | iData a
instance @>> SubPage
where (@>>) UseAjax task = \tst -> IF_Ajax
(mkTaskThread UseAjax task tst)
(newTask "Ajax Thread Disabled" task tst)
(@>>) OnClient task = \tst -> IF_Ajax
(mkTaskThread OnClient task tst)
(newTask "Client Thread Disabled" task tst)
instance == GarbageCollect
where
(==) Collect Collect = True
(==) NoCollect NoCollect = True
(==) _ _ = False
instance == ThreadKind
where
(==) ServerThread ServerThread = True
(==) ClientThread ClientThread = True
(==) ClientServerThread ClientServerThread = True
(==) ExceptionHandler ExceptionHandler = True
(==) AnyThread _ = True
(==) _ _ = False
instance == WorkflowStatus
where
(==) WflActive WflActive = True
(==) WflSuspended WflSuspended = True
(==) WflFinished WflFinished = True
(==) WflDeleted WflDeleted = True
(==) _ _ = False
instance toString ThreadKind
where
toString ServerThread = "ServerThread"
toString ClientThread = "ClientThread"
toString ClientServerThread = "ClientServerThread"
toString ExceptionHandler = "ExceptionHandler"
toString AnyThread = "AnyThread"
toString _ = "??? print error in thread"
determineUserOptions :: ![StartUpOptions] -> UserStartUpOptions
determineUserOptions startUpOptions = determineUserOptions` startUpOptions defaultStartUpOptions
where
determineUserOptions` [] options = options
determineUserOptions` [TraceOn:xs] options = determineUserOptions` xs {options & traceOn = True}
determineUserOptions` [TraceOff:xs] options = determineUserOptions` xs {options & traceOn = False}
determineUserOptions` [ThreadStorage nloc:xs] options = determineUserOptions` xs {options & threadStorageLoc = nloc}
determineUserOptions` [ShowUsers max:xs] options = determineUserOptions` xs {options & showUsersOn = if (max <= 0) Nothing (Just max)}
determineUserOptions` [VersionCheck:xs] options = determineUserOptions` xs {options & versionCheckOn = True}
determineUserOptions` [NoVersionCheck:xs] options = determineUserOptions` xs {options & versionCheckOn = False}
determineUserOptions` [MyHeader bodytag:xs] options = determineUserOptions` xs {options & headerOff = Just bodytag}
determineUserOptions` [TestModeOn:xs] options = determineUserOptions` xs {options & testModeOn = True}
determineUserOptions` [TestModeOff:xs] options = determineUserOptions` xs {options & testModeOn = False}
// ******************************************************************************************************
// *** wrappers for the end user, to be used in combination with an iData wrapper...
// ******************************************************************************************************
singleUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
singleUserTask startUpOptions maintask hst
# userOptions = determineUserOptions [ThreadStorage TxtFile:startUpOptions]
# tst = initTst 0 Session userOptions.threadStorageLoc hst
# (exception,html,hst) = startTstTask 0 False (False,[]) userOptions maintask tst
= mkHtmlExcep "singleUser" exception html hst
multiUserTask :: ![StartUpOptions] !(Task a) !*HSt -> (!Bool,Html,*HSt) | iData a
multiUserTask startUpOptions maintask hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# nusers = case userOptions.showUsersOn of
Nothing -> 0
Just n -> n
| nusers == 0 = singleUserTask startUpOptions maintask hst
# (idform,hst) = FuncMenu (Init,nFormId "User_Selected"
(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
# currentWorker = snd idform.value
# tst = initTst currentWorker TxtFile userOptions.threadStorageLoc hst
# (exception,html,hst) = startTstTask currentWorker True
(if userOptions.traceOn (idform.changed,idform.form) (False,[])) userOptions maintask tst
= mkHtmlExcep "multiUser" exception html hst
workFlowTask :: ![StartUpOptions] !(Task ((Bool,UserId),a)) !(UserId a -> LabeledTask b) !*HSt -> (!Bool,Html,*HSt) | iData b
workFlowTask startUpOptions taska userTask hst
# userOptions = determineUserOptions startUpOptions
# tst = initTst -1 Session userOptions.threadStorageLoc hst
# (((new,i),a),tst=:{activated,html,hst}) = taska tst // for doing the login
| not activated
# iTaskHeader = [showHighLight "i-Task", showLabel " - Multi-User Workflow System ",Hr []]
# iTaskInfo = mkDiv "iTaskInfo" [showText "Login procedure... ", Hr []]
= mkHtmlExcep "workFlow" True [Ajax [ ("thePage",iTaskHeader ++ iTaskInfo ++ noFilter html) // Login ritual cannot be handled by client
]] hst
# userOptions = determineUserOptions [TestModeOff, VersionCheck, ThreadStorage TxtFile:startUpOptions]
# tst = initTst i Session userOptions.threadStorageLoc hst
# (exception,body,hst) = startTstTask i True (False,[]) userOptions (newUserTask ((new,i),a) <<@ TxtFile) tst
= mkHtmlExcep "workFlow" exception body hst
where
noFilter :: HtmlTree -> HtmlCode
noFilter (BT body) = body
noFilter (_ @@: html) = noFilter html
noFilter (_ -@: html) = noFilter html
noFilter (htmlL +-+ htmlR) = [noFilter htmlL <=> noFilter htmlR]
noFilter (htmlL +|+ htmlR) = noFilter htmlL <|.|> noFilter htmlR
noFilter (DivCode str html) = noFilter html
newUserTask ((True,i),a) = (spawnWorkflow i True (userTask i a)) =>> \_ -> return_V Void
newUserTask _ = return_V Void
// ******************************************************************************************************
// Main routine for the creation of the workflow page
// ******************************************************************************************************
startTstTask :: !Int !Bool !(!Bool,!HtmlCode) UserStartUpOptions !(Task a) !*TSt -> (!Bool,!HtmlCode,!*HSt) | iData a
startTstTask thisUser multiuser (userchanged,multiuserform) useroptions=:{traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff, testModeOn} maintask tst=:{hst,tasknr,staticInfo}
// prologue
| thisUser < 0 = abort "Users should have id's >= 0 !\n"
# (refresh,hst) = simpleButton refreshId "Refresh" id hst
# (traceAsked,hst) = simpleButton traceId "ShowTrace" (\_ -> True) hst
# doTrace = traceAsked.value False
# versionsOn = IF_ClientTasks False versionCheckOn // no version control on client
# noNewVersion = not versionsOn || refresh.changed || traceAsked.changed || userchanged // no version control in these cases
# (appversion,hst) = setAppversion inc hst
# (pversion,hst) = setPUserNr thisUser id hst
# (sversion,hst) = setSVersionNr thisUser id hst
# versionconflict = sversion > 0 && sversion < pversion.versionNr && not noNewVersion // test if there is a version conflict
# iTaskHeader = [Table [Tbl_Width (Percent 100)] [Tr []
[ Td [] [Img [Img_Src (ThisExe +++ "/img/clean-logo.jpg"),Img_Align Alo_Middle]
,showHighLight " i -Task", showLabel " Workflow System "]
, Td [Td_Align Aln_Right] (multiuserform ++ refresh.form ++ ifTraceOn traceAsked.form)] ]]++
[Hr []]
| versionconflict
# iTaskInfo = mkDiv "iTaskInfo" [showLabel "Cannot apply request. Version conflict. Please refresh the page!", Hr []]
= (True,[Ajax [ ("thePage",iTaskHeader ++ iTaskInfo)
]
],hst)
// Here the iTasks are evaluated ...
# maintask = scheduleWorkflows maintask // schedule all active tasks, not only maintask
# ((toServer,thrOwner,event,thrinfo,threads),tst=:{html,hst,trace,activated})
= ((IF_Ajax (startAjaxApplication thisUser pversion) startMainTask)
maintask) {tst & hst = hst, trace = if doTrace (Just []) Nothing, activated = True, html = BT []}
// epilogue
# 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