htmlTask.icl 43.6 KB
Newer Older
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
1
2
implementation module htmlTask

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
3
4
// (c) MJP 2006 - 2007

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
5
6
import StdEnv, StdHtml

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
7
8
9
10
11
derive gForm 	[], Void
derive gUpd 	[], Void
derive gParse 	Void
derive gPrint 	Void
derive gerda 	Void
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
12

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
13
14
15
derive gForm Trace
derive gForm Maybe

16
17
import dynamic_string, EncodeDecode

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
18
19
:: *TSt 		=	{ tasknr 		:: ![Int]			// for generating unique form-id's
					, activated		:: !Bool   			// if true activate task, if set as result task completed	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
20
					, myId			:: !Int				// id of user to which task is assigned
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
21
					, userId		:: !Int				// id of application user 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
22
					, html			:: !HtmlTree		// accumulator for html code
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
23
					, storageInfo	:: !Storage			// iData lifespan and storage format
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
24
					, trace			:: !Maybe [Trace]	// for displaying task trace
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
25
					, hst			:: !HSt				// iData state
26
					}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
27

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
28
29
:: HtmlTree		=	BT [BodyTag]						// simple code
				|	(@@:) infix  0 (Int,String) HtmlTree// code with id of user attached to it
30
				|	(-@:) infix  0 Int 			HtmlTree// skip code with this id if it is the id of the user 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
31
32
33
34
				|	(+-+) infixl 1 HtmlTree HtmlTree	// code to be placed next to each other				
				|	(+|+) infixl 1 HtmlTree HtmlTree	// code to be placed below each other				

:: Storage		=	{ tasklife		:: !Lifespan		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
35
					, taskstorage	:: !StorageFormat
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
36
					, taskmode		:: !Mode
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
37
38
					}

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
39
40
:: Trace		=	Trace TraceInfo [Trace]				// traceinfo with possibly subprocess

41
:: TraceInfo	:== Maybe (Bool,(Int,[Int],String,String))	// Task finished? who did it, task nr, task name (for tracing) value produced
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
42

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
43
// setting global iData options for tasks
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
44
45
46
47
48
49
50
51
52
53
54
55

instance setTaskAttr Lifespan
where setTaskAttr lifespan tst = {tst & storageInfo.tasklife = lifespan}

instance setTaskAttr StorageFormat
where setTaskAttr storageformat tst = {tst & storageInfo.taskstorage = storageformat}

instance setTaskAttr Mode
where setTaskAttr mode tst = {tst & storageInfo.taskmode = mode}

// wrappers

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
56
57
58
59
60
61
singleUserTask :: !(Task a) !*HSt -> (Html,*HSt) | iData a 
singleUserTask task hst 
# (_,html,hst) = startTask 0 task hst
= mkHtml "stest" html hst

multiUserTask :: !Int!(Task a) !*HSt -> (Html,*HSt) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
62
multiUserTask nusers task  hst 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
63
# (idform,hst) 	= FuncMenu (Init,nFormId "User_Selected" 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
64
65
66
67
68
						(0,[("User " +++ toString i,\_ -> i) \\ i<-[0..nusers - 1] ])) hst
# currentWorker	= snd idform.value
# (_,html,hst) 	= startTask currentWorker task hst
= mkHtml "mtest" (idform.form ++ html) hst

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
69
startTask :: !Int !(Task a) !*HSt -> (a,[BodyTag],!*HSt) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
70
startTask thisUser taska hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
71
72
# userVersionNr			= "User" <+++ thisUser <+++ "_VersionPNr"
# sessionVersionNr		= "User" <+++ thisUser <+++ "_VersionSNr" 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
73
# traceId				= "User" <+++ thisUser <+++ "_Trace" 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
74
# (pversion,hst)	 	= mkStoreForm (Init, pFormId userVersionNr 0) id hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
75
# (refresh,hst) 		= simpleButton userVersionNr "Refresh" id hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
76
77
# (traceAsked,hst) 		= simpleButton traceId "ShowTrace" (\_ -> True) hst
# doTrace				= traceAsked.value False
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
78
# (sversion,hst)	 	= mkStoreForm (Init, nFormId sessionVersionNr pversion.value) (if refresh.changed (\_ -> pversion.value) id) hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
79
80
81
82
| sversion.value < pversion.value	= (createDefault,  refresh.form ++ [Br,Br, Hr [],Br] <|.|>
														[Font [Fnt_Color (`Colorname Yellow)]
													   [B [] "Sorry, cannot apply command.",Br, 
													    B [] "Your page is not up-to date!",Br]],hst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
83
84
85
86
87
88
89
90
# (a,{html,hst,trace}) = taska 	{ tasknr	= [-1]
								, activated = True
								, userId	= thisUser 
								, myId		= defaultUser 
								, html 		= BT []
								, trace		= if doTrace (Just []) Nothing
								, hst 		= hst
								, storageInfo = {tasklife = Session, taskstorage = PlainString, taskmode = Edit }}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
91
92
# (pversion,hst)	 	= mkStoreForm (Init, pFormId userVersionNr 0) inc hst
# (sversion,hst)	 	= mkStoreForm (Init, nFormId sessionVersionNr pversion.value) inc hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
93
94
# (selbuts,seltask,hst)	= Filter thisUser defaultUser ((defaultUser,"Main") @@: html) hst
= 	(a,	refresh.form ++ traceAsked.form ++
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
95
		[Br,Br, Hr [],Br] ++ 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
96
		if doTrace
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
97
			[ printTrace2 trace ]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
98
99
100
101
			[ mkSTable2 [ [yellowUser thisUser,EmptyBody,EmptyBody]
						, [mkColForm selbuts, EmptyBody, BodyTag seltask]
						]
			]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
102
	,hst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
103
104
where
	defaultUser	= 0
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
105

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
106
107
108
109
110
111
112
	mkSTable2 :: [[BodyTag]] -> BodyTag
	mkSTable2 table
	= Table []	(mktable table)
	where
		mktable table 	= [Tr [] (mkrow rows) \\ rows <- table]	
		mkrow rows 		= [Td [Td_VAlign Alo_Top] [row] \\ row <- rows] 
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
113
	Filter id user tree hst
114
	# (_,accu) 		= Collect ((==) id) user [] tree
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
115
116
117
118
119
120
121
122
	| isNil accu	= ([],[],hst)
	# (names,tasks) = unzip accu
	# (fun,hst)		= ListFuncBut (Init,sFormId ("User" <+++ id <+++ "_Task" <+++ length accu) [(LButton defpixel name,dotask i) \\ name <- names & i <- [0..]]) hst
	# (selected,hst)= mkStoreForm (Init,sFormId ("User" <+++ id <+++ "_Task" <+++ length accu) 0) fun.value hst 
	= (fun.form,tasks!!if (selected.value >= length accu) 0 selected.value,hst)
	where
		dotask i _ = i
	
123
124
125
126
127
	Collect pred user accu (nuser -@: tree)
					= Collect (\v -> pred v && ((<>) nuser v)) user accu tree
	Collect pred user accu ((nuser,taskname) @@: tree)
	# (myhtml,accu)	= Collect pred nuser accu tree
	| pred nuser && not (isNil myhtml)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
128
129
					= ([],[(taskname,myhtml):accu])
	| otherwise		= ([],accu)
130
	Collect pred user accu (BT bdtg)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
131
					= (bdtg,accu)
132
133
134
	Collect pred user accu  (tree1 +|+ tree2)
	# (lhtml,accu)	= Collect pred user accu tree1
	# (rhtml,accu)	= Collect pred user accu tree2
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
135
	= (lhtml <|.|> rhtml,accu)
136
137
138
	Collect pred user accu  (tree1 +-+ tree2)
	# (lhtml,accu)	= Collect pred user accu tree1
	# (rhtml,accu)	= Collect pred user [] tree2
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
139
140
141
142
	= ([lhtml <=> rhtml],accu)

	isNil [] = True
	isNil _ = False
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
143

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
144
145
146
147
// Task makers are wrappers which take care of
//		- deciding whether a task should be called (activated) or not
//		- adding trace information
//		- generating task numbers in a systematic way
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
148
149
// It is very important that the numbering of the tasks is done systematically
// Every task should have a unique number
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
150
151
152
// Every sequential task should increase the task number
// If a task i is composed out of subtasks, all subtasks have as number [...:i] called a shift
// For parallel tasks you need two shifts, one for the subtask and one to allow subsequent numbering
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
153
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
154
mkTask :: !String (Task a) -> (Task a) | iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
155
mkTask taskname mytask = \tst -> mkTask` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
156
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
157
	mkTask` tst		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
158
159
160
161
	# tst			= incTask tst						// every task should first increment its tasknumber
	# (tasknr,tst)	= tst!tasknr						// to avoid uniqueness type error
	# (a,tst)		= mkTaskNoInc taskname mytask tst
	= (a,{tst & tasknr = tasknr})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
162

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
163
mkTaskNoInc :: !String (Task a) -> (Task a) | iData a				// common second part of task wrappers
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
164
mkTaskNoInc taskname mytask = \tst -> mkTaskNoInc` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
165
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
166
	mkTaskNoInc` tst=:{activated,tasknr,myId}		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
167
168
169
	| not activated							= (createDefault,tst)	// not active, don't call tasl, return default value
	# (val,tst=:{activated,trace})			= mytask tst			// active, so perform task and get its result
	| isNothing trace || taskname == ""		= (val,tst)				// no trace, just return value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
170
	= (val,{tst & trace 					= Just (InsertTrace activated tasknr myId taskname (printToString val) (fromJust trace))}) // adjust trace
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
171

172
173
174

// non optimized versions of repeattask and recTask will increase the task tree stack and
// therefore cannot be used for big applications
175
176

repeatTask2 :: (Task a) -> Task a | iData a
177
repeatTask2 task = \tst -> mkTask "repeatTask2" repeatTask` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
178
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
179
	repeatTask` tst=:{tasknr}		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
180
	# (val,tst)	= task {tst & tasknr = [-1:tasknr]}					// shift tasknr
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
181
	= repeatTask2 task tst						// loop
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
182

183
184
recTask2 :: !String (Task a) -> (Task a) 	| iData a 
recTask2 taskname mytask = \tst -> mkTask taskname recTask` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
185
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
186
	recTask` tst=:{tasknr}		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
187
	= mytask {tst & tasknr = [-1:tasknr]} 				// shift tasknr
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
188

189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
// same, but by remembering results stack space can be saved

repeatTask :: (Task a) -> Task a | iData a
repeatTask task = \tst -> repeatTask` tst
where
	repeatTask` tst=:{tasknr,hst} 
	# mytasknr					= incTasknr tasknr					// manual incr task nr
	# taskId					= itaskId mytasknr "_Rep"				// create store id
	# (currtasknr,hst)			= mkStoreForm (Init,cFormId tst.storageInfo taskId mytasknr) id hst	// fetch actual tasknr
	# (val,tst=:{activated,hst})= mkTaskNoInc "repeatTask" repeatTask`` {tst & tasknr = currtasknr.value,hst = hst}
	| activated 																					// task is completed	
		# ntasknr				= incTasknr currtasknr.value										// incr tasknr
		# (currtasknr,hst)		= mkStoreForm (Init,cFormId tst.storageInfo taskId tasknr) (\_ -> ntasknr) hst // store next task nr
		= mkTaskNoInc "repeatTask" repeatTask`` {tst & tasknr = currtasknr.value, hst = hst}		// initialize new task
	= (val,tst)					
	where
		repeatTask`` tst=:{tasknr}		
		# (val,tst)= task {tst & tasknr = [-1:tasknr]}	// do task to repeat
		= (val,{tst & tasknr = tasknr})					

recTask :: !String (Task a) -> (Task a) 	| iData a 
recTask taskname mytask = \tst -> mkTask taskname (recTask` False mytask) tst

recTask` collect mytask tst=:{tasknr,hst}		
# taskId					= itaskId tasknr "_Rec"
# (taskval,hst) 			= mkStoreForm (Init,cFormId tst.storageInfo taskId (False,createDefault)) id hst  // remember if the task has been done
# (taskdone,taskvalue)		= taskval.value
| taskdone					= (taskvalue,{tst & hst = hst})					// optimize: return stored value
# (val,tst=:{activated,hst})= mytask {tst & tasknr = [-1:tasknr],hst =hst} 	// do task, first shift tasknr
| not activated				= (val,{tst & tasknr = tasknr})					// subtask not ready, return value of subtasks
# tst=:{hst}				= if collect 
									(deleteSubTasks [0:tasknr] {tst & tasknr = [0:tasknr]})
									tst
# (_,hst) 					= mkStoreForm (Init,cFormId tst.storageInfo taskId (False,createDefault)) (\_ -> (True,val)) hst  // remember if the task has been done
= (val,{tst & tasknr = tasknr, hst = hst})

// same, but additionally deleting subtasks

repeatTaskGC :: (Task a) -> Task a | iData a
repeatTaskGC task = \tst -> mkTask "repeatTaskGC" repeatTask` tst
where
	repeatTask` tst=:{tasknr}		
	# (val,tst=:{activated})	= task {tst & tasknr = [-1:tasknr]}					// shift tasknr
	| activated 				= repeatTask` (deleteSubTasks tasknr {tst & tasknr = tasknr}) // loop
	= (val,tst)					

recTaskGC :: !String (Task a) -> (Task a) 	| iData a 
recTaskGC taskname mytask = \tst -> mkTask taskname (recTask` True mytask) tst


// parallel subtask creation utility

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
241
242
243
244
245
246
247
mkParSubTask :: !String !Int (Task a) -> (Task a)  | iData a 		// two shifts are needed
mkParSubTask name i task = \tst -> mkParSubTask` name i task tst
where
	mkParSubTask` name i task tst=:{tasknr}
	# (v,tst) = mkTaskNoInc (name <+++ "." <+++ i) mysubtask {tst & tasknr = [i:tasknr],activated = True} // shift task
	= (v,{tst & tasknr = tasknr})
	where
248
		mysubtask tst=:{tasknr} = task {tst & tasknr = [-1:tasknr], activated = True/*, html = BT []*/}	// shift once again!
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
249
250

// assigning tasks to users, each user is identified by a number
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
251

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
252
(@:) infix 4 :: !(!Int,!String) (Task a)	-> (Task a)			| iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
253
(@:) (userId,taskname) taska = \tst=:{myId} -> assignTask` myId {tst & myId = userId}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
254
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
255
	assignTask` myId tst=:{html=ohtml}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
256
	# (a,tst=:{html=nhtml,activated})	= taska {tst & html = BT [],myId = userId}		// activate task of indicated user
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
257
258
	| activated 						= (a,{tst & activated = True
												  ,	myId = myId							// work is done						
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
259
												  ,	html = ohtml +|+ 					// clear screen
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
260
													BT [yellowUser userId, Txt " finished task ",yellow taskname, Br,Br] +|+
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
261
													((userId,taskname) @@: nhtml)})	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
262
	= (a,{tst & myId = myId																// restore user Id
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
263
			  , html = 	ohtml +|+ 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
264
265
						BT [Br, Txt ("Waiting for Task "), yellow taskname, Txt " from ", yellowUser userId,Br] +|+ 
						((userId,taskname) @@: BT [Txt "Task ",yellow taskname, Txt " requested by ", yellowUser myId,Br,Br] +|+ nhtml)})				// combine html code, filter later					
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
266

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
267
(@::) infix 4 :: !Int (Task a)	-> (Task a)			| iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
268
(@::) userId taska = \tst=:{myId} -> assignTask` myId {tst & myId = userId}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
269
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
270
	assignTask` myId tst=:{html}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
271
272
273
274
	# (a,tst=:{html=nhtml,activated})	= taska {tst & html = BT [],myId = userId}		// activate task of indicated user
	| activated 						= (a,{tst & myId = myId							// work is done						
												  ,	html = html})	
	= (a,{tst & myId = myId																// restore user Id
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
275
			  , html = 	html +|+  ((userId,"Task " <+++ myId) @@: nhtml)})				// combine html code, filter later					
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
276

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
277
// sequential tasks
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
278

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
279
iSTask tracename prompt task = \tst -> mkTask tracename (STask` prompt task) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
280

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
281
STask :: String a -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
STask prompt a = \tst -> mkTask "STask" (STask` prompt a) tst

STask` prompt a tst=:{tasknr,html,hst}
# taskId			= itaskId tasknr "_Seq"
# editId			= itaskId tasknr "_Val"
# buttonId			= itaskId tasknr "_But"
# (taskdone,hst) 	= mkStoreForm (Init,cFormId tst.storageInfo taskId False) id hst  			// remember if the task has been done
| taskdone.value																				// test if task has completed
	# (editor,hst) 	= (mkEditForm  (Init,cdFormId tst.storageInfo editId a <@ Display) hst)		// yes, read out current value, make editor passive
	= (editor.value,{tst & activated = True, html = html +|+ BT editor.form, hst = hst})		// return result task
# (editor,hst) 		= mkEditForm  (Init,cFormId tst.storageInfo editId a) hst					// no, read out current value from active editor
# (finbut,hst)  	= simpleButton buttonId prompt (\_ -> True) hst								// add button for marking task as done
# (taskdone,hst) 	= mkStoreForm (Init,cFormId tst.storageInfo taskId False) finbut.value hst 	// remember task status for next time
| taskdone.value	= STask` prompt a {tst & hst = hst}												// task is now completed, handle as previously
= (a,{tst & activated = taskdone.value, html = html +|+ BT (editor.form ++ finbut.form), hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
297

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
298
STask_button :: String (Task a) -> (Task a) | iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
299
STask_button s task = iCTask_button "STask_button" [(s,task)]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
300
301

STasks :: [(String,Task a)] -> (Task [a])| iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
302
STasks options = \tst -> mkTask "STasks" STasks` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
303
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
304
305
306
307
308
309
310
	STasks` tst=:{tasknr}
	# (val,tst)	 = doSandTasks` options [] {tst & tasknr = [-1:tasknr]}
	= (val,{tst & tasknr = tasknr})

	doSandTasks` [] accu tst 		= (reverse accu,{tst & activated = True})
	doSandTasks` [(txt,task):ts] accu tst=:{html} 
	# (a,tst=:{activated=adone,html=ahtml}) 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
311
									= task {tst & activated = True, html = BT []}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
312
313
	| not adone						= (reverse accu,{tst & html = html +|+ BT [Txt ("Task: " +++ txt),Br] +|+ ahtml})
	= doSandTasks` ts [a:accu] {tst & html = html +|+ ahtml}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
314
315

// Choose one or more tasks out of a collection
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
316
iCTask_button tracename options = \tst -> mkTask tracename (doCTask` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
317

318
319
CTask :: [(String,Task a)] -> (Task a) | iData a
CTask options = \tst -> mkTask "CTask_button" (doCTask` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
320

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
321
doCTask` [] tst					= ireturnV createDefault tst				
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
322
doCTask` options tst=:{tasknr,html,hst}									// choose one subtask out of the list
323
324
# taskId						= itaskId tasknr ("_Or0." <+++ length options)
# buttonId						= itaskId tasknr "_But"
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
325
326
327
328
329
330
# (chosen,hst)					= mkStoreForm  (Init,cFormId tst.storageInfo taskId -1) id hst
| chosen.value == -1
	# (choice,hst)				= TableFuncBut (Init,cFormId tst.storageInfo buttonId [[(but txt,\_ -> n) \\ txt <- map fst options & n <- [0..]]] <@ Page) hst
	# (chosen,hst)				= mkStoreForm  (Init,cFormId tst.storageInfo taskId -1) choice.value hst
	| chosen.value == -1		= (createDefault,{tst & activated =False,html = html +|+ BT choice.form, hst = hst})
	# chosenTask				= snd (options!!chosen.value)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
331
	# (a,tst=:{activated=adone,html=ahtml,hst}) = chosenTask {tst & tasknr = [-1:tasknr], activated = True, html = BT [], hst = hst}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
332
	= (a,{tst & tasknr = tasknr, activated = adone, html = html +|+ ahtml,hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
333
334
335
# chosenTask					= snd (options!!chosen.value)
# (a,tst=:{activated=adone,html=ahtml,hst}) = chosenTask {tst & tasknr = [-1:tasknr], activated = True, html = BT [], hst = hst}
= (a,{tst & tasknr = tasknr, activated = adone, html = html +|+ ahtml,hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
336

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
337
but i = LButton defpixel i
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
338

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
339
CTask_pdmenu :: [(String,Task a)] -> (Task a) | iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
340
CTask_pdmenu options = \tst -> mkTask "CTask_pdmenu" (doCTask` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
341
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
342
	doCTask` [] tst					= (createDefault,{tst& activated = True})	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
343
	doCTask` options tst=:{tasknr,html,hst}								// choose one subtask out of the list
344
	# taskId						= itaskId tasknr ("_Or0." <+++ length options)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
345
	# (choice,hst)					= FuncMenu  (Init,cFormId tst.storageInfo taskId (0,[(txt,id) \\ txt <- map fst options]))	hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
346
347
348
	# (_,tst=:{activated=adone,html=ahtml})	
									= iSTask "" "Done" Void {tst & activated = True, html = BT [], hst = hst,tasknr = [-1:tasknr]} 	
	| not adone						= (createDefault,{tst & activated = False, html = html +|+ BT choice.form +|+ ahtml, tasknr = tasknr})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
349
350
	# chosenIdx						= snd choice.value
	# chosenTask					= snd (options!!chosenIdx)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
351
352
353
	# (a,tst=:{activated=bdone,html=bhtml,hst}) 
									= chosenTask {tst & activated = True, html = BT [], tasknr = [0:tasknr]}
	= (a,{tst & activated = adone&&bdone, html = html +|+ bhtml,hst = hst, tasknr = tasknr})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
354
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
355
MCTask_ckbox :: [(String,Task a)] -> (Task [a]) | iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
356
MCTask_ckbox options = \tst -> mkTask "MCTask_ckbox" (MCTask_ckbox` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
357
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
358
	MCTask_ckbox` [] tst			= ([],{tst& activated = True})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
359
	MCTask_ckbox` options tst=:{tasknr,html,hst}									// choose one subtask out of the list
360
	# taskId						= itaskId tasknr ("_MLC." <+++ length options)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
361
	# (cboxes,hst)					= ListFuncCheckBox (Init,cFormId tst.storageInfo taskId initCheckboxes) hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
362
	# optionsform					= cboxes.form <=|> [Txt text \\ (text,_) <- options]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
363
364
365
	# (_,tst=:{html=ahtml,activated = adone})
									= (iSTask "" "OK" Void <<@ Page)	{tst & activated = True, html = BT [],hst = hst,tasknr = [-1:tasknr]} 
	| not adone						= STasks [] {tst & html=html +|+ BT [optionsform] +|+ ahtml,tasknr = [0:tasknr]}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
366
	# mytasks						= [option \\ option <- options & True <- snd cboxes.value]
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
367
368
	# (val,tst)						= STasks mytasks {tst & tasknr = [0:tasknr]}
	= (val,{tst & tasknr = tasknr})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
369
370
371
372

	initCheckboxes  = 
		[(CBNotChecked  text,  \ b bs id -> id) \\ (text,_) <- options]

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
373
374
// Parallel tasks ending as soon as one completes

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
375
PCTask2 :: (Task a,Task a) -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
376
PCTask2 (taska,taskb) = \tst -> mkTask "PCTask2" (PCTask2` (taska,taskb)) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
377
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
378
	PCTask2` (taska,taskb) tst=:{tasknr,html}
379
380
	# (a,tst=:{activated=adone,html=ahtml})	= mkParSubTask "PTask2" 0 taska {tst & html = BT []}
	# (b,tst=:{activated=bdone,html=bhtml})	= mkParSubTask "PTask2" 1 taskb {tst & tasknr = tasknr, html = BT []}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
381
	# (aorb,aorbdone,myhtml)				= if adone (a,adone,ahtml) (if bdone (b,bdone,bhtml) (a,False,ahtml +|+ bhtml))
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
382
	= (aorb,{tst & activated = aorbdone, html = html +|+ myhtml})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
383

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
384
PCTasks :: [(String,Task a)] -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
385
PCTasks options = \tst -> mkTask "PCTasks" (PCTasks` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
386
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
387
	PCTasks` [] tst 				= ireturnV createDefault tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
388
	PCTasks` tasks tst=:{tasknr,html,hst}
389
390
391
392
	# (chosen,hst)					= mkStoreForm  (Init,cFormId tst.storageInfo (itaskId tasknr ("_One0." <+++ length options) ) 0) id hst
	# (choice,hst)					= TableFuncBut2 (Init,cFormId tst.storageInfo (itaskId tasknr "_But" ) [[(mode chosen.value n, but txt,\_ -> n)] \\ txt <- map fst options & n <- [0..]] <@ Page) hst
	# (chosen,hst)					= mkStoreForm  (Init,cFormId tst.storageInfo (itaskId tasknr ("_One0." <+++ length options) ) 0) choice.value hst
	# (choice,hst)					= TableFuncBut2 (Init,cFormId tst.storageInfo (itaskId tasknr "_But" ) [[(mode chosen.value n, but txt,\_ -> n)] \\ txt <- map fst options & n <- [0..]] <@ Page) hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
393
	# chosenTask					= snd (options!!chosen.value)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
394
	# (a,{tasknr,activated=adone,html=ahtml,hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
395
396
397
									= chosenTask {tst & tasknr = [-1,chosen.value:tasknr], activated = True, html = BT [], hst = hst}
	| not adone						= (a,{tst & activated = adone, html = html +|+ BT choice.form +-+ ahtml, hst = hst})
	= (a,{tst & activated = adone, html = html +|+ ahtml, hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
398

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
399
	but i = LButton defpixel i
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
400
401
402
	mode i j
	| i==j = Display
	= Edit
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
403

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
404
405
// Parallel tasks ending if all complete

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
406
PTask2 :: (Task a,Task b) -> (Task (a,b)) | iData a & iData b
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
407
PTask2 (taska,taskb) = \tst -> mkTask "PTask2" (PTask2` (taska,taskb)) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
408
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
409
	PTask2` (taska,taskb) tst=:{tasknr,html}
410
411
	# (a,tst=:{activated=adone,html=ahtml})	= mkParSubTask "PTask2" 0 taska {tst & html = BT []}
	# (b,tst=:{activated=bdone,html=bhtml})	= mkParSubTask "PTask2" 1 taskb {tst & tasknr = tasknr, html = BT []}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
412
	= ((a,b),{tst & activated = adone&&bdone, html = html +|+ ahtml +|+ bhtml})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
413

414
checkAllTasks traceid options ctasknr bool alist tst=:{tasknr}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
415
416
| ctasknr == length options		= (reverse alist,{tst & activated = bool})
# (taskname,task)				= options!!ctasknr
417
418
# (a,tst=:{activated = adone})	= mkParSubTask traceid ctasknr task {tst & tasknr = tasknr, activated = True}
= checkAllTasks traceid options (inc ctasknr) (bool&&adone) (if adone [(taskname,a):alist] alist) {tst & tasknr = tasknr}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
419

420
checkAnyTasks traceid taskoptions ctasknr bool tst=:{tasknr}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
421
422
| ctasknr == length taskoptions	= (bool,tst)
# task							= taskoptions!!ctasknr
423
424
425
# (a,tst=:{activated = adone})	= mkParSubTask traceid ctasknr task {tst & tasknr = tasknr, activated = True}
= checkAnyTasks traceid taskoptions (inc ctasknr) (bool||adone) {tst & tasknr = tasknr}

426
427
PmuTasks :: String [(Int,Task a)] -> (Task [a]) | iData a 
PmuTasks taskid tasks = \tst-> recTask "PmuTasks" (PmuTasks` tasks) tst
428
where
429
	PmuTasks` list tst								= PTasks [(taskid <+++ " " <+++ i, i @:: task) \\ (i,task) <- list] tst
430
431
432
433
434
435
436
437
/*
	PmuTasks` [] tst								= ireturnV [] tst
	PmuTasks` [(ida,taska):tasks] tst=:{html}
	# (a, tst=:{html=htmla,activated=adone})		= (ida @:: taska) {tst & html = (ida,"Task") @@: BT [], activated = True}
	# (ax,tst=:{html=htmlstasks,activated=alldone})	= PmuTasks` tasks (incTask {tst & html = (ida,"Task") @@: BT []})
	= ([a:ax],{tst & html = html +|+ htmla +|+ htmlstasks,activated=adone&&alldone})	
*/
//	# (a,tst=:{activated=adone,html=ahtml})	= mkParSubTask "PTask2" 0 taska tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
438

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
439
PTasks :: [(String,Task a)] -> (Task [a]) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
440
PTasks options = \tst -> mkTask "PTasks" (doPTasks` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
441
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
442
	doPTasks` [] tst	= ireturnV [] tst
443
	doPTasks` options tst=:{tasknr,html,hst,trace,myId}
444
445
446
447
	# (chosen,hst)		= mkStoreForm   (Init,cFormId tst.storageInfo (itaskId tasknr ("_All" <+++ length options) ) 0) id hst
	# (choice,hst)		= TableFuncBut2 (Init,cFormId tst.storageInfo (itaskId tasknr "_But" ) [[(mode chosen.value n,but txt,\_ -> n) \\ txt <- map fst options & n <- [0..]]] <@ Page) hst
	# (chosen,hst)		= mkStoreForm   (Init,cFormId tst.storageInfo (itaskId tasknr ("_All" <+++ length options) ) 0) choice.value hst
	# (choice,hst)		= TableFuncBut2 (Init,cFormId tst.storageInfo (itaskId tasknr "_But" ) [[(mode chosen.value n,but txt,\_ -> n) \\ txt <- map fst options & n <- [0..]]] <@ Page) hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
448
449
	# chosenTask		= snd (options!!chosen.value)
	# chosenTaskName	= fst (options!!chosen.value)
450
451
	# (alist,{activated=finished,hst,trace,html=allhtml})		
						= checkAllTasks "PTasks" options 0 True [] {tst & html = BT [], hst = hst,trace = trace}
452
	| finished			= (map snd alist,{tst & activated = finished, hst = hst,trace = trace, html = html +|+ (myId -@: allhtml)})
453
	# (a,{activated=adone,html=ahtml,hst,trace}) = mkParSubTask "PTasks" chosen.value chosenTask {tst & tasknr = tasknr, activated = True, html = BT [], hst = hst, trace = trace}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
454
455
	| not adone			= ([a],{tst & 	trace = trace,
										activated = adone, 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
456
										html = html +|+ BT choice.form +|+ 
457
												(BT [Br, gray chosenTaskName,Br] +|+ ahtml +|+ (myId -@: allhtml)), 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
458
										hst = hst})
459
460
	# (alist,{activated=finished,hst,trace,html=allhtml})		
						= checkAllTasks "PTasks" options 0 True [] {tst & html = BT [], hst = hst, trace = trace}
461
	| finished			= (map snd alist,{tst & activated = finished, hst = hst,trace =trace, html = html +|+ (myId -@: allhtml)})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
462
	= (map snd alist,{tst & trace = trace,
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
463
				  activated = finished, html = 	html +|+ 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
464
												BT choice.form +|+ (BT [Br, gray chosenTaskName,Br] +|+ 
465
																	ahtml +|+ (myId -@: allhtml)), hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
466

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
467
	but i = LButton defpixel i
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
468
469
470
	mode i j
	| i==j = Display
	= Edit
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
471

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
472
PMilestoneTasks :: [(String,Task a)] -> (Task [(String,a)]) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
473
PMilestoneTasks options = \tst -> mkTask "PMilestoneTasks" (PMilestoneTasks` options) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
474
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
475
	PMilestoneTasks` [] tst	= ireturnV [] tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
476
	PMilestoneTasks` options tst=:{tasknr,html,hst,trace}
477
478
479
480
	# (chosen,hst)		= mkStoreForm   (Init,cFormId tst.storageInfo (itaskId tasknr ("_PMile_" <+++ length options) ) 0) id hst
	# (choice,hst)		= TableFuncBut2 (Init,cFormId tst.storageInfo (itaskId tasknr "_But" ) [[(mode chosen.value n,but txt,\_ -> n) \\ txt <- map fst options & n <- [0..]]] <@ Page) hst
	# (chosen,hst)		= mkStoreForm   (Init,cFormId tst.storageInfo (itaskId tasknr ("_PMile_" <+++ length options) ) 0) choice.value hst
	# (choice,hst)		= TableFuncBut2 (Init,cFormId tst.storageInfo (itaskId tasknr "_But" ) [[(mode chosen.value n,but txt,\_ -> n) \\ txt <- map fst options & n <- [0..]]] <@ Page) hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
481
482
483
	# chosenTask		= snd (options!!chosen.value)
	# chosenTaskName	= fst (options!!chosen.value)
	# (alist,{activated=finished,hst,trace})		
484
						= checkAllTasks "PMilestoneTasks" options 0 True [] {tst & html = BT [], hst = hst,trace = trace}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
485
486
487
	| finished			= (alist,{tst & activated = finished, hst = hst,trace = trace})
	# (a,{activated=adone,html=ahtml,hst,trace}) = chosenTask {tst & tasknr = [-1,chosen.value:tasknr], activated = True, html = BT [], hst = hst, trace = trace}
	# (milestoneReached,{hst})	
488
						= checkAnyTasks "PMilestoneTasks" (map snd options) 0 False {tst & html = BT [], hst = hst, trace = trace}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
489
490
491
492
493
494
	| not adone			= (alist,{tst & 	trace = trace,
										activated = adone || milestoneReached, 
										html = html +|+ BT choice.form +|+ 
												(BT [Br, gray chosenTaskName,Br] +|+ ahtml +|+ BT [Br, Hr [], Br]), 
										hst = hst})
	# (alist,{activated=finished,hst,trace})		
495
						= checkAllTasks "PMilestoneTasks" options 0 True [] {tst & html = BT [], hst = hst, trace = trace}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
496
497
498
499
500
501
502
503
504
505
	| finished			= (alist,{tst & activated = finished, hst = hst,trace =trace})
	= (alist,{tst & trace = trace,
				  activated = finished || milestoneReached, html = 	html +|+ 
												BT choice.form +|+ (BT [Br, gray chosenTaskName,Br] +|+ 
																	ahtml +|+ BT [Br, Hr [], Br]), hst = hst})

	but i = LButton defpixel i
	mode i j
	| i==j = Display
	= Edit
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
506

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
507

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
508
ireturnV :: a -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
509
ireturnV a  = \tst  -> (a,tst)	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
510

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
511
returnV :: a -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
512
returnV a  = \tst  -> mkTask "returnV" returnV` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
513
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
514
	returnV` tst = (a,tst)				// return result task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
515
516

returnTask :: a -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
517
returnTask a = \tst -> mkTask "returnTask" (returnTask` a) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
518
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
519
	returnTask` a  tst=:{tasknr,activated,html,hst}
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
520
	= (a,{tst & html = html +|+ BT [toHtml a ], activated = True, hst = hst})		// return result task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
521

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
522
returnVF :: a [BodyTag] -> (Task a) | iData a 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
523
returnVF a bodytag = \tst = mkTask "returnVF" returnVF` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
524
525
where
	returnVF` tst =:{html} 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
526
	= (a,{tst & html = html +|+ BT bodytag, activated = True})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
527
528

returnF :: [BodyTag] -> TSt -> TSt
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
529
530
531
532
533
534
returnF bodytag = \tst = returnVF` tst
where
	returnVF` tst=:{activated, html}  
	| not activated				= tst		// not active, return default value
	= {tst & html = html +|+ BT bodytag}	// active, so perform task or get its result

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
535
mkRTask :: String (Task a) *TSt -> ((Task a,Task a),*TSt) | iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
536
537
mkRTask s task tst = let (a,b,c) = mkRTask` s task (incTask tst) in ((a,b),c)
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
538
	mkRTask` s task tst=:{tasknr = maintasknr,storageInfo} = (bossTask, workerTask s task,tst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
539
	where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
540
		workerTask s task tst = mkTask "mkRTaskcallee" (workerTask` s task) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
541
		where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
542
			workerTask` s task tst=:{tasknr,html,hst} 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
543
544
			# (todo,hst)	= checkBossSignal id hst	// check whether lazy task evaluation has to be done
			| todo.value								// yes	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
545
				# (a,{activated=adone,html=ahtml,hst}) = task {tst & tasknr = maintasknr++[0], activated = True, html = BT [], hst = hst}			// do task
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
546
				# (_,hst) 					= lazyTaskStore (\_ -> (adone,a)) hst	// store task and status
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
547
				= (a,{tst & html = html +|+ BT (if adone [] [Txt ("lazy task \"" +++ s +++ "\" activated:"),Br]) +|+ ahtml, hst = hst})
548
			= (createDefault,{tst & hst = hst})	// no
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
549
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
550
		bossTask tst = mkTask "mkRTaskcallee" (bossTask`) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
551
		where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
552
			bossTask` tst=:{tasknr,html,hst} 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
553
			# buttonId		= "getlt" <+++ showTaskNr tasknr
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
554
555
556
557
			# (finbut,hst)  = simpleButton buttonId s (\_ -> True) hst	// button press will trigger related lazy task	
			# (todo,hst)	= checkBossSignal finbut.value hst			// set store True if button pressed
			# (result,hst)	= lazyTaskStore id hst						// inspect status task
			# (done,value)	= result.value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
558
559
			| not done 		= (createDefault,{tst & activated = False, html = html +|+ BT (if todo.value [Txt ("Waiting for task \"" +++ s +++ "\"..")] finbut.form), hst = hst})
			= (value,{tst & html = html +|+  BT [Txt ("Result of lazy task \"" +++ s +++ "\" :")], hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
560
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
561
562
		lazyTaskStore   fun = mkStoreForm (Init,cFormId storageInfo ("getLT" <+++ showTaskNr maintasknr) (False,createDefault)) fun 
		checkBossSignal fun = mkStoreForm (Init,cFormId storageInfo ("setLT" <+++ showTaskNr maintasknr) (fun False)) fun 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
563
		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
564
565
mkRTaskCall :: String b (b -> Task a) *TSt -> ((b -> Task a,Task a),*TSt) | iData a
												& iData b
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
566
567
mkRTaskCall  s initb batask tst = let (a,b,c) = mkRTaskCall` s (incTask tst) in ((a,b),c)
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
568
	mkRTaskCall` s tst=:{tasknr = maintasknr,storageInfo} = (bossTask, workerTask s,tst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
569
	where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
570
		workerTask s tst = mkTask "mkRTaskCallcallee" (workerTask` s) tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
571
		where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
572
573
574
575
576
			workerTask` s tst=:{tasknr,html,hst}
			# (boss,hst)		= bossStore id hst		// check input from boss
			# (worker,hst)		= workerStore id hst	// check result from worker
			# (bdone,binput)	= boss.value
			# (wdone,wresult)	= worker.value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
577
			| wdone				= (wresult,{tst & activated = True, html = html +|+ BT [Txt ("Lazy task \"" +++ s +++ "\" completed:")], hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
578
			| bdone
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
579
				# (wresult,{activated=wdone,html=whtml,hst}) = batask binput {tst & tasknr = maintasknr++[0], activated = True, html = BT [], hst = hst}	// apply task to input from boss
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
580
581
				| wdone															// worker task finshed
					# (_,hst)	= workerStore (\_ -> (wdone,wresult)) hst		// store task and status
582
					= workerTask` s {tst &  hst = hst}				// complete as before
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
583
584
				= (createDefault,{tst & activated = False, html = html +|+ BT (if wdone [] [Txt ("lazy task \"" +++ s +++ "\" activated:"),Br]) +|+ whtml, hst = hst})
			= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for task \"" +++ s +++ "\"..")], hst = hst})
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
585
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
586
		bossTask b tst = mkTask "mkRTaskCallcaller" bossTask` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
587
		where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
588
589
590
591
592
			bossTask` tst=:{tasknr,html,hst} 
			# (boss,hst)		= bossStore id hst		// check input from boss
			# (worker,hst)		= workerStore id hst	// check result from worker
			# (bdone,binput)	= boss.value
			# (wdone,wresult)	= worker.value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
593
			| bdone && wdone	= (wresult,{tst & activated = True, html = html +|+ BT [Txt ("Result of lazy task \"" +++ s +++ "\" :")], hst = hst})	// finished
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
594
595
			| not bdone
				# (_, hst)		= bossStore (\_ -> (True,b)) hst	// store b information to communicate to worker	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
596
597
				= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for task \"" +++ s +++ "\"..")], hst = hst})
			= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for task \"" +++ s +++ "\"..")], hst = hst})	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
598
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
599
600
		workerStore   fun = mkStoreForm (Init,cFormId storageInfo ("workerStore" <+++ showTaskNr maintasknr) (False,createDefault)) fun 
		bossStore     fun = mkStoreForm (Init,cFormId storageInfo ("bossStore"   <+++ showTaskNr maintasknr) (False,initb)) fun 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
601
		
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
602
mkRDynTaskCall :: String a *TSt -> (((Task a) -> (Task a),Task a),*TSt) | iData a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
603
604
mkRDynTaskCall s a tst = mkRDynTaskCall` (incTask tst)
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
605
	mkRDynTaskCall` tst=:{tasknr = maintasknr,storageInfo} = ((bossTask, workerTask),tst)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
606
	where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
607
		workerTask tst = mkTask "mkRDynTaskCallcallee" workerTask` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
608
		where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
609
610
611
612
613
			workerTask` tst=:{tasknr,html,hst} 
			# (boss,hst)		= bossStore (False,defaulttask) hst		// check input from boss
			# (worker,hst)		= workerStore id hst					// check result from worker
			# (bdone,btask)		= boss.value
			# (wdone,wresult)	= worker.value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
614
			| wdone				= (wresult,{tst & activated = True, html = html +|+ BT [Txt ("Lazy task \"" +++ s +++ "\" completed:")], hst = hst})	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
615
			| bdone
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
616
				# (wresult,{activated=wdone,html=whtml,hst}) = btask {tst & tasknr = maintasknr++[0], activated = True, html = BT [], hst = hst}	// apply task stored in memory
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
617
618
				| wdone															// worker task finshed
					# (_,hst)	= workerStore (\_ -> (wdone,wresult)) hst		// store task and status
619
					= workerTask` {tst & hst = hst} 							// complete as before
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
620
621
				= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("lazy task \"" +++ s +++ "\" activated:"),Br] +|+ whtml, hst = hst})
			= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for task \"" +++ s +++ "\"..")], hst = hst})		// no
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
622
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
623
		bossTask taska tst = mkTask "mkRDynTaskCallcaller" bossTask` tst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
624
		where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
625
			bossTask` tst=:{tasknr,html,hst} 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
626
			# (boss,hst)		= bossStore (False,defaulttask) hst		// check input from boss
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
627
			# (worker,hst)		= workerStore id hst					// check result from worker
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
628
629
			# (bdone,btask)		= boss.value
			# (wdone,wresult)	= worker.value
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
630
			| bdone && wdone	= (wresult,{tst & activated = True, html = html +|+ BT [Txt ("Result of lazy task \"" +++ s +++ "\" :")], hst = hst})	// finished
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
631
			| not bdone
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
632
				# (_, hst)		= bossStore (True,taska) hst			// store b information to communicate to worker	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
633
634
				= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("Task commited.\nWaiting for task \"" +++ s +++ "\"..")], hst = hst})
			= (createDefault,{tst & activated = False, html = html +|+ BT [Txt ("Waiting for task \"" +++ s +++ "\"..")], hst = hst})	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
635
	
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
636
		workerStore   fun = mkStoreForm (Init,cFormId storageInfo ("workerStore" <+++ showTaskNr maintasknr) (False,createDefault)) fun 
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
637
638

		bossStore (set,task) hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
639
		# (boss,hst) 			= mkStoreForm (Init,cFormId storageInfo ("bossStore" <+++ showTaskNr maintasknr) initBoss) settask hst
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
640
641
		# (bdone,encbtask)		= boss.value
		# btask					= case string_to_dynamic` encbtask of
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
642
									(mytask:: *TSt -> *(a^,*TSt)) -> mytask
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
643
									_ -> 	defaulttask
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
644
645
646
647
648
649
650
651
		= ({boss & value = (bdone,btask)},hst)
		where
			initBoss			= (False,convertTask defaulttask)
			settask				= if set (\_ -> (True,convertTask task)) id
			convertTask task 	= dynamic_to_string (dynamic task::*TSt -> *(a^,*TSt))

			string_to_dynamic` s = string_to_dynamic ( {s` \\ s` <-: s})

Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
652
		defaulttask 		 	= STask "DefaultTask" a
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
653
		
654
655
656
// time and date related tasks

waitForTimeTask:: HtmlTime	-> (Task HtmlTime)
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
657
waitForTimeTask time = \tst ->  mkTask "waitForTimeTask" waitForTimeTask` tst
658
where
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
659
	waitForTimeTask` tst=:{tasknr,hst}
660
	# taskId				= itaskId tasknr "_Time_"
Rinus Plasmeijer's avatar
Rinus Plasmeijer committed
661
	# (stime,hst) 			= mkStoreForm (Init,cFormId tst.storageInfo taskId time) id hst  			// remember time