Commit 0c5dbef0 authored by Bas Lijnse's avatar Bas Lijnse

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
parent 5ed56c3f
definition module ProcessAdmin
import iTasks
processAdmin :: [Workflow]
\ No newline at end of file
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
......@@ -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
......@@ -90,7 +90,7 @@ where
reassign wid
= selectUser "Who is next?"
>>= \who -> setProcessOwner who wid
>>= \who -> updateProcessOwner who wid
>>| return False
waitForIt wid
......
definition module ChangeHandling
import iTasks
changeHandlingExample :: [Workflow]
\ No newline at end of file
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
......
......@@ -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
......
......@@ -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
......@@ -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
......
......@@ -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
}
......
......@@ -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
......
......@@ -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
......@@ -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)
......@@ -30,6 +30,7 @@ import Engine // basic iTask system creator
, StdList
, StdOrdList
, StdTuple
, StdEnum
, StdOverloaded
from StdFunc import id, const
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment