implementation module Task

import StdClass, StdArray, StdTuple, StdInt, StdList, StdFunc, StdBool, StdMisc, HTML, SystemTypes, GenRecord, HTTP, Map, Util
import GenVisualize, iTaskClass
from TaskContext	import :: TaskContextTree(..), :: SubTaskContext, :: ParallelMeta
from ProcessDB		import :: Process
from iTasks			import JSONEncode, JSONDecode, dynamicJSONEncode, dynamicJSONDecode

mkTask :: !d !TaskInitFun !TaskEditFun !(TaskEvalFun a) -> Task a | descr d
mkTask description initFun editFun evalFun =
	{ Task
	| properties			= initTaskMeta description
	, type = NormalTask
		{ initFun		= initFun
		, editFun		= editFun
		, evalFun		= evalFun
		}
	, layout				= Nothing
	}
	
mkInstantTask :: !d (TaskNr *IWorld -> (!TaskResult a,!*IWorld)) -> Task a | descr d
mkInstantTask description iworldfun =
	{ Task
	| properties			= initTaskMeta description
	, type = NormalTask
		{ initFun		= \_ iworld -> (TCEmpty,iworld)
		, editFun		= \_ _  context iworld -> (context,iworld)
		, evalFun		= \taskNr _ _ _ _ _ _ iworld -> iworldfun taskNr iworld
		}
	, layout				= Nothing
	}
	
mkActionTask :: !d !(A.b: (TermFunc a b) -> TaskFuncs b | iTask b) -> Task a | descr d
mkActionTask description actionTaskFun =
	{ Task
	| properties	= initTaskMeta description
	, type			= ActionTask actionTaskFun
	, layout		= Nothing
	}

mapActionTask :: !((InformationState a) -> (InformationState b)) !(Task a) -> Task b
mapActionTask f task=:{Task|type} = case type of
	ActionTask actionF	= {Task | task & type = ActionTask (\termF -> actionF (termF o f))}
	_					= abort "mapActionTask: no action task"
	
mapActionTaskModelValue	:: !(a -> b) !(Task a) -> Task b
mapActionTaskModelValue f task = mapActionTask (\st=:{modelValue} -> {st & modelValue = f modelValue}) task
	
taskTitle :: !(Task a) -> String
taskTitle task = task.Task.properties.TaskMeta.title

taskMeta :: !(Task a) -> TaskMeta
taskMeta {Task|properties} = properties

taskProperties :: !(Task a) -> TaskMeta
taskProperties {Task|properties} = properties
	
instance iTaskId TaskNr
where
	iTaskId :: !TaskNr !String -> String
	iTaskId tasknr postfix = iTaskId (taskNrToString tasknr) postfix

instance iTaskId TaskId
where
	iTaskId :: !TaskId !String -> String
	iTaskId taskid postfix
		# postfix	=	{ c \\ c <-: postfix | not (isMember c ['\\\"/:*?<>|"']) }		// throw away characters not allowed in a file name
		| postfix == ""		= "iTask_" +++ taskid 
		| otherwise			= "iTask_" +++ taskid +++ "-" +++ postfix
		
taskNrToString :: !TaskNr -> String
taskNrToString [] 		= ""
taskNrToString [i] 		= toString i
taskNrToString [i:is] 	= taskNrToString is +++ "." +++ toString i 

taskNrFromString :: !String -> TaskNr
taskNrFromString "" 		= []
taskNrFromString string	= reverse (parseTaskNr` (fromString string))
where
	parseTaskNr` :: ![Char] -> TaskNr
	parseTaskNr` [] = []
	parseTaskNr` list 
	# (front,end)	= span (\c -> c <> '.') list
	=  [toInt (toString  front) : parseTaskNr` (stl end)]

	toString :: [Char] -> String
	toString list = {c \\ c <- list}

	stl :: [Char] -> [Char]
	stl [] = []
	stl xs = tl xs

stepEvent :: !Int !(Maybe (Event e)) -> Maybe (Event e)
stepEvent i (Just (TaskEvent [s:ss] e))
	| s == i	= Just (TaskEvent ss e)
				= Nothing
stepEvent i (Just (ProcessEvent s e))	= Just (ProcessEvent s e)
stepEvent _ _ 							= Nothing

stepTarget :: !Int !ReversedTaskNr -> ReversedTaskNr
stepTarget i []		= []
stepTarget i [t:ts]	
	| i == t			= ts
	| otherwise			= []

derive bimap Maybe, (,)

JSONEncode{|Task|} _ tt = dynamicJSONEncode tt			
JSONDecode{|Task|} _ [tt:c] = (dynamicJSONDecode tt,c)
JSONDecode{|Task|} _ c = (Nothing,c)

gUpdate{|Task|} fx UDCreate ust
	# (a,ust) = fx UDCreate ust
	= basicCreate (defaultTask a) ust
where
	defaultTask a =	{ Task
					| properties		= initTaskMeta "return"
					, type = NormalTask
						{ initFun	= abort funerror
						, editFun	= abort funerror
						, evalFun	= abort funerror
						}
					, layout = Nothing
					}
	funerror = "Creating default task functions is impossible"
	
gUpdate{|Task|} _ (UDSearch t) ust = basicSearch t (\Void t -> t) ust

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

gVerify{|Task|} _ _ vst = alwaysValid vst

gVisualizeText{|Task|} _ _ {Task|properties} = [properties.TaskMeta.title]
gVisualizeHtml{|Task|} _ _ {Task|properties} = [Text properties.TaskMeta.title]
gVisualizeEditor{|Task|} _ _ _ mbVal vst
	# vis = case mbVal of
		Just {Task|properties}	= [stringDisplay properties.TaskMeta.title]
		Nothing					= []
	= (vis,vst)
	
gEq{|Task|} _ _ _ = True // tasks are always equal

gGetRecordFields{|Task|} _ _ _ fields = fields
gPutRecordFields{|Task|} _ t _ fields = (t,fields)

taskFuncs :: !(Task a) -> TaskFuncs a | iTask a
taskFuncs {Task|type} = case type of
	NormalTask funcs	= funcs
	ActionTask actionF	= actionF (\{modelValue,localValid} -> UserActions [(ActionOk,if localValid (Just modelValue) Nothing)])

taskLayouters :: !(Task a) -> (InteractionLayouter, ParallelLayouter)
taskLayouters {Task|layout} = case layout of
	Nothing				= (defaultInteractionLayout	, defaultParallelLayout)
	Just (Left ilayout)	= (ilayout					, defaultParallelLayout)
	Just (Right playout)= (defaultInteractionLayout	, playout)
	

taskException :: !e -> TaskResult a | TC, toString e
taskException e = TaskException (dynamic e) (toString e)