implementation module CoreTasks

import StdList, StdBool, StdInt, StdTuple,StdMisc, Util, HtmlUtil, Time, Error, OSError, Map, Tuple, List
import iTaskClass, Task, TaskContext, TaskEval, ProcessDB, TuningCombinators, TUIDefinition
from SharedCombinators		import :: Shared
from Shared					import qualified readShared, writeShared, isSharedChanged, updateShared
from Shared					import :: SharedGetTimestamp, :: SharedWrite, :: SharedRead, :: SharedId, :: ReadWriteShared(..)
from StdFunc				import o, id
from IWorld					import :: IWorld(..), :: Control(..)
from iTasks					import dynamicJSONEncode, dynamicJSONDecode
from ExceptionCombinators	import :: SharedException(..), instance toString SharedException, :: OSException(..), instance toString OSException, :: WorkOnException(..), instance toString WorkOnException
from SystemData				import topLevelTasks
from Map					import qualified get

derive class iTask WorkOnProcessState

PARTS_STORE				:== "parts"
LOCAL_STORE				:== "local"
LAST_EDIT_STORE			:== "lastEdit"
EVENT_STORE				:== "event"
EDIT_CONFLICT_STORE		:== "editConflict"
EDIT_CONFLICT_WARNING	:== "An edit conflict occurred. The form was refreshed with the most recent value."

derive JSONEncode StoredPart, UpdateMask
derive JSONDecode StoredPart, UpdateMask
JSONEncode{|StoredPutback|} _ _ p			= dynamicJSONEncode p
JSONDecode{|StoredPutback|} _ _ [json:r]	= (dynamicJSONDecode json,r)
JSONDecode{|StoredPutback|} _ _ _			= (Nothing,[])
derive bimap Maybe,(,)

return :: !a -> (Task a) | iTask a
return a  = mkInstantTask ("return", "Return a value") (\_ iworld -> (TaskFinished a,iworld))

sharedStore :: !SharedStoreId !a -> Shared a | JSONEncode{|*|}, JSONDecode{|*|}, TC a
sharedStore storeId defaultV = ReadWriteShared
	["sharedStore_" +++ storeId]
	(get loadValue defaultV)
	write
	(get getStoreTimestamp (Timestamp 0))
where	
	get f defaultV iworld
		# (mbV,iworld) = f storeId iworld
		# res = case mbV of
			Nothing	= Ok defaultV
			Just v	= Ok v
		= (res,iworld)
		
	write v iworld = (Ok Void,storeValue storeId v iworld)

get :: !(ReadWriteShared a w) -> Task a | iTask a
get shared = mkInstantTask ("Read shared", "Reads a shared value") eval
where
	eval taskNr iworld
		# (val,iworld) = 'Shared'.readShared shared iworld
		# res = case val of
			Ok val	= TaskFinished val
			Error e	= taskException (SharedException e)
		= (res, iworld)

set :: !(ReadWriteShared r a) !a -> Task a | iTask a
set shared val = mkInstantTask ("Write shared", "Writes a shared value") eval
where
	eval taskNr iworld
		# (res,iworld)	='Shared'.writeShared shared val iworld
		# res = case res of
			Ok _	= TaskFinished val
			Error e	= taskException (SharedException e)
		= (res, iworld)

update :: !(r -> w) !(ReadWriteShared r w) -> Task w | iTask r & iTask w
update f shared = mkInstantTask ("Update shared", "Updates a shared value") eval
where
	eval taskNr iworld
		# (val,iworld)	= 'Shared'.updateShared shared f iworld
		| isError val	= (taskException (SharedException (fromError val)), iworld)
		= (TaskFinished (fromOk val), iworld)

interact :: !d !(l r Bool -> [InteractionPart l w]) l !(ReadWriteShared r w) -> Task (l,r) | descr d & iTask l & iTask r & iTask w
interact description partFunc initLocal shared = mkActionTask description (\termFunc -> {initFun = init, editFun = edit, evalFun = eval termFunc})
where
	init taskNr iworld
		= (TCBasic newMap, iworld)
	
	//There is an edit event for this task (because the location part of the event is the empty list)
	edit taskNr (TaskEvent [] (dps,editV)) context iworld=:{IWorld|timestamp,latestEvent}
		//Split datapath into datapath & part index
		# (idx,dp)					= splitDataPath dps
		//Read latest versions of states
		# (model,iworld) 			= 'Shared'.readShared shared iworld
		| isError model				= (context, iworld)
		# local						= getLocalState context
		# parts						= getParts context
		| idx >= length parts		= (context, iworld) 
		//Save event for use in the visualization of the task
		# context					= setEvent (dps,editV) context
		//Check if the share has changed since the last event
		# (changed,iworld) = case latestEvent of
			Nothing			= (Ok False,iworld)
			Just lastEvent	= 'Shared'.isSharedChanged shared lastEvent iworld
		= case changed of
			Ok True
				//Edit conflict
				= (setLocalVar EDIT_CONFLICT_STORE True context, iworld) 
			_
				# context = delLocalVar EDIT_CONFLICT_STORE context 
				= case parts !! idx of
					StoredUpdateView jsonV umask (StoredPutback putback)
						# mbValue				= fromJSON jsonV
						| isNothing mbValue		= (context,iworld)
						# value					= fromJust mbValue
						// update value & masks
						# (value,umask,iworld)	= updateValueAndMask dp editV value umask iworld
						# vmask					= verifyForm value umask
						# parts					= updateAt idx (StoredUpdateView (toJSON value) umask (StoredPutback putback)) parts
						# context				= setLocalVar PARTS_STORE parts context
						// calculate new local & model value
						# (local,mbModel)		= putback (if (isValidValue vmask) (Just value) Nothing)
						# context				= setLocalState initLocal local context
						# context				= setLocalVar LAST_EDIT_STORE timestamp context
						= case mbModel of
							Just model
								# (_,iworld) 	= 'Shared'.writeShared shared model iworld
								= (context,iworld)
							Nothing	
								= (context, iworld)
					StoredUpdate (local,mbModel)			
						# context				= setLocalState initLocal local context
						= case mbModel of
							Just model	= (context, snd ('Shared'.writeShared shared model iworld))
							Nothing		= (context, iworld)
					_
						= (context,iworld)
				
	edit _ _ context iworld = (context,iworld)
	
	eval termFunc taskNr props event tuiTaskNr ilayout playout context iworld=:{IWorld|timestamp}
		# (model,iworld) 				= 'Shared'.readShared shared iworld
		| isError model					= (sharedException model, iworld)
		# (localTimestamp,iworld)		= getLocalTimestamp context iworld
		# (changed,iworld)				= 'Shared'.isSharedChanged shared localTimestamp iworld
		| isError changed				= (sharedException changed, iworld)
		# local							= getLocalState context
		# parts							= partFunc local (fromOk model) (fromOk changed)
		# storedParts					= getParts context
		# (mbEvent,context)				= getEvent context
		# (tuis,newParts,valid)			= visualizeParts taskNr parts storedParts mbEvent
		# context 						= setLocalVar PARTS_STORE newParts context
		= case termFunc {modelValue = (local,fromOk model), localValid = valid} of
			StopInteraction result		= (TaskFinished result,iworld)
			UserActions actions
				= case getActionResult event actions of
					Just result			= (TaskFinished result, iworld)
					Nothing
						# warning = case (getLocalVar EDIT_CONFLICT_STORE context) of
							Just True	= Just EDIT_CONFLICT_WARNING
							_			= Nothing
						# taskId		= taskNrToString taskNr
						# tactions		= [(taskId,action,isJust val) \\ (action,val) <- actions]
						# (tui,actions)	= mergeTUI props ilayout tuis warning tactions 
						= (TaskBusy (Just tui) actions context, iworld)
						
	getLocalTimestamp context iworld=:{IWorld|timestamp}
		= case getLocalVar LAST_EDIT_STORE context of
			Just ts	= (ts,iworld)
			Nothing	= (Timestamp 0,iworld)
	
	getLocalState context
		= fromMaybe initLocal (getLocalVar LOCAL_STORE context)

	setLocalState :: l !l !TaskContextTree -> TaskContextTree | JSONEncode{|*|} l
	setLocalState _ state context
		= setLocalVar LOCAL_STORE state context
	
	splitDataPath dp
		= (hd dplist, dataPathFromList (reverse (tl dplist)))
	where
		dplist = reverse (dataPathList (s2dp dp))
	
	getParts context 
		= case getLocalVar PARTS_STORE context of
			Just parts	= parts
			Nothing		= []

	setEvent event context
		= setLocalVar EVENT_STORE event context
		
	getEvent context
		= case getLocalVar EVENT_STORE context of
			Just (dp,val)	= (Just (s2dp dp, val), delLocalVar EVENT_STORE context)
			Nothing			= (Nothing, context)
			
:: StoredPart l w	= StoredUpdateView	!JSONNode !UpdateMask !(StoredPutback l w)
					| StoredDisplayView
					| StoredUpdate		!(!l,!Maybe w)
:: StoredPutback l w = E.v: StoredPutback !((Maybe v) -> (!l,!Maybe w)) & iTask v

visualizeParts :: !TaskNr ![InteractionPart l w] ![StoredPart l w] !(Maybe (!DataPath,!JSONNode)) -> (![TUIDef],![StoredPart l w],!Bool)
visualizeParts taskNr parts oldParts mbEdit
	# res =  [(tui,newPart,valid) \\ (Just tui,newPart,valid) <- [visualizePart (part,mbV,idx) \\ part <- parts & mbV <- (map Just oldParts ++ repeat Nothing) & idx <- [0..]]]
	= appThd3 and (unzip3 res)
where
	visualizePart (part,mbV,idx)
		= case part of
			FormPart formView putback = case formView of
				FormValue value
					# umask				= defaultMask value
					# vmask				= verifyForm value umask
					# tui				= visualizeAsEditor value (taskNrToString taskNr) idx vmask mbEdit
					= (tui,StoredUpdateView (toJSON value) umask (StoredPutback putback), isValidValue vmask)
				Unchanged init = case mbV of
					Just (StoredUpdateView jsonV umask _) = case fromJSON` formView jsonV of
						Just value
										# vmask = verifyForm value umask
										= (visualizeAsEditor value (taskNrToString taskNr) idx vmask mbEdit,StoredUpdateView jsonV umask (StoredPutback putback), isValidValue vmask)
						Nothing			= visualizePart (FormPart init putback,Nothing,idx)
					_					= visualizePart (FormPart init putback,Nothing,idx)
				Blank					= blankForm formView putback mbEdit
			
			DisplayPart v				= (visualizeAsDisplay v, StoredDisplayView, True)
				
			
			UpdatePart label w			=	(Just (defaultDef (TUIButton	{ TUIButton
																	| name			= toString idx
																	, taskId		= taskNrToString taskNr
																	, text			= label
																	, disabled		= False
																	, iconCls		= ""
																	, actionButton	= False
																	})),StoredUpdate w, True)
	where
		fromJSON` :: !(FormView v) !JSONNode -> (Maybe v) | JSONDecode{|*|} v
		fromJSON` _ json = fromJSON json

		blankForm formView putback mbEdit
			# value	= defaultValue` formView
			# umask	= Untouched
			# vmask	= verifyForm value umask
			= (visualizeAsEditor value (taskNrToString taskNr) idx vmask mbEdit,StoredUpdateView (toJSON value) umask (StoredPutback putback), isValidValue vmask)
		
		defaultValue` :: !(FormView v) -> v | gUpdate{|*|} v
		defaultValue` _ = defaultValue

mergeTUI props imerge tuis warning actions
	= imerge { title = props.TaskMeta.title
			 , instruction = props.TaskMeta.instruction
			 , editorParts = tuis
			 , actions = actions
			 , type = props.interactionType
			 , isControlTask = props.controlTask
			 , localInteraction = props.TaskMeta.localInteraction
			 , warning = warning
			 }
	
sharedException :: !(MaybeErrorString a) -> (TaskResult b)
sharedException err = taskException (SharedException (fromError err))

workOn :: !ProcessId -> Task WorkOnProcessState
workOn (SessionProcess sessionId)
	= abort "workOn applied to session process"
workOn (WorkflowProcess processId)
	= workOn (EmbeddedProcess processId "")
workOn (EmbeddedProcess processId target)
	= mkActionTask ("Work on","Work on another top-level instance.") (\termFunc -> {initFun = init, editFun = edit, evalFun = eval termFunc})
where
	init taskNr iworld = (TCEmpty, iworld)
	
	edit taskNr event _ iworld
		//Load instance
		# (mbContext,iworld)	= loadInstance (WorkflowProcess processId) iworld
		| isError mbContext		= (TCEmpty, iworld)
		//Apply event to instance
		# (mbContext,iworld)	= editInstance (Just event) (fromOk mbContext) iworld
		//Store instance
		| isError mbContext		= (TCEmpty, iworld)
		# iworld				= storeInstance (fromOk mbContext) iworld
		= (TCEmpty, iworld)
		
	eval termFunc taskNr props event tuiTaskNr ilayout playout _ iworld=:{evalStack}
		//Check for cycles
		| isMember (WorkflowProcess processId) evalStack
			=(taskException WorkOnDependencyCycle, iworld)
		//Load instance
		# (mbContext,iworld)		= loadInstance (WorkflowProcess processId) iworld
		| isError mbContext	
			//If the instance can not be found, check if it was only just added by an
			//appendTask in the same session. If so, create a temporary result and trigger
			//reevaluation.
			# (found,iworld)	= checkIfAddedGlobally processId iworld
			| found
				= (TaskBusy (Just (stringDisplay "Task finished")) [] TCEmpty, {iworld & readShares = Nothing})
			| otherwise
				= (taskException WorkOnNotFound ,iworld)
		//Eval instance
		# targetTaskNo = case target of
			""	= [processId,changeNo (fromOk mbContext)]
			_	= reverse (taskNrFromString target)
		# (mbResult,context,iworld)	= evalInstance targetTaskNo event (fromOk mbContext) iworld
		= case mbResult of
			Error e				= (taskException WorkOnEvalError, iworld)
			Ok result
				//Store context
				# iworld		= storeInstance context iworld
				# (state,tui,sactions,iworld) = case result of
					(TaskBusy tui actions _)		= (WOActive, tui, actions, iworld)
					(TaskFinished _)				= (WOFinished, Just (stringDisplay "Task finished"), [], iworld)
					(TaskException _ err)			= (WOExcepted, Just (stringDisplay ("Task excepted: " +++ err)), [], iworld)
				//Check trigger
				= case termFunc {localValid = True, modelValue = state} of
					StopInteraction result
						= (TaskFinished result,iworld)
					UserActions uactions	
						= case getActionResult event uactions of
							Just result
								= (TaskFinished result, iworld)
							Nothing
								# taskId			= taskNrToString taskNr
								# tactions			= [(taskId,action,isJust val) \\ (action,val) <- uactions]
								= (TaskBusy tui (sactions ++ tactions) TCEmpty,iworld)

	changeNo (TaskContext _ _ n _) = n
		 
getActionResult (Just (TaskEvent [] name)) actions
	= listToMaybe (catMaybes [result \\ (action,result) <- actions | actionName action == name])
getActionResult _ actions
	= Nothing

checkIfAddedGlobally processId iworld=:{parallelControls}
	= case 'Map'.get (toString topLevelTasks) parallelControls of
		Just (_,controls)
			= (isMember processId [i \\ AppendTask i _ <- controls], iworld)
		_
			= (False,iworld)


applyChangeToProcess :: !ProcessId !ChangeDyn !ChangeLifeTime  -> Task Void
applyChangeToProcess pid change lifetime
	= mkInstantTask ("Apply a change to a process", ("Apply a " +++ lt +++ " change to task " +++ toString pid)) eval
where
	eval taskNr iworld = (TaskException (dynamic "TODO") "TODO", iworld)

//id (\tst -> (TaskFinished Void, applyChangeToTaskTree pid (lifetime,change) tst))
//Interesting one, we need the tst somehow :)
	lt = case lifetime of
		CLTransient = "transient"
		CLPersistent _	= "persistent"
	
appWorld :: !(*World -> *World) -> Task Void
appWorld fun = mkInstantTask ("Run world function", "Run a world function.") eval
where
	eval taskNr iworld=:{IWorld|world}
		= (TaskFinished Void, {IWorld|iworld & world = fun world})
		
accWorld :: !(*World -> *(!a,!*World)) -> Task a | iTask a
accWorld fun = mkInstantTask ("Run world function", "Run a world function and get result.") eval
where
	eval taskNr iworld=:{IWorld|world}
		# (res,world) = fun world
		= (TaskFinished res, {IWorld|iworld & world = world})
	
accWorldError :: !(*World -> (!MaybeError e a, !*World)) !(e -> err) -> Task a | iTask a & TC, toString err
accWorldError fun errf = mkInstantTask ("Run a world function", "Run a world function with error handling.") eval
where
	eval taskNr iworld=:{IWorld|world}
		# (res,world)	= fun world
		= case res of
			Error e		= (taskException (errf e),{IWorld|iworld & world = world})
			Ok v		= (TaskFinished v,{IWorld|iworld & world = world})
	
accWorldOSError :: !(*World -> (!MaybeOSError a, !*World)) -> Task a | iTask a
accWorldOSError fun = accWorldError fun OSException