implementation module iTasks.UI.Editor

import StdEnv
import Data.Maybe, Data.Functor, Data.Tuple, Data.Func, Data.Error
import iTasks.Engine
import iTasks.Internal.IWorld
import iTasks.Internal.Serialization
import iTasks.UI.Definition, iTasks.WF.Definition
import qualified Data.Map as DM
import Text, Text.GenJSON
import Data.GenEq
import ABC.Interpreter.JavaScript

derive JSONEncode EditState, LeafState, EditorId
derive JSONDecode EditState, LeafState, EditorId
derive binumap Editor

instance Functor EditorReport
where
	fmap :: (a -> b) !(EditorReport a) -> EditorReport b
	fmap _ (EmptyEditor) = EmptyEditor
	fmap f (ValidEditor x) = ValidEditor (f x)
	fmap _ (InvalidEditor r) = InvalidEditor r

instance pure EditorReport where
	pure a = ValidEditor a

instance <*> EditorReport where
	(<*>) (ValidEditor f) (ValidEditor a) = ValidEditor (f a)
	(<*>) (InvalidEditor e1) (InvalidEditor e2) = InvalidEditor (e1 ++ e2)
	(<*>) (InvalidEditor e) _ = InvalidEditor e
	(<*>) _ (InvalidEditor e) = InvalidEditor e
	(<*>) _ EmptyEditor = EmptyEditor
	(<*>) EmptyEditor _ = EmptyEditor

instance Monad EditorReport where
	bind (ValidEditor a) a2mb = a2mb a
	bind (InvalidEditor e) a2mb = InvalidEditor e
	bind EmptyEditor a2mb = EmptyEditor

derive gPrint EditorReport

liftedNonValidEditorReport :: !(EditorReport a) -> EditorReport b
liftedNonValidEditorReport EmptyEditor       = EmptyEditor
liftedNonValidEditorReport (InvalidEditor e) = InvalidEditor e
liftedNonValidEditorReport _ = abort "iTasks.UI.Editor.liftedNonValidEditorReport: argument is ValidEditor"

editorReportToMaybe :: !(EditorReport a) -> ?a
editorReportToMaybe (ValidEditor x) = ?Just x
editorReportToMaybe _ = ?None

editorReportToMaybeError :: !(EditorReport a) -> MaybeError [String] a
editorReportToMaybeError (ValidEditor a) = Ok a
editorReportToMaybeError EmptyEditor = Error []
editorReportToMaybeError (InvalidEditor e) = Error e

maybeErrorToEditorReport :: !(MaybeError [String] a) -> EditorReport a
maybeErrorToEditorReport (Ok a) = ValidEditor a
maybeErrorToEditorReport (Error e) = InvalidEditor e

editorReportList :: ![EditorReport a] -> EditorReport [a]
editorReportList items
	// If all editors are EmptyEditor -> EmptyEditor
	| length empty == length items = EmptyEditor
	// If there are no invalid and no empty editors -> ValidEditor
	| empty =: [] && invalid =: [] = ValidEditor [x \\ ValidEditor x <- items]
	// Report empty and invalid  items
	| otherwise = InvalidEditor (empty ++ invalid)
where
	empty = [concat3 "List item " (toString n) " is empty" \\ EmptyEditor <- items & n <- [1..]]
	invalid = [concat4 "List item " (toString n) ": " (join ", " rs) \\ InvalidEditor rs <- items & n <- [1..]]

editorReportTuple2 :: !(!EditorReport a, !EditorReport b) -> EditorReport (!a,!b)
editorReportTuple2 (EmptyEditor, EmptyEditor) = EmptyEditor
editorReportTuple2 (ValidEditor a, ValidEditor b) = ValidEditor (a,b)
editorReportTuple2 (ea, eb) = InvalidEditor (editorError "First" ea ++ editorError "Second" eb)

editorReportTuple3 :: !(!EditorReport a, !EditorReport b, !EditorReport c) -> EditorReport (!a,!b,!c)
editorReportTuple3 (EmptyEditor, EmptyEditor, EmptyEditor) = EmptyEditor
editorReportTuple3 (ValidEditor a, ValidEditor b, ValidEditor c) = ValidEditor (a,b,c)
editorReportTuple3 (ea, eb, ec) = InvalidEditor (editorError "First" ea ++ editorError "Second" eb ++ editorError "Third" ec)

editorReportTuple4 ::
	!(!EditorReport a, !EditorReport b, !EditorReport c, !EditorReport d) -> EditorReport (!a,!b,!c,!d)
editorReportTuple4 (EmptyEditor, EmptyEditor, EmptyEditor, EmptyEditor) = EmptyEditor
editorReportTuple4 (ValidEditor a, ValidEditor b, ValidEditor c, ValidEditor d) = ValidEditor (a,b,c,d)
editorReportTuple4 (ea, eb, ec, ed) = InvalidEditor (editorError "First" ea ++ editorError "Second" eb ++ editorError "Third" ec ++ editorError "Fourth" ed)

editorReportTuple5 ::
	!(!EditorReport a, !EditorReport b, !EditorReport c, !EditorReport d, !EditorReport e)
	-> EditorReport (!a,!b,!c,!d,!e)
editorReportTuple5 (EmptyEditor, EmptyEditor, EmptyEditor, EmptyEditor, EmptyEditor) = EmptyEditor
editorReportTuple5 (ValidEditor a, ValidEditor b, ValidEditor c, ValidEditor d, ValidEditor e) = ValidEditor (a,b,c,d,e)
editorReportTuple5 (ea, eb, ec, ed, ee) = InvalidEditor (editorError "First" ea ++ editorError "Second" eb ++ editorError "Third" ec ++ editorError "Fourth" ed ++ editorError "Fifth" ee)

editorError m EmptyEditor = [m +++ " element is empty"]
editorError m (InvalidEditor rs) = [concat3 m " element: " (join ", " rs)]
editorError _ (ValidEditor _) = []

leafEditorToEditor :: !(LeafEditor edit st r w) -> Editor r w | TC st & JSONDecode{|*|} edit
leafEditorToEditor leafEditor = leafEditorToEditor_
	(\st -> ?Just (dynamic st))
	(\dyn -> case dyn of
		?Just (st :: st^) -> ?Just st
		_                 -> ?None)
	leafEditor

leafEditorToEditor_ ::
	!(st -> ?Dynamic) !((?Dynamic) -> (? st)) !(LeafEditor edit st r w)
	-> Editor r w | JSONDecode{|*|} edit
leafEditorToEditor_  encode decode leafEditor =
	{Editor| onReset = onReset, onEdit = onEdit, onRefresh = onRefresh, writeValue = writeValue}
where
	onReset attr val vst=:{VSt|taskId}
		# (editorId,vst) = nextEditorId vst
		# attr = 'DM'.union attr $ 'DM'.fromList
			[ ("editorId", JSONString (toString editorId))
			, ("taskId", JSONString (toString taskId))
			]
		= appFst (mapRes editorId) $ leafEditor.LeafEditor.onReset attr val vst
	where
		mapRes editorId (Ok (ui,st,mbw)) = Ok (ui, LeafState {editorId= ?Just editorId, touched=False, state=encode st}, mbw)
		mapRes _        e                = liftError e

	onEdit (eventId, jsone) (LeafState st=:{editorId= ?Just editorId,state}) vst
		| eventId <> editorId
			= (Ok ?None, vst)
			= case decode state of
				?Just state = case fromJSON jsone of
					?Just e = case leafEditor.LeafEditor.onEdit e state vst of
						(Ok (ui,state,mbw),vst) = (Ok (?Just (ui, LeafState {st & touched = True, state = encode state}, mbw)),vst)
						(Error e,vst) = (Error e,vst)
					_ = (Error "Illegal JSON for LeafEditor edit event",vst)
				_ = (Error "Corrupt internal state in leaf editor", vst)
	onEdit _ _ vst = (Error "Corrupt editor state in leaf editor", vst)

	onRefresh mbval (LeafState leafSt) vst = case decode leafSt.state of
		?Just st = case leafEditor.LeafEditor.onRefresh mbval st vst of
			(Ok (ui,st,mbw),vst) = (Ok (ui, LeafState {leafSt & touched = leafSt.touched, state = encode st}, mbw),vst)
			(Error e,vst) = (Error e,vst)
		_       = (Error "Corrupt internal state in leaf editor", vst)
	onRefresh _ _ vst = (Error "Corrupt editor state in leaf editor", vst)

	writeValue (LeafState {state}) = case decode state of
		?Just st = leafEditor.LeafEditor.writeValue st
		?None = Error "Corrupt internal state in leaf editor"
	writeValue _ = Error "Corrupt internal state in leaf editor"

compoundEditorToEditor :: !(CompoundEditor st r w) -> Editor r w | TC st
compoundEditorToEditor compoundEditor =
	{Editor| onReset = onReset, onEdit = onEdit, onRefresh = onRefresh, writeValue = writeValue}
where
	onReset attr val vst = mapRes $ compoundEditor.CompoundEditor.onReset attr val vst

	onEdit e (CompoundState (?Just (st :: st^)) childSts) vst =
		case compoundEditor.CompoundEditor.onEdit e st childSts vst of
			(Ok ?None,vst) = (Ok ?None,vst)
			(Ok (?Just (ui, st, childSts, ?Just w)),vst) = (Ok (?Just (ui, CompoundState (?Just (dynamic st)) childSts, ?Just w)), vst)
			(Ok (?Just (ui, st, childSts, ?None)),vst)   = (Ok (?Just (ui, CompoundState (?Just (dynamic st)) childSts, ?None)), vst)
			(Error e,vst) = (Error e, vst)
	onEdit _ (CompoundState _ _) vst = (Error "Corrupt internal state in compound editor", vst)
	onEdit _ _ vst = (Error "Corrupt editor state in compound editor", vst)

	onRefresh mbval (CompoundState (?Just (st :: st^)) childSts) vst =
		case compoundEditor.CompoundEditor.onRefresh mbval st childSts vst of
			(Ok (ui, st, childSts,?Just w),vst) = (Ok (ui, CompoundState (?Just (dynamic st)) childSts, ?Just w), vst)
			(Ok (ui, st, childSts,?None),vst)   = (Ok (ui, CompoundState (?Just (dynamic st)) childSts, ?None), vst)
			(Error e,vst) = (Error e, vst)
	onRefresh _ (CompoundState _ _) vst = (Error "Corrupt internal state in compound editor", vst)
	onRefresh _ _ vst = (Error "Corrupt editor state in compound editor", vst)

	writeValue (CompoundState (?Just (st :: st^)) childSts) = compoundEditor.CompoundEditor.writeValue st childSts
	writeValue (CompoundState _ _) = Error "Corrupt internal state in compound editor"
	writeValue _ = Error "Corrupt editor state in compound editor"

	mapRes (Ok (ui, st, childSts, mbw), vst) = (Ok (ui, CompoundState (?Just (dynamic st)) childSts, mapMaybe id mbw), vst)
	mapRes (Error e, vst) = (Error e, vst)

editorModifierWithStateToEditor :: !(EditorModifierWithState st r w) -> Editor r w | TC st
editorModifierWithStateToEditor modifier =
	{Editor| onReset = onReset, onEdit = onEdit, onRefresh = onRefresh, writeValue = writeValue}
where
	onReset attr val vst =
		case modifier.EditorModifierWithState.onReset attr val vst of
			(Ok (ui, st, childSt, mbw), vst) = (Ok (ui, AnnotatedState (?Just (dynamic st :: st^)) childSt, mbw), vst)
			(Error e, vst) = (Error e, vst)

	onEdit e (AnnotatedState (?Just (st :: st^)) childSt) vst =
		case modifier.EditorModifierWithState.onEdit e st childSt vst of
			(Ok ?None,vst) = (Ok ?None,vst)
			(Ok (?Just (ui,st,childSt,mbw)),vst) = (Ok (?Just (ui, AnnotatedState (?Just (dynamic st)) childSt, mbw)),vst)
			(Error e,vst) = (Error e,vst)
	onEdit _ (AnnotatedState _ _) vst = (Error "Corrupt internal state in editor modifier", vst)
	onEdit _ _ vst = (Error "Corrupt editor state in editor modifier", vst)

	onRefresh mbval (AnnotatedState (?Just (st :: st^)) childSt) vst =
		case modifier.EditorModifierWithState.onRefresh mbval st childSt vst of
			(Ok (ui,st,childSt,mbw),vst) = (Ok (ui, AnnotatedState (?Just (dynamic st)) childSt, mbw),vst)
			(Error e,vst) = (Error e,vst)
	onRefresh _ (AnnotatedState _ _) vst = (Error "Corrupt internal state in editor modifier", vst)
	onRefresh _ _ vst = (Error "Corrupt editor state in editor modifier", vst)

	writeValue (AnnotatedState (?Just (st :: st^)) childSt) = modifier.EditorModifierWithState.writeValue st childSt
	writeValue (AnnotatedState _ _) = Error "Corrupt internal state in editor modifier"
	writeValue _ = Error "Corrupt editor state in editor modifier"

:: EditorId =: EditorId Int

instance zero EditorId where zero = EditorId 0

instance == EditorId
where
	(==) :: !EditorId !EditorId -> Bool
	(==) _ _ = code inline {
		eqI
	}

instance toString EditorId
where
	toString :: !EditorId -> {#Char}
	toString _ = code inline {
		.d 0 1 i
		jsr ItoAC
		.o 1 0
	}

instance fromString EditorId
where
	fromString s = EditorId (toInt s)

withVSt :: !TaskId !EditorId !.(*VSt -> (a, *VSt)) !*IWorld -> (!a, !EditorId, !*IWorld)
withVSt taskId editorId f iworld=:{IWorld| abcInterpreterEnv,options}
	# (x, vst=:{VSt|nextEditorId}) = f
		{ VSt
		| taskId            = toString taskId
		, nextEditorId      = editorId
		, optional          = False
		, selectedConsIndex = -1
		, pathInEditMode    = abort "VSt.dataPathInEditMode should be set by OBJECT instance of gEditor"
		, abcInterpreterEnv = abcInterpreterEnv
		, engineOptions     = options
		}
	= (x, nextEditorId, iworld)

nextEditorId :: !*VSt -> *(!EditorId,!*VSt)
nextEditorId vst=:{VSt|nextEditorId=id=:(EditorId i)} = (id,{VSt|vst & nextEditorId = EditorId (i + 1)})

isTouched :: !EditState -> Bool
isTouched (LeafState      {LeafState|touched}) = touched
isTouched (CompoundState  _ childSts)          = or (map isTouched childSts)
isTouched (AnnotatedState _ childSt)           = isTouched childSt

isCompound :: !EditState -> Bool
isCompound (LeafState _)              = False
isCompound (AnnotatedState _ childSt) = isCompound childSt
isCompound (CompoundState _ _)        = True

withClientSideInit :: !(FrontendEngineOptions JSVal *JSWorld -> *JSWorld) !(Editor r w) -> Editor r w
withClientSideInit initUI editor=:{Editor|onReset,onEdit,onRefresh} =
	{ Editor | editor
	& onReset   = withClientSideInitOnReset initUI onReset
	, onEdit    = withClientSideInitOnEdit initUI onEdit
	, onRefresh = \val st vst -> withClientSideInitOnReplaceUi initUI $ onRefresh val st vst
	}

withClientSideInitOnLeafEditor ::
	!(FrontendEngineOptions JSVal *JSWorld -> *JSWorld)
	!(LeafEditor edit st r w) -> LeafEditor edit st r w
withClientSideInitOnLeafEditor initUI editor=:{LeafEditor|onReset,onEdit,onRefresh} =
	{ LeafEditor | editor
	& onReset   = withClientSideInitOnReset initUI onReset
	, onEdit    = \ev st vst -> withClientSideInitOnReplaceUi initUI $ onEdit ev st vst
	, onRefresh = \val st vst -> withClientSideInitOnReplaceUi initUI $ onRefresh val st vst
	}

withClientSideInitOnReset ::
	!(FrontendEngineOptions JSVal *JSWorld -> *JSWorld)
	!(UIAttributes -> .(.a -> *(*VSt -> *(u:MaybeErrorString (!UI, !st, !?w), *VSt))))
	!UIAttributes !.a !*VSt
	-> *(!v:MaybeErrorString (!UI, !st, !?w), !*VSt)
	, [u <= v]
withClientSideInitOnReset initUI onReset attr val vst = case onReset attr val vst of
	(Ok (ui,mask, mbw),vst)
		# (ui, vst) = uiWithClientSideInit initUI ui vst
		= (Ok (ui,mask,mbw), vst)
	e = e

withClientSideInitOnEdit initUI onEdit event st vst = case onEdit event st vst of
	(Ok (?Just (ReplaceUI ui,st, mbw)),vst)
		# (ui, vst) = uiWithClientSideInit initUI ui vst
		= (Ok (?Just (ReplaceUI ui,st,mbw)), vst)
	e = e

withClientSideInitOnReplaceUi ::
	!(FrontendEngineOptions JSVal *JSWorld -> *JSWorld)
	!*(!u:MaybeErrorString v:(UIChange, st, w: ?w), !*VSt)
	-> *(!x:MaybeErrorString y:(UIChange, st, z: ?w), !*VSt)
	, [u <= v, v <= w, u <= x, x <= y, v <= y, y w <= z] // don't ask.
withClientSideInitOnReplaceUi initUI (Ok (ReplaceUI ui, st, val), vst)
	# (ui, vst) = uiWithClientSideInit initUI ui vst
	= (Ok (ReplaceUI ui, st, val), vst)
withClientSideInitOnReplaceUi _ res
	= res

uiWithClientSideInit :: !(FrontendEngineOptions JSVal *JSWorld -> *JSWorld) !UI !*VSt -> (!UI, !*VSt)
uiWithClientSideInit initUi (UI type attr items) vst=:{taskId, engineOptions}
	# frontendOptions =
		{ FrontendEngineOptions
		| serverDirectory = engineOptions.EngineOptions.serverDirectory
		}
	# (initUi, vst) = serializeForClient (wrapInitFunction (hyperstrict (initUi frontendOptions))) vst
	# extraAttr = 'DM'.fromList
		[("taskId",  JSONString taskId)
		,("initUI",  JSONString initUi)
		]
	= (UI type ('DM'.union extraAttr attr) items, vst)

withClientSideEventHandling :: (Editor r w) -> (Editor r w)
withClientSideEventHandling editor=:{Editor|onReset=editorOnReset}
	= {Editor|editor & onReset = onReset}
where
	onReset attr mode vst =:{VSt| taskId} = case editorOnReset attr mode vst of
		(Ok (UI type attr items, state, mbw),vst)
			# (initUI, vst) = serializeForClient (wrapInitFunction initUI) vst
			# extraAttr = 'DM'.fromList
				[("taskId",  JSONString taskId)
				,("editorState", toJSON state)
				,("initUI",  JSONString initUI)
				]
			= (Ok (UI type ('DM'.union extraAttr attr) items,state,mbw), vst)
		e = e

	initUI :: JSVal *JSWorld -> *JSWorld
	initUI me world
		# (jsDoEditEvent,world) = jsWrapFun (doEditEvent me) me world
		# world = (me .# "doEditEvent" .= jsDoEditEvent) world
		= world

	doEditEvent :: !JSVal {!JSVal} !*JSWorld -> *JSWorld
	doEditEvent me args world
		//Retrieve the encoded editor state from the attributes (very inefficient)
		# (jsonstate,world) = me .# "attributes.editorState" .? world
		# (editorstate,world) = appFst fromJSON $ jsValToJSONNode jsonstate world
		# taskId = maybe (TaskId 0 0) fromString (jsValToString args.[0])
		# eventId = EditorId (fromJS 0 args.[1])
		# (eventvalue,world) = jsValToJSONNode args.[2] world
		//TODO: When handling editors on the client, we need to generate editorId's on the client too.
		# (result,_,world) = withVSt taskId zero (editor.Editor.onEdit (eventId,eventvalue) (fromJust editorstate)) world
		= case result of
			(Ok ?None) = world
			(Ok (?Just (change,state,mbw)))
				//Sending the write value back to the server is a problem for a later time...
				# (jsonstate,world) = jsonNodeToJsVal (toJSON state) world
				# world = (me .# "attributes.editorState" .= jsonstate) world
				//Apply UI modification
				# world = (me .# "onUIChange" .$! (toJS $ encodeUIChange change)) world
				= world
			(Error msg) = jsTrace msg world

	//Print to string, then parse with Clean function: not efficient, but quick for proof of concept
	jsValToJSONNode :: !JSVal !*JSWorld -> *(!JSONNode,!*JSWorld)
	jsValToJSONNode val world
		# (json,world) = (jsGlobal "JSON" .# "stringify" .$ val) world
		= (maybe JSONNull fromString $ jsValToString json,world)

	//And the other way around...
	jsonNodeToJsVal :: !JSONNode !*JSWorld -> *(!JSVal,!*JSWorld)
	jsonNodeToJsVal val world = (jsGlobal "JSON" .# "parse" .$ (toString val)) world

	withVSt :: !TaskId !EditorId !.(*VSt -> (a, *VSt)) !*JSWorld -> (!a, !EditorId, !*JSWorld)
	withVSt taskId editorId f jsworld
		# (x, vst=:{VSt|nextEditorId}) = f { VSt
		           | taskId            = toString taskId
		           , nextEditorId      = editorId
		           , optional          = False
		           , selectedConsIndex = -1
		           , pathInEditMode    = abort "VSt.dataPathInEditMode should be set by OBJECT instance of gEditor"
	               , abcInterpreterEnv = abort "abcInterpreterEnv not available on client for now..."
				   , engineOptions     = abort "engineOptions not available on client"
	               }
		= (x, nextEditorId, jsworld)
