implementation module CoreTasks

import StdList, StdBool, StdInt, StdTuple,StdMisc, Util, HtmlUtil, Time, Error, OSError, Map, Tuple, List
import qualified StdList
import iTaskClass, Task, TaskContext, TaskEval, TaskStore, TUIDefinition, LayoutCombinators, Shared
from SharedDataSource		import qualified read, write, getVersion, readWrite, :: RWRes(..)
from StdFunc				import o, id
from IWorld					import :: IWorld(..)
from iTasks					import dynamicJSONEncode, dynamicJSONDecode
from SystemData				import topLevelTasks
from Map					import qualified get

derive class iTask WorkOnProcessState

derive JSONEncode UpdateMask
derive JSONDecode UpdateMask

return :: !a -> (Task a) | iTask a
return a  = mkInstantTask (\taskId iworld -> (TaskStable a NoRep (TCEmpty taskId), iworld))

throw :: !e -> Task a | iTask a & iTask, toString e
throw e = mkInstantTask (\taskId iworld -> (TaskException (dynamic e) (toString e), iworld))

get :: !(ReadWriteShared a w) -> Task a | iTask a
get shared = mkInstantTask eval
where
	eval taskId iworld
		# (val,iworld) = 'SharedDataSource'.read shared iworld
		# res = case val of
			Ok (val,_)	= TaskStable val NoRep (TCEmpty taskId)
			Error e		= taskException (SharedException e)
		= (res, iworld)

set :: !a !(ReadWriteShared r a)  -> Task a | iTask a
set val shared = mkInstantTask eval
where
	eval taskId iworld
		# (res,iworld)	='SharedDataSource'.write val shared iworld
		# res = case res of
			Ok _	= TaskStable val NoRep (TCEmpty taskId)
			Error e	= taskException (SharedException e)
		= (res, iworld)

update :: !(r -> w) !(ReadWriteShared r w) -> Task w | iTask r & iTask w
update fun shared = mkInstantTask eval
where
	eval taskId iworld
		# (val,iworld)	= 'SharedDataSource'.readWrite (\r _ -> let w = fun r in 'SharedDataSource'.Write w w) shared iworld
		| isError val	= (taskException (SharedException (fromError val)), iworld)
		= (TaskStable (fromOk val) NoRep (TCEmpty taskId), iworld)

watch :: !(ReadWriteShared r w) -> Task r | iTask r
watch shared = mkTask init eval
where
	init taskId iworld
		= (TCEmpty taskId, iworld)
	
	eval eEvent cEvent repAs (TCEmpty taskId) iworld
		# (val,iworld)	= 'SharedDataSource'.read shared iworld
		# res = case val of
			Ok (val,_)	= TaskUnstable (Just val) NoRep (TCEmpty taskId)
			Error e		= taskException (SharedException e)
		= (res,iworld)
		
interact :: !d !((Maybe l) r -> l) ![InteractionPart l r] !(Maybe l) !(ReadOnlyShared r) -> Task (l,r) | descr d & iTask l & iTask r
interact desc initFun parts initLocal shared = mkTask init eval
where
	init taskId iworld					//Create the initial views
		# (mbrvalue,iworld) 			= 'SharedDataSource'.read shared iworld
		| isError mbrvalue				= (TCEmpty taskId, iworld)
		# (rvalue,version)				= fromOk mbrvalue
		# lvalue						= initFun initLocal rvalue
		= (TCInteract taskId (toJSON lvalue) (initParts lvalue rvalue parts) version, iworld)

	initParts l r parts = map (initPart l r) parts
	
	initPart l r (DisplayPart f)	= (toJSON (f l r),Untouched, False)
	initPart l r (FormPart f _ _)
		# (_,encv,maskv)	= initFormView (f l r)
		= (encv,maskv,False)
	
	initFormView BlankForm		= (v, toJSON v, Untouched) where v = defaultValue
	initFormView (FilledForm v)	= (v, toJSON v, defaultMask v)
	
	eval eEvent cEvent repAs context=:(TCInteract taskId encl views lastShareVersion) iworld=:{IWorld|timestamp}
		# (mbrvalue,iworld) 				= 'SharedDataSource'.read shared iworld
		| isError mbrvalue					= (sharedException mbrvalue, iworld)
		# (rvalue,currentShareVersion)		= (fromOk mbrvalue)
		# changed							= currentShareVersion > lastShareVersion
		# lvalue							= fromJust (fromJSON encl)
		# mbEdit	= case eEvent of
			Just (TaskEvent t e)
				| t == taskId		= Just e
			Just (LuckyEvent e)		= Just e						
			_						= Nothing
		# (lvalue,reps,views,valid,iworld)	= evalParts 0 taskId repAs (fmap (appFst s2dp) mbEdit) changed lvalue rvalue parts views iworld
		# rep = case repAs of
			(RepAsTUI Nothing layout) 
				= TUIRep ((fromMaybe DEFAULT_LAYOUT layout) SingleTask [gui \\ (TUIRep gui) <- reps] [] (initAttributes desc))
			(RepAsTUI (Just target) layout)	//If there is a target set, we only produce a representation only if this task is the target
				| target == taskId
					= TUIRep ((fromMaybe DEFAULT_LAYOUT layout) SingleTask [gui \\ (TUIRep gui) <- reps] [] (initAttributes desc))
				| otherwise
					= NoRep
			_	
				# (parts,actions,attributes) = unzip3 [(part,actions,attributes) \\ (ServiceRep (part,actions,attributes)) <- reps]
				= ServiceRep (flatten parts,flatten actions, flatten attributes)
		
		# result	= if valid (Just (lvalue,rvalue)) Nothing 
		= (TaskUnstable result rep (TCInteract taskId (toJSON lvalue) views currentShareVersion), iworld)
	eval eEvent cEvent repAs (TCEmpty _) iworld
		= (taskException "Failed to initialize interact",iworld)
	eval eEvent cEvent repAs context iworld
		= (taskException "Corrupt context in interact",iworld)

	evalParts idx taskId repAs mbEvent changed l r [] [] iworld
		= (l,[],[],True,iworld)
	evalParts idx taskId repAs mbEvent changed l r [p:ps] [v:vs] iworld	
		# (nl,rep,view,pvalid,iworld)	= evalPart idx taskId repAs mbEvent changed l r p v iworld
		# (nnl,reps,views,valid,iworld)	= evalParts (idx + 1) taskId repAs mbEvent changed nl r ps vs iworld
		= (nnl,[rep:reps],[view:views],pvalid && valid,iworld) //All parts have to be valid
		
	evalPart idx taskId repAs mbEvent changed l r part view=:(encv,maskv,dirty) iworld = case part of
		DisplayPart f
			//Simply visualize the view
			# (rep,iworld) 	= displayRep idx taskId repAs f l r encv iworld
			= (l,rep,view,True,iworld)		
		FormPart initf sharef viewf
			//Update the local value and possibly the view if the share has changed
			# v							= fromJust (fromJSON encv)
			# vermask					= verifyForm v maskv
			//If the edit event is for this part, update the view
			# (l,v,encv,maskv,vermask,dirty,iworld)
				= if (matchEditEvent idx mbEvent) 
						(applyEditEvent idx mbEvent viewf l r v encv maskv vermask dirty iworld)
						(l,v,encv,maskv,vermask,dirty,iworld)
			//If the share has changed, update the view
			# (l,v,encv,maskv,vermask,dirty)
				= if changed (refreshForm sharef l r v encv maskv vermask dirty) (l,v,encv,maskv,vermask,dirty) 
			//Create an editor for the view
			# (rep,iworld)				= editorRep idx taskId repAs initf v encv maskv vermask mbEvent iworld
			= (l,rep,(encv,maskv,dirty),isValidValue vermask,iworld)
			
	displayRep idx taskId (RepAsTUI _ _) f l r encv iworld
		# (editor,iworld) = visualizeAsDisplay (f l r) iworld
		= (TUIRep (ViewPart,editor,[],[]),iworld)
	displayRep idx taskId _ f l r encv iworld
		= (ServiceRep ([(toString taskId,idx,encv)],[],[]),iworld)
	
	editorRep idx taskId (RepAsTUI _ _) f v encv maskv vermask mbEvent iworld
		# (editor,iworld) = visualizeAsEditor v taskId idx vermask mbEvent iworld
		= (TUIRep (ViewPart,editor,[],[]),iworld)
	editorRep idx taskId _ f v encv maskv vermask mbEvent iworld
		= (ServiceRep ([(toString taskId,idx,encv)],[],[]),iworld)
	
	matchEditEvent idx Nothing = False
	matchEditEvent idx (Just (dp,_))
		= case reverse (dataPathList dp) of
			[idx:_]	= True
			_		= False 		
			
	applyEditEvent idx (Just (dp,editv)) viewf l r v encv maskv vermask dirty iworld
		//Remove part index from datapath
		# dp 	= dataPathFromList ('StdList'.init (dataPathList dp))
		//Update full value
		| dataPathLevel dp == 0
			= case fromJSON editv of
				Just nv
					# maskv = defaultMask nv
					# vermask = verifyForm nv maskv
					= (l,nv,editv,maskv,vermask,True,iworld)	//QUESTION: Should we also do a react here?
				Nothing
					= (l,v,encv,maskv,vermask,dirty,iworld)
		//Update partial value
		# (v,maskv,iworld)	= updateValueAndMask dp editv v maskv iworld
		# encv				= toJSON v
		# vermask			= verifyForm v maskv
		= reactToEditEvent viewf l r v encv maskv vermask dirty iworld
	
	reactToEditEvent viewf l r v encv maskv vermask dirty iworld
		= case viewf l r (if (isValidValue vermask) (Just v) Nothing) of
			(l,Nothing)
				= (l,v,encv,maskv,vermask,dirty,iworld)
			(l,Just form)
				# (v,encv,maskv)	= initFormView form
				# vermask 			= verifyForm v maskv
				= (l,v,encv,maskv,vermask,False,iworld)
		
	refreshForm f l r v encv maskv vermask dirty
		= case f l r (if (isValidValue vermask) (Just v) Nothing) dirty of
			(l,Nothing)			= (l,v,encv,maskv,vermask,dirty)
			(l,Just form)
				# (v,encv,maskv)	= initFormView form
				# vermask			= verifyForm v maskv
				= (l,v,encv,maskv,vermask,False)
	
sharedException :: !(MaybeErrorString a) -> (TaskResult b)
sharedException err = taskException (SharedException (fromError err))

workOn :: !TaskId -> Task WorkOnProcessState
workOn target=:(TaskId topNo taskNo)
	= mkTask init eval
where
	init taskId iworld
		= (TCEmpty taskId, iworld)

	eval eEvent cEvent repAs (TCEmpty taskId) iworld=:{evalStack}
		//Check for cycles
		| isMember taskId evalStack
			=(taskException WorkOnDependencyCycle, iworld)
		//Load instance
		# (mbContext,iworld)		= loadTaskInstance (Right topNo) 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 topNo iworld
			| found
				= (TaskUnstable Nothing (TUIRep (SingleTask, Just (stringDisplay "Task finished"),[],[])) (TCEmpty taskId), {iworld & readShares = Nothing})
			| otherwise
				= (taskException WorkOnNotFound ,iworld)
		//Eval instance
		# target					= if (taskNo == 0) Nothing (Just (TaskId topNo taskNo))
		# genGUI					= case repAs of (RepAsTUI _ _) = True ; _ = False
		# (mbResult,context,iworld)	= evalInstance eEvent cEvent target genGUI (fromOk mbContext) iworld
		= case mbResult of
			Error e				= (taskException WorkOnEvalError, iworld)
			Ok result
				//Store context
				# iworld		= storeTaskInstance context iworld
				# (result,rep,iworld) = case result of
					(TaskUnstable _ rep _)			= (WOActive, rep, iworld)
					(TaskStable _ rep _)			= (WOFinished, rep, iworld)
					(TaskException _ err)			= (WOExcepted, TUIRep (SingleTask, Just (stringDisplay ("Task excepted: " +++ err)), [], []), iworld)
				= case result of
					WOFinished	= (TaskStable WOFinished rep (TCEmpty taskId), iworld)
					_			= (TaskUnstable (Just result) rep (TCEmpty taskId), iworld)

	//If a top instance has just been added, but has not been evaluated before it is still in the
	//queue of ParallelControls. If so, we don't throw an exception but return an unstable value
	//as we are still waiting for the instance to be evaluated
	checkIfAddedGlobally topNo iworld=:{parallelControls}
		= case 'Map'.get ("taskList:" +++ toString TopLevelTaskList) parallelControls of
			Just (_,controls)
				= (isMember topNo [i \\ AppendTask {ParallelItem|taskId=TaskId i 0} <- controls], iworld)
			_
				= (False,iworld)
	checkIfAddedGlobally _ iworld = (False,iworld)

appWorld :: !(*World -> *World) -> Task Void
appWorld fun = mkInstantTask eval
where
	eval taskId iworld=:{IWorld|world}
		= (TaskStable Void NoRep (TCEmpty taskId), {IWorld|iworld & world = fun world})
		
accWorld :: !(*World -> *(!a,!*World)) -> Task a | iTask a
accWorld fun = mkInstantTask eval
where
	eval taskId iworld=:{IWorld|world}
		# (res,world) = fun world
		= (TaskStable res NoRep (TCEmpty taskId), {IWorld|iworld & world = world})
	
accWorldError :: !(*World -> (!MaybeError e a, !*World)) !(e -> err) -> Task a | iTask a & TC, toString err
accWorldError fun errf = mkInstantTask eval
where
	eval taskId iworld=:{IWorld|world}
		# (res,world)	= fun world
		= case res of
			Error e		= (taskException (errf e), {IWorld|iworld & world = world})
			Ok v		= (TaskStable v NoRep (TCEmpty taskId), {IWorld|iworld & world = world})
	
accWorldOSError :: !(*World -> (!MaybeOSError a, !*World)) -> Task a | iTask a
accWorldOSError fun = accWorldError fun OSException