implementation module iTasks.UI.Editor.Generic

import StdEnv

import graph_copy

import iTasks.WF.Derives
import iTasks.UI.Definition
import iTasks.Internal.Serialization
import iTasks.UI.Editor
import iTasks.UI.Editor.Controls
import iTasks.UI.Editor.Modifiers
import iTasks.UI.Editor.Common

import qualified Data.Map as DM
import Text
import Text.GenJSON
import Text.Language
import System.Time
import Data.GenEq, Data.Func, Control.GenBimap, Data.Functor, Data.Tuple, Data.Integer, Data.Integer.GenJSON
import Data.Maybe
import qualified Control.Monad as CM

generic gEditor a | gText a, gEq a *! :: !EditorPurpose -> Editor a (EditorReport a)

gEditor{|UNIT|} purpose = mapEditorWrite (const $ ValidEditor UNIT) emptyEditor 

gEditor{|RECORD of {grd_arity}|} ex _ _ purpose
	= compoundEditorToEditor
		{CompoundEditor|onReset=onReset purpose,onEdit=onEdit,onRefresh=onRefresh purpose,writeValue=writeValue purpose}
where
	{Editor|onReset=exOnReset,onEdit=exOnEdit,onRefresh=exOnRefresh,writeValue=exWriteValue} = ex purpose

	onReset ViewValue attr val vst=:{taskId, optional} //Viewing a record
		= case val of
			?None
				= (Ok (UI UIContainer (addClassAttr "record" attr) [], optional, [], ?None), vst)
			?Just (RECORD x)
				= case exOnReset emptyAttr (?Just x) {VSt|vst & optional = False} of
					(Ok (ui, childSts, mbw),vst)
						# (ui, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity (ui,childSts)
						= (Ok (ui, optional, childSts, (fmap RECORD) <$> mbw),{VSt|vst & optional = optional})
					(Error e,vst) = (Error e,vst)
	onReset EditValue attr val vst=:{taskId, optional}
		| optional
			# (editorId,vst) = nextEditorId vst
			= case val of
				?None
					# (enableUI,enableSt) = genEnableUI taskId editorId False
					= (Ok (uiac UIContainer (addClassAttr "record" attr) [enableUI], True, [enableSt], ?None), vst)
				?Just (RECORD x)
					= case exOnReset emptyAttr (?Just x) {VSt|vst & optional = False} of
						(Ok (ui,childSts,mbw),vst)
							# (UI type attr items, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity (ui,childSts)
							# (enableUI, enableSt) = genEnableUI taskId editorId True
							= (Ok (UI type attr [enableUI:items], True, [enableSt: childSts], (fmap RECORD) <$> mbw), {VSt|vst & optional = optional})
						(Error e,vst) = (Error e,vst)
		| otherwise
			= case val of
				?None
					= case exOnReset emptyAttr ?None {VSt|vst & optional = False} of
						(Ok (ui, childSts, mbw) , vst)
							# (ui, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity (ui,childSts)
							= (Ok (ui, False, childSts, (fmap RECORD) <$> mbw), vst)
						(Error e,vst) = (Error e,vst)
				?Just (RECORD x)
					= case exOnReset emptyAttr (?Just x) {VSt|vst & optional = False} of
						(Ok (ui,childSts,mbw),vst)
							# (UI type attr items, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity (ui,childSts)
							= (Ok (UI type attr items, False, childSts, (fmap RECORD) <$> mbw), vst)
						(Error e,vst) = (Error e,vst)

	//Enabling an optional record
	onEdit (eventId,JSONArray [_, JSONBool True])
			True [LeafState enableSt=:{LeafState|editorId= ?Just editorId}:childSts] vst=:{VSt|optional} | eventId == editorId
		//Create and add the fields
		= case exOnReset emptyAttr ?None {vst & optional = False} of
			(Ok (ui,childSts,mbw),vst)
				//Always write after enabling
				# mbew = (requireFields o fmap (\x -> RECORD x)) <$> maybe (exWriteValue childSts) Ok mbw
				# (UI type attr items, childSts) = fromPairUI UIContainer (classAttr ["record"]) grd_arity (ui,childSts)
				# change = ChangeUI [] [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
				# enableSt = LeafState {enableSt & touched=True,state= ?Just (dynamic True)}
				= case mbew of
					(Ok w) = (Ok (?Just (change, True, [enableSt:childSts],?Just w)), {vst & optional = optional})
					(Error e) = (Error e,vst)
			(Error e,vst) = (Error e, vst)

	//Disabling an optional record
	onEdit (eventId,JSONArray [_, JSONBool False])
			True [LeafState enableSt=:{LeafState|editorId= ?Just editorId}:childSts] vst=:{VSt|optional} | eventId == editorId
		//Remove all fields except the enable/disable checkbox
		# change = ChangeUI [] (repeatn grd_arity (1,RemoveChild))
		# enableSt = LeafState {enableSt & touched=True, state = ?Just (dynamic False)}
		= (Ok (?Just (change, True, [enableSt:childSts], ?Just EmptyEditor)), {vst & optional = optional})

	onEdit (eventId,e) True [enableSt=:(LeafState {LeafState|editorId= ?Just editorId, state}):childSts] vst=:{VSt|taskId,optional}
		| childSts =: []
			= (Ok ?None, vst)
		= case exOnEdit (eventId,e) (toPairState $ CompoundState ?None childSts) {VSt|vst & optional = False} of
			(Ok ?None, vst) = (Ok ?None, {vst & optional=optional})
			(Ok (?Just (change, childSts, mbw)),vst)
				# change = fromPairChange 0 grd_arity change
				# childSts = fromPairState grd_arity childSts
				# change = adjustChangeIndex taskId editorId change
				= (Ok (?Just (change, True, [enableSt:childSts], (requireFields o fmap (\x -> RECORD x)) <$> mbw)), {vst & optional = optional})
			(Error e,vst) = (Error e, vst)

	onEdit (eventId,e) False childSts vst=:{VSt|optional}
		= case exOnEdit (eventId,e) (toPairState $ CompoundState ?None childSts) {VSt|vst & optional = False} of
			(Ok ?None, vst) = (Ok ?None, {vst & optional=optional})
			(Ok (?Just (change, childSts, mbw)),vst)
				# change = fromPairChange 0 grd_arity change
				# childSts = fromPairState grd_arity childSts
				= (Ok (?Just (change, False, childSts, (fmap (\x -> RECORD x)) <$> mbw)), {vst & optional=optional})
			(Error e,vst) = (Error e, vst)

	onEdit _ _ _ vst = (Ok ?None,vst)

	//Once an optional record is enabled, the record is invalid until all fields are supplied
	requireFields EmptyEditor = InvalidEditor ["Mandatory record fields are missing"]
	requireFields e = e

	//When viewing mandatory records we simply refresh the fields
	onRefresh ViewValue mbnew False childSts vst=:{VSt|taskId,optional}
		= case exOnRefresh (fmap (\(RECORD new) -> new) mbnew) (toPairState $ CompoundState ?None childSts) {VSt|vst & optional = False} of
			(Ok (change, childSt, mbw),vst)
				= (Ok (fromPairChange 0 grd_arity change, False, fromPairState grd_arity childSt, (fmap (\x -> RECORD x)) <$> mbw), {vst & optional=optional})
			(Error e,vst)
				= (Error e, vst)

	//When an optional record is viewed it can be empty
	onRefresh ViewValue ?None True [] vst=:{VSt|taskId,optional}
		= (Ok (NoChange, True, [], ?None), vst)

	onRefresh ViewValue ?None True childSts vst=:{VSt|taskId,optional}
		# change = ChangeUI [] (repeatn grd_arity (0,RemoveChild))
		= (Ok (change, True, [], ?None), vst)

	//When viewing an optional record it can be empty, so we need to insert all fields when a refresh value is given
	onRefresh ViewValue (?Just (RECORD new)) True [] vst=:{VSt|taskId,optional}
		= case exOnReset emptyAttr (?Just new) {vst & optional = False} of
			(Ok (ui,childSts,mbw),vst)
				# (UI type attr items, childSts) = fromPairUI UIContainer (classAttr ["record"]) grd_arity (ui,childSts)
				# change = ChangeUI [] [(i,InsertChild ui) \\ ui <- items & i <- [0..]]
				= (Ok (change, True, childSts, (fmap (\x -> RECORD x)) <$> mbw), {vst & optional = optional})
			(Error e,vst) = (Error e, vst)

	onRefresh ViewValue (?Just (RECORD new)) True childSts vst=:{VSt|taskId,optional}
		= case exOnRefresh (?Just new) (toPairState $ CompoundState ?None childSts) {VSt|vst & optional = False} of
			(Ok (change, childSt, mbw),vst)
				= (Ok (fromPairChange 0 grd_arity change, True, fromPairState grd_arity childSt, (fmap (\x -> RECORD x)) <$> mbw), {vst & optional=optional})
			(Error e,vst)
				= (Error e, vst)

	//When editing a mandatory record we also simply refresh the fields
	onRefresh EditValue mbnew False childSts vst=:{VSt|taskId,optional}
		= case exOnRefresh (fmap (\(RECORD new) -> new) mbnew) (toPairState $ CompoundState ?None childSts) {VSt|vst & optional = False} of
			(Ok (change, childSt, mbw),vst)
				= (Ok (fromPairChange 0 grd_arity change, False, fromPairState grd_arity childSt, (fmap (\x -> RECORD x)) <$> mbw), {vst & optional=optional})
			(Error e,vst)
				= (Error e, vst)

	//When the record is already empty, nothing needs to be done
	onRefresh EditValue ?None True [LeafState enableSt] vst=:{VSt|taskId,optional}
		# enableSt = LeafState {enableSt & touched=False, state = ?Just (dynamic False)}
		= (Ok (NoChange, True, [enableSt], ?None), {vst & optional = optional})

	//When the record has fields, uncheck the checkbox and remove the fields fields
	onRefresh EditValue ?None True [LeafState enableSt:childSts] vst=:{VSt|taskId,optional}
		//Remove all fields except the enable/disable checkbox
		# change = ChangeUI [] [(0,ChangeChild (ChangeUI [SetAttribute "value" (JSONBool False)] [])):repeatn grd_arity (1,RemoveChild)]
		# enableSt = LeafState {enableSt & touched=False, state = ?Just (dynamic False)}
		= (Ok (change, True, [enableSt], ?None), {vst & optional = optional})

	//When the record has no fields yet, create them
	onRefresh EditValue (?Just (RECORD new)) True [LeafState enableSt] vst=:{VSt|taskId,optional}
		//Enable checkbox and add fields
		= case exOnReset emptyAttr (?Just new) {vst & optional = False} of
			(Ok (ui,childSts,mbw),vst)
				# (UI type attr items, childSts) = fromPairUI UIContainer (classAttr ["record"]) grd_arity (ui,childSts)
				# enable = (0,ChangeChild (ChangeUI [SetAttribute "value" (JSONBool True)] []))
				# change = ChangeUI [] [enable:[(i,InsertChild ui) \\ ui <- items & i <- [1..]]]
				# enableSt = LeafState {enableSt & touched=False, state = ?Just (dynamic True)}
				= (Ok (change, True, [enableSt:childSts], (fmap (\x -> RECORD x)) <$> mbw), {vst & optional = optional})
			(Error e,vst) = (Error e, vst)

	//When there are already fields, refresh them
	onRefresh EditValue (?Just (RECORD new)) True [LeafState enableSt=:{LeafState|editorId= ?Just editorId}:childSts] vst=:{VSt|taskId,optional}
		//Account for the extra state of the enable/disable checkbox
		= case exOnRefresh (?Just new) (toPairState $ CompoundState ?None childSts) {VSt|vst & optional = False} of
			(Ok (change, childSts, mbw),vst)
				# change = fromPairChange 0 grd_arity change
				# childSts = fromPairState grd_arity childSts
				# change = adjustChangeIndex taskId editorId change
				= (Ok (change, True, [LeafState enableSt:childSts], (fmap (\x -> RECORD x)) <$> mbw), {vst & optional=optional})
			(Error e,vst)
				= (Error e, vst)

	genEnableUI taskId editorId enabled =
		( uia UICheckbox (editAttrs taskId editorId (?Just (JSONBool enabled)))
		, LeafState {editorId= ?Just editorId, touched=False, state= ?Just (dynamic False)}
		)

	adjustChangeIndex taskId editorId NoChange = NoChange
	adjustChangeIndex taskId editorId (ChangeUI attrChanges itemChanges)
		= ChangeUI attrChanges ([(i + 1,c) \\ (i,c) <- itemChanges])
	adjustChangeIndex taskId editorId (ReplaceUI (UI type attr items))
		# enableUI = fst $ genEnableUI taskId editorId True
		= ReplaceUI (UI type attr [enableUI:items])

	writeValue ViewValue True [] = Ok EmptyEditor
	writeValue ViewValue _ states = fmap (fmap RECORD) $ exWriteValue $ toPairState $ CompoundState ?None states

	writeValue EditValue True [LeafState _] = Ok EmptyEditor
	writeValue EditValue True [LeafState _:childSts] = fmap (fmap RECORD) $ exWriteValue $ toPairState $ CompoundState ?None childSts

	writeValue EditValue False childSts
		= fmap (fmap RECORD) $ exWriteValue $ toPairState $ CompoundState ?None childSts
	writeValue _ _ _ = Error "Corrupt state in optional record"

gEditor{|FIELD of {gfd_name}|} ex _ _ purpose
	= {Editor|onReset=onReset,onEdit=onEdit,onRefresh=onRefresh,writeValue=writeValue}
where
	{Editor|onReset=exOnReset,onEdit=exOnEdit,onRefresh=exOnRefresh,writeValue=exWriteValue} = ex purpose

	//Just add the field name as a label
	onReset attr val vst = case exOnReset attr ((\(FIELD x) -> x) <$> val) vst of 
		(Ok (UI type attr items, childSt, mbw),vst)
			= (Ok (UI type ('DM'.union attr (labelAttr $ toLabelText gfd_name)) items, childSt, (fmap (\x -> FIELD x)) <$> mbw),vst)
		(Error e,vst) = (Error e,vst)

	onEdit (tp,e) childSt vst = case exOnEdit (tp,e) childSt vst of
		(Ok ?None,vst) = (Ok ?None,vst)
		(Ok (?Just (ui,childSt,mbw)),vst) = (Ok (?Just (ui,childSt,(fmap (\x -> FIELD x)) <$> mbw)),vst)
		(Error e,vst) = (Error e,vst)

	onRefresh mbnew childSt vst = case exOnRefresh ((\(FIELD new) -> new) <$> mbnew) childSt vst of
		(Ok (ui,childSt,mbw),vst) = (Ok (ui,childSt,(fmap (\x -> FIELD x)) <$> mbw),vst)
		(Error e,vst) = (Error e,vst)
	writeValue state = fmap (\x -> FIELD x) <$> exWriteValue state

/*
* For ADT's we need to deal with two cases:
* - There is only one constructor
* - There are multiple constructors
*/
gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} ce _ _ purpose
	//Newtypes or ADTs just use the child editor
	| gtd_num_conses < 2
		= mapEditorWrite (fmap (\i->OBJECT i)) $ mapEditorRead (\(OBJECT i)->i) (ce purpose)
	= compoundEditorToEditor
		{CompoundEditor|onReset=onReset,onEdit=onEdit,onRefresh=onRefresh,writeValue=writeValue}
where
	{Editor|onReset=exOnReset,onEdit=exOnEdit,onRefresh=exOnRefresh,writeValue=exWriteValue} = ce purpose

	gcd_names   = [gcd_name  \\ {GenericConsDescriptor | gcd_name}  <- gtd_conses]  // preselect cons names   to circumvent cyclic dependencies
	gcd_arities = [gcd_arity \\ {GenericConsDescriptor | gcd_arity} <- gtd_conses]  // preselect cons arities to circumvent cyclic dependencies
	
	onReset attr val vst=:{VSt|taskId,selectedConsIndex,optional}
		| purpose =: ViewValue = case val of
			?None
				= (Ok (UI UIContainer (addClassAttr "var-cons" attr) [], (), [], ?None),vst)
			?Just (OBJECT x)
				= case exOnReset emptyAttr (?Just x) vst of
					(Ok (consUI=:(UI _ attr` items), childSt, mbw),vst)
						# (consViewUI,consViewSt) = genConsViewUI gcd_names vst.selectedConsIndex
						= (Ok (UI UIContainer (addClassAttr "var-cons" ('DM'.union attr attr`)) [consViewUI:items]
							, ()
							, [consViewSt, childSt], (fmap (\x -> OBJECT x)) <$> mbw)
							, {vst & selectedConsIndex = selectedConsIndex, optional = optional})
					(Error e,vst) = (Error e,vst)
		# (editorId,vst) = nextEditorId vst
		= case val of
			?None
				//Only generate a UI to select the constructor
				# (consChooseUI, consChooseSt) = genConsChooseUI taskId editorId gcd_names ?None
				= (Ok (UI UIContainer (addClassAttr "var-cons" attr) [consChooseUI], ()
					, [consChooseSt], ?None),{vst & selectedConsIndex = selectedConsIndex})
			?Just (OBJECT x)
				//Generate the ui for the current value
				= case exOnReset emptyAttr (?Just x) {vst & optional = False} of
					(Ok (consUI=:(UI _ attr` items), childSt, mbw),vst)
						//Add the UI to select the constructor and change the type to UIVarCons
						# (consChooseUI, consChooseSt) = genConsChooseUI taskId editorId gcd_names (?Just vst.selectedConsIndex)
						= (Ok (UI UIContainer (addClassAttr "var-cons" ('DM'.union attr attr`)) [consChooseUI:items]
							, (), [consChooseSt, childSt], (fmap (\x -> OBJECT x)) <$> mbw)
							, {vst & selectedConsIndex = selectedConsIndex, optional = optional})
					(Error e,vst) = (Error e, vst)

	genConsChooseUI taskId editorId gcd_names mbSelectedCons = (consChooseUI,consChooseSt)
	where
		consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gcd_name)] \\ gcd_name <- gcd_names & i <- [0..]]
		consChooseUI = uia UIDropdown (choiceAttrs taskId editorId (maybe [] (\x -> [x]) mbSelectedCons) consOptions)
		consChooseSt = LeafState {editorId= ?Just editorId,touched=False,state= (\c -> dynamic c) <$> mbSelectedCons}

	genConsViewUI gcd_names selectedCons =
		( uia UITextView (valueAttr (JSONString (gcd_names !! selectedCons)))
		, LeafState {editorId= ?None, touched=False, state= ?None}
		)

	//Update is a constructor switch
	onEdit (eventId,JSONArray [JSONInt consIdx]) _ [LeafState st=:{editorId= ?Just editorId,touched,state}: _] vst=:{pathInEditMode,optional} | eventId == editorId
		//Create a UI for the new constructor
		# (ui, vst) = exOnReset emptyAttr ?None {vst & pathInEditMode = consCreatePath consIdx gtd_num_conses, optional = False}
		# vst = {vst & pathInEditMode = pathInEditMode}
		= case ui of
			Ok (UI _ attr items, childSt, mbw)
				//Construct a UI change that does the following: 
				//1: If necessary remove the fields of the previously selected constructor
				# removals = case state of
					?Just (prevConsIdx :: Int)
						-> repeatn (gcd_arities !! prevConsIdx) (1,RemoveChild)
						-> []
				//2: Inserts the fields of the newly created ui
				# inserts = [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
				# change = ChangeUI [] (removals ++ inserts)
				//Create a new state for the constructor selection
				# consChooseSt = LeafState {st & touched=True,state= ?Just (dynamic consIdx)}
				//When a constructor is switched, always write out the value
				= case maybe (exWriteValue childSt) Ok mbw of
					Ok w
						# wo = case w of
							ValidEditor x = ValidEditor $ OBJECT x
							InvalidEditor rs = InvalidEditor rs
							EmptyEditor = InvalidEditor ["missing required fields"]
						= (Ok (?Just (change, (), [consChooseSt, childSt], ?Just wo)), {vst & optional = False})
					Error e = (Error e,vst)

			Error e = (Error e, vst)

	//Other events targeted directly at the ADT 
	onEdit (eventId,e) _ [LeafState st=:{LeafState|editorId= ?Just editorId,touched,state}: _] vst | eventId == editorId
		| e =: JSONNull || e =: (JSONArray []) // A null or an empty array are accepted as a reset events
			//If necessary remove the fields of the previously selected constructor
			# change = case state of
				?Just (prevConsIdx :: Int)
					-> ChangeUI [] (repeatn (gcd_arities !! prevConsIdx) (1,RemoveChild))
					-> NoChange
			# consChooseSt = LeafState {st & touched = True, state = ?None}
			= (Ok (?Just (change, (), [consChooseSt], ?Just EmptyEditor)), vst)
		| otherwise
			= (Error ("Unknown constructor select event: '" +++ toString e +++ "'"),vst)

	//Update may be targeted somewhere inside this value
	onEdit (eventId,e) _ [consChooseSt, childSt] vst=:{VSt|optional} = case exOnEdit (eventId,e) childSt {vst & optional = False} of
		(Ok ?None,vst) = (Ok ?None,{vst & optional = optional})
		(Ok (?Just (change, childSt, mbw)),vst)
			# change = case change of
				(ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
				_                                  = NoChange
			= (Ok (?Just (change, (), [consChooseSt, childSt], fmap (fmap (\i -> (OBJECT i))) mbw)),{vst & optional=optional})
		(Error e,vst) = (Error e, vst)

	onEdit _ _ _ vst = (Ok ?None, vst)

	//Nothing selected currently, nothing to do
	onRefresh ?None _ st vst
		| st =: [] || st =: [_] = (Ok (NoChange,(),st,?None),vst)

	//Something was selected, reset the selector and remove the fields
	onRefresh ?None _ [consChooseSt=:(LeafState st=:{LeafState|state}),childSt] vst=:{VSt|taskId,selectedConsIndex=curSelectedConsIndex}
		//Reset the selector
		# selectorChanges = [(0, ChangeChild (ChangeUI [SetAttribute "value" (JSONArray [JSONInt -1,JSONBool True])] []))]
		//If necessary remove the fields of the previously selected constructor
		# childChanges = case state of
			?Just (prevConsIdx :: Int)
				-> (repeatn (gcd_arities !! prevConsIdx) (1,RemoveChild))
				-> []
		# change = ChangeUI [] (selectorChanges ++ childChanges)
		# consChooseSt = LeafState {st & touched = True, state = ?None}
		= (Ok (change, (), [consChooseSt], ?None), vst)

	onRefresh (?Just new=:(OBJECT _)) _ [] vst=:{VSt|taskId,selectedConsIndex=curSelectedConsIndex}
		//Nothing selected currently and no cons UI generated yet, do an entire reset with the new value
		= case onReset emptyAttr (?Just new) vst of
			(Ok (ui, st, childSts, mbw),vst)
				# change = ReplaceUI ui
				= (Ok (change, st, childSts, mbw), {vst & selectedConsIndex = curSelectedConsIndex})
			(Error e,vst) = (Error e, vst)

	onRefresh (?Just (OBJECT new)) _ [consChooseSt] vst=:{VSt|taskId,selectedConsIndex=curSelectedConsIndex}
		//Nothing selected currently, do a reset with the new value
		= case exOnReset emptyAttr (?Just new) vst of
			(Ok (ui, childSt, mbw),vst)
				# change = ChangeUI [] [(1,InsertChild ui)]
				= (Ok (change, (), [consChooseSt, childSt], fmap (\x -> OBJECT x) <$> mbw), {vst & selectedConsIndex = curSelectedConsIndex})
			(Error e,vst) = (Error e, vst)

	onRefresh (?Just (OBJECT new)) _ [consChooseSt=:(LeafState {LeafState|editorId}),childSt] vst=:{VSt|taskId,selectedConsIndex=curSelectedConsIndex}
		//Adjust for the added constructor view/choose UI
		= case exOnRefresh (?Just new) childSt {vst & selectedConsIndex = 0} of
			(Ok (change, childSt, mbw),vst=:{VSt|selectedConsIndex})
				//If the cons was changed we need to update the selector
				# consIndex = ~selectedConsIndex - 1
				# consChange = if (selectedConsIndex < 0)
					[(0, ChangeChild (ChangeUI [SetAttribute "value" (JSONArray [JSONInt consIndex,JSONBool True])] []))]
					[]
				//Adjust the changes
				# change = case change of
					NoChange						     = if (consChange =: []) NoChange (ChangeUI [] consChange)
					(ChangeUI attrChanges itemChanges)   = ChangeUI attrChanges (consChange ++ [(i + 1,c) \\ (i,c) <- itemChanges])
					(ReplaceUI ui=:(UI type attr items))
						//Add the constructor selection/view ui
						# (consUI,_) = maybe
							(genConsViewUI gcd_names consIndex)
							(\editorId -> genConsChooseUI taskId editorId gcd_names (?Just consIndex)) editorId
						= ReplaceUI (UI type attr [consUI:items])
				= (Ok (change, (), [consChooseSt, childSt], fmap (\x -> OBJECT x) <$> mbw), {vst & selectedConsIndex = curSelectedConsIndex})
			(Error e,vst) = (Error e,vst)

	onRefresh _ _ _ vst = (Error "Corrupt OBJECT editor state",vst)

	writeValue _ [LeafState _] = Ok EmptyEditor
	writeValue _ []            = Ok EmptyEditor // view purpose editor without value -> no child states
	writeValue _ [_, childSt]  = fmap (\x -> OBJECT x) <$> exWriteValue childSt
	writeValue _ _             = Error "Corrupt OBJECT editor state"

gEditor{|EITHER|} ex _ _ ey _ _ purpose
	// the additional boolean state represents the LEFT/RIGHT choice (LEFT = False, RIGHT = True)
	= compoundEditorToEditor
		{CompoundEditor|onReset=onReset,onEdit=onEdit,onRefresh=onRefresh,writeValue=writeValue}
where
	onReset _ val vst=:{pathInEditMode} = case (val, pathInEditMode) of
		(?None, [nextChoiceIsRight:restOfPath])
			# vst = {vst & pathInEditMode = restOfPath}
			| nextChoiceIsRight
				= attachInfoToChildResult True $ fmapChildResult RIGHT $ (ey purpose).Editor.onReset emptyAttr ?None vst
			| otherwise
				= attachInfoToChildResult False $ fmapChildResult LEFT $ (ex purpose).Editor.onReset emptyAttr ?None vst
		(?Just (LEFT x),  _)
			= attachInfoToChildResult False $ fmapChildResult LEFT $ (ex purpose).Editor.onReset emptyAttr (?Just x) vst
		(?Just (RIGHT y), _)
			= attachInfoToChildResult True $ fmapChildResult RIGHT $ (ey purpose).Editor.onReset emptyAttr (?Just y) vst

	//Just pass the edit event through 
	onEdit (eventId,e) False [childSt] vst
		= attachInfoToChildResultEdit False
		$ fmapChildResultEdit LEFT $ (ex purpose).Editor.onEdit (eventId,e) childSt vst
	onEdit (eventId,e) True [childSt] vst
		= attachInfoToChildResultEdit True
		$ fmapChildResultEdit RIGHT $ (ey purpose).Editor.onEdit (eventId,e) childSt vst

	onEdit _ _ _ vst = (Error "Corrupt edit state in generic EITHER editor", vst)

	//Same choice is for previous value is made
	onRefresh (?Just (LEFT new)) False [childSt] vst =
		attachInfoToChildResult False $ fmapChildResult LEFT $ (ex purpose).Editor.onRefresh (?Just new) childSt vst
	onRefresh (?Just (RIGHT new)) True [childSt] vst =
		attachInfoToChildResult True $ fmapChildResult RIGHT $ (ey purpose).Editor.onRefresh (?Just new) childSt vst

	//Empty the current choice
	onRefresh ?None False [childSt] vst =
		attachInfoToChildResult False $ fmapChildResult LEFT $ (ex purpose).Editor.onRefresh ?None childSt vst
	onRefresh ?None True [childSt] vst =
		attachInfoToChildResult True $ fmapChildResult RIGHT $ (ey purpose).Editor.onRefresh ?None childSt vst

	//A different constructor is selected -> generate a new UI
	//We use a negative selConsIndex to encode that the constructor was changed
	onRefresh (?Just (RIGHT new)) False _ vst = case (ey purpose).Editor.onReset emptyAttr (?Just new) vst of
		(Ok (ui,childSt,mbw),vst=:{selectedConsIndex}) = (Ok (ReplaceUI ui, True, [childSt], ?None),{vst & selectedConsIndex = -1 - selectedConsIndex})
		(Error e,vst=:{selectedConsIndex}) = (Error e,{vst & selectedConsIndex = -1 - selectedConsIndex})

	onRefresh (?Just (LEFT new)) True _ vst = case (ex purpose).Editor.onReset emptyAttr (?Just new) vst of
		(Ok (ui,childSt,mbw),vst=:{selectedConsIndex}) = (Ok (ReplaceUI ui, False, [childSt], ?None),{vst & selectedConsIndex = -1 - selectedConsIndex})
		(Error e,vst=:{selectedConsIndex}) = (Error e,{vst & selectedConsIndex = -1 - selectedConsIndex})
	onRefresh _ _ _ vst = (Error "Corrupt edit state in generic EITHER editor", vst)

	writeValue False [childSt] = fmap LEFT <$> (ex purpose).Editor.writeValue childSt
	writeValue True  [childSt] = fmap RIGHT <$> (ey purpose).Editor.writeValue childSt
	writeValue _     _         = Error "Corrupt edit state in generic EITHER editor"

	attachInfoToChildResult isRight (res, vst) =
		((\(ui, childSt, mbw) -> (ui, isRight, [childSt], mbw)) <$> res, vst)
	attachInfoToChildResultEdit isRight (res, vst) =
		((fmap (\(ui, childSt, mbw) -> (ui, isRight, [childSt], mbw))) <$> res, vst)

	fmapChildResult f (res,vst) = ((\(ui, st, mbw) -> (ui, st, fmap (fmap f) mbw)) <$> res,vst)
	fmapChildResultEdit f (res,vst) = ((fmap (\(ui, st, mbw) -> (ui, st, fmap (fmap f) mbw))) <$> res,vst)

gEditor{|CONS of {gcd_index,gcd_arity}|} ex _ _ purpose
	= compoundEditorToEditor {CompoundEditor|onReset=onReset,onEdit=onEdit,onRefresh=onRefresh,writeValue=writeValue}
where
	{Editor|onReset=exOnReset,onEdit=exOnEdit,onRefresh=exOnRefresh,writeValue=exWriteValue} = ex purpose

	onReset attr val vst = case exOnReset emptyAttr ((\(CONS x) -> x) <$> val) vst of
		(Ok (ui, childSts, mbw),vst)
			# (ui, childSts) = fromPairUI UIContainer (addClassAttr "cons" attr) gcd_arity (ui,childSts)
			= (Ok (ui, (), childSts, (fmap (\x -> CONS x)) <$> mbw), {VSt| vst & selectedConsIndex = gcd_index})
		(Error e,vst) = (Error e,{VSt| vst & selectedConsIndex = gcd_index})

	onEdit (eventId,edit) _ childSts vst
		//Update the targeted field in the constructor
		= case exOnEdit (eventId,edit) (toPairState $ CompoundState ?None childSts) vst of
			(Ok ?None, vst) = (Ok ?None, vst)
			(Ok (?Just (change, childSts, mbw)),vst)
				= (Ok (?Just (fromPairChange 0 gcd_arity change, (), fromPairState gcd_arity childSts, fmap CONS <$> mbw)), vst)
			(Error e,vst) = (Error e,vst)

	onRefresh mbnew _ childSts vst
		//Refresh 
		= case exOnRefresh ((\(CONS new) -> new) <$> mbnew) (toPairState $ CompoundState ?None childSts) vst of
			(Ok (change, childSts, mbw),vst)
				= (Ok (fromPairChange 0 gcd_arity change, (), fromPairState gcd_arity childSts, fmap CONS <$> mbw), vst)
			(Error e,vst)
				= (Error e, vst)

	writeValue _ childSts = fmap (fmap CONS) $ exWriteValue $ toPairState $ CompoundState ?None childSts

gEditor{|PAIR|} ex _ _ ey _ _ purpose
	= {Editor|onReset=onReset,onRefresh=onRefresh,onEdit=onEdit,writeValue=writeValue}
where
	{Editor|onReset=exOnReset,onEdit=exOnEdit,onRefresh=exOnRefresh,writeValue=exWriteValue} = ex purpose
	{Editor|onReset=eyOnReset,onEdit=eyOnEdit,onRefresh=eyOnRefresh,writeValue=eyWriteValue} = ey purpose

	onReset attr val vst
		# (vizx, vst) = exOnReset emptyAttr ((\(PAIR x _) -> x) <$> val) vst
		| vizx =: (Error _) = (liftError vizx,vst)
		# (vizy, vst) = eyOnReset emptyAttr ((\(PAIR _ y) -> y) <$> val) vst
		| vizy =: (Error _) = (liftError vizy,vst)
		# ((vizx, stx, mbwx), (vizy, sty, mbwy)) = (fromOk vizx, fromOk vizy)
		# mbw = case (mbwx,mbwy) of
			(?Just (ValidEditor wx), ?Just (ValidEditor wy)) = ?Just (ValidEditor (PAIR wx wy))
			(?Just EmptyEditor, ?Just EmptyEditor) = ?Just EmptyEditor
			(?Just _, _) = ?Just (InvalidEditor [])
			(_,?Just _) = ?Just (InvalidEditor [])
			_ = ?None
		= (Ok (uiac UIContainer attr [vizx, vizy], CompoundState ?None [stx, sty], mbw),vst)

	onEdit event (CompoundState _ [stX, stY]) vst
		= case exOnEdit event stX vst of
			(Error e,vst) = (Error e,vst)
			(Ok (?Just (change, stX, mbw)),vst)
				# change = ChangeUI [] [(0,ChangeChild change),(1,ChangeChild NoChange)]
				= case mbw of
					?None = (Ok (?Just (change, CompoundState ?None [stX,stY], ?None)),vst)
					(?Just wx) = case eyWriteValue stY of
						(Error e) = (Error e,vst)
						(Ok wy) 
							# mbw = pairEditorReport wx wy
							= (Ok (?Just (change, CompoundState ?None [stX,stY], ?Just mbw)),vst)
			(Ok ?None,vst) = case eyOnEdit event stY vst of
				(Error e,vst) = (Error e,vst)
				(Ok (?Just (change, stY, mbw)),vst)
					# change = ChangeUI [] [(0,ChangeChild NoChange),(1,ChangeChild change)]
					= case mbw of
						?None = (Ok (?Just (change, CompoundState ?None [stX,stY], ?None)),vst)
						(?Just wy) = case exWriteValue stX of
							(Error e) = (Error e,vst)
							(Ok wx) 
								# mbw = pairEditorReport wx wy
								= (Ok (?Just (change, CompoundState ?None [stX,stY], ?Just mbw)),vst)
				(Ok ?None,vst) = (Ok ?None,vst)
	onEdit _ _ vst = (Error "Corrupt editor state in generic PAIR editor", vst)

	onRefresh mbnew (CompoundState _ [stX, stY]) vst
		# (newx,newy) = case mbnew of
			?Just (PAIR newx newy) = (?Just newx,?Just newy)
			?None  = (?None,?None)
		# (changex,vst) 	= exOnRefresh newx stX vst
		| changex=: (Error _) = (liftError changex,vst)
		# (changey,vst) 	= eyOnRefresh newy stY vst
		| changey =: (Error _) = (liftError changey,vst)
		# ((changex,stX,mbwX),(changey,stY,mbwY)) = (fromOk changex,fromOk changey)
		| mbwX =: ?None && mbwY =: ?None
			= (Ok (ChangeUI [] [(0,ChangeChild changex),(1,ChangeChild changey)],CompoundState ?None [stX, stY], ?None), vst)
		# wx = maybe (exWriteValue stX) Ok mbwX
		| wx =: (Error _) = (liftError wx,vst)
		# wy = maybe (eyWriteValue stY) Ok mbwY
		| wy =: (Error _) = (liftError wy,vst)
		# mbw = pairEditorReport (fromOk wx) (fromOk wy)
		= (Ok (ChangeUI [] [(0,ChangeChild changex),(1,ChangeChild changey)],CompoundState ?None [stX, stY], ?Just mbw), vst)
	onRefresh _ _ vst
		= (Error "Corrupt editor state in generic PAIR editor", vst)

	writeValue (CompoundState _ [stX, stY]) = case (exWriteValue stX, eyWriteValue stY) of
        (Ok mbx, Ok mby) = Ok $ pairEditorReport mbx mby
        (Error x,Error y) = Error (x +++ ", " +++ y)
        (Error x,_)  = Error x
        (_,Error y)  = Error y
    writeValue _     = Error "Corrupt editor state in generic PAIR editor"

	pairEditorReport EmptyEditor EmptyEditor = EmptyEditor
	pairEditorReport (ValidEditor x) (ValidEditor y) = ValidEditor (PAIR x y)
	pairEditorReport (InvalidEditor ex) (InvalidEditor ey) = InvalidEditor (ex++ey)
	pairEditorReport (InvalidEditor ex) _ = InvalidEditor ex
	pairEditorReport _ (InvalidEditor ey) = InvalidEditor ey
	pairEditorReport _ _ = InvalidEditor []

//Make a special datapath that encodes the desired nesting of EITHER's to create a constructor
consCreatePath :: !Int !Int -> [Bool]
consCreatePath i n
 	| i >= n     = []
	| n == 1     = []
	| i < (n /2) = [ False: consCreatePath i (n/2) ]
	| otherwise  = [ True:  consCreatePath (i - (n/2)) (n - (n/2)) ]

//When UIs, or UI differences are aggregated in PAIR's they form a binary tree 

//Recreate the binary-tree representation for a pair
toPairState :: !EditState -> EditState
toPairState m=:(CompoundState _ [])         = m
toPairState m=:(CompoundState _ [m1])       = m1
toPairState m=:(CompoundState _ [m1,m2])    = m
toPairState m=:(CompoundState _ [m1,m2,m3]) = CompoundState ?None [m1, CompoundState ?None [m2,m3]]
toPairState m=:(CompoundState _ fields)     = CompoundState ?None [m1,m2]
where
	half = length fields / 2
	m1 = toPairState (CompoundState ?None (take half fields))
	m2 = toPairState (CompoundState ?None (drop half fields))

//Desconstruct the binary-tree representation of a pair
fromPairState :: !Int !EditState -> [EditState]
fromPairState 0 m                                                   = [m]
fromPairState 1 m                                                   = [m]
fromPairState 2 m=:(CompoundState _ sts)                            = sts
fromPairState 3 m=:(CompoundState _ [m1, CompoundState _ [m2, m3]]) = [m1,m2,m3]
fromPairState n m=:(CompoundState _ [m1, m2])                       = f1 ++ f2
where
	half = n / 2
	f1 = fromPairState half m1
	f2 = fromPairState (n - half) m2

//These functions flatten this tree back to a single CompoundEditor or ChangeUI definition
fromPairUI :: !UIType !UIAttributes !Int !(!UI, !EditState) -> (!UI, ![EditState])
fromPairUI type attr arity (ui, st) | arity < 2 = (UI type attr [ui], [st])
fromPairUI type attr 2 (UI _ _ [ul,ur], CompoundState _ [ml,mr])
	= (UI type attr [ul,ur],[ml,mr])
fromPairUI type attr 3 (UI _ _ [ul,UI _ _ [um,ur]], CompoundState _ [ml,CompoundState _ [mm,mr]])
	= (UI type attr [ul,um,ur], [ml,mm,mr])
fromPairUI type attr n (UI _ _ [ul,ur], CompoundState _ [ml,mr])
	= (UI type attr (uls ++ urs), (mls ++ mrs))
where
	half = n / 2
	(UI _ _ uls, mls) = fromPairUI type attr half (ul,ml)
	(UI _ _ urs, mrs) = fromPairUI type attr (n - half) (ur,mr)

fromPairChange :: Int Int UIChange -> UIChange
//No pairs are introduced for 0 or 1 fields
fromPairChange s arity change | arity < 2 = ChangeUI [] [(s,ChangeChild change)]
//For two and three fields, set the correct child index values 
fromPairChange s _ NoChange
	= ChangeUI [] []
fromPairChange s 2 (ChangeUI _ [(_,ChangeChild l),(_,ChangeChild r)])
	= ChangeUI [] [(s,ChangeChild l),(s+1,ChangeChild r)]
fromPairChange s 3 (ChangeUI _ [(_,ChangeChild l),(_,ChangeChild NoChange)])
	= ChangeUI [] [(s,ChangeChild l)]
fromPairChange s 3 (ChangeUI _ [(_,ChangeChild l),(_,ChangeChild (ChangeUI _ [(_,ChangeChild m),(_,ChangeChild r)]))])
	= ChangeUI [] [(s,ChangeChild l), (s+1,ChangeChild m), (s+2,ChangeChild r)]
fromPairChange s n (ChangeUI _ [(_,ChangeChild l),(_,ChangeChild r)])
	= ChangeUI [] (ll ++ rl)
where
	half = n / 2
	(ChangeUI _ ll) = fromPairChange s half l
	(ChangeUI _ rl) = fromPairChange (s + half) (n - half) r

//The maybe editor makes its content optional and marks the underlying editor as optional in the vst
gEditor{|(?)|} ex _ _ purpose
	= mapEditorReads mapReadReset mapReadRefresh
	$ mapEditorWrite mapWrite 
	$ markOptional
	$ withExtraAttributes (\_ opt -> optionalAttr opt) (\_ opt -> optionalAttr opt)
	$ ex purpose
where
	mapReadReset (?Just (?Just x))  = ?Just x
	mapReadReset _ = ?None

	mapReadRefresh _ (?Just (?Just x)) = ?Just x
	mapReadRefresh _ _ = ?None

	mapWrite EmptyEditor = ValidEditor ?None
	mapWrite (ValidEditor x) = ValidEditor (?Just x)
	mapWrite (InvalidEditor r) = InvalidEditor r

	markOptional {Editor|onReset=exOnReset,onEdit=exOnEdit,onRefresh=exOnRefresh,writeValue=writeValue}
		= {Editor|onReset=onReset,onEdit=onEdit,onRefresh,writeValue=writeValue}
	where
		onReset attr val vst=:{VSt|optional}
			# (res, vst) = exOnReset attr val {VSt|vst & optional = True}
			= (res, {VSt|vst & optional = optional})
		onEdit event st vst=:{VSt|optional}
			# (res, vst) = exOnEdit event st {VSt|vst & optional = True}
			= (res, {VSt|vst & optional = optional})
		onRefresh val st vst=:{VSt|optional}
			# (res, vst) = exOnRefresh val st {VSt|vst & optional = True}
			= (res, {VSt|vst & optional = optional})

gEditor{|Int|} ViewValue = mapEditorWrite (const EmptyEditor) $ mapEditorRead toString textView
gEditor{|Int|} EditValue = withDynamicHintAttributes "whole number" integerField

gEditor{|Real|} ViewValue = mapEditorWrite (const EmptyEditor) $ mapEditorRead toString textView
gEditor{|Real|}	EditValue = withDynamicHintAttributes "decimal number" decimalField

gEditor{|Char|} ViewValue = mapEditorWrite (const EmptyEditor) $mapEditorRead toString textView
gEditor{|Char|} EditValue
	= mapEditorRead toString
	$ withDynamicHintAttributes "single character"
	$ mapEditorWrite
		(\v -> case v of
			EmptyEditor = EmptyEditor
			(ValidEditor c) = if (size c == 1) (ValidEditor c.[0]) (InvalidEditor ["The value must be exactly 1 character"])
			(InvalidEditor r) = InvalidEditor r
		)
	$ textField <<@ boundedlengthAttr 1 1
						
gEditor{|String|} ViewValue = mapEditorWrite (const EmptyEditor) textView
gEditor{|String|} EditValue
	= withDynamicHintAttributes "single line of text"
	$ textField <<@ minlengthAttr 1

gEditor{|Bool|} ViewValue
	= mapEditorWrite (const EmptyEditor) $ mapEditorRead (\b -> if b "True" "False") textView
gEditor{|Bool|} EditValue
	= mapEditorReads
		(\mbr -> ?Just $ toDropdown mbr)
		(\_ mbr -> ?Just $ toDropdown mbr)
	$ mapEditorWrite
		(\v -> case v of
			[0] = ValidEditor False
			[1] = ValidEditor True
			_   = EmptyEditor
		)
	$ dropdown
where
	toDropdown mbr = maybe (options,[]) (\b -> (options, if b [1] [0])) mbr
	options = [{ChoiceText|id=i,text=t} \\ t <- ["False","True"] & i <- [0..]]

derive gEq EditorReport

gEditor{|[]|} ex _ eqx purpose
	=  mapEditorWrite editorReportList
	$ listEditor_ (gEq{|*->*|} eqx) (purpose =: ViewValue) (?Just (const ?None)) True True
		(?Just (\l -> pluralisen English (length l) "item")) ValidEditor (ex purpose)

gEditor{|()|} purpose = mapEditorWrite (const $ ValidEditor ()) emptyEditor
gEditor{|(->)|} _ _ _ _ _ _ purpose
	= mapEditorWithState ?None
		(\f _ -> (?None, ?Just (copy_to_string f)))
		(\_ s -> (maybe EmptyEditor (\f -> ValidEditor (fst (copy_from_string {c \\ c <-: f}))) s,s))
		emptyEditor

gEditor{|Dynamic|} purpose
	= mapEditorWithState ?None (\d _ -> (?None, ?Just d)) (\_ s -> (maybe EmptyEditor ValidEditor s,s)) emptyEditor

gEditor{|HtmlTag|} purpose = mapEditorWrite (const EmptyEditor) htmlView

gEditor{|{}|} edx gtx eqx purpose =
	mapEditorWrite (fmap (\x->{x\\x<-x})) $
	mapEditorRead (\x->[x\\x<-:x]) $
	(gEditor{|*->*|} edx gtx eqx purpose)

gEditor{|{!}|} edx gtx eqx purpose =
	mapEditorWrite (fmap (\x->{x\\x<-x})) $
	mapEditorRead (\x->[x\\x<-:x]) $
	(gEditor{|*->*|} edx gtx eqx purpose)

gEditor{|Integer|} ViewValue = mapEditorWrite (const EmptyEditor) $ mapEditorRead toString textView
gEditor{|Integer|} EditValue = withDynamicHintAttributes "whole number" bigIntegerField

derive gEditor JSONNode, Either, MaybeError, (,), (,,), (,,,), (,,,,), (,,,,,), Timestamp, Map

toLabelText :: !String -> String
toLabelText "" = ""
toLabelText label = {c \\ c <- [toUpper lname : addspace lnames]}
where
	[lname:lnames] = fromString label
	addspace [] = []
	addspace [c:cs]
		| c == '_'  = [' ':addspace cs]
		| isUpper c = [' ',toLower c:addspace cs]
		| otherwise = [c:addspace cs]
