implementation module TUIEncode

import StdMisc, StdList, JSON, SystemTypes, TUIDefinition, TUIDiff

encodeTUIDefinition :: !TUIDef -> JSONNode
encodeTUIDefinition d = toJSON d

//TUI DEFINITIONS
derive JSONEncode TUIButton, TUIIcon, TUIHtml, Hotkey
derive JSONEncode TUIButtonControl
derive JSONEncode TUIContainer, TUIPanel, TUIWindow, TUITabContainer, TUIBorderContainer, TUIListContainer
derive JSONEncode TUIGridControl, TUITree, TUIEditControl, TUIShowControl

JSONEncode{|TUIDef|} {content,width,height,margins}
	= merge (JSONEncode{|*|} content) (sizeAttributes width height margins)

JSONEncode{|TUIDefContent|} (TUIEditControl c b)		= merge (encodeControlType editprefix c) (JSONEncode{|*|} b)
JSONEncode{|TUIDefContent|} (TUIShowControl c b)		= merge (encodeControlType showprefix c) (JSONEncode{|*|} b)
JSONEncode{|TUIDefContent|} (TUIPanel r)				= addXType "itasks_panel" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIContainer r)			= addXType "itasks_container" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIWindow r)				= addXType "itasks_window" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUITabContainer r)			= addXType "itasks_tab_container" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUITabItem r)				= JSONEncode{|*|} r
JSONEncode{|TUIDefContent|} (TUIBorderContainer r)		= addXType "iborderc" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIBorderItem r)			= addXType "iborderi" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIListContainer r) 		= addXType "itasks_list_container" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIListItem r)				= JSONEncode{|*|} r
JSONEncode{|TUIDefContent|} (TUIRadioChoice r)			= JSONEncode{|*|} r
JSONEncode{|TUIDefContent|} (TUICheckChoice r)			= JSONEncode{|*|} r
JSONEncode{|TUIDefContent|} (TUIIcon r)					= addXType "itasks_icon" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIHtml r)					= addXType "itasks_html" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIButton r)				= addXType "itasks_button" (JSONEncode{|*|} r)
JSONEncode{|TUIDefContent|} (TUIMenuButton r) 			= JSONEncode{|*|} r
JSONEncode{|TUIDefContent|} (TUIMenuItem r) 			= JSONEncode{|*|} r

JSONEncode{|TUIDefContent|} (TUICustom r)				= [r]

JSONEncode{|TUIListItem|}  {TUIListItem|items,index}
	= [JSONObject [("xtype",JSONString "itasks_list_item"),("index",JSONInt index),("items", toJSON items)]]

JSONEncode{|TUITabItem|} {TUITabItem|taskId,items,title,iconCls,padding,menus,closeAction}
	= [JSONObject (filterNull [("xtype",JSONString "itasks_tab_item"),("taskId",toJSON taskId),("items",toJSON items),("title",toJSON title),("iconCls",toJSON iconCls)
				  ,("padding",toJSON padding),("menus",toJSON menus),("closeAction",toJSON closeAction)])]

JSONEncode{|TUIBorderItem|} {TUIBorderItem|title,iconCls,item}
	= [JSONObject [("xtype",JSONString "iborderi"),("title",toJSON title),("iconCls",toJSON iconCls),("items",toJSON item)]]

JSONEncode{|TUIMenuButton|} {TUIMenuButton|text,target,action,disabled,iconCls,menu}
	= 	[JSONObject (filterNull [("xtype",JSONString "itasks_menu_button"),("text",toJSON text),("target",toJSON target),("action",toJSON action)
					,("disabled",toJSON disabled),("iconCls",toJSON iconCls),("menu",toJSON menu)])]
JSONEncode{|TUIMenuItem|} {TUIMenuItem|text,target,action,disabled,iconCls,hotkey,menu}
	= 	[JSONObject	(filterNull [("xtype",JSONString "itasks_menu_item"),("text",toJSON text),("target",toJSON target),("action",toJSON action)
					,("disabled",toJSON disabled),("iconCls",toJSON iconCls),("hotkey",toJSON hotkey),("menu",toJSON menu)])
		]
JSONEncode{|TUIMenu|} {TUIMenu|items}
	= [JSONObject [("xtype",JSONString "menu"),("items", JSONArray (map toJSON items))]]

JSONEncode{|TUIRadioChoice|} {TUIRadioChoice|items,taskId,name,index,checked}
	= [JSONObject [("xtype",JSONString "itasks_radiochoice"),("items", JSONArray (map toJSON items))
					,("taskId",toJSON taskId),("name", JSONString name),("index",JSONInt index),("checked",JSONBool checked)]]

JSONEncode{|TUICheckChoice|} {TUICheckChoice|items,taskId,name,index,checked}
	= [JSONObject [("xtype",JSONString "itasks_checkchoice"),("items", JSONArray (map toJSON items))
					,("taskId",toJSON taskId),("name", JSONString name),("index",JSONInt index),("checked",JSONBool checked)]]

editprefix :== "itasks_edit_"
showprefix :== "itasks_show_"

encodeControlType prefix TUIStringControl				= justXType (prefix +++ "string")
encodeControlType prefix TUICharControl					= justXType (prefix +++ "char") 
encodeControlType prefix TUIIntControl					= justXType (prefix +++ "int")
encodeControlType prefix TUIRealControl					= justXType (prefix +++ "real")
encodeControlType prefix TUIBoolControl					= justXType (prefix +++ "bool")
encodeControlType prefix TUINoteControl					= justXType (prefix +++ "note")
encodeControlType prefix TUIDateControl					= justXType (prefix +++ "date")
encodeControlType prefix TUITimeControl					= justXType (prefix +++ "time")
encodeControlType prefix TUIPasswordControl				= justXType (prefix +++ "password")
encodeControlType prefix TUIUserControl					= justXType (prefix +++ "string")
encodeControlType prefix TUICurrencyControl				= justXType (prefix +++ "currency")
encodeControlType prefix (TUIDocumentControl r)			= justXType (prefix +++ "document")
encodeControlType prefix (TUIButtonControl r)			= addXType "itasks_button" (JSONEncode{|*|} r)
encodeControlType prefix (TUIComboControl r)			= [JSONObject [("xtype",JSONString "itasks_combo"),("options",toJSON r)]]
encodeControlType prefix (TUIGridControl r)				= addXType "itasks_grid" (JSONEncode{|*|} r)
encodeControlType prefix (TUITreeControl r)				= [JSONObject [("xtype",JSONString "itasks_tree"),("tree",toJSON r)]]
encodeControlType prefix (TUICustomControl xtype)		= justXType xtype

JSONEncode{|TUIDirection|} Horizontal	= [JSONString "horizontal"]
JSONEncode{|TUIDirection|} Vertical		= [JSONString "vertical"]
JSONEncode{|TUIHAlign|} AlignLeft		= [JSONString "left"]
JSONEncode{|TUIHAlign|} AlignCenter		= [JSONString "center"]
JSONEncode{|TUIHAlign|} AlignRight		= [JSONString "right"]
JSONEncode{|TUIVAlign|} AlignTop		= [JSONString "top"]
JSONEncode{|TUIVAlign|} AlignMiddle		= [JSONString "middle"]
JSONEncode{|TUIVAlign|} AlignBottom		= [JSONString "bottom"]
JSONEncode{|TUIMargins|} {TUIMargins|top,right,bottom,left} = [JSONString (toString top +++ " " +++ toString right +++ " " +++ toString bottom +++ " " +++ toString left)]

sizeAttributes width height margins
	= [JSONObject (widthfields ++ heightfields ++ marginfields)]
where
	widthfields = sizefields "width" "minWidth" "hwrap" "hflex" width
	heightfields = sizefields "height" "minHeight" "vwrap" "vflex" height
	
	sizefields fixedField minField wrapField flexField size = case size of
		Nothing								= []
		Just (Fixed pixels)					= [(fixedField,JSONInt  pixels)]
		Just (WrapContent 0)				= [(wrapField,JSONBool True)] //Don't include minField if it is 0
		Just (WrapContent minsize)			= [(wrapField,JSONBool True),(minField, JSONInt minsize)]
		Just (FillParent weight minsize)	= [(flexField,JSONInt weight)] ++ case minsize of
												ContentSize			= [(wrapField,JSONBool True)]
												FixedMinSize 0		= [] //Don't include minField if it is 0
												FixedMinSize pixels	= [(minField, JSONInt pixels)]
		
	marginfields = case margins of
		Nothing = []
		Just m	= [("margins",toJSON m)]
				
addXType :: !String ![JSONNode] -> [JSONNode]
addXType xtype [JSONObject fields: xs]	= [JSONObject [("xtype", JSONString xtype):fields] : xs]
addXType _ _							= abort "cannot add xtype"

justXType :: !String -> [JSONNode]
justXType xtype = [JSONObject [("xtype",JSONString xtype)]]

merge :: ![JSONNode] ![JSONNode] -> [JSONNode]
merge [JSONObject obja] [JSONObject objb]	= [JSONObject (obja ++ objb)]
merge _ _									= abort "two JSON objects required"

filterNull :: [(!String,JSONNode)] -> [(!String,!JSONNode)]
filterNull fields = [(field,node) \\ (field,node) <- fields | node <> JSONNull]

encodeTUIUpdates :: ![TUIUpdate] -> JSONNode
encodeTUIUpdates updates = JSONArray (flatten (map encodeTUIUpdate updates))

encodeTUIUpdate :: TUIUpdate -> [JSONNode]
encodeTUIUpdate (TUISetValue path value)		= [node path "setEditValue"		[value]]
encodeTUIUpdate (TUISetTaskId path taskId)		= [node path "setTaskId"	 	[JSONString taskId]]
encodeTUIUpdate (TUISetName path name)			= [node path "setName"			[JSONString name]]
encodeTUIUpdate (TUISetEnabled path enabled)	= [node path "setDisabled"		[JSONBool (not enabled)]]
encodeTUIUpdate (TUISetTitle path (title,icon))	= [node path "setTitle"			[JSONString title: maybe [] (\x -> [JSONString x]) icon]]
encodeTUIUpdate (TUISetSize path (Just (Fixed width)) (Just (Fixed height)))
												= [node path "setSize"			[JSONInt width, JSONInt height]]
encodeTUIUpdate (TUISetSize _ _ _)				= [] //Only set size with fixed values
encodeTUIUpdate (TUISetActiveTab path index)	= [node path "setActiveTab"		[JSONInt index]]
encodeTUIUpdate (TUIReplace path index def)		= [node path "replace" 			[JSONInt index,toJSON def]]
encodeTUIUpdate (TUIUpdate path def)			= [node path "update"			[toJSON def]]
encodeTUIUpdate	(TUIAdd path index def)			= [node path "insert"			[JSONInt index, toJSON def]]
encodeTUIUpdate (TUIRemove path index)			= [node path "remove"			[JSONInt index]]

node path method arguments
	= JSONObject [("path",JSONString path),("method",JSONString method),("arguments",JSONArray arguments)]