implementation module iTasks.UI.Editor.Common

import StdBool, StdEnum, StdOrdList, StdList, StdList, StdString, StdFunc
import Text.GenJSON, Data.GenEq
from Data.List import unzip3, instance Functor [], intersperse, findIndex, getItems, zipWith

import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Containers, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
import Data.Tuple, Data.Error, Text, Text.GenJSON, Data.Func, Data.Functor
import Data.Error.GenJSON
import qualified Data.Map as DM
import Data.Maybe

emptyEditor :: Editor a (EditorReport w)
emptyEditor = leafEditorToEditor {LeafEditor|onReset=onReset,onEdit=onEdit,onRefresh=onRefresh,writeValue=writeValue}
where
	onReset attr _ vst = (Ok (uia UIEmpty attr, (), ?None),vst)
	onEdit () _ vst = (Ok (NoChange, (), ?None),vst) // ignore edit events
	onRefresh _ _ vst = (Ok (NoChange, (), ?None),vst) // just use new value
	writeValue _ = Ok EmptyEditor

diffChildren :: ![a] ![a] !(a a -> ChildUpdate) !(a -> UI) -> [(Int, UIChildChange)]
diffChildren old new updateFromOldToNew toUI = diffChildren` (length old - 1) (reverse old) (reverse new)
where
    // only children from old list are left -> remove them all
    diffChildren` _ old [] = removeRemaining old
    // only new children are left -> insert them all
    diffChildren` _ [] new = addNew new
    diffChildren` idx [nextOld : old] [nextNew : new] = case updateFromOldToNew nextOld nextNew of
        ChildUpdateImpossible
            | isEmpty $ filter (\n -> not $ (updateFromOldToNew nextOld n) =: ChildUpdateImpossible) new
                // old item cannot be reused, as no remaining new item can be updated to it -> remove it
                 = [(idx, RemoveChild) : diffChildren` (dec idx) old [nextNew : new]]
            | otherwise
                # (change, idx, old`) = moveFromOldOrInsert (dec idx) old
                = change ++ diffChildren` idx [nextOld : old`] new
            where
                // no item found which can be updated to next new child -> insert it
                moveFromOldOrInsert _ [] = ([(inc idx, InsertChild $ toUI nextNew)], idx, [])
                moveFromOldOrInsert idxOld [nextOld : oldRest] = case updateFromOldToNew nextOld nextNew of
                    // look for child to reuse in remaining old children elements
                    ChildUpdateImpossible = appThd3 (\old` -> [nextOld : old`])
                                                    (moveFromOldOrInsert (dec idxOld) oldRest)
                    // move item without change
                    NoChildUpdateRequired = ([(idxOld, MoveChild idx)], dec idx, oldRest)
                    // old item which can be updated to next new child found -> reuse it,
                    // i.e. move it to new index & update
                    ChildUpdate change
                        | idxOld == idx = ([(idx, ChangeChild change)], dec idx, oldRest)
                        | otherwise     = ([(idxOld, MoveChild idx), (idx, ChangeChild change)], dec idx, oldRest)
        NoChildUpdateRequired = diffChildren` (dec idx) old new
        ChildUpdate change    = [(idx, ChangeChild change): diffChildren` (dec idx) old new]

    removeRemaining rem = [(0, RemoveChild) \\ _ <- rem]
    addNew          new = [(0, InsertChild (toUI x)) \\ x <- new]

chooseWithDropdown :: ![String] -> Editor Int (EditorReport Int)
chooseWithDropdown labels
	= mapEditorWrite selection
	$ mapEditorRead (\i -> [i])
	$ withConstantChoices options dropdown <<@ multipleAttr False
where
	selection [x] = ValidEditor x
	selection _   = EmptyEditor

	options = [{ChoiceText|id=i,text=t} \\ t <- labels & i <- [0..]]

choiceEditor ::
	!EditorPurpose !(v -> [a]) !([a] -> EditorReport v) !Bool ![a] -> Editor v (EditorReport v) | toString, == a
choiceEditor ViewValue r w multiple as =
	mapEditorRead readf $ mapEditorWrite (\_ -> EmptyEditor) $ gEditor{|*|} ViewValue
where
	readf = concat o intersperse ", " o map toString o r
choiceEditor EditValue r w multiple as = mapEditorRead readf $ mapEditorWrite writef editor
where
	editor = withConstantChoices cs (checkGroup <<@ multipleAttr multiple)
	writef = w o getItems as
	readf = getIndexes as o r
	cs = zipWith (\i a -> {ChoiceText | id = i, text = toString a}) [0 ..] as

	getIndexes :: ![a] ![a] -> [Int] | == a
	getIndexes as [] = []
	getIndexes as [b:bs] = case findIndex ((==) b) as of
		?None -> getIndexes as bs
		(?Just i) -> [i : getIndexes as bs]

listEditor ::
	!Bool !(?([w] -> ?r)) !Bool !Bool !(?([w] -> String)) !(r -> w) !(Editor r w)
	-> Editor [r] [w]
	| gEq{|*|} w
listEditor view add remove reorder count rtow itemEditor = listEditor_ gEq{|*|} view add remove reorder count rtow itemEditor

listEditor_ ::
	!(w w -> Bool) !Bool !(?([w] -> ?r)) !Bool !Bool !(?([w] -> String)) !(r -> w) !(Editor r w)
	-> Editor [r] [w]
listEditor_ eq view add remove reorder count rtow itemEditor = compoundEditorToEditor
	{CompoundEditor|onReset=onReset,onEdit=onEdit,onRefresh=onRefresh,writeValue=writeValue}
where
	onReset attr mbval vst=:{VSt|taskId}
		# (editorId,vst) = nextEditorId vst
		= case resetChildUIs 0 val [] vst of
		(Ok (items, childSts, childWs),vst)
			//Add list structure editing buttons
			# items = if (not view && (remove || reorder)) [listItemUI taskId editorId (length val) idx idx dx \\ dx <- items & idx <- [0..]] items
			//Add the add button
			# items = if (not view && isJust add) (items ++ [addItemControl editorId val]) items
			//All item UI's have a unique id that is used in the data-paths of that UI
			= (Ok (uiac UIList attr items, (editorId,indexList val), childSts, ?Just childWs), vst)
		(Error e,vst)  = (Error e,vst)
	where
		val = fromMaybe [] mbval

		resetChildUIs _ [] us vst = (Ok (unzip3 (reverse us)), vst)
		resetChildUIs i [c:cs] us vst = case itemEditor.Editor.onReset emptyAttr (?Just c) vst of
			(Ok (u,m,mbw),vst)
				= case maybe (itemEditor.Editor.writeValue m) Ok mbw of
					(Error e) = (Error e, vst)
					(Ok w) = resetChildUIs (i+1) cs [(u,m,w):us] vst
			(Error e,vst)  = (Error e,vst)

		addItemControl editorId val
			# val       = [rtow x \\ x <- val]
			# counter  	= maybe [] (\f -> [uia UITextView ('DM'.unions [widthAttr FlexSize, valueAttr (JSONString (f val))])]) count
			# button	= if (isJust add) [uia UIButton ('DM'.unions [iconClsAttr "icon-add",editAttrs taskId editorId (?Just (JSONString "add"))])] []
			= uiac UIToolBar (classAttr ["itask-listitem-controls"]) (counter ++ button)

	listItemUI taskId editorId numItems idx id item
		# buttons	= (if reorder
			[uia UIButton ('DM'.unions [iconClsAttr "icon-up", enabledAttr (idx <> 0), editAttrs taskId editorId (?Just (JSONString ("mup_" +++ toString id)))])
							  ,uia UIButton ('DM'.unions [iconClsAttr "icon-down", enabledAttr (idx <> numItems - 1), editAttrs taskId editorId (?Just (JSONString ("mdn_" +++ toString id)))])
							  ] []) ++
							  (if remove
							  [uia UIButton ('DM'.unions [iconClsAttr "icon-remove",editAttrs taskId editorId (?Just (JSONString ("rem_" +++ toString id)))])
							  ] [])
		# attr = 'DM'.unions [heightAttr WrapSize]
		= uiac UIListItem attr (if (reorder || remove) ([flexWidth item] ++ buttons) [flexWidth item])
	where
		flexWidth (UI type attr content) = UI type ('DM'.union (widthAttr FlexSize) attr) content

	//Structural edits on the list
	onEdit (eventId,JSONString e) (editorId,ids) childSts vst=:{VSt|taskId} | eventId == editorId
		# [op,id:_] = split "_" e
		# id = toInt id
		# index = itemIndex id ids
		# num = length childSts
		| op == "mup" && reorder
			// List move is out of bounds so nothing is changed.
			// May happen because of an event occurred before the previous event could be processed.
			| index < 1 || index >= num = (Ok ?None,vst)
				# changes =  if (index == 1) [(index,toggle 1 False),(index - 1,toggle 1 True)] [] //Update 'move-up' buttons
						  ++ if (index == num - 1) [(index,toggle 2 True),(index - 1,toggle 2 False)] [] //Update 'move-down' buttons
						  ++ [(index,MoveChild (index - 1))] //Actually move the item
				# internalSt = swap ids index
				# childSts = swap childSts index
				= (Ok (?Just (ChangeUI [] changes, (editorId,internalSt), childSts, ?Just (validChildValues childSts))), vst)
		| op == "mdn" && reorder
			// List move is out of bounds so nothing is changed.
			// May happen because of an event occurred before the previous event could be processed.
			| index < 0 || index > (num - 2) = (Ok ?None,vst)
				# changes =  if (index == 0) [(index,toggle 1 True),(index + 1,toggle 1 False)] [] //Update 'move-up' buttons
                          ++ if (index == num - 2) [(index,toggle 2 False),(index + 1,toggle 2 True)] [] //Update 'move-down' buttons
                          ++ [(index,MoveChild (index + 1))]
				# internalSt = swap ids (index + 1)
				# childSts = swap childSts (index + 1)
			    = (Ok (?Just (ChangeUI [] changes, (editorId,internalSt), childSts, ?Just (validChildValues childSts))), vst)
		| op == "rem" && remove
			// List remove is out of bounds so nothing is changed.
			// May happen because of an event occurred before the previous event could be processed.
			| index < 0 || index >= num = (Ok ?None, vst)
			# childSts   = removeAt index childSts
			# internalSt = removeAt index ids
			# nitems = [item \\ Ok item <- itemEditor.Editor.writeValue <$> childSts]
			# counter = maybe [] (\f -> [(length nitems, ChangeChild (ChangeUI [] [(0,ChangeChild (ChangeUI [SetAttribute "value" (JSONString (f nitems))] []))]))]) count
			# changes =  if (index == 0 && num > 1) [(index + 1, toggle 1 False)] []
						++ if (index == num - 1 && index > 0) [(index - 1, toggle 2 False)] []
						++ [(index,RemoveChild)] ++ counter
		= (Ok (?Just (ChangeUI [] changes, (editorId,internalSt), childSts, ?Just (validChildValues childSts))), vst)
		| op == "add" && isJust add
			# mbNx = (fromJust add) [i \\ Ok i <- itemEditor.Editor.writeValue <$> childSts]
			# ni = num
			# nid = nextId ids
            // use enter mode if no value for new item is given; otherwise use update mode
			= case itemEditor.Editor.onReset emptyAttr mbNx vst of
				(Error e,vst) = (Error e, vst)
				(Ok (ui,nm,_),vst)
					# nChildSts = childSts ++ [nm]
					# nitems = [item \\ Ok item <- itemEditor.Editor.writeValue <$> nChildSts]
					# nids = ids ++ [nid]
					# insert = [(ni,InsertChild (listItemUI taskId editorId (ni + 1) ni nid ui))]
					# counter = maybe [] (\f -> [(ni + 1, ChangeChild (ChangeUI [] [(0,ChangeChild (ChangeUI [SetAttribute "value" (JSONString (f nitems))] []))]))]) count
					# prevdown = if (ni > 0) [(ni - 1,toggle 2 True)] []
					# change = ChangeUI [] (insert ++ counter ++ prevdown)
					= (Ok (?Just (change,  (editorId,nids), nChildSts, ?Just (validChildValues nChildSts))), vst)
		= (Ok (?Just (NoChange, (editorId,ids), childSts, ?None)), vst)
	where
		swap []	  _		= []
		swap list index
			| index == 0 			= list //prevent move first element up
			| index >= length list 	= list //prevent move last element down
			| otherwise
				# f = list !! (index-1)
				# l = list !! (index)
				= updateAt (index-1) l (updateAt index f list)
		toggle idx value = ChangeChild (ChangeUI [] [(idx,ChangeChild (ChangeUI [SetAttribute "enabled" (JSONBool value)] []))])

		errorToMaybe (Ok x) = ?Just x
		errorToMaybe _ = ?None

	//Potential edit inside the list
	onEdit (eventId,e) (editorId,ids) childSts vst
		= case onEditChildren 0 childSts vst of
			(Error e,vst) = (Error e,vst)
			(Ok ?None,vst) = (Ok ?None, vst)
			(Ok (?Just (index, change, childSts, write)), vst)
				= (Ok (?Just (childChange index change, (editorId,ids)
					, childSts, if write (?Just (validChildValues childSts)) ?None)), vst)
	where
		onEditChildren i [] vst = (Ok ?None, vst)
		onEditChildren i [childSt:childSts] vst = case itemEditor.Editor.onEdit (eventId,e) childSt vst of
			(Error e,vst) = (Error e,vst)
			(Ok (?Just (change,childSt,mbw)),vst)
				= (Ok (?Just (i,change,[childSt:childSts],isJust mbw)),vst)
			(Ok ?None,vst) = case onEditChildren (i + 1) childSts vst of
				(Error e,vst) = (Error e,vst)
				(Ok ?None,vst) = (Ok ?None,vst)
				(Ok (?Just (index,change,childSts,write)),vst) = (Ok (?Just (index,change,[childSt:childSts],write)),vst)

		childChange i NoChange = NoChange
		childChange i change = ChangeUI [] [(i,ChangeChild (ChangeUI [] [(0,ChangeChild change)]))]

	//Very crude full replacement
	onRefresh (?Just new) (editorId,ids) childSts vst
		| gEq{|*->*|} eq (map rtow new) (fromMaybe [] (error2mb (writeValue ids childSts)))
			= (Ok (NoChange, (editorId,ids), childSts, ?None), vst)
		//TODO: Determine small UI change
		| otherwise
			= case onReset emptyAttr (?Just new) vst of
				(Ok (ui, (editorId,internalSt), childSts,_),vst) = (Ok (ReplaceUI ui, (editorId,internalSt), childSts, ?None), vst)
				(Error e,vst) = (Error e, vst)
	onRefresh ?None (editorId,ids) childSts vst = onRefresh (?Just []) (editorId,ids) childSts vst

	writeValue _ childSts = writeValues childSts [] //Only return a value if all child values are valid
	where
		writeValues [] acc = Ok $ reverse acc
		writeValues [st: sts] acc = case itemEditor.Editor.writeValue st of
			(Ok val) = writeValues sts [val: acc]
			(Error e) = Error e

	validChildValues childSts = [val \\ Ok val <- map itemEditor.Editor.writeValue childSts]

	nextId [] = 0
	nextId ids = maxList ids + 1

	itemIndex id ids = itemIndex` 0 id ids
	where
		itemIndex` _ _ [] = -1
		itemIndex` i id [x:xs] = if (id == x) i (itemIndex` (i + 1) id xs)

