Added tasks for manipulating the process database and added a simple process...

Added tasks for manipulating the process database and added a simple process administration workflow.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/fancyTasks@533 63da3aa8-80fd-4f01-9db8-e6ea747a3da2

Admin/ProcessAdmin.dcl

+definition module ProcessAdmin
+
+import iTasks
+
+processAdmin :: [Workflow]
\ No newline at end of file

Admin/ProcessAdmin.icl

+implementation module ProcessAdmin
+
+import iTasks
+
+processAdmin :: [Workflow]
+processAdmin
+	= [	{Workflow
+		| name = "Admin/Manage processes"
+		, label = "Manage processes"
+		, roles	= []
+		, mainTask = processAdminMainTask
+		}]
+		
+processAdminMainTask :: Task Void
+processAdminMainTask
+= (	stopOrRefresh
+	-||-
+	(	
+							getProcesses [Active,Suspended]
+		>>= \processes ->	case processes of
+								[]	= return True
+								_	= gridChooseTask processes header visualizeProcess processTasks
+	)
+  ) <! id <<@ TTVertical
+  >>| return Void
+
+where
+	header :: [[HtmlTag]]
+	header = [[Text h] \\ h <- ["Id","Label","Owner","Delegator"]]
+	
+	visualizeProcess :: Process -> [[HtmlTag]]
+	visualizeProcess {Process|id,label,owner,delegator}
+		= [[Text (toString id)]
+		  ,[Text label]
+		  ,[Text (toString owner)]
+		  ,[Text (toString delegator)]
+		  ]
+	
+	processTasks :: [(Process -> String, Process -> Task Bool)]
+ 	processTasks = [(\proc -> if (isActive proc) "Suspend" "Activate",	toggleProcess)
+ 				   ,(\_ -> "Inspect",									inspectProcess)
+ 				   ,(\_ -> "Kill",										killProcess)
+ 				   ]
+
+	isActive {status = Active } = True
+	isActive _					= False
+ 	
+stopOrRefresh :: Task Bool
+stopOrRefresh = button "Reload process list" False -||- button "I am done" True <<@ TTHorizontal
+
+toggleProcess :: Process -> Task Bool
+toggleProcess process=:{Process|id,status}
+	= case status of
+		Active		= setProcessStatus Suspended id
+		Suspended	= setProcessStatus Active id		
+	  >>| return False
+
+inspectProcess :: Process -> Task Bool
+inspectProcess process = yes
+
+killProcess :: Process -> Task Bool
+killProcess process=:{Process|id}
+	=	setProcessStatus Deleted id
+	>>|	return False
+
+gridChooseTask :: [a] [[HtmlTag]] (a -> [[HtmlTag]]) [(a -> String, a -> Task Bool)] -> Task Bool | iData a
+gridChooseTask xs header rowVisualizeFun rowTasks
+	=				orTasks [("row-" +++ toString i, row x) \\ x <- xs & i <- [1..]] <<@ TTCustom (toTable header)	//Show the grid
+	>>= \task -> 	task																																	//Execute the chosen task
+where
+
+	row x = parallel "row-content" (\list -> length list == 1) (\[index] -> (snd (rowTasks !! index)) x) [("row-buttons", selectWithButtons [labelFun x \\ (labelFun,_) <- rowTasks])]
+				<<@ TTCustom (toRow (toCells (rowVisualizeFun x)))
+				
+	toCells html = [TdTag [] cell \\ cell <- html]
+	toRow info [tasks] = [TrTag [] (info ++ [TdTag [] tasks])]
+	toTable header rows = [TableTag [ClassAttr "debug-table"] [TrTag [] ([ThTag [] cell \\ cell <- header ] ++ [ThTag [] [RawText "&nbsp;"]]):flatten rows]]  
\ No newline at end of file

AllExamples.icl

@@ -19,8 +19,12 @@ import ReviewTask
 import Coffeemachine
 import Newsgroups
 import ExceptionHandling
+import ChangeHandling
 import WebShop
 
+//Administrative tasks
+import ProcessAdmin
+
 Start :: *World -> *World
 Start world = startEngine workflows world
 where
@@ -36,5 +40,7 @@ where
 						, coffeemachineExample
 						, newsgroupsExample
 						, exceptionHandlingExample
+						, changeHandlingExample
 						, webShopExample
+						, processAdmin
 						]
\ No newline at end of file

Examples/Higher order/MovingTask.icl

@@ -90,7 +90,7 @@ where
 
 	reassign wid
 	=						selectUser "Who is next?"
-		>>= \who ->			setProcessOwner who wid 
+		>>= \who ->			updateProcessOwner who wid 
 		>>| 				return False
 
 	waitForIt wid

Examples/Miscellaneous/ChangeHandling.dcl

+definition module ChangeHandling
+
+import iTasks
+
+changeHandlingExample :: [Workflow]
\ No newline at end of file

Examples/Miscellaneous/ChangeHandling.icl

-module ChangeHandling
+implementation module ChangeHandling
 
 import iTasks, iDataTrivial
 import StdMisc
 
 
-Start world = startEngine exceptionHandlingExample world
+//Start world = startEngine exceptionHandlingExample world
 
-exceptionHandlingExample :: [Workflow]
-exceptionHandlingExample
-=	[{ name		= "Change handling"
+changeHandlingExample :: [Workflow]
+changeHandlingExample
+=	[{ name		= "Examples/Miscellaneous/Change handling"
 	 , label	= "Change example"
 	 , roles	= []
 	 , mainTask	= doTest >>| return Void

Libraries/iTasks/BasicTasks/UITasks.icl

@@ -60,6 +60,7 @@ mySimpleButton options id label fun hst
 	= FuncBut (Init, (nFormId id (HtmlButton label False,fun)) <@ if (options.tasklife == LSClient) LSClient LSPage) hst
 
 displayHtml	:: ![HtmlTag] -> Task a	| iData a
+displayHtml [] = mkBasicTask "displayHtml" (\tst -> (createDefault,{tst & activated = False}))
 displayHtml html = mkBasicTask "displayHtml" displayTask`
 where
 	displayTask` tst

Libraries/iTasks/Framework/Data/ProcessDB.dcl

@@ -29,28 +29,28 @@ from TSt import :: Workflow
 
 :: DynamicProcessEntry = { result	:: !String		//A serialized final value of the task performed by the process 
 						 , task		:: !String		//A serialized function of the task performed by the process
-						 , parent	:: !Int			//The process that created the current process
+						 , parent	:: !ProcessId	//The process that created the current process
 						 }
 
 class ProcessDB st
 where
-	createProcess		:: !Process												!*st -> (!Int, 			!*st)
-	deleteProcess		:: !Int													!*st -> (!Bool,			!*st)
-	getProcess			:: !Int													!*st -> (!Maybe Process,!*st)
-	getProcessForUser	:: !Int !Int											!*st -> (!Maybe Process,!*st)
+	createProcess		:: !Process												!*st -> (!ProcessId,	!*st)
+	deleteProcess		:: !ProcessId											!*st -> (!Bool,			!*st)
+	getProcess			:: !ProcessId											!*st -> (!Maybe Process,!*st)
+	getProcessForUser	:: !UserId !ProcessId									!*st -> (!Maybe Process,!*st)
 	getProcesses		:: ![ProcessStatus]										!*st -> (![Process],	!*st)
-	getProcessesById	:: ![Int]												!*st -> (![Process],	!*st)
-	getProcessesForUser	:: !Int ![ProcessStatus]								!*st -> (![Process],	!*st)
-	setProcessOwner		:: !Int !Int !Int										!*st -> (!Bool,			!*st)
-	setProcessStatus	:: !ProcessStatus !Int									!*st -> (!Bool,			!*st)
-	setProcessResult	:: !String !Int											!*st -> (!Bool,			!*st)
+	getProcessesById	:: ![ProcessId]											!*st -> (![Process],	!*st)
+	getProcessesForUser	:: !UserId ![ProcessStatus]								!*st -> (![Process],	!*st)
+	setProcessOwner		:: !UserId !UserId !ProcessId							!*st -> (!Bool,			!*st)
+	setProcessStatus	:: !ProcessStatus !ProcessId							!*st -> (!Bool,			!*st)
+	setProcessResult	:: !String !ProcessId									!*st -> (!Bool,			!*st)
 	updateProcess		:: !ProcessStatus !(Maybe String) ![UserId] !ProcessId	!*st -> (!Bool,			!*st) 
 
 instance ProcessDB HSt
 /*
 * Utility functions for creating process database entries.
 */
-mkStaticProcessEntry	:: Workflow UserId UserId ProcessStatus				-> Process
-mkDynamicProcessEntry	:: String String UserId UserId ProcessStatus Int	-> Process
+mkStaticProcessEntry	:: Workflow UserId UserId ProcessStatus					-> Process
+mkDynamicProcessEntry	:: String String UserId UserId ProcessStatus ProcessId	-> Process
 
 instance toString ProcessStatus

Libraries/iTasks/Framework/Data/ProcessDB.icl

@@ -25,27 +25,27 @@ where
 
 instance ProcessDB HSt
 where
-	createProcess :: !Process !*HSt -> (!Int,!*HSt)
+	createProcess :: !Process !*HSt -> (!ProcessId,!*HSt)
 	createProcess entry hst 
 		# (procs,hst) 	= processStore id hst
 		# newPid		= inc (maxPid procs)
 		# (procs,hst)	= processStore (\_ -> procs ++ [{Process | entry & id = newPid}]) hst
 		= (newPid, hst)
 		
-	deleteProcess :: !Int !*HSt	-> (!Bool, !*HSt)
+	deleteProcess :: !ProcessId !*HSt	-> (!Bool, !*HSt)
 	deleteProcess processId hst 
 		# (procs,hst) 	= processStore id hst
 		# (nprocs,hst)	= processStore (\_ -> [process \\ process <- procs | process.Process.id <> processId]) hst
 		= (length procs <> length nprocs, hst)
 		
-	getProcess :: !Int !*HSt -> (!Maybe Process,!*HSt)
+	getProcess :: !ProcessId !*HSt -> (!Maybe Process,!*HSt)
 	getProcess processId hst
 		# (procs,hst) 	= processStore id hst
 		= case [process \\ process <- procs | process.Process.id == processId] of
 			[entry]	= (Just entry, hst)
 			_		= (Nothing, hst)
 
-	getProcessForUser :: !Int !Int !*HSt -> (!Maybe Process,!*HSt)
+	getProcessForUser :: !UserId !ProcessId !*HSt -> (!Maybe Process,!*HSt)
 	getProcessForUser userId processId hst
 		# (procs,hst) 	= processStore id hst
 		= case [process \\ process <- procs | process.Process.id == processId && (process.Process.owner == userId || isMember userId process.Process.users)] of
@@ -57,25 +57,25 @@ where
 		# (procs,hst) 	= processStore id hst
 		= ([process \\ process <- procs | isMember process.Process.status statusses], hst)
 	
-	getProcessesById :: ![Int] !*HSt -> (![Process], !*HSt)
+	getProcessesById :: ![ProcessId] !*HSt -> (![Process], !*HSt)
 	getProcessesById ids hst
 		# (procs,hst) 	= processStore id hst
 		= ([process \\ process <- procs | isMember process.Process.id ids], hst)
 
-	getProcessesForUser	:: !Int ![ProcessStatus] !*HSt -> (![Process], !*HSt)
+	getProcessesForUser	:: !UserId ![ProcessStatus] !*HSt -> (![Process], !*HSt)
 	getProcessesForUser userId statusses hst
 		# (procs,hst) 	= processStore id hst
 		= ([process \\ process <- procs | (process.Process.owner == userId || isMember userId process.Process.users) && isMember process.Process.status statusses], hst)
 
 
 	
-	setProcessOwner	:: !Int !Int !Int !*HSt	-> (!Bool, !*HSt)
+	setProcessOwner	:: !UserId !UserId !ProcessId !*HSt	-> (!Bool, !*HSt)
 	setProcessOwner userId delegatorId processId hst = setProcessProperty (\x -> {Process| x & owner = userId, delegator = delegatorId}) processId hst
 	
-	setProcessStatus :: !ProcessStatus !Int	!*HSt -> (!Bool,!*HSt)
+	setProcessStatus :: !ProcessStatus !ProcessId !*HSt -> (!Bool,!*HSt)
 	setProcessStatus status processId hst = setProcessProperty (\x -> {Process| x & status = status}) processId hst
 
-	setProcessResult :: !String !Int !*HSt -> (!Bool,!*HSt)
+	setProcessResult :: !String !ProcessId !*HSt -> (!Bool,!*HSt)
 	setProcessResult result processId hst = setProcessProperty (update result) processId hst 
 	where
 		update result x = case x.Process.process of
@@ -96,7 +96,7 @@ where
 					Nothing		= {Process | x & status = status, users = users, process = RIGHT dynamicProc}
 	
 //Generic process property update function
-setProcessProperty :: (Process -> Process) Int *HSt -> (!Bool, *HSt)
+setProcessProperty :: (Process -> Process) ProcessId *HSt -> (!Bool, *HSt)
 setProcessProperty f processId hst
 	# (procs,hst) 	= processStore id hst
 	# (nprocs,upd)	= unzip (map (update f) procs)
@@ -119,7 +119,7 @@ mkStaticProcessEntry workflow owner delegator status
 		, status	= status
 		, process	= LEFT {workflow = workflow.name}
 		}
-mkDynamicProcessEntry :: String String UserId UserId ProcessStatus Int-> Process
+mkDynamicProcessEntry :: String String UserId UserId ProcessStatus ProcessId -> Process
 mkDynamicProcessEntry label task owner delegator status parent
 	=	{ Process
 		| id		= 0
@@ -136,10 +136,10 @@ processStore fn hst
 	# (form,hst) = mkStoreForm (Init, pFormId "ProcessDB" []) fn hst
 	= (form.Form.value, hst)
 
-maxPid :: [Process] -> Int
+maxPid :: [Process] -> ProcessId
 maxPid db = foldr max 0 [id \\ {Process|id} <- db]
 
-indexPid :: !Int [Process] -> Int
+indexPid :: !ProcessId [Process] -> Int
 indexPid pid db = indexPid` pid 0 db
 where
 	indexPid` pid i [] = -1

Libraries/iTasks/Framework/TSt.dcl

@@ -44,7 +44,7 @@ from Time		import :: Time(..)
 					, staticWorkflows	:: ![Workflow]							// the list of workflows supported by the application				
 					}
 :: ChangeCondition = CC (*TSt -> *(ChangeResult,*TSt))							// used to pass a list of change predicates down the task tree
-:: ChangeResult	=	{ newCondition		:: !Maybe !ChangeCondition				// new condition to pass to future handlers	
+:: ChangeResult	=	{ newCondition		:: !Maybe ChangeCondition				// new condition to pass to future handlers	
 					, changePred		:: !Bool								// True if the change is applicable here; note that the dynamic information pushed should also match
 					, makeChange		:: !Bool								// True if the work indeed has to be changed by the alternative defined 		
 					} 														

Libraries/iTasks/TaskCombinators/BasicCombinators.dcl

@@ -49,7 +49,7 @@ return 		:: !a 										-> Task a 		| iData a
 */
 forever		:: !(Task a) 								-> Task a 		| iData a
 /**
-* Repeats a task as long as a given predicate holds. The predicate is tested as soon as the
+* Repeats a task until a given predicate holds. The predicate is tested as soon as the
 * given task is finished. When it does not hold, the task is restarted.
 *
 * @param The task to be looped

Libraries/iTasks/TaskCombinators/ProcessCombinators.dcl

@@ -6,15 +6,15 @@ definition module ProcessCombinators
 
 import StdMaybe
 from TSt		import :: Task, :: LabeledTask
-from ProcessDB	import :: ProcessStatus
-from Types		import :: UserId
+from ProcessDB	import :: ProcessStatus(..), :: Process(..), :: StaticProcessEntry(..), :: DynamicProcessEntry(..)
+from Types		import :: UserId, :: ProcessId
 
 import iDataForms
 
-derive gForm ProcessReference
-derive gUpd ProcessReference
-derive gPrint ProcessReference
-derive gParse ProcessReference
+derive gForm	ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+derive gUpd		ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+derive gPrint	ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+derive gParse	ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
 
 /**
 * A typed process reference. These references are used to reference
@@ -114,4 +114,77 @@ deleteCurrentProcess	::									    Task Bool
 * @return A task that yields True when the process owner was successfully updated
 *         and False when the process could not be found.
 */
-setProcessOwner			:: UserId (ProcessReference a)		->	Task Bool					| iData a 
\ No newline at end of file
+updateProcessOwner		:: UserId (ProcessReference a)		->	Task Bool					| iData a
+
+
+//Untyped process tasks, these regard a process as a black box
+
+/**
+* Retrieves the process id of the current process
+*
+* @return The process id of the current process
+*/
+getCurrentProcessId		:: 										Task ProcessId
+/**
+* Retrieves a Process record from the process table
+* 
+* @param The process id
+*
+* @return When found, the Process record. Nothing when the process can not be found.
+*/
+getProcess				:: !ProcessId 							-> Task (Maybe Process)
+/**
+* Retrieves a Process record with an additional check on the process owner. Only
+* when the process is owned by the indicated user it will be returned.
+*
+* @param The owner of the indicated process
+* @param The process id
+*
+* @return When found, the Process record. Nothing when the process can not be found.
+*/
+getProcessForUser		:: !UserId !ProcessId 					-> Task (Maybe Process)
+/**
+* Retrieves all process that have one of the given statuses
+*
+* @param A list of statuses to match on
+* 
+* @return The list of processes having the given statuses
+*/
+getProcesses			:: ![ProcessStatus]						-> Task [Process]
+/**
+* Retrieves the processes with indicated process ids
+*
+* @param A list of process ids to match on
+* 
+* @return The list of found processes
+*/
+getProcessesById		:: ![ProcessId]							-> Task [Process]
+/**
+* Retrieves the processes that are owned by indicated user and have one of the
+* given statuses.
+*
+* @param A process owner to match on
+* @param A list of statuses to match on
+*
+* @return The list of found processes
+*/
+getProcessesForUser		:: !UserId ![ProcessStatus]				-> Task [Process]
+/**
+* Changes the owner of the indicated process. The current user is automatically set
+* as delegator of the process.
+*
+* @param The new process owner
+* @param The process id
+*
+* @return True when the process is updated, False if the process was not found.
+*/
+setProcessOwner			:: !UserId !ProcessId					-> Task Bool
+/**
+* Changes the status of the indicated process.
+*
+* @param The new process status
+* @param The process id
+*
+* @return True when the process is updated, False if the process was not found.
+*/
+setProcessStatus		:: !ProcessStatus !ProcessId			-> Task Bool

Libraries/iTasks/TaskCombinators/ProcessCombinators.icl

@@ -12,10 +12,11 @@ from ProcessDB import mkDynamicProcessEntry
 import iDataForms
 import CommonCombinators
 
-derive gForm	ProcessReference, ProcessStatus
-derive gUpd		ProcessReference, ProcessStatus
-derive gPrint	ProcessReference, ProcessStatus
-derive gParse	ProcessReference, ProcessStatus
+derive gForm	ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+derive gUpd		ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+derive gPrint	ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+derive gParse	ProcessReference, Process, DynamicProcessEntry, StaticProcessEntry, ProcessStatus
+
 
 :: ProcessReference a 	= ProcessReference !Int		//We only keep the id in the process database
 
@@ -109,10 +110,42 @@ where
 		# (pid, tst)	= getCurrentProcess tst
 		= accHStTSt (ProcessDB@deleteProcess pid) tst
 
-setProcessOwner :: UserId (ProcessReference a) ->	Task Bool | iData a 
-setProcessOwner uid (ProcessReference pid) = compound "setProcessOwner" (Task setProcessOwner`)
+updateProcessOwner :: UserId (ProcessReference a) ->	Task Bool | iData a 
+updateProcessOwner uid (ProcessReference pid) = compound "updateProcessOwner" (Task setProcessOwner`)
 where
 	setProcessOwner` tst
 		# (curUid,tst)	= getCurrentUser tst
 		= accHStTSt (ProcessDB@setProcessOwner uid curUid pid) tst
 
+
+//New "meta" process tasks
+getCurrentProcessId :: Task ProcessId
+getCurrentProcessId = mkBasicTask "getCurrentProcessId" getCurrentProcessId`
+where
+	getCurrentProcessId` tst=:{staticInfo}
+		= (staticInfo.currentProcessId,tst)
+
+getProcess :: !ProcessId -> Task (Maybe Process)
+getProcess pid = mkBasicTask "getProcess" (\tst ->	accHStTSt (ProcessDB@getProcess pid) tst)
+
+getProcessForUser :: !UserId !ProcessId -> Task (Maybe Process)
+getProcessForUser uid pid = mkBasicTask "getProcessForUser" (\tst -> accHStTSt (ProcessDB@getProcessForUser uid pid) tst)
+
+getProcesses :: ![ProcessStatus] -> Task [Process]
+getProcesses statuses = mkBasicTask "getProcesses" (\tst -> accHStTSt (ProcessDB@getProcesses statuses) tst)
+
+getProcessesById :: ![ProcessId] -> Task [Process]
+getProcessesById ids = mkBasicTask "getProcessesById" (\tst -> accHStTSt (ProcessDB@getProcessesById ids) tst)
+
+getProcessesForUser	:: !UserId ![ProcessStatus] -> Task [Process]
+getProcessesForUser uid statuses = mkBasicTask "getProcessesForUser" (\tst -> accHStTSt (ProcessDB@getProcessesForUser uid statuses) tst)
+
+setProcessOwner :: !UserId !ProcessId -> Task Bool
+setProcessOwner uid pid = mkBasicTask "setProcessOwner" setProcessOwner`
+where
+	setProcessOwner` tst
+		# (cur,tst)	= getCurrentUser tst //Current user is the new delegator of the process
+		= accHStTSt (ProcessDB@setProcessOwner uid cur pid) tst
+
+setProcessStatus :: !ProcessStatus !ProcessId -> Task Bool
+setProcessStatus status pid = mkBasicTask "setProcessStatus" (\tst -> accHStTSt (ProcessDB@setProcessStatus status pid) tst)

Libraries/iTasks/iTasks.dcl

@@ -30,6 +30,7 @@ import	Engine						// basic iTask system creator
 	,	StdList
 	,	StdOrdList
 	,	StdTuple
+	,	StdEnum
 	,	StdOverloaded
 
 from StdFunc import id, const