WorkflowAdmin.icl 16.7 KB
Newer Older
1
implementation module iTasks.Extensions.Admin.WorkflowAdmin
2 3

import iTasks
4
import StdMisc, Data.Tuple, Text, Data.Either, Data.Functor
5 6 7
import iTasks.Internal.SDS
import iTasks.Internal.Serialization
import iTasks.Internal.Store
8
from StdFunc import seq
9
import qualified Data.Map as DM
10
import Data.List, Data.Tuple
11
import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Common, iTasks.UI.Layout.Default, iTasks.UI.Layout.Common
12
import iTasks.Extensions.DateTime
13
// SPECIALIZATIONS
14
derive class iTask Workflow
15

16
gText{|WorkflowTaskContainer|} _ _			            = []
17
gEditor{|WorkflowTaskContainer|} 						= emptyEditor
18 19 20
JSONEncode{|WorkflowTaskContainer|} _ c				    = [dynamicJSONEncode c]
JSONDecode{|WorkflowTaskContainer|} _ [c:r]			    = (dynamicJSONDecode c,r)
JSONDecode{|WorkflowTaskContainer|} _ r				    = (Nothing,r)
Bas Lijnse's avatar
Bas Lijnse committed
21
gEq{|WorkflowTaskContainer|} _ _					    = True
22
gDefault{|WorkflowTaskContainer|}					    = WorkflowTask (return ())
23

24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

// Application specific types
:: WorklistRow =
    { taskNr	 :: Maybe String
    , title		 :: Maybe String
	, priority	 :: Maybe String
	, createdBy	 :: Maybe String
	, date		 :: Maybe String
	, deadline	 :: Maybe String
	, createdFor :: Maybe String
	, parentTask :: Maybe String
	}

derive class iTask WorklistRow

// list of active task instances for current user without current one (to avoid work on dependency cycles)
myWork :: ReadOnlyShared [(TaskId,WorklistRow)]
41 42 43
myWork = workList taskInstancesForCurrentUser

allWork :: ReadOnlyShared [(TaskId,WorklistRow)]
44
allWork = workList allTaskInstances
45 46

workList instances = mapRead projection (instances |+| currentTopTask)
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
where
	projection (instances,ownPid)
		= [(TaskId i.TaskInstance.instanceNo 0, mkRow i) \\ i <- instances | notSelf ownPid i && isActive i]

	notSelf ownPid {TaskInstance|instanceNo} = (TaskId instanceNo 0) <> ownPid
	notSelf ownPid _ = False
		
	isActive {TaskInstance|value} = value === None || value === Unstable

	mkRow {TaskInstance|instanceNo,attributes,listId} =
		{WorklistRow
		|taskNr		= Just (toString instanceNo)
		,title      = fmap toString ('DM'.get "title"          attributes)
		,priority   = fmap toString ('DM'.get "priority"       attributes)
		,createdBy	= fmap toString ('DM'.get "createdBy"      attributes)
		,date       = fmap toString ('DM'.get "createdAt"      attributes)
		,deadline   = fmap toString ('DM'.get "completeBefore" attributes)
		,createdFor = fmap toString ('DM'.get "createdFor"     attributes)
		,parentTask = if (listId == TaskId 0 0) Nothing (Just (toString listId))
		}

68

69 70 71
// SHARES
// Available workflows

72 73
workflows :: Shared [Workflow]
workflows = sharedStore "Workflows" []
74

75
workflowByPath :: !String -> Shared Workflow
76
workflowByPath path = mapReadWriteError (toPrj,fromPrj) workflows
77 78 79
where
	toPrj wfs = case [wf \\ wf <- wfs | wf.Workflow.path == path] of
		[wf:_]	= Ok wf
Bas Lijnse's avatar
Bas Lijnse committed
80
		_		= Error (exception ("Workflow " +++ path +++ " could not be found"))
81 82

	fromPrj nwf wfs
83
		= Ok (Just [if (wf.path == path) nwf wf \\ wf <- wfs])
84

85
allowedWorkflows :: ReadOnlyShared [Workflow]
86
allowedWorkflows = mapRead filterAllowed (workflows |+| currentUser)
87
where
88
	filterAllowed (workflows,user) = filter (isAllowedWorkflow user) workflows
89 90 91 92 93 94 95 96

//All tasks that you can do in a session
allowedTransientTasks :: ReadOnlyShared [Workflow] 
allowedTransientTasks = mapRead (\wfs -> [wf \\ wf=:{Workflow|transient} <- wfs | transient]) allowedWorkflows

allowedPersistentWorkflows :: ReadOnlyShared [Workflow]
allowedPersistentWorkflows = mapRead (\wfs -> [wf \\ wf=:{Workflow|transient} <- wfs | not transient]) allowedWorkflows

97
// MANAGEMENT TASKS
98
manageWorkflows :: ![Workflow] ->  Task ()
99 100
manageWorkflows iflows
	=	installInitialWorkflows iflows
101
	>>| forever (catchAll (doAuthenticated manageWorkInSession) viewError)
102
where
103
	viewError error = viewInformation "Error" [] error >>! \_ -> return ()
104

105
manageWorklist :: ![Workflow] -> Task ()
Bas Lijnse's avatar
Bas Lijnse committed
106 107
manageWorklist iflows
	=	installInitialWorkflows iflows
108
	>>| manageWorkInSession
Bas Lijnse's avatar
Bas Lijnse committed
109

110 111
installInitialWorkflows ::[Workflow] -> Task ()
installInitialWorkflows [] = return ()
112
installInitialWorkflows iflows
113
	=   try (get workflows) (\(StoreReadBuildVersionError _) -> return [])
114
	>>= \flows -> case flows of
115 116
		[]	= set iflows workflows @! ()
		_	= return ()
117
		
118
loginAndManageWorkList :: !String ![Workflow] -> Task ()
119
loginAndManageWorkList welcome workflows 
120 121 122 123 124 125 126 127 128 129 130 131 132
	= forever
		(((	viewTitle welcome
			||-
			(anyTask [
	 				enterInformation ("Authenticated access","Enter your credentials and login") [] @ Just
				>>* [OnAction (Action "Login")  (hasValue return)]
				,
					viewInformation ("Guest access","Alternatively, you can continue anonymously as guest user") [] ()
					>>| (return Nothing)
				] <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal)))
	 	   ) 
		>>- browse workflows) <<@ ApplyLayout (beforeStep layout) //Compact layout before login, full screen afterwards
		) 
133
where
134
	browse workflows (Just {Credentials|username,password})
135 136 137
		= authenticateUser username password
		>>= \mbUser -> case mbUser of
			Just user 	= workAs user (manageWorklist workflows)
138
			Nothing		= viewInformation (Title "Login failed") [] "Your username or password is incorrect" >>| return ()
139
	browse workflows Nothing
140
		= workAs (AuthenticatedUser "guest" ["manager"] (Just "Guest user")) (manageWorklist workflows)
141
		
142
	layout = sequenceLayouts (layoutSubUIs (SelectByType UIAction) (setActionIcon ('DM'.fromList [("Login","login")]))) frameCompact
143
		
144 145
manageWorkInSession:: Task ()
manageWorkInSession
146 147 148
	= 	((manageSession -||
		  (chooseWhatToDo >&> withSelection (viewInformation () [] "Welcome!") (\wf -> unwrapWorkflowTask wf.Workflow.task))
		)
149
	>>* [OnValue (ifStable (const (return ())))]) <<@ ApplyLayout layout
Bas Lijnse's avatar
Bas Lijnse committed
150
where
151
	layout = foldl1 sequenceLayouts
152 153 154
		[unwrapUI //Get rid of the step
		,arrangeWithSideBar 0 TopSide 50 True
		,layoutSubUIs (SelectByPath [0]) layoutManageSession
155
		,layoutSubUIs (SelectByPath [1]) (sequenceLayouts unwrapUI layoutWhatToDo)
156 157 158
		//Use maximal screen space
		,setUIAttributes (sizeAttr FlexSize FlexSize)
		]
159

160
	layoutManageSession = foldl1 sequenceLayouts 
161
		[layoutSubUIs SelectChildren actionToButton
162 163 164
		,layoutSubUIs (SelectByPath [0]) (setUIType UIContainer)
		,setUIType UIContainer
		,setUIAttributes ('DM'.unions [heightAttr WrapSize,directionAttr Horizontal,paddingAttr 2 2 2 10])
Bas Lijnse's avatar
Bas Lijnse committed
165
		]
Bas Lijnse's avatar
Bas Lijnse committed
166
	layoutWhatToDo = sequenceLayouts (arrangeWithSideBar 0 LeftSide 150 True) (layoutSubUIs (SelectByPath [1]) unwrapUI)
167

168 169 170 171 172
manageSession :: Task ()
manageSession =
		(viewSharedInformation () [ViewAs view] currentUser	
	>>* [OnAction (Action "Log out") (always (return ()))])
		 <<@ ApplyLayout (layoutSubUIs (SelectByType UIAction) (setActionIcon ('DM'.fromList [("Log out","logout")])))
173
where
Bas Lijnse's avatar
Bas Lijnse committed
174
	view user	= "Welcome " +++ toString user		
175

176 177 178 179 180
chooseWhatToDo = updateChoiceWithShared (Title "Menu") [ChooseFromList workflowTitle] (mapRead addManageWork allowedTransientTasks) manageWorkWf
where
	addManageWork wfs = [manageWorkWf:wfs]
	manageWorkWf = transientWorkflow "My work" "Manage your worklist"  manageWork
	
181
manageWork :: Task ()
182
manageWork = parallel [(Embedded, manageList)] [] <<@ ApplyLayout layoutManageWork @! ()
183
where
184 185
	
	manageList taskList
186 187
		= get currentUser @ userRoles
		>>- \roles -> 
188
			 forever
189 190
			(	enterChoiceWithSharedAs () [ChooseFromGrid snd] (worklist roles) (appSnd (\{WorklistRow|parentTask} -> isNothing parentTask))
				>>* (continuations roles taskList)
191 192
			)

193
	worklist roles = if (isMember "admin" roles) allWork myWork
194 195 196 197
	continuations roles taskList = if (isMember "manager" roles) [new,open,delete] [open]
	where
		new = OnAction (Action "New") (always (appendTask Embedded (removeWhenStable (addNewTask taskList)) taskList @! () ))
		open = OnAction (Action "Open") (hasValue (\(taskId,_) -> openTask taskList taskId @! ()))
198
		delete = OnAction (Action "Delete") (ifValue (\x -> snd x || isMember "admin" roles) (\(taskId,_) -> removeTask taskId topLevelTasks @! ()))
199 200 201 202

	userRoles (AuthenticatedUser _ roles _)  = roles
	userRoles _ = []

203 204 205 206
	layoutManageWork = foldl1 sequenceLayouts
		//Split the screen space
		[arrangeWithSideBar 0 TopSide 200 True
		//Layout all dynamically added tasks as tabs
207
		,layoutSubUIs (SelectByPath [1]) (arrangeWithTabs False)
208 209
		]

210 211
addNewTask :: !(SharedTaskList ()) -> Task ()
addNewTask list 
212
	=   ((chooseWorkflow >&> viewWorkflowDetails) <<@ ApplyLayout (setUIAttributes (directionAttr Horizontal))
213 214
	>>* [OnAction (Action "Start task") (hasValue (\wf -> startWorkflow list wf @! ()))
		,OnAction ActionCancel (always (return ()))
215
		] ) <<@ Title "New work"
216

217
chooseWorkflow :: Task Workflow
218
chooseWorkflow
219 220
	=  editSelectionWithShared [Att (Title "Tasks"), Att IconEdit] False (SelectInTree toTree fromTree) allowedWorkflows (const []) <<@ Title "Workflow Catalogue"
	@? tvHd 
221
where
222 223
	//We assign unique negative id's to each folder and unique positive id's to each workflow in the list
	toTree workflows = snd (seq (map add (zip ([0..],workflows))) (-1,[]))
224
	where
225
	    add (i,wf=:{Workflow|path}) (folderId,nodeList) = add` path (split "/" path) (folderId,nodeList)
226
        where
227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
    	    add` wfpath [] (folderId,nodeList) = (folderId,nodeList)
		    add` wfpath [title] (folderId,nodeList) = (folderId,nodeList ++ [{ChoiceNode|id=i,label=workflowTitle wf,icon=Nothing,children=[],expanded=False}])
		    add` wfpath path=:[nodeP:pathR] (folderId,[node=:{ChoiceNode|label=nodeL}:nodesR])
		    	| nodeP == nodeL
					# (folderId,children) = add` wfpath pathR (folderId,node.ChoiceNode.children)
					= (folderId,[{ChoiceNode|node & children = children,expanded=False}:nodesR])
		    	| otherwise
					# (folderId,rest) = add` wfpath path (folderId,nodesR)
					= (folderId,[node:rest])
		    add` wfpath path=:[nodeP:pathR] (folderId,[])
				# (folderId`,children) = add` wfpath pathR (folderId - 1,[])
                = (folderId`,[{ChoiceNode|id = folderId, label=nodeP, icon=Nothing, children=children,expanded=False}])
		    add` wfpath path (folderId,[node:nodesR]) 
				# (folderId,rest) = add` wfpath path (folderId,nodesR)
				= (folderId,[node:rest])
242 243 244 245 246 247 248

 	fromTree workflows [idx]
      | idx >= 0 && idx < length workflows = [workflows !! idx]
											 = []
	fromTree _ _                             = []
	result (Value [x] s) = Value x s
	result _ = NoValue
249 250 251

viewWorkflowDetails :: !(ReadOnlyShared (Maybe Workflow)) -> Task Workflow
viewWorkflowDetails sel
252
	= viewSharedInformation [Att (Title "Task description"), Att IconView] [ViewUsing view textView] sel
253 254
	@? onlyJust
where
255
	view = maybe "" (\wf -> wf.Workflow.description)
256
	
257 258 259
	onlyJust (Value (Just v) s) = Value v s
	onlyJust _					= NoValue

260
startWorkflow :: !(SharedTaskList ()) !Workflow -> Task Workflow
261
startWorkflow list wf
262 263
	= 	get currentUser -&&- get currentDateTime
	>>=	\(user,now) ->
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
264 265 266 267 268
		appendTopLevelTask ('DM'.fromList [ ("title",      workflowTitle wf)
                                          , ("catalogId",  wf.Workflow.path)
                                          , ("createdBy",  toString (toUserConstraint user))
                                          , ("createdAt",  toString now)
                                          , ("createdFor", toString (toUserConstraint user))
269
                                          , ("priority",   toString 5):userAttr user]) False (unwrapWorkflowTask wf.Workflow.task)
270 271 272
	>>= \procId ->
		openTask list procId
	@	const wf
273
where
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
274 275
    userAttr (AuthenticatedUser uid _ _) = [("user", uid)]
    userAttr _                           = []
276

277 278
unwrapWorkflowTask (WorkflowTask t) = t @! ()
unwrapWorkflowTask (ParamWorkflowTask tf) = (enterInformation "Enter parameters" [] >>= tf @! ())		
279

280
openTask :: !(SharedTaskList ()) !TaskId -> Task ()
281
openTask taskList taskId
282
	=	appendOnce taskId (workOnTask taskId) taskList @! ()
283

284
workOnTask :: !TaskId -> Task ()
285
workOnTask taskId
286
    =   (workOn taskId <<@ ApplyLayout (setUIAttributes (heightAttr FlexSize))
287
    >>* [OnValue    (ifValue ((===) ASExcepted) (\_ -> viewInformation (Title "Error") [] "An exception occurred in this task" >>| return ()))
288
        ,OnValue    (ifValue ((===) ASIncompatible) (\_ -> dealWithIncompatibleTask))
289 290 291
        ,OnValue    (ifValue ((===) ASDeleted) (\_ -> return ()))
        ,OnValue    (ifValue ((===) (ASAttached True)) (\_ -> return ())) //If the task is stable, there is no need to work on it anymore
        ,OnAction ActionClose   (always (return ()))
292
        ] ) <<@ ApplyLayout (copySubUIAttributes (SelectKeys ["title"]) [0] []) //Use the title from the workOn for the composition
293 294 295 296
where
    dealWithIncompatibleTask
        =   viewInformation (Title "Error") [] "This this task is incompatible with the current application version. Restart?"
        >>* [OnAction ActionYes (always restartTask)
297
            ,OnAction ActionNo (always (return ()))
298 299 300 301 302 303 304
            ]

    restartTask
        =   findReplacement taskId
        >>- \mbReplacement -> case mbReplacement of
            Nothing
                =   viewInformation (Title "Error") [] "Sorry, this task is no longer available in the workflow catalog"
305
                >>| return ()
306
            Just replacement
Bas Lijnse's avatar
Bas Lijnse committed
307
                =   replaceTask taskId (const (unwrapWorkflowTask replacement.Workflow.task)) topLevelTasks
308 309 310 311 312 313
                >>| workOnTask taskId

    //Look in the catalog for an entry that has the same path as
    //the 'catalogId' that is stored in the incompatible task instance's properties
    findReplacement taskId
        =  get (sdsFocus taskId (taskListEntryMeta topLevelTasks) |+| workflows)
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
314
        @  \(taskListEntry,catalog) -> maybe Nothing (lookup catalog) ('DM'.get "catalogId" taskListEntry.TaskListItem.attributes)
315
    where
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
316
        lookup [wf=:{Workflow|path}:wfs] cid = if (path == cid) (Just wf) (lookup wfs cid)
317
        lookup [] _ = Nothing
318

319
appendOnce :: TaskId (Task a) (SharedTaskList a) -> Task () | iTask a
320 321
appendOnce identity task slist
    =   get (taskListMeta slist)
322
    >>- \items -> if (checkItems name items)
323 324
        (return ())
	    (appendTask (NamedEmbedded name) (removeWhenStable task) slist @! ())
325 326
where
    name = toString identity
327 328
    checkItems name [] = False
    checkItems name [{TaskListItem|attributes}:is]
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
329
        | maybe False ((==) name) ('DM'.get "name" attributes)  = True //Item with name exists!
330
                                                                = checkItems name is
331

332
removeWhenStable :: (Task a) (SharedTaskList a) -> Task a | iTask a
333 334 335 336
removeWhenStable task slist
    =   task
    >>* [OnValue (ifStable (\_ -> get (taskListSelfId slist) >>- \selfId -> removeTask selfId slist))]
    @?  const NoValue
337

338 339
addWorkflows :: ![Workflow] -> Task [Workflow]
addWorkflows additional
340
	=	upd (\flows -> flows ++ additional) workflows
341

342 343
// UTIL FUNCTIONS
workflow :: String String w -> Workflow | toWorkflow w
344
workflow path description task = toWorkflow path description [] False task
345

346 347 348
transientWorkflow :: String String w -> Workflow | toWorkflow w
transientWorkflow path description task = toWorkflow path description [] True task

349
restrictedWorkflow :: String String [Role] w -> Workflow | toWorkflow w
350
restrictedWorkflow path description roles task = toWorkflow path description roles False task
Bas Lijnse's avatar
Bas Lijnse committed
351

352 353 354
restrictedTransientWorkflow :: String String [Role] w -> Workflow | toWorkflow w
restrictedTransientWorkflow path description roles task = toWorkflow path description roles True task

Bas Lijnse's avatar
Bas Lijnse committed
355 356 357
inputWorkflow :: String String String (a -> Task b) -> Workflow | iTask a & iTask b
inputWorkflow name desc inputdesc tfun
	= workflow name desc (enterInformation inputdesc [] >>= tfun)  
358 359 360
	
instance toWorkflow (Task a) | iTask a
where
361
	toWorkflow path description roles transient task = toWorkflow path description roles transient (Workflow defaultValue task)
362 363 364
	
instance toWorkflow (WorkflowContainer a) | iTask a
where
365
	toWorkflow path description roles transient (Workflow managerP task) = mkWorkflow path description roles transient (WorkflowTask task) managerP
366 367 368

instance toWorkflow (a -> Task b) | iTask a & iTask b
where
369
	toWorkflow path description roles transient paramTask = toWorkflow path description roles transient (ParamWorkflow defaultValue paramTask)
370 371 372
	
instance toWorkflow (ParamWorkflowContainer a b) | iTask a & iTask b
where
373
	toWorkflow path description roles transient (ParamWorkflow managerP paramTask) = mkWorkflow path description roles transient (ParamWorkflowTask paramTask) managerP
374
	
375
mkWorkflow path description roles transient taskContainer managerProps =
376 377 378
	{ Workflow
	| path	= path
	, roles	= roles
379
	, transient = transient
380 381 382 383 384
	, task = taskContainer
	, description = description
	, managerProperties = managerProps
	}

385 386 387
workflowTitle :: Workflow -> String
workflowTitle {Workflow|path} = last (split "/" path)

388 389 390 391 392
isAllowedWorkflow :: !User !Workflow -> Bool
isAllowedWorkflow _ {Workflow|roles=[]}		= True								//Allow workflows without required roles
isAllowedWorkflow (AuthenticatedUser _ hasRoles _) {Workflow|roles=needsRoles}	//Allow workflows for which the user has permission
	= or [isMember r hasRoles \\ r <- needsRoles]
isAllowedWorkflow _ _ 						= False								//Don't allow workflows in other cases