iTasksProcessHandling.icl 21.1 KB
Newer Older
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
1 2 3 4 5 6 7 8 9 10 11
implementation module iTasksProcessHandling

// *********************************************************************************************************************************
// This module contains iTask combinators for creating iTask workflow processes
// *********************************************************************************************************************************
// iTask & iData Concept and Implementation: (c) 2006,2007,2008 - Rinus Plasmeijer
// *********************************************************************************************************************************
//
import StdEnv 
import iDataFormlib
import InternaliTasksCommon, InternaliTasksThreadHandling
12
import BasicCombinators, iTasksSettings
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
13
import dynamic_string
14
import GenBimap
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
15

16 17 18 19
derive gForm 	Wid, WorkflowStatus, []
derive gUpd 	Wid, WorkflowStatus, []
derive gParse 	Wid, WorkflowStatus
derive gPrint 	Wid, WorkflowStatus
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
20
derive gerda 	Wid, WorkflowStatus
21 22
derive read 	Wid, WorkflowStatus
derive write 	Wid, WorkflowStatus
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
23 24

:: Wid a			= Wid WorkflowLink											// id of workflow process
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
25 26 27
:: WorkflowProcess 	= ActiveWorkflow 	ProcessIds !(Task Dynamic)
					| SuspendedWorkflow ProcessIds !(Task Dynamic)
					| FinishedWorkflow 	ProcessIds !Dynamic !(Task Dynamic)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
28 29 30 31
					| DeletedWorkflow	ProcessIds

instance == WorkflowStatus
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
32 33
	(==) (WflActive _) 			(WflActive _)  	= True
	(==) (WflSuspended _)  		(WflSuspended _)= True
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
34 35 36 37 38 39
	(==) WflFinished    		WflFinished 	= True
	(==) WflDeleted 			WflDeleted		= True
	(==) _ 						_ 				= False

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

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
40 41 42 43
derive gForm	WorkflowProcess
derive gUpd		WorkflowProcess
derive gPrint	WorkflowProcess
derive gParse	WorkflowProcess
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
44
derive gerda	WorkflowProcess	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
45 46
derive read		WorkflowProcess	
derive write	WorkflowProcess	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
47 48 49 50 51 52 53 54 55

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
	
56
gForm{|Dynamic|} (init, formid) hst = ({changed=False,form=[], inputs = [],value=formid.ival},(incrHStCntr 1 hst))
57 58
gUpd{|Dynamic|} (UpdSearch 0 _) a 	= (UpdDone,a)
gUpd{|Dynamic|} (UpdSearch i v) a 	= (UpdSearch (i-1) v,a)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
59 60
gUpd{|Dynamic|} (UpdCreate c) a 	= (UpdCreate c,dynamic 0)
gUpd{|Dynamic|} UpdDone a 			= (UpdDone,a)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
61 62 63 64 65 66 67 68
write{|Dynamic|} dyn pst 	= write{|*|} (dynamic_to_string dyn) pst
read{|Dynamic|} pst 		= case myread pst of
								Read  string i f	= Read (string_to_dynamic {s` \\ s` <-: string}) i f
								Fail f				= Fail f
where
	myread :: !*Write -> *Read .String
	myread pst = read{|*|} pst

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
69
gerda{|Dynamic|} 	= abort "Cannot yet store a Dynamic in a Database\n" 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
70
gerda{|Task|} ga		= abort "Cannot yet store an iTask of type TCL in a Database\n" 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
71

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
72 73
import DrupBasic

74 75 76 77 78 79 80 81 82
getProcessId :: (Wid a) -> ProcessNr
getProcessId (Wid (entry,processIds)) = entry

latestProcessId :: *TSt -> (ProcessNr,*TSt)
latestProcessId tst
# ((processid,wfls),tst) = workflowProcessStore id tst							// read workflow process administration
= (processid,tst)


Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
83 84 85 86
isValidWorkflowReference :: !WorkflowProcess !ProcessIds -> Bool								// checks whether pointer to workflow is still refering to to right entry in the table
isValidWorkflowReference workflowprocess idsref = drop1tuple3 (getWorkflowWid workflowprocess) == drop1tuple3 idsref
where
	drop1tuple3 (x,y,z) = (y,z)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
87

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
88
getWorkflowWid :: !WorkflowProcess -> ProcessIds 									// get wid of a process
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
89 90 91 92
getWorkflowWid (ActiveWorkflow 	ids _)			= ids
getWorkflowWid (SuspendedWorkflow ids _)		= ids
getWorkflowWid (FinishedWorkflow 	ids _ _)	= ids
getWorkflowWid (DeletedWorkflow	ids)			= ids
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
93

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
94
getWorkflowUser :: !WorkflowProcess -> UserId										// fetch user who should do the work
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
95 96 97 98 99
getWorkflowUser (ActiveWorkflow 	(userid,_,_) _)		= userid 
getWorkflowUser (SuspendedWorkflow  (userid,_,_) _)		= userid
getWorkflowUser (FinishedWorkflow 	(userid,_,_) _ _)	= userid
getWorkflowUser (DeletedWorkflow	(userid,_,_))		= userid

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
100
setWorkflowUser :: !UserId !WorkflowProcess -> WorkflowProcess						// fetch user who should do the work
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
101 102 103 104 105
setWorkflowUser nuserid (ActiveWorkflow 		(userid,procnr,wflab) task)		= (ActiveWorkflow 		(nuserid,procnr,wflab) task)
setWorkflowUser nuserid (SuspendedWorkflow  	(userid,procnr,wflab) task)		= (SuspendedWorkflow  	(nuserid,procnr,wflab) task)
setWorkflowUser nuserid (FinishedWorkflow 		(userid,procnr,wflab) dyn task)	= (FinishedWorkflow 	(userid,procnr,wflab) dyn task)
setWorkflowUser nuserid (DeletedWorkflow		(userid,procnr,wflab))			= (DeletedWorkflow		(nuserid,procnr,wflab))

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
106
getTask :: !WorkflowProcess -> Task Dynamic
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
107 108 109
getTask (ActiveWorkflow 	(_,_,_) task)		= task 
getTask (SuspendedWorkflow  (_,_,_) task)		= task
getTask (FinishedWorkflow 	(_,_,_) _ task)		= task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
110

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
111
isDeletedWorkflow :: !WorkflowProcess -> Bool
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
112 113 114
isDeletedWorkflow (DeletedWorkflow _) = True
isDeletedWorkflow _	= False

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
115
workflowProcessStore ::  !((!Int,![WorkflowProcess]) -> (!Int,![WorkflowProcess])) !*TSt -> (!(!Int,![WorkflowProcess]),!*TSt) 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
116
workflowProcessStore wfs tst	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
117 118 119 120
= IF_Ajax 																		
	(IF_ClientServer															// we running both client and server
		(IF_ClientTasks												
			(abort "Cannot access workflow process table on client\n")			// workflow table only on server site
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
121
			(workflowProcessStore` wfs tst)										// access workflow store
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
122 123 124 125
		)
		(workflowProcessStore` wfs tst)
	)
	(workflowProcessStore` wfs tst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
126 127 128
where
	workflowProcessStore` wfs tst=:{hst}	
	# (form,hst) = mkStoreForm (Init, pFormId workflowProcessStoreName (0,[]) <@ NoForm) wfs hst
129
	= (form.Form.value,{tst & hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
130

131 132
scheduleWorkflows :: !(LabeledTask a) !Int -> (Task a) | iData a
scheduleWorkflows mainTask mainUser 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
133
//# nmaintask	= newTask defaultWorkflowName (mkTask "StartMain" (assignTaskTo 0 ("main",maintask)))
134
# nmaintask	= assignTaskTo mainUser mainTask
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
135 136 137 138
= IF_Ajax 																		
	(IF_ClientServer															// we running both client and server
		(IF_ClientTasks												
			nmaintask															// workflow table only on server site, do only maintask
139
			(Task (scheduleWorkflows` nmaintask))								// access workflow store
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
140
		)
141
		(Task (scheduleWorkflows` nmaintask))
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
142
	)
143
	(Task (scheduleWorkflows` nmaintask))
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
144
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
145
	scheduleWorkflows` nmaintask tst 
146
	# (a,tst=:{activated}) 	= appTaskTSt nmaintask tst	// start maintask
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
147 148 149 150 151
	# ((_,wfls),tst) 		= workflowProcessStore id tst												// read workflow process administration
	# (done,tst)			= scheduleWorkflowTable True wfls 0 {tst & 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

scheduleWorkflowTable done [] _ tst = (done,tst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
152
scheduleWorkflowTable done [ActiveWorkflow _  dyntask:wfls] procid tst
153
# (_,tst=:{activated}) = appTaskTSt dyntask {tst & activated = True}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
154 155 156
= scheduleWorkflowTable (done && activated) wfls (inc procid) {tst & activated = activated}
scheduleWorkflowTable done [SuspendedWorkflow _ _:wfls] procid tst
= scheduleWorkflowTable done wfls (inc procid) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
157
scheduleWorkflowTable done [FinishedWorkflow _ _ dyntask:wfls] procid tst	// just to show result in trace..
158
# (_,tst) = appTaskTSt dyntask tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
159 160 161 162 163
= scheduleWorkflowTable done wfls (inc procid) tst
scheduleWorkflowTable done [DeletedWorkflow _:wfls] procid tst
= scheduleWorkflowTable done wfls (inc procid) tst

spawnWorkflow :: !UserId !Bool !(LabeledTask a) -> Task (Wid a) | iData a
164
spawnWorkflow userid active (label,task) = Task (\tst=:{options,staticInfo} -> appTaskTSt ((newTask ("spawn " +++ label) (Task (spawnWorkflow` options))<<@ staticInfo.threadTableLoc)) tst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
165 166 167 168 169 170
where
	spawnWorkflow` options tst
	# ((processid,wfls),tst) 		
						= workflowProcessStore id tst							// read workflow process administration
	# (found,entry)		= findFreeEntry wfls 1									// found entry in table
	# processid			= processid + 1											// process id currently given by length list, used as offset in list
171
	# wfl				= mkdyntask options entry processid task				// convert user task in a dynamic task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
172
	# nwfls				= if found 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
173 174
							(updateAt (entry - 1) (if active ActiveWorkflow SuspendedWorkflow (userid,processid,label) wfl) wfls)
							(wfls ++ [if active ActiveWorkflow SuspendedWorkflow (userid,processid,label) wfl])				// turn task into a dynamic task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
175
	# (wfls,tst) 		= workflowProcessStore (\_ -> (processid,nwfls)) tst	// write workflow process administration
176
	# (_,tst)			= appTaskTSt (if active wfl (Task (\tst -> (undef,tst)))) tst	// if new workflow is active, schedule it in
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
177 178
	= (Wid (entry,(userid,processid,label)),{tst & activated = True})

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
179
	findFreeEntry :: [WorkflowProcess] Int -> (Bool,Int)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
180 181 182 183 184
	findFreeEntry [] n	= (False,n)
	findFreeEntry [DeletedWorkflow _:wfls] n = (True,n)
	findFreeEntry [_:wfls] n = findFreeEntry wfls (n + 1)

	mkdyntask options entry processid task 
185
	=  Task (\tst -> convertTask entry processid label task 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
186 187 188 189 190 191 192
				{tst & tasknr = [entry - 1],activated = True,userId = userid, options = options,workflowLink = (entry,(userid,processid,label))})
	
	convertTask entry processid label task tst

	# ((processid,wfls),tst) 	= workflowProcessStore id tst					// read workflow process administration
	# wfl						= wfls!!(entry - 1)								// fetch entry
	# currentWorker				= getWorkflowUser wfl							// such that worker can be changed dynamically !
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
193 194
//	# (a,tst=:{activated})		= appTaskTSt (newTask label (mkTask "StartMain" (assignTaskTo currentWorker ("main",task)))) tst			
	# (a,tst=:{activated})		= appTaskTSt (assignTaskTo currentWorker ("main",task)) tst			
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
195 196 197 198 199

	# dyn						= dynamic a
	| not activated				= (dyn,tst)										// not finished, return
	# ((_,wfls),tst) 			= workflowProcessStore id tst					// read workflow process administration
	# wfls						= case (wfls!!(entry - 1)) of					// update process administration
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
200
										(ActiveWorkflow wid acttask) -> updateAt (entry - 1) (FinishedWorkflow wid dyn acttask) wfls
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
201 202 203 204 205
										_ -> wfls
	# (wfls,tst) 				= workflowProcessStore (\_ -> (processid,wfls)) tst		// write workflow process administration
	= (dyn,tst)												

changeWorkflowUser :: !UserId !(Wid a) -> Task Bool 
206
changeWorkflowUser nuser (Wid (entry,ids=:(_,_,label))) = newTask ("changeUser " +++ label) (Task deleteWorkflow`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
207 208 209 210 211 212 213 214 215 216 217 218 219
where
	deleteWorkflow` tst
	| entry == 0		= (False,tst)											// main task cannot be handled
	# ((maxid,wfls),tst)= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids
	| not refok			= (False,tst)											// wid does not refer to the correct entry anymore
	# wfl				= setWorkflowUser nuser wfl
	# nwfls				= updateAt (entry - 1) wfl wfls							// delete entry in table
	# (wfls,tst) 		= workflowProcessStore (\_ -> (maxid,nwfls)) tst		// update workflow process administration
	= (True,tst)																// if everything is fine it should always succeed

waitForWorkflow :: !(Wid a) -> Task (Maybe a) | iData a
220
waitForWorkflow (Wid (entry,ids=:(_,_,label))) = newTask ("waiting for " +++ label) (Task waitForResult`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
221 222 223 224 225
where
	waitForResult` tst
	# ((_,wfls),tst) 	= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
226
	| not refok			= (Nothing,{tst & activated = True})					// wid does not refer to the correct entry anymore
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
227 228 229 230
	= case wfl of																// update process administration
			(FinishedWorkflow _ (val::a^) _) -> (Just val,{tst & activated = True})	// finished
			_ 					->  (Nothing,{tst & activated = False})	// not yet

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
/*
waitForWorkflowWithName :: !String -> Task (Maybe a) | iData a
waitForWorkflowWithName labelSearched = newTask ("waiting for " +++ labelSearched) waitForResult`
where
	waitForResult` tst
	# ((_,wfls),tst) 	= workflowProcessStore id tst							// read workflow process administration
	# foundEntries		= [i \\ i <- [0 ..] & wfl <- wfls | thd3 (getWorkflowWid wfl) == labelSearched]
	| isEmpty foundEntries
						= (Nothing,{tst & activated = False})					// entry does not exist
	# entry				= hd foundEntries										// entry found; first entry is taken
	# wfl				= wfls!!(entry - 1)										// fetch entry
	= case wfl of																// update process administration
			(FinishedWorkflow _ (val::a^) _) -> (Just val,{tst & activated = True})	// finished
			_ 					->  (Nothing,{tst & activated = False})			// not yet
*/

waitForWorkflowWid :: !String -> Task (Maybe (Wid a)) | iData a
248
waitForWorkflowWid labelSearched = newTask ("waiting for " +++ labelSearched) (Task waitForResult`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
249 250 251 252 253 254 255 256 257 258 259 260
where
	waitForResult` tst
	# ((_,wfls),tst) 	= workflowProcessStore id tst							// read workflow process administration
	# foundEntries		= [i \\ i <- [1 ..] & wfl <- wfls | thd3 (getWorkflowWid wfl) == labelSearched]
	| isEmpty foundEntries
// set True as experiment...
						= (Nothing,{tst & activated = True})					// entry does not (yet) exist
	| length foundEntries <> 1
						= (Nothing,{tst & activated = True})					// there are more; illegal action; it is assumed that there is only one
	# entry				= hd foundEntries
	= (Just (Wid (entry,getWorkflowWid (wfls!!(entry - 1)))),{tst & activated = True})						// entry found

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
261
deleteMe :: (Task Void)
262
deleteMe = Task deleteMe`
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
263 264
where
	deleteMe` tst=:{workflowLink} 
265
	=	appTaskTSt (				deleteWorkflow (Wid workflowLink)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
266 267 268
			=>> \_ ->	return_V Void ) tst

deleteWorkflow :: !(Wid a) -> Task Bool 
269
deleteWorkflow (Wid (entry,ids=:(_,_,label))) = newTask ("delete " +++ label) (Task deleteWorkflow`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
270 271 272 273 274 275 276 277 278 279
where
	deleteWorkflow` tst
	| entry == 0		= (False,tst)											// main task cannot be handled
	# ((maxid,wfls),tst)= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids						// does the Wid indeed refers to this process
	| not refok			= (False,tst)											// wid does not refer to the correct entry anymore
	| isDeletedWorkflow wfl = (True,tst)										// already deleted
	# nwfls				= updateAt (entry - 1) (DeletedWorkflow ids) wfls		// delete entry in table
	# (wfls,tst=:{html}) = workflowProcessStore (\_ -> (maxid,nwfls)) tst		// update workflow process administration
280
	# (_,tst)			= appTaskTSt (getTask wfl) {tst & html = BT [] []}					// calculate workflow to delete for the last time to obtain all its itasks in the task tree
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
281
	# tst				= deleteSubTasksAndThreads [entry] tst					// delete all iTask storage of this process ...
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
282
	= (True,{tst & html = html, activated = True})												// if everything is fine it should always succeed
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
283 284

suspendMe :: (Task Void)
285
suspendMe = Task suspendMe`
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
286 287 288
where
	suspendMe` tst=:{workflowLink = workflowLink=:(entry,ids)} 
	| entry == 0		= (Void,tst)											// main task cannot be handled
289
	= appTaskTSt (	suspendWorkflow (Wid workflowLink)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
290 291 292
			=>> \_ ->	return_V Void ) tst

suspendWorkflow :: !(Wid a) -> Task Bool
293
suspendWorkflow (Wid (entry,ids=:(_,_,label))) = newTask ("suspend " +++ label) (Task deleteWorkflow`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
where
	deleteWorkflow` tst
	| entry == 0		= (False,tst)											// main task cannot be handled
	# ((maxid,wfls),tst)= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids
	| not refok			= (False,tst)											// wid does not refer to the correct entry anymore
	# (ok,nochange,wfl)	= case wfl of
							(ActiveWorkflow label acttask) -> (True,False,SuspendedWorkflow label acttask)
							(DeletedWorkflow label) -> (False,True,DeletedWorkflow label) // a deleted workflow cannot be suspendend
							wfl -> (True,True,wfl)								// in case of finsihed or already suspended flows
	| nochange			= (ok,{tst & activated = True})							// no change needed
	# nwfls				= updateAt (entry - 1) wfl wfls							// update entry
	# (wfls,tst) 		= workflowProcessStore (\_ -> (maxid,nwfls)) tst		// update workflow process administration
	= (ok,tst)																	// if everything is fine it should always succeed

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
310
activateWorkflow :: !(Wid a) -> Task Bool
311
activateWorkflow (Wid (entry,ids=:(_,_,label))) = newTask ("activate " +++ label) (Task activateWorkflow`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
312 313 314 315 316 317 318 319 320 321 322 323
where
	activateWorkflow` tst
	| entry == 0		= (False,tst)											// main task cannot be handled
	# ((maxid,wfls),tst)= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids
	| not refok			= (False,tst)											// wid does not refer to the correct entry anymore
	= case wfl of
		(SuspendedWorkflow label susptask) -> scheduleWorkflow label maxid susptask wfls tst
		(ActiveWorkflow    label acttask)  -> (True,{tst & activated = True})
		wfl -> (False,{tst & activated = True})									// in case of finished or deleted task

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
324 325
	scheduleWorkflow label maxid wfl wfls tst										
	# nwfls				= updateAt (entry - 1) (ActiveWorkflow label wfl) wfls // mark workflow as activated
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
326
	# (wfls,tst) 		= workflowProcessStore (\_ -> (maxid,nwfls)) tst		// update workflow process administration
327
	# (_,tst)			= appTaskTSt wfl {tst & activated = True}				// schedule workflow
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
328 329 330 331
	= (True,tst)																// done


/*
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
332 333 334 335 336 337 338 339 340 341 342
activateWorkflow :: !(Wid a) -> Task Bool
activateWorkflow (Wid (entry,ids=:(_,_,label))) = newTask ("activate " +++ label) activateWorkflow`
where
	activateWorkflow` tst
	| entry == 0		= (False,tst)											// main task cannot be handled
	# ((maxid,wfls),tst)= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids
	| not refok			= (False,tst)											// wid does not refer to the correct entry anymore
	# (ok,nochange,wfl,tst)	
						= case wfl of
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
343 344
								(SuspendedWorkflow label susptask) -> scheduleWorkflow label susptask tst
//								(DeletedWorkflow label) -> (False,True,DeletedWorkflow label,tst) // a deleted workflow cannot be suspendend
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
345 346 347 348 349 350
								wfl -> (True,True,wfl,tst)						// in case of finished or already activated flows
	| nochange			= (ok,{tst & activated = True})							// no change needed
	# nwfls				= updateAt (entry - 1) wfl wfls							// update entry
	# (wfls,tst) 		= workflowProcessStore (\_ -> (maxid,nwfls)) tst		// update workflow process administration
	= (ok,tst)																	// if everything is fine it should always succeed

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
351
	scheduleWorkflow label (Task wfl) tst										// schedule workflow
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
352
	# (_,tst)	= wfl {tst & activated = True}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
353
	= (True,False,ActiveWorkflow label (Task wfl),{tst & activated = True})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
354

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
355
*/
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
356
getWorkflowStatus :: !(Wid a) -> Task WorkflowStatus
357
getWorkflowStatus (Wid (entry,ids=:(_,_,label))) = newTask ("get status " +++ label) (Task getWorkflowStatus`)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
358 359 360 361 362 363 364
where
	getWorkflowStatus` tst
	# ((_,wfls),tst) 	= workflowProcessStore id tst							// read workflow process administration
	# wfl				= wfls!!(entry - 1)										// fetch entry
	# refok				= isValidWorkflowReference wfl ids
	| not refok			= (WflDeleted,tst)										// wid does not refer to the correct entry anymore
	# status			= case wfl of
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
365 366 367 368
							(ActiveWorkflow (user,_,_) _) 		-> WflActive user
							(SuspendedWorkflow (user,_,_) _) 	-> WflSuspended user
							(FinishedWorkflow _ _ _) 			-> WflFinished
							(DeletedWorkflow _) 				-> WflDeleted		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
369 370
	= (status,tst)																// if everything is fine it should always succeed

371
showWorkflows :: !Bool !*TSt -> ([HtmlTag],*TSt)
372
showWorkflows alldone tst 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
373 374 375 376 377 378 379 380 381
= 	IF_ClientTasks												
		(\tst -> ([],tst))														// workflow table not available on clients
		(showWorkflows` alldone) tst											// show tables
where
	showWorkflows` alldone tst
	# ((_,wfls),tst) 		= workflowProcessStore id tst						// read workflow process administration
	= (mkTable wfls,tst)

	mkTable []		= []
382 383 384 385 386 387 388 389 390 391 392 393 394

	mkTable wfls	= [DivTag [IdAttr "itasks-workflow-process-table",ClassAttr "trace"] [H2Tag [] [Text "Workflow Process Table:"], TableTag [] [header : rows]]]
	where
		header	= TrTag [] 
					[   ThTag [] [Text "Entry"], 		ThTag [] [Text "User Id"],  ThTag [] [Text "Process Id"],  ThTag [] [Text "Task Name"], 		 ThTag [] [Text "Status"]]
		rows	= 	[	TrTag [] [TdTag [] [Text "0"],  TdTag [] [Text "0"], 		TdTag [] [Text "0"], 		   TdTag [] [Text defaultWorkflowName], TdTag [] [if alldone (Text "Finished") (Text "Active")]]
					: [ TrTag [] [TdTag [] [Text (toString i)]: showStatus wfl] \\ wfl <- wfls & i <- [1..]]
					]

	showStatus (ActiveWorkflow 	 	(userid,processid,label) dyntask)		= [TdTag [] [Text (toString userid)], TdTag [] [Text (toString processid)], TdTag [] [Text label], TdTag [] [Text "Active"]]
	showStatus (SuspendedWorkflow 	(userid,processid,label) dyntask)		= [TdTag [] [Text (toString userid)], TdTag [] [Text (toString processid)], TdTag [] [Text label], TdTag [] [Text "Suspended"]]
	showStatus (FinishedWorkflow 	(userid,processid,label) dyn dyntask)	= [TdTag [] [Text (toString userid)], TdTag [] [Text (toString processid)], TdTag [] [Text label], TdTag [] [Text "Finished"]]
	showStatus (DeletedWorkflow  	(userid,processid,label))				= [TdTag [] [Text (toString userid)], TdTag [] [Text (toString processid)], TdTag [] [Text label], TdTag [] [Text "Deleted"]]
395 396 397 398 399

	STable atts table		= TableTag atts (mktable table)
	where
		mktable table 	= [TrTag [] (mkrow rows)           \\ rows <- table]
		mkrow   rows 	= [TdTag [ValignAttr "top"]  [row] \\ row  <- rows ]