implementation module iTasks.WF.Combinators.SDS

import iTasks.WF.Derives
import iTasks.WF.Definition
import iTasks.SDS.Definition
from iTasks.SDS.Combinators.Core import sdsLens
from iTasks.SDS.Combinators.Common import sdsFocus, mapWrite

import iTasks.Engine
import iTasks.Internal.IWorld
import iTasks.Internal.Task
import iTasks.Internal.TaskState
import iTasks.Internal.TaskEval
import iTasks.Internal.Util
from iTasks.Internal.SDS import write, read, readRegister

from Data.Func import mapSt, $

import StdTuple, StdArray, StdList, StdString
import Text, Text.GenJSON
import Data.Error, Data.Functor, Data.Maybe
import System.Directory, System.File, System.FilePath, Data.Error, System.OSError
import qualified Data.Map as DM

withShared :: !b !((SimpleSDSLens b) -> Task a) -> Task a | iTask a & iTask b
withShared initial stask = withSharedWithCustomNotifyPred (\_ _ _ -> True) initial stask

withSharedNotifyingOnNonEqVals :: !b !((SimpleSDSLens b) -> Task a) -> Task a | iTask a & iTask b
withSharedNotifyingOnNonEqVals initial stask = withSharedWithCustomNotifyPred (\_ r w -> r =!= w) initial stask

withSharedWithCustomNotifyPred ::
	!(Timespec (?b) (?b) -> Bool) !b !((SimpleSDSLens b) -> Task a) -> Task a | iTask a & iTask b
withSharedWithCustomNotifyPred notifyFor initial stask = Task evalinit
where
	//Initialization
	evalinit event _ iworld
		| isDestroyOrInterrupt event = (DestroyedResult,iworld)

	evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
		# (taskIda, iworld) = getNextTaskId iworld
		# localSds =
			sdsLens
				(toString taskId)
				(\_ -> taskId)
				(SDSRead \_ r -> Ok $ fromJust r)
				(SDSWriteConst \_ w -> Ok $ ?Just w)
				(SDSNotify \_ r w -> \timespec _ -> notifyFor timespec r w)
				?None
				localShare
		# (e, iworld) = write (?Just initial) localSds EmptyContext iworld
		| isError e
			= (ExceptionResult (fromError e),iworld)
		= eval
			taskIda
			localSds
			(stask $ mapWrite (\w _ -> ?Just $ ?Just w) ?None localSds)
			event
			evalOpts
			iworld

	//Running
	eval :: !TaskId !(SDSLens () b (?b)) !(Task a) !Event !TaskEvalOpts !*IWorld -> (!TaskResult a, !*IWorld) | TC b
	eval innerTaskId localSds inner ServerInterruptedEvent opts iworld
		= apTask inner ServerInterruptedEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld
	eval innerTaskId localSds inner DestroyEvent opts iworld
		= case apTask inner DestroyEvent {TaskEvalOpts|opts&taskId=innerTaskId} iworld of
			(ValueResult _ _ _ _, iworld)
				= (ExceptionResult (exception "Failed to destroy withShared child"), iworld)
			(DestroyedResult, iworld)
				// free memory of share
				# (e, iworld) = write ?None localSds EmptyContext iworld
				= (if (isError e) (ExceptionResult (fromError e)) DestroyedResult ,iworld)
			e
				= e

	eval innerTaskId localSds inner event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld
		= case apTask inner event {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld of
			(ValueResult val info rep newinner, iworld)
				# info & TaskEvalInfo.lastEvent = max lastEval info.TaskEvalInfo.lastEvent
				= (ValueResult val info rep (Task (eval innerTaskId localSds newinner)), iworld)
			e = e

withTaskId :: (Task a) -> Task (a, TaskId)
withTaskId task = Task eval
where
	eval event evalOpts=:{TaskEvalOpts|taskId} iworld
		= case apTask task event evalOpts iworld of
			(ValueResult (Value x st) info rep newtask, iworld)
				= (ValueResult (Value (x, taskId) st) info rep (withTaskId newtask), iworld)
			(ExceptionResult te, iworld) = (ExceptionResult te, iworld)
			(DestroyedResult, iworld) = (DestroyedResult, iworld)

withTemporaryDirectory :: (FilePath -> Task a) -> Task a | iTask a
withTemporaryDirectory taskfun = Task evalinit
where
	//Initialization
	evalinit event _ iworld
		| isDestroyOrInterrupt event = (DestroyedResult, iworld)
	evalinit event eo=:{TaskEvalOpts|taskId} iworld=:{options={appVersion,tempDirPath}}
		# tmpDir                    = tempDirPath </> (appVersion +++ "-" +++ toString taskId +++ "-tmpdir")
		# (taskIda,iworld=:{world}) = getNextTaskId iworld
		# (ok ,world)               = ensureDirectoryExists tmpDir world
		# iworld & world            = world
		= case ok of
			Ok _    = eval tmpDir taskIda (taskfun tmpDir) event eo iworld
			Error e = (ExceptionResult (exception ("Could not create temporary directory: " +++ tmpDir +++ " (" +++ toString e +++ ")")) , iworld)
	//Actual task execution
	//First destroy the inner task, then delete the tmp dir
	eval tmpDir innerTaskId inner ServerInterruptedEvent evalOpts iworld
		= apTask inner ServerInterruptedEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
	eval tmpDir innerTaskId inner DestroyEvent evalOpts iworld
		# (resa,iworld)  = apTask inner DestroyEvent {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
		# (merr, world)  = recursiveDelete tmpDir iworld.world
		# iworld & world = world
		| isError merr = (ExceptionResult (exception (fromError merr)), iworld)
		= case resa of
			ValueResult _ _ _ _ = (ExceptionResult (exception "Failed to destroy inner task withTempdir"), iworld)
			e = (e, iworld)

	//During execution, set the cwd to the tmp dir
	eval tmpDir innerTaskId inner event evalOpts=:{TaskEvalOpts|lastEval} iworld
		# (oldcurdir, iworld)= liftIWorld getCurrentDirectory iworld
		| isError oldcurdir  = (ExceptionResult (exception (fromError oldcurdir)), iworld)
		# (Ok oldcurdir)     = oldcurdir
		# (mbErr, iworld)    = liftIWorld (setCurrentDirectory tmpDir) iworld
		| isError mbErr      = (ExceptionResult (exception (fromError mbErr)), iworld)
		# (resa, iworld)     = apTask inner event {TaskEvalOpts|evalOpts&taskId=innerTaskId} iworld
		# (mbErr,iworld)     = setCurrentDirectory oldcurdir iworld
		| isError mbErr      = (ExceptionResult (exception (fromError mbErr)), iworld)
		= case resa of
			ValueResult value info rep newinner
				# info = {TaskEvalInfo|info & lastEvent = max lastEval info.TaskEvalInfo.lastEvent}
				= (ValueResult value info rep (Task (eval tmpDir innerTaskId newinner)), iworld)
			ExceptionResult e = (ExceptionResult e, iworld)

instance toString (OSErrorCode,String) where toString x = snd x
