implementation module WorkflowAdmin

import iTasks
import StdMisc, Tuple, Text, Shared
from StdFunc import seq
from WorkflowDB import qualified addWorkflow, class WorkflowDB(..), instance WorkflowDB IWorld
from Util import mb2list, timestampToGmDateTime

// SPECIALIZATIONS

derive gVisualizeText	Workflow, WorkflowDescription
derive gVisualizeHtml	Workflow, WorkflowDescription
derive gVisualizeEditor	Workflow, WorkflowDescription
derive gUpdate 			Workflow, WorkflowDescription
derive gDefaultMask		Workflow, WorkflowDescription
derive gVerify			Workflow, WorkflowDescription

derive JSONEncode		Workflow, WorkflowDescription
derive JSONDecode		Workflow, WorkflowDescription
derive gEq				Workflow, WorkflowDescription

gVisualizeText{|WorkflowTaskContainer|} _ _	= []
gVisualizeHtml{|WorkflowTaskContainer|} _ _	= []
gVisualizeEditor{|WorkflowTaskContainer|} _ vst = noVisualization vst
gUpdate{|WorkflowTaskContainer|} mode ust = basicUpdate mode (\Void x -> x) (WorkflowTask defTask) ust
where
	defTask :: Task Void
	defTask = abort "default task container"

gDefaultMask{|WorkflowTaskContainer|}_ = [Touched []]

gVerify{|WorkflowTaskContainer|} _ vst = alwaysValid vst

JSONEncode{|WorkflowTaskContainer|} c		= dynamicJSONEncode c
JSONDecode{|WorkflowTaskContainer|} [c:r]	= (dynamicJSONDecode c,r)
JSONDecode{|WorkflowTaskContainer|} r		= (Nothing,r)
gEq{|WorkflowTaskContainer|} _ _			= True

// Internal state type
:: ClientState =
	{ selectedProcess	:: !Maybe ProcessId
	, selectedWorkflow	:: !Maybe (!WorkflowId, !String)
	}
	
derive class iTask ClientState
derive bimap Maybe, (,)

// SHARES
// Available workflows

workflows :: ReadOnlyShared [WorkflowDescription]
workflows = makeReadOnlyShared "SystemData_workflows" 'WorkflowDB'.getWorkflowDescriptions 'WorkflowDB'.lastChange

allowedWorkflows :: ReadOnlyShared [WorkflowDescription]
allowedWorkflows = mapSharedRead filterAllowed (workflows |+| (currentUser |+| currentUserDetails))
where
	filterAllowed (workflows,(user,mbDetails)) = filter (isAllowedWorkflow user mbDetails) workflows
	
workflowTree :: ReadOnlyShared (Tree WorkflowDescription)
workflowTree = mapSharedRead mkFlowTree workflows

allowedWorkflowTree :: ReadOnlyShared (Tree WorkflowDescription)
allowedWorkflowTree = mapSharedRead mkFlowTree allowedWorkflows

mkFlowTree :: ![WorkflowDescription] -> Tree WorkflowDescription
mkFlowTree workflows = Tree (seq (map insertWorkflow workflows) [])
where
	insertWorkflow descr=:{WorkflowDescription|path} nodeList = insertWorkflow` (split "/" path) nodeList
	where
		insertWorkflow` [] nodeList = nodeList
		insertWorkflow` [title] nodeList = nodeList ++ [Leaf descr]
		insertWorkflow` path=:[nodeP:pathR] [node=:(Node nodeL nodes):nodesR]
			| nodeP == nodeL	= [Node nodeL (insertWorkflow` pathR nodes):nodesR]
			| otherwise			= [node:insertWorkflow` path nodesR]
		insertWorkflow` path [leaf=:(Leaf _):nodesR] = [leaf:insertWorkflow` path nodesR]
		insertWorkflow` [nodeP:pathR] [] = [Node nodeP (insertWorkflow` pathR [])]
		
workflowTask :: !WorkflowId -> ReadOnlyShared WorkflowTaskContainer
workflowTask wid = makeReadOnlySharedError ("SystemData_workflowTask_" +++ (toString wid)) getTask ((appFst Ok) o 'WorkflowDB'.lastChange)
where
	getTask iworld
		# (mbWorkflow,iworld) = 'WorkflowDB'.getWorkflow wid iworld
		= case mbWorkflow of
			Just {task}	= (Ok task, iworld)
			_			= (Error ("could not find workflow " +++ (toString wid)), iworld)


// MANAGEMENT TASKS

manageWorkflows :: [Workflow] ->  Task Void
manageWorkflows iflows = initWorkflows iflows >>| forever (doAuthenticated workflowDashboard)

initWorkflows ::[Workflow] -> Task Void
initWorkflows [] = return Void
initWorkflows iflows
	= get workflows
	>>= \flows -> case flows of
		[]	= allTasks [addWorkflow flow \\ flow <- iflows] >>| return Void
		_	= return Void

doAuthenticated :: (Task a) -> Task (Maybe a) | iTask a
doAuthenticated task
	//=	(appIdentity ||- enterInformation "Log in" []) <<@ tweak
	=	enterInformation "Log in" [] <<@ tweak
	>>= \credentials ->
		authenticateUser credentials.username (toString credentials.Credentials.password)
	>>= \mbUser -> case mbUser of
		Nothing
			= showInformation "Log in failed" [] Nothing
		Just user
			=	workAs user task
			>>= transform Just
where
	appIdentity :: Task Void
	appIdentity = (showSharedInformation "Application identity" [] applicationName Void >>+ noActions)
	
	tweak :: LayoutTweak
	tweak = \(def,actions) -> ({TUIDef|def & margins = topMargin 100, width = Just (WrapContent 0)},actions)
	
workflowDashboard :: Task Void
workflowDashboard = mainLayout @>> parallel "Workflow Dashboard" {selectedProcess = Nothing, selectedWorkflow = Nothing} (\_ _ -> Void)
	[ (BodyTask,	\list	-> infoBar 								<<@ infoBarLayout)
	, (BodyTask,	\list	-> chooseWorkflow (taskListState list)	<<@ treeLayout)
	, (BodyTask,	\list	-> showDescription (taskListState list)	)
	, (BodyTask,	\list	-> workTabPanel list					<<@ tabParallelLayout)
	, (BodyTask,	\list	-> processTable list					<<@ processTableLayout)
	, (HiddenTask,	\_		-> controlClient)
	]

infoBar :: Task ParallelControl
infoBar = showSharedInformation "Info" [ShowView (GetShared view)] currentUser Void >>+ (\_ -> UserActions [(Action "Log out",Just Stop)])
where
	view user = "Welcome " +++ toString user
	
chooseWorkflow :: !(Shared ClientState) -> Task ParallelControl
chooseWorkflow state = updateSharedInformation "Tasks" [UpdateView (GetLocalAndShared mkTree, Putback putback)] (state >+| allowedWorkflowTree) Nothing >>+ noActions
where
	mkTree sel (_,flows) = mkTreeChoice (fmap (\{path,description,workflowId} -> (last (split "/" path),(workflowId,description))) flows) sel
	putback tree _ (state,_) = (Just (Just selection), Just {state & selectedWorkflow = Just selection})
	where
		selection = getSelection tree

showDescription :: !(Shared ClientState) -> Task ParallelControl
showDescription state = forever (
		showSharedInformation "Task description" [ShowView (GetShared view)] state Void <<@ descriptionLayout
	>?*	[(Action "Start workflow", Sometimes \{modelValue=m=:({selectedWorkflow},_)} -> if (isJust selectedWorkflow) (Just (addWorkflow (fromJust selectedWorkflow))) Nothing)])
where			
	view {selectedWorkflow} = case selectedWorkflow of
		Nothing			= ""
		Just (_,descr)	= descr
		
	addWorkflow (wid,_) =
									get (workflowTask wid)
		>>=	\(WorkflowTask task) ->	get currentUser
		>>= \user ->				appendTask (DetachedTask {initManagerProperties & worker = user}, \_ -> task >>| return Continue) topLevelTasks

processTable :: !(TaskList ClientState) -> Task ParallelControl	
processTable taskList = updateSharedInformation "process table" [UpdateView (GetLocalAndShared mkTable, Putback putback)] (processes |+< state) Nothing >>+ noActions
where
	state = taskListState taskList
	// list of active processes for current user without current one (to avoid work on dependency cycles)
	processes = mapSharedRead (\(procs,ownPid) -> filter (\{processId} -> processId <> ownPid) procs) (processesForCurrentUser |+| currentProcessId)
	
	mkTable mbSel (procs,_) = Table ["Title", "Priority", "Date", "Deadline"] (map mkRow procs) mbSel
	mkRow {Process|properties=p=:{taskProperties,managerProperties,systemProperties},processId} =
		[ html taskProperties.TaskMeta.title
		, formatPriority managerProperties.ManagerProperties.priority
		, visualizeAsHtml AsDisplay (timestampToGmDateTime systemProperties.issuedAt)
		, visualizeAsHtml AsDisplay managerProperties.ManagerProperties.deadline
		, Text (toString processId)
		]
		
	putback (Table _ cells mbSel) _ (_,state) = (Just mbSel,Just {state & selectedProcess = fmap (getProcId cells) mbSel})
	getProcId cells idx = case cells !! idx !! 4 of
		Text procId	= fromString procId
		_ = abort "getProcId"

workTabPanel :: !(TaskList ClientState) -> Task ParallelControl
workTabPanel taskList = parallel "Work tab panel" [] (\_ _ -> Continue) [(HiddenTask, controlWorkTabs (taskListState taskList))]

controlWorkTabs :: !(Shared ClientState) !(TaskList [ProcessId]) -> Task ParallelControl
controlWorkTabs state taskList = forever (
					chooseActionDyn openTabTrigger (state >+< openProcs)
	>>= \proc ->	appendTask (BodyTask, \_ -> workTab proc openProcs  <<@ singleControlLayout) taskList
	>>|				update (\state -> {state & selectedProcess = Nothing}) state
	>>|				update (\procs -> [proc:procs]) openProcs)
where
	openProcs = taskListState taskList
	
	openTabTrigger ({selectedProcess},procs) = case selectedProcess of
		Just selectedProcess | not (isMember selectedProcess procs)
			= StopInteraction selectedProcess
		_
			= UserActions []

workTab :: !ProcessId !(Shared [ProcessId]) -> Task ParallelControl											
workTab procId openProcs =
		update (\procs -> [procId:procs]) openProcs
	>>|	(workOn procId >>+ \{modelValue} -> if (modelValue =!= WOActive) (StopInteraction Void) (UserActions [(ActionClose, Just Void)]))
	>>|	update (filter ((<>) procId)) openProcs
	>>|	return Continue

controlClient :: Task ParallelControl										
controlClient = chooseAction [(ActionQuit, Stop)]

addWorkflow :: !Workflow -> Task WorkflowDescription
addWorkflow workflow = mkInstantTask "Adds a workflow to the system" eval
where
	eval taskNr iworld = appFst TaskFinished ('WorkflowDB'.addWorkflow workflow iworld)

// LAYOUTS
mainLayout {TUIParallel | items=i=:[(_,Just infoBar, logoutAction), (_,Just tree,_), (_,Just description,_),(_,Just workTabPanel,_), (_,Just processTable,_), (_,_,controlActions):_]} =
	({ content	= content
	, width		= Just (FillParent 1 (FixedMinSize 0))
	, height	= Just (FillParent 1 (FixedMinSize 0))
	, margins	= Nothing
	},controlActions ++ logoutAction)
where
	content = TUIContainer {TUIContainer | defaultLayoutContainer [left,right] & direction = Horizontal}
	/*
	content = TUIBorderContainer {TUIBorderContainer | direction = Horizontal
								 , itemA = {TUIBorderItem| title = Nothing, iconCls = Nothing, item = left}
								 , itemB = {TUIBorderItem| title = Nothing, iconCls = Nothing, item = right} 
								 , initSplit = 260, collapsible = True}
	*/
	left =	{ content	= TUIPanel (defaultLayoutPanel [tree,description])
			, width		= Just (Fixed 260)
			//, width		= FillParent 1 (FixedMinSize 100)
			, height	= Just (FillParent 1 (FixedMinSize 0))
			, margins	= Nothing
			}
	right = { content	= TUIPanel (defaultLayoutPanel [infoBar,workArea])
			, width		= Just (FillParent 1 (FixedMinSize 0))
			, height	= Just (FillParent 1 (FixedMinSize 0))
			, margins	= Nothing
			}
	
	/*
	workArea = {content = TUIBorderContainer {TUIBorderContainer | direction = Vertical
								  , itemA = {TUIBorderItem | title = Nothing, iconCls = Nothing, item = fillParent processTable}
								  , itemB = {TUIBorderItem | title = Nothing, iconCls = Nothing, item = fillParent workTabPanel}
								  , initSplit = 200
								  , collapsible = True
								  }
				,width		= FillParent 1 (FixedMinSize 0)
				,height		= FillParent 1 (FixedMinSize 0)
				,margins	= Nothing
				}
	*/
	workArea =	{content	= TUIContainer (defaultLayoutContainer [processTable, fillParent workTabPanel])
				,width		= Just (FillParent 1 (FixedMinSize 0))
				,height		= Just (FillParent 1 (FixedMinSize 0))
				,margins	= Nothing
				}
				
mainLayout p = defaultParallelLayout p

infoBarLayout :: TUIInteraction -> (TUIDef,[TaskAction])
infoBarLayout {title,editorParts,actions=actions=:[(ltask,laction,_)]} = (
	{ content	= TUIContainer {TUIContainer|defaultLayoutContainer [{hd editorParts & width = Just (WrapContent 0), margins = Nothing},{logoutButton & margins = Nothing}]
								& direction = Horizontal, halign = AlignRight, valign = AlignMiddle, baseCls = Just "x-panel-header"}
	, width		= Just (FillParent 1 (ContentSize))
	, height	= Just (Fixed 30)
	, margins	= Nothing
	}, [])
where
	logoutButton =
		{content = TUIButton { TUIButton | name = actionName laction, taskId = ltask, disabled = False
							 , text = actionName laction, iconCls = "icon-log-out", actionButton = True }
		, width = Just (WrapContent 0), height = Just (WrapContent 0), margins = Nothing }

treeLayout {title,editorParts,actions} = (	{ content	= TUIPanel {TUIPanel | defaultLayoutPanel [{hd editorParts & width = Just (FillParent 1 ContentSize), height = Just (FillParent 1 ContentSize)}] & title = title, iconCls = Just "icon-newwork", frame = False}
											, width		= Just (FillParent 1 (FixedMinSize 100))
											, height	= Just (FillParent 1 (FixedMinSize 0))
											, margins	= Nothing
											}, actions)

descriptionLayout {title,editorParts,actions} = (	{ content	= TUIPanel {TUIPanel | defaultLayoutPanel (defaultContent editorParts (fst (defaultButtons actions))) & title = title, iconCls = Just "icon-description", frame = False}
													, width		= Just (FillParent 1 (FixedMinSize 100))
													, height	= Just (Fixed 150)
													, margins	= Nothing
													}, actions)

processTableLayout interaction
	= ({hd interaction.editorParts & width = Just (FillParent 1 ContentSize), height = Just (Fixed 150), margins = (sameMargins 0)},interaction.TUIInteraction.actions)	 
singleControlLayout interaction
	= ({hd interaction.editorParts & width = Just (FillParent 1 ContentSize), height = Just (FillParent 1 ContentSize)},interaction.TUIInteraction.actions)

// UTIL FUNCTIONS

workflow :: String String w -> Workflow | toWorkflow w
workflow path description task = toWorkflow path description [] task

restrictedWorkflow :: String String [Role] w -> Workflow | toWorkflow w
restrictedWorkflow path description roles task = toWorkflow path description roles task
	
instance toWorkflow (Task a) | iTask a
where
	toWorkflow path description roles task = toWorkflow path description roles (Workflow initManagerProperties task)
	
instance toWorkflow (WorkflowContainer a) | iTask a
where
	toWorkflow path description roles (Workflow managerP task) = mkWorkflow path description roles (WorkflowTask task) managerP

instance toWorkflow (a -> Task b) | iTask a & iTask b
where
	toWorkflow path description roles paramTask = toWorkflow path description roles (ParamWorkflow initManagerProperties paramTask)
	
instance toWorkflow (ParamWorkflowContainer a b) | iTask a & iTask b
where
	toWorkflow path description roles (ParamWorkflow managerP paramTask) = mkWorkflow path description roles (ParamWorkflowTask paramTask) managerP
	
mkWorkflow path description roles taskContainer managerProps =
	{ Workflow
	| path	= path
	, roles	= roles
	, task = taskContainer
	, description = description
	, managerProperties = managerProps
	}

isAllowedWorkflow :: !User !(Maybe UserDetails) !WorkflowDescription -> Bool
//Allow the root user
isAllowedWorkflow RootUser _ _									= True
//Allow workflows without required roles
isAllowedWorkflow _ _ {WorkflowDescription|roles=r=:[]}			= True
//Allow workflows for which the user has permission
isAllowedWorkflow _ (Just details) {WorkflowDescription|roles}	= or [isMember role (mb2list details.UserDetails.roles) \\ role <- roles]
//Don't allow workflows in other cases
isAllowedWorkflow _ _ _											= False