iTasks.icl

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
					, workflowName	:: !WorkflowName	// wid and name of the workflow process a task is part of
					, 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]
:: WorkflowName	:== !(WorkflowId,WorkflowLabel)			// wid and name of the workflow process a task is part of
:: WorkflowId	:== !Int
:: WorkflowLabel:== !String
:: 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
:: TaskName		:== !(UserId,WorkflowName,!TaskLabel)	// id of user, workflow process name, task name
:: 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
					, thrWorkflowName	:: !WorkflowName// 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 WorkflowName					// id of workflow process
:: WorflowProcess 	= ActiveWorkflow 	!WorkflowLabel !(TCl Dynamic)
					| SuspendedWorkflow !WorkflowLabel !(TCl Dynamic)
					| FinishedWorkflow 	!WorkflowLabel !Dynamic !(TCl Dynamic)
					| DeletedWorkflow	!WorkflowLabel

// Initial values

defaultUser			:== 0								// default id of user
defaultWorkflowName :== "start"							// name of initial workflow process
defaultWid			:== 0								// initial workflow process id

initTst :: UserId !Lifespan !*HSt -> *TSt
initTst thisUser location hst
				=	{ tasknr		= [-1]
					, activated 	= True
					, staticInfo	= initStaticInfo thisUser location
					, userId		= if (thisUser >= 0) defaultUser thisUser
					, workflowName	= (defaultWid,defaultWorkflowName)
					, html 			= BT []
					, trace			= Nothing
					, hst 			= hst
					, options 		= initialOptions
					}

initialOptions :: Options
initialOptions	=	{ tasklife 		= 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 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 startUpOptions
# tst					= initTst 0 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 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 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 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


/*
workFlowTask :: ![StartUpOptions] !(Task (UserId,a)) !((UserId,a) -> Task b) !*HSt -> (!Bool,Html,*HSt) | iData b 
workFlowTask  startUpOptions taska iataskb hst 
# userOptions 						= determineUserOptions startUpOptions 
# tst								= initTst -1 userOptions.threadStorageLoc hst
# ((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
# tst								= initTst i userOptions.threadStorageLoc hst
# (exception,body,hst) 				= startTstTask i True (False,[]) userOptions (iataskb (i,a)) 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
*/

// ******************************************************************************************************
// 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) {traceOn, threadStorageLoc, showUsersOn, versionCheckOn, headerOff, testModeOn} maintask tst=:{hst,tasknr,staticInfo}

// prologue

# maintask				= activateWorkflows maintask												// force main process to start on tasknr 0.1

| 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 +++ "/scleanlogo.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 iTask starts...
													    
# ((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

# showCompletePage		= IF_Ajax (hd threads == [-1]) True
# (threadtrace,tst=:{hst})	
						= if TraceThreads showThreadTable nilTable {tst & hst = hst} 
# threadsText			= if showCompletePage "" (foldl (+++) "" [showThreadNr tasknrs +++ " + " \\ tasknrs <- reverse threads])
# (processadmin,hst)	= showWorkflows activated hst
# (threadcode,taskname,mainbuts,subbuts,seltask,hst)	
						= Filter showCompletePage thrOwner html hst

# iTaskInfo				= 	mkDiv "iTaskInfo" 
							case headerOff of
								Nothing ->
									(	IF_Ajax (IF_ClientServer (IF_ClientTasks [showLabel "Client: "] [showLabel "Server: "]) []) [] ++
										if multiuser 
											[showText "User: " , showLabel thisUser, showText " - "] [] ++
										if (thrinfo == "" ) [] [showLowLight thrinfo, showText " - "] ++
										if (multiuser && versionsOn)
											 [showText "Query " , showTrace ((sversion +++> " / " )<+++ appversion)] [] ++
										IF_Ajax
											( [showText " - Task#: ", showTrace (showTaskNr  event)] ++
											  if (isNil threads || showCompletePage) [] [showText " - Thread(s)#: ", showTrace threadsText]
											 ) [] ++
										[Br,Hr []]
									)
								Just userInfo -> userInfo
# iTaskTraceInfo		=	showOptions staticInfo.threadTableLoc ++ processadmin ++ threadtrace ++ [printTrace2 trace ]
| showCompletePage		=	(toServer,[Ajax [("thePage",	iTaskHeader ++
															iTaskInfo  ++
															if (doTrace && traceOn)
																	iTaskTraceInfo
																	[	[[BodyTag taskname, Br] <||> mainbuts] <=>
																		[BodyTag subbuts,Br,Br, BodyTag seltask]
																	]
											)]
									] 
							,hst)
# (newthread,oldthreads)=	(hd threads, tl threads)
| otherwise				=	(toServer,[Ajax (	[("iTaskInfo", iTaskInfo)] ++			// header ino
											[(showTaskNr childthreads,[showText " "]) \\ childthreads <- oldthreads] ++ //clear childthreads, since parent thread don't need to be on this page
											[(showTaskNr newthread, if (isNil threadcode) seltask threadcode)]	// task info
										   )
									]
							,hst)
where
//	wrap maintask = activateWorkflows (newTask "main" (assignTaskTo False 0 ("main",maintask)))				
//	where
//		clearIStore hst=:{world}								/* would be nice but don't know how to clear this */
//		# world = if testModeOn deleteAllStateFiles id world
//		= (Void,{hst & world = world})


	nilTable tst = 	([],tst)

	startMainTask :: !(Task a) !*TSt -> ((!Bool,!Int,!TaskNr,!String,![TaskNr]),*TSt) 	// No threads, always start from scratch		
	startMainTask task tst
	# (_,tst=:{activated}) = task tst
	= ((True,defaultUser,[0],if activated "iTask application has ended" "",[]),{tst & activated = activated})

	mbUpdate True _ = id
	mbUpdate _ f = f

	ifTraceOn form = if traceOn form []

	showOptions location
	= [showText "Version nr: ", showTrace iTaskVersion] ++
	  [showText " - Enabled: "] ++
	  [showTrace (IF_Ajax 	(" + Ajax (" <+++ location <+++ ") ") "")] ++
	  [showTrace (IF_ClientServer	(IF_Ajax " + Client" "") "")] ++
	  [showTrace (IF_Database " + Database" "")] ++
	  [showTrace (IF_DataFile " + DataFile" "")] ++
	  [showText " - Disabled: "] ++
	  [showTrace (IF_Ajax 	"" " - Ajax " )] ++
	  [showTrace (IF_ClientServer	"" " - Client" )] ++
	  [showTrace (IF_Database "" " - Database" )] ++
	  [showTrace (IF_DataFile "" " - DataFile" )] ++
	  [Br,Hr []]


	mkSTable2 :: [HtmlCode] -> BodyTag
	mkSTable2 table
	= Table []	(mktable table)
	where
		mktable table 	= [Tr [] (mkrow rows) \\ rows <- table]	
		mkrow rows 		= [Td [Td_VAlign Alo_Top] [row] \\ row <- rows] 

	Filter :: !Bool !UserId !HtmlTree !*HSt -> *(![BodyTag],![BodyTag],![BodyTag],![BodyTag],![BodyTag],!*HSt)
	Filter wholepage thrOwner tree hst
	# startuser			= if wholepage defaultUser thrOwner
	# (threadcode,accu) = Collect thisUser startuser [] ((startuser,(defaultWid,defaultWorkflowName),"main") @@: tree)  // KLOPT DIT WEL ??
	| isNil accu		= (threadcode,[],[],[],[],hst)
	# accu				= sortBy (\((i,_),_,_) ((j,_),_,_) -> i < j) accu
	# (workflownames,subtasks) 						= unziptasks accu
	# ((mainSelected,mainButtons,chosenMain),hst) 	= mkTaskButtons True ("User " <+++ thisUser) thisUser [] initialOptions workflownames hst 
	# (subtasksnames,tcode)							= unzipsubtasks (subtasks!!mainSelected)
	# ((taskSelected,subButtons,chosenTask),hst) 	= mkTaskButtons False ("User " <+++ thisUser <+++ "subtask" <+++ mainSelected) 
																							thisUser [] initialOptions subtasksnames hst 
	= (threadcode,[showMainLabel chosenMain, showTrace " / ", showLabel chosenTask],mainButtons,subButtons,tcode!!taskSelected,hst)
	where
		unziptasks [] 			= ([],[])
		unziptasks all=:[((wid,wlabel),tlabel,tcode):tasks] 
		# (wsubtask,other) 		= span (\((mwid,_),_,_) ->  mwid == wid) all 
		# (wlabels,wsubtasks)	= unziptasks other
		= ([wlabel:wlabels],[wsubtask:wsubtasks])

		unzipsubtasks []		= ([],[])
		unzipsubtasks [(_,tlabel,tcode):subtasks]		
		# (labels,codes)		= unzipsubtasks subtasks
		= ([tlabel:labels],[tcode:codes])


	Collect :: !UserId !UserId [(WorkflowName,TaskLabel,[BodyTag])] !HtmlTree -> (![BodyTag],![(WorkflowName,TaskLabel,[BodyTag])])
	Collect thisuser taskuser accu ((ntaskuser,workflowName,taskname) @@: tree) 	// Collect returns the wanted code, and the remaining code
	# (myhtml,accu)	= Collect thisuser ntaskuser accu tree							// Collect all code of this user belonging to this task
	| thisuser == ntaskuser && not (isNil myhtml)
							= ([],[(workflowName,taskname,myhtml):accu])
	| otherwise				= ([],accu)
	Collect thisuser taskuser accu (nuser -@: tree)
	| thisuser == nuser 	= ([],accu)
	| otherwise				= Collect thisuser taskuser accu tree
	Collect thisuser taskuser accu (tree1 +|+ tree2)
	# (lhtml,accu)	= Collect thisuser taskuser accu tree1
	# (rhtml,accu)	= Collect thisuser taskuser accu tree2
	= (lhtml <|.|> rhtml,accu)
	Collect thisuser taskuser accu (tree1 +-+ tree2)
	# (lhtml,accu)	= Collect thisuser taskuser accu tree1
	# (rhtml,accu)	= Collect thisuser taskuser accu tree2
	= ([lhtml <=> rhtml],accu)
	Collect thisuser taskuser accu (BT bdtg)
	| thisuser == taskuser	= (bdtg,accu)
	| otherwise				= ([],accu)
	Collect thisuser taskuser accu (DivCode id tree)
	# (html,accu)			= Collect thisuser taskuser accu tree
	| thisuser == taskuser 	= (mkDiv id html,accu)
	= ([],accu)

	showThreadTable :: *TSt -> (HtmlCode,*TSt)	// watch it: the actual threadnumber stored is one level deaper, so [-1:nr] instead of nr !!
	showThreadTable tst=:{staticInfo}
	# thisUser		= staticInfo.currentUserId
	# (tableS,tst)	= ThreadTableStorage id tst													// read thread table from server
	# tableS		= sortBy (\e1=:{thrTaskNr = t1} e2=:{thrTaskNr =t2} = t1 < t2) tableS
	# (tableC,tst)	= IF_ClientServer
						(\tst -> ClientThreadTableStorage id tst)								// read thread table from client
						(\tst -> ([],tst)) tst
	
	# tableC		= sortBy (\e1=:{thrTaskNr = t1} e2=:{thrTaskNr =t2} = t1 < t2) tableC
	# bodyS			= 	if (isNil tableS)
						[]
						[showLabel "Server Thread Table: ",
						STable []	(   [[showTrace "UserNr:", showTrace "Kind:", showTrace "TaskNr:", showTrace "Created:"
										 ,showTrace "Storage"]] ++
										[	[ showText (toString entry.thrUserId)
											, showText (toString entry.thrKind)
											, showText (showThreadNr entry.thrTaskNr)
											, showText (toString entry.thrVersionNr)
											, showText (toString entry.thrOptions.tasklife)
											] 
											\\ entry <- tableS
										]
									),
						Hr []
						]
	# bodyC			= if (isNil tableC)
						[]
						[showLabel ("Client User " +++ toString thisUser +++ " Thread Table: "),
						STable []	(   [[showTrace "UserNr:", showTrace "Kind:", showTrace "TaskNr:", showTrace "Created:"
										 ,showTrace "Storage"]] ++
										[	[ showText (toString entry.thrUserId)
											, showText (toString entry.thrKind)
											, showText (showThreadNr entry.thrTaskNr)
											, showText (toString entry.thrVersionNr)
											, showText (toString entry.thrOptions.tasklife)
											] 
											\\ entry <- tableC
										]
									),
						Hr []
						]
	= (bodyS ++ bodyC,tst)

mkTaskButtons :: !Bool !String !Int !TaskNr !Options ![String] *HSt -> ((Int,HtmlCode,String),*HSt)
mkTaskButtons vertical myid userId tasknr info btnnames hst
# btnsId			= iTaskId userId tasknr (myid <+++ "genBtns")
# myidx				= length btnnames
//| myidx == 1		= ((0,[],[]),hst)													// no task button if there is only one task to choose from
# (chosen,hst)		= SelectStore (myid,myidx) tasknr info id hst						// which choice was made in the past
# (buttons,hst)		= SelectButtons Init btnsId info (chosen,btnnames) hst				// create buttons
# (chosen,hst)		= SelectStore (myid,myidx) tasknr info  buttons.value hst			// maybe a new button was pressed
# (buttons,hst)		= SelectButtons Set btnsId info (chosen,btnnames) hst				// adjust look of that button
= ((chosen,buttons.form,btnnames!!chosen),hst)
where
	SelectButtons init id info (idx,btnnames) hst 
		= if vertical
			(TableFuncBut2 (init,pageFormId info id [[(mode idx n, but txt,\_ -> n)] \\ txt <- btnnames & n <- [0..]]) hst)
			(TableFuncBut2 (init,pageFormId info id [[(mode idx n, but txt,\_ -> n) \\ txt <- btnnames & n <- [0..]]]) hst)
	but i = iTaskButton i

	mode i j
	| i==j = Display

	= Edit

	SelectStore :: !(String,Int) !TaskNr !Options (Int -> Int) *HSt -> (Int,*HSt)
	SelectStore (myid,idx) tasknr info fun hst 
	# storeId 			= iTaskId userId tasknr (myid <+++ "BtnsS" <+++ idx)
	# (storeform,hst)	= mkStoreForm (Init,storageFormId info storeId 0) fun hst
	= (storeform.value,hst)

// ******************************************************************************************************
// Event handling for Ajax calls and Sapl handling on the client
// ******************************************************************************************************

// The following functions are defined to support "Ajax technologie" and Client site evaluation of i-Tasks.
// To make this possible, a part of the iTask task tree must be assigened to be a thread such that it can be evaluated as a stand-alone i-Task.
// The programmer has to decide which iTask should become a thread.
// For each event (iData triplet), the system will search for the thread to handle it.
// If a thread task is finished, the parent thread task is activated, and so on.
// Any action requiering the calculation of the Task Tree from scratch will be done one the server
// Watch it: the Client cannot create new Server threads


startFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
startFromRoot versioninfo eventnr tasknrs message maintask tst
=	IF_ClientServer																// we are running client server
		(IF_ClientTasks
			(stopClient eventnr tasknrs message)								// client cannot evaluate from root of task tree, give it up
			(evaluateFromRoot versioninfo eventnr tasknrs message maintask) tst	// sever can evaluate from scratch
		)
	(evaluateFromRoot versioninfo eventnr tasknrs message maintask tst)			// ajax can evaluate from scratch as well
where
	stopClient :: !TaskNr ![TaskNr]  !String  !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
	stopClient eventnr tasknrs message tst
	= ((True,defaultUser,eventnr,message,tasknrs), tst)
	
	evaluateFromRoot :: !GlobalInfo !TaskNr ![TaskNr] !String !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt)
	evaluateFromRoot versioninfo eventnr tasknrs message maintask tst
	# tst					= deleteAllSubTasks versioninfo.deletedThreads tst	// delete subtasks being obsolute
	# (_,tst) 				= maintask tst										// evaluate main application from scratch
	# tst=:{activated}		= copyThreadTableToClient tst						// copy thread table to client, if applicable
	# message				= if activated "iTask application finished" message
	= (((True,defaultUser,eventnr,message,tasknrs), {tst & activated = activated}))

startAjaxApplication :: !Int !GlobalInfo !(Task a) !*TSt -> ((!Bool,!Int,TaskNr,!String,![TaskNr]),*TSt) 		// determines which threads to execute and calls them..
startAjaxApplication thisUser versioninfo maintask tst=:{tasknr,options,html,trace,userId}
# tst					= copyThreadTableFromClient	versioninfo tst				// synchronize thread tables of client and server, if applicable

// first determine whether we should start calculating the task tree from scratch starting at the root

# (mbevent,tst)			= getTripletTaskNrs tst									// see if there are any events, i.e. triplets received
| isNothing mbevent																// no events
						= startFromRoot versioninfo tasknr [tasknr] "No events, page refreshed" maintask tst			
# event					= fromJust mbevent										// event found
# (table,tst)			= ThreadTableStorage id tst								// read thread table
| isNil table																	// events, but no threads, evaluate main application from scratch
						= startFromRoot versioninfo event [tasknr] "No threads, page refreshed" maintask tst			
# (mbthread,tst)		= findParentThread event tst							// look for thread to evaluate
| isNil mbthread																// no thread can be found, happens e.g. when one switches from tasks
						= startFromRoot versioninfo event [tasknr] "No matching thread, page refreshed" maintask tst			
# thread 				= hd mbthread											// thread found
| isMember thread.thrTaskNr versioninfo.deletedThreads							// thread has been deleted is some past, version conflict
	# tst				= copyThreadTableToClient tst							// copy thread table to client
	= ((True,defaultUser,event,"Task does not exist anymore, please refresh",[tasknr]), tst)
| versioninfo.newThread															// newthread added by someone
						= startFromRoot versioninfo event [tasknr] "New tasks added, page refreshed" maintask tst			
| not (isNil versioninfo.deletedThreads) 										// some thread has been deleted										
						= startFromRoot versioninfo event [tasknr] "Tasks deleted, page refreshed" maintask tst			
| thread.thrUserId <> thisUser													// updating becomes too complicated
						= startFromRoot versioninfo event [tasknr] ("Thread of user " <+++ thread.thrUserId <+++ ", page refreshed") maintask tst			

// ok, we have found a matching thread

# (_,tst=:{activated}) 	= evalTaskThread thread {tst & html = BT []}			// evaluate the thread
| not activated																	// thread / task not yet finished
	# tst				= copyThreadTableToClient tst							// copy thread table to client
	= ((False,thisUser,event,"",[thread.thrTaskNr]),tst)						// no further evaluation, aks user for more input

# (mbthread,tst)		= findParentThread (tl thread.thrTaskNr) tst			// look for thread to evaluate
= doParent mbthread maintask event [thread.thrTaskNr] {tst & html = BT [], options = options}				// more to evaluate, call thread one level higher
where
	doParent [] maintask event accu tst											// no more parents of current event, do main task
						= startFromRoot versioninfo event [tasknr:accu] "No more threads, page refreshed" maintask {tst & html = BT []}			

	doParent [parent:next] maintask event accu tst								// do parent of current thread
	| parent.thrUserId <> thisUser												// updating becomes too complicated
						= startFromRoot versioninfo event [tasknr:accu] ("Parent thread of user " <+++ parent.thrUserId <+++ ", page refreshed") maintask {tst & html = BT []}			

	# (_,tst=:{activated}) 	= evalTaskThread parent {tst & html = BT []}		// start parent
	| not activated																// parent thread not yet finished
		# tst				= copyThreadTableToClient tst						// copy thread table to client
		= ((False,thisUser,event, "",[parent.thrTaskNr:accu]),tst)				// no further evaluation, aks user for more input
	# (mbthread,tst)		= findParentThread (tl parent.thrTaskNr) tst		// look for thread to evaluate
	= doParent mbthread maintask event [parent.thrTaskNr:accu] {tst & options = options}// continue with grand parent ...

// ******************************************************************************************************
// Workflow process management
// ******************************************************************************************************

workflowProcessStoreName :== "Application" +++  "-ProcessTable"

derive gForm	WorflowProcess
derive gUpd		WorflowProcess
derive gPrint	WorflowProcess
derive gParse	WorflowProcess

gPrint{|Dynamic|} dyn pst 	= gPrint{|*|} (dynamic_to_string dyn) pst
gParse{|Dynamic|} expr 		= case parseString expr of
								(Just string) 	= Just (string_to_dynamic {s` \\ s` <-: string})
								Nothing			= Nothing
where
	parseString :: Expr -> Maybe String
	parseString expr = gParse{|*|} expr
	
gForm{|Dynamic|} (init, formid) hst = ({changed=False,form=[],value=formid.ival},(incrHSt 1 hst))
gUpd{|Dynamic|} (UpdSearch _ 0) a 	= (UpdDone,a)
gUpd{|Dynamic|} (UpdSearch v i) a 	= (UpdSearch v (i-1),a)
gUpd{|Dynamic|} (UpdCreate c) a 	= (UpdCreate c,dynamic 0)
gUpd{|Dynamic|} UpdDone a 			= (UpdDone,a)

workflowProcessStore ::  !([WorflowProcess] -> [WorflowProcess]) !*HSt -> (![WorflowProcess],!*HSt) 
workflowProcessStore wfs hst	
# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName [] <@ NoForm) wfs hst
= (form.value,hst)

activateWorkflows :: !(Task a) -> (Task a) | iData a
activateWorkflows maintask = activateWorkflows`
where
	activateWorkflows` tst=:{hst} 
	# (a,tst=:{activated,hst}) 	= newTask defaultWorkflowName (assignTaskTo False 0 ("main",maintask)) tst	// start maintask
	# (wfls,hst) 				= workflowProcessStore id hst					// read workflow process administration
	# (done,tst)				= activateAll True wfls 0 {tst & hst = hst,activated = True}		// all added workflows processes are inspected (THIS NEEDS TO BE OPTIMIZED AT SOME STAGE)
	= (a,{tst & activated = activated && done})									// whole application ends when all processes have ended
	where
		activateAll done [] _ tst = (done,tst)
		
		activateAll done [ActiveWorkflow _ (TCl dyntask):wfls] procid tst
		# (_,tst=:{activated}) = dyntask tst
		= activateAll (done && activated) wfls (inc procid) {tst & activated = activated}
		
		activateAll done [SuspendedWorkflow _ _:wfls] procid tst
		= activateAll done wfls (inc procid) tst
		
		activateAll done [FinishedWorkflow _ _ (TCl dyntask):wfls] procid tst	// just to show result in trace..
		# (_,tst) = dyntask tst
		= activateAll done wfls (inc procid) tst
		
		activateAll done [DeletedWorkflow _:wfls] procid tst
		= activateAll done wfls (inc procid) tst

spawnWorkflow :: !UserId !Bool !(LabeledTask a) -> Task (Wid a) | iData a
spawnWorkflow userid active (label,task) = \tst=:{options,staticInfo} -> (newTask ("spawn " +++ label) (spawnWorkflow` options)<<@ staticInfo.threadTableLoc) tst
where
	spawnWorkflow` options tst=:{hst}
	# (wfls,hst) 		= workflowProcessStore id hst							// read workflow process administration
	# processid			= length wfls + 1										// process id currently given by length list, used as offset in list
	# wfl				= mkdyntask options processid task 						// convert user task in a dynamic task
	# nwfls				= wfls ++ [if active ActiveWorkflow SuspendedWorkflow label wfl]					// turn task into a dynamic task
	# (wfls,hst) 		= workflowProcessStore (\_ -> nwfls) hst				// write workflow process administration
	= (Wid (processid,label),{tst & hst = hst, activated = True})

	mkdyntask options processid task = TCl (\tst -> convertTask processid label task 
										{tst & tasknr = [processid - 1],activated = True,options = options,workflowName = (processid,label)})
	
	convertTask processid label task tst
	# (a,tst=:{hst,activated})		= newTask label (assignTaskTo False userid ("main",task)) tst//newTask label task tst			
	# dyn							= dynamic a
	| not activated					= (dyn,tst)									// not finished, return
	# (wfls,hst) 					= workflowProcessStore id hst				// read workflow process administration
	# wfls							= case (wfls!!(processid - 1)) of			// update process administration
											(ActiveWorkflow _ entry) -> updateAt (processid - 1) (FinishedWorkflow label dyn entry) wfls
											_ -> wfls
	# (wfls,hst) 					= workflowProcessStore (\_ -> wfls) hst		// write workflow process administration
	= (dyn,{tst & hst = hst})												

waitForWorkflow :: !(Wid a) -> Task a | iData a
waitForWorkflow (Wid (processid,label)) = newTask ("waiting for " +++ label) waitForResult`
where
	waitForResult` tst=:{hst}
	# (wfls,hst) 		= workflowProcessStore id hst							// read workflow process administration
	# (done,val)		= case (wfls!!(processid - 1)) of						// update process administration
								(FinishedWorkflow _ (val::a^) _) -> (True,val)	// finished
								_ -> (False,createDefault)						// not yet
	= (val,{tst & hst = hst, activated = done})									// return value and release when done

deleteWorkflow :: !(Wid a) -> Task Bool