implementation module LayoutCombinators

import StdTuple, StdList, StdBool
import Maybe, Text, Tuple, Map, Util, HtmlUtil
import SystemTypes, UIDefinition

from StdFunc import o

from Task import :: TaskCompositionType, :: TaskCompositionType(..)
derive gEq TaskCompositionType

autoLayout :: Layout
autoLayout = {editor = autoEditorLayout, interact = autoInteractionLayout ,step = autoStepLayout, parallel = autoParallelLayout, final = autoFinalLayout}
/**
* The basic data layout groups the controls of a part of a compound datastructure in a fieldset
*/
autoEditorLayout :: UIDef -> UIDef
autoEditorLayout def=:{UIDef|attributes,controls}
	# def = autoReduce (decorateControls {UIDef|attributes = put TYPE_ATTRIBUTE "partial" attributes,controls=controls,actions=[]})
	//Attributes are discarded so merge with the reduced control
	= {UIDef|def & controls = [(c,mergeAttributes a attributes) \\ (c,a) <- def.UIDef.controls]}
/**
* The basic interaction layout simply decorates the prompt and merges it with the editor.
*/	
autoInteractionLayout :: UIDef UIDef -> UIDef
autoInteractionLayout prompt editor
	# def = mergeDefs (decoratePrompt prompt) editor
	= {UIDef|def & attributes = put TYPE_ATTRIBUTE "partial" def.UIDef.attributes}

autoStepLayout :: UIDef [UIAction]-> UIDef
autoStepLayout def=:{UIDef|attributes,controls,actions} stepActions
	//If the definition is not already of gorup type, add actions from this step
	//We set the type attribute to "group" because the step combinator binds the controls
	//in the definition together. If the step is made, all these controls will disappear together.
	| not (isGroup def)
		= {UIDef|def & actions = actions ++ stepActions, attributes = put TYPE_ATTRIBUTE "group" def.UIDef.attributes}
	| otherwise
		= def
where
	isGroup {UIDef|attributes} = case get TYPE_ATTRIBUTE attributes of Just "group" = True; _ = False;
/**
* The default parallel composition only merges the prompt of the parallel with
* the definitions of the constituents.
*/
autoParallelLayout :: UIDef [UIDef] -> UIDef
autoParallelLayout prompt defs
	| allPartial defs		//If we are composing partial user interfaces
		= partialMerge prompt defs
	| otherwise
		= groupedMerge prompt defs
where
	allPartial [] = True
	allPartial [d:ds] = case get TYPE_ATTRIBUTE d.UIDef.attributes of 
		Just "partial"	= allPartial ds
		Just "group"	= allPartial ds	//Experiment...
		_ = False;
/**
* Add actions and frame the content
*/
autoFinalLayout :: UIDef -> UIDef	//TODO: Size should be minWidth, but that doesn't seem to work yet...
autoFinalLayout def
	| singleControl def && isEmpty (actionsOf def)	= def
													= appControls finalTouch (autoReduce (decorateControls def))
where
	finalTouch = setWidth (ExactSize 600) o setFramed True

//Default reduction function that reduces the list of controls to a single control by
//wrapping them in a panel if necessary.
//If possible, actions are converted to menus and buttons and added to this panel
autoReduce :: UIDef -> UIDef
autoReduce def=:{UIDef|attributes,controls,actions}
	# (buttons,actions)	= actionsToButtons actions
	# controls			= addButtons buttons controls
	# (controls,actions) = case controls of
		
		[(UIPanel _ _ _ _,_)]		= (controls,actions)						//Do nothing if the controls already consist of a single panel
		[(c=:(UIContainer _ _ _ _),a)] = case titleAttr of
				Nothing			= (controls,actions)							//If we don't have a title, just leave the container be the single control
				(Just title)	= ([(setTitle title (toPanel c),a)],actions)	//Promote container to panel and set title
		[_] | isNothing titleAttr
			= (controls,actions)
		_					
			# (menus,actions)	= actionsToMenus actions
			= (wrapControls attributes menus controls,actions)
	= {UIDef|def & controls = controls, actions = actions, attributes = attributes}
where
	addButtons [] controls		= controls
	addButtons buttons controls	= controls ++ [(buttonPanel buttons,newMap)]

	titleAttr	= get TITLE_ATTRIBUTE attributes
	
	//Create the panel
	wrapControls attributes menus controls
		= [(UIPanel sizeOpts layoutOpts (map fst controls) panelOpts,newMap)]
	where
		tbar		= case menus of [] = Nothing; _ = Just menus
		
		sizeOpts  = {defaultSizeOpts & width = Just FlexSize, minWidth = Just WrapMin, height = Just WrapSize}
		layoutOpts = {defaultLayoutOpts & padding = Nothing}
		panelOpts = {UIPanelOpts|title = titleAttr,frame = False, tbar 
					,iconCls = iconClsAttr, baseCls = Nothing, bodyCls = Nothing}
		
		iconClsAttr	= fmap (\icon -> "icon-" +++ icon) (get ICON_ATTRIBUTE attributes)

fillReduce :: UIDef -> UIDef
fillReduce def = appControls fill (autoReduce (fillOutFlexibleControls def))

//This sets all controls which are suitable for flexing flexable.
//It makes no sense to flex checkboxes or vertically flexed string inputs,
//but text areas, grids and maps can be easily flexed

fillOutFlexibleControls	:: UIDef -> UIDef
fillOutFlexibleControls def=:{UIDef|controls} = {UIDef|def & controls= map (appFst fillIfPossible) controls}
where	
	fillIfPossible c=:(UIEditNote _ _) = fill c
	fillIfPossible c = c
	
//Add labels and icons to a set of controls if they have any of those attributes set
decorateControls :: UIDef -> UIDef
decorateControls def=:{UIDef|controls} = {UIDef|def & controls = mapLst decorateControl controls}
where
	mapLst f [] = []
	mapLst f [x] = [f True x]
	mapLst f [x:xs] = [f False x: mapLst f xs]
	
decorateControl :: Bool (!UIControl,!UIAttributes) -> (!UIControl,!UIAttributes)
decorateControl last (control,attributes)
	# mbLabel 	= get LABEL_ATTRIBUTE attributes
	# mbHint 	= get HINT_ATTRIBUTE attributes
	# mbValid	= get VALID_ATTRIBUTE attributes
	# mbError	= get ERROR_ATTRIBUTE attributes
	# hasMargin	= hasMargin control
	# noMargins	= noMarginControl control
	= case (mbLabel,mbHint,mbValid,mbError) of
		(Nothing,Nothing,Nothing,Nothing)	//Just set margins
			| hasMargin	= (control,attributes)
			# control = if noMargins (setMargins 0 0 0 0 control) (if last (setMargins 0 5 5 5 control) (setMargins 0 5 0 5 control))
			= (control,attributes)
		_									//Add decoration													
			# control = row (labelCtrl mbLabel ++ [control] ++ iconCtrl mbHint mbValid mbError) 
			# control = if noMargins (setMargins 0 0 0 0 control) (if last (setMargins 0 5 5 5 control) (setMargins 0 5 0 5 control))
			
			# attributes = foldr del attributes [LABEL_ATTRIBUTE,HINT_ATTRIBUTE,VALID_ATTRIBUTE,ERROR_ATTRIBUTE]
			= (control,attributes)
where
	row ctrls				= (setSize FlexSize WrapSize o setDirection Horizontal) (defaultContainer ctrls)
	
	labelCtrl (Just label)	= [setWidth (ExactSize 100) (stringDisplay label)]
	labelCtrl Nothing		= []
	
	iconCtrl (Just msg) _ _	= icon "icon-hint" msg
	iconCtrl _ (Just msg) _	= icon "icon-valid" msg
	iconCtrl _ _ (Just msg)	= icon "icon-invalid" msg
	iconCtrl _ _ _			= []
	
	icon cls tooltip		= [setLeftMargin 5 (UIIcon defaultSizeOpts {UIIconOpts|iconCls = cls, tooltip = Just tooltip})]

	hasMargin control = isJust (getSizeOpts control).UISizeOpts.margins

	noMarginControl	(UIPanel _ _ _ _)	= True
	noMarginControl	(UIGrid _ _ _)		= True
	noMarginControl	(UITree _ _)		= True
	noMarginControl _					= False


//Wrap the controls of the prompt in a container with a nice css class and add some bottom margin
decoratePrompt :: UIDef -> UIDef
decoratePrompt def=:{UIDef|controls=[]} = def //If there are no controls in the prompt def, don't create a container
decoratePrompt def=:{UIDef|controls}
	= {UIDef|def & controls = [(container,newMap)]}
where
	container = UIContainer sizeOpts defaultLayoutOpts (map fst controls) containerOpts
	sizeOpts = {defaultSizeOpts & margins = Just {top= 5, right = 5, bottom = 10, left = 5}, width = Just FlexSize, minWidth = Just WrapMin, height = Just WrapSize}
	containerOpts = {UIContainerOpts|baseCls=Just "itwc-prompt", bodyCls=Nothing}

//Merge the fragments of a composed interactive task into a single definition
partialMerge :: UIDef [UIDef] -> UIDef
partialMerge prompt defs
	# attributes =  put TYPE_ATTRIBUTE "partial" prompt.UIDef.attributes
	# controls = foldr (++) (decoratePrompt prompt).UIDef.controls [d.UIDef.controls \\ d <- defs]
	# actions = foldr (++) [] [d.UIDef.actions \\ d <- defs]
	//Determine title: if prompt has title use it, else combine titles 
	# attributes = case (get TITLE_ATTRIBUTE attributes, collectTitles defs) of
		(Just _,_) 	= attributes //Title already set, do nothing
		(_,[])		= attributes //None of the parts have a title, do nothing
		(_,titles)	= put TITLE_ATTRIBUTE (join ", " titles) attributes	//Set the joined titles
	= {UIDef|attributes = attributes, controls = controls, actions = actions}
where
	collectTitles defs = [title \\ Just title <- [get TITLE_ATTRIBUTE d.UIDef.attributes \\ d <- defs]]


//Minimal merge, ignore the prompt, only reduce all parts
minimalMerge :: ParallelMerger
minimalMerge = merge
where
	merge _ defs
		# attributes	= put TYPE_ATTRIBUTE "multi" newMap
		# controls		= foldr (++) [] [d.UIDef.controls \\ d <- defs]
		# actions		= foldr (++) [] [d.UIDef.actions \\ d <- defs]
		= {UIDef|attributes = attributes, controls = controls, actions = actions}
	
//Create groups for all definitions in the list
groupedMerge :: ParallelMerger
groupedMerge = merge
where
	merge prompt defs
		# groups		= map (autoReduce o decorateControls) defs
		# attributes	= put TYPE_ATTRIBUTE "multi" prompt.UIDef.attributes
		# controls		= foldr (++) (decoratePrompt prompt).UIDef.controls [d.UIDef.controls \\ d <- groups]
		# actions		= foldr (++) [][d.UIDef.actions \\ d <- groups]
		= {UIDef|attributes = attributes, controls = controls, actions = actions}

sideMerge :: UISide Int ParallelMerger -> ParallelMerger
sideMerge side size restMerge = merge
where
	merge prompt []		= prompt
	merge prompt parts
		# (direction,sidePart,restParts) = case side of
			TopSide		= (Vertical, hd parts,tl parts)
			RightSide	= (Horizontal, last parts,init parts)
			BottomSide	= (Vertical, last parts,init parts)
			LeftSide	= (Horizontal, hd parts, tl parts)
		# restPart		= fillReduce (restMerge prompt restParts)
		# sidePart		= fillReduce sidePart
		# sideUI		= (ifH direction (setWidth (ExactSize size)) (setHeight (ExactSize size))) (fill (uiOf sidePart))
		# restUI		= fill (uiOf restPart)
		# ui			= (fill o setDirection direction) (defaultContainer (ifTL side [sideUI,restUI] [restUI,sideUI]))
		= {UIDef|controls = [(ui,newMap)],actions = sidePart.UIDef.actions ++ restPart.UIDef.actions, attributes = prompt.UIDef.attributes}

	ifTL TopSide a b = a
	ifTL LeftSide a b = a
	ifTL _ a b = b
	
	ifH Horizontal a b = a
	ifH _ a b = b
	
splitMerge :: UIDirection -> ParallelMerger
splitMerge dir = merge
where
	merge prompt parts = prompt
	/*
		# (parts1,parts2)		= splitFun parts
		# side1 = merger1 prompt parts1
		# side2 = merger2 prompt parts2
		# ui1 = defaultContainer (map fst side1.UIDef.controls)
		# ui2 = defaultContainer (map fst side2.UIDef.controls)
		# (uis,dir) = case side of
			TopSide		= ([(fillWidth o fixedHeight size) ui1,fill ui2],Vertical)
			RightSide	= ([fill ui2,(fixedWidth size o fillHeight) ui1],Horizontal)
			BottomSide	= ([fill ui2,(fillWidth o fixedHeight size) ui1],Vertical)
			LeftSide	= ([(fixedWidth size o fillHeight) ui1,fill ui2],Horizontal)
		# ui = (fill o setDirection dir) (defaultContainer uis)
		= {UIDef|attributes = prompt.UIDef.attributes, controls = [(ui,newMap)], actions = side1.UIDef.actions ++ side2.UIDef.actions} 
	*/

tabbedMerge :: ParallelMerger
tabbedMerge = merge
where
	merge prompt defs
		# attributes				= prompt.UIDef.attributes
		# (activeIndex,activeDef)	= findActive defs	
		# (tabBar,actions)			= mkTabs activeIndex defs	
		# tabContent				= maybe [(defaultPanel [],newMap)]
			(\d -> (tweakUI (setPadding 0 0 0 0) (fillReduce (tweakAttr (del TITLE_ATTRIBUTE) d))).UIDef.controls) (fmap removeCloseAction activeDef)
		# controls					= [(defaultContainer (map fst (decoratePrompt prompt).UIDef.controls ++ [tabBar] ++ map fst tabContent),newMap)]
		= {UIDef|attributes = attributes, controls = controls, actions = []}

	findActive defs = find 0 (0,Nothing) defs
	where
		find i bestSoFar [] = bestSoFar
		find i (_,Nothing) [d:ds]	= find (i+1) (i,Just d) ds
		find i bestSoFar=:(_,Just best) [d:ds]	= if (later d best) (find (i+1) (i,Just d) ds) (find (i+1) bestSoFar ds)
		
		later a b = case (get LAST_EVENT_ATTRIBUTE a.UIDef.attributes,get LAST_EVENT_ATTRIBUTE b.UIDef.attributes) of
			(Just ta,Just tb)
				| ta == tb	//If the last event time is the same, then we compare creation times to which tab is newest
					= case (get CREATED_AT_ATTRIBUTE a.UIDef.attributes,get CREATED_AT_ATTRIBUTE b.UIDef.attributes) of
						(Just ca,Just cb)	= toInt ca > toInt cb
						_					= False
				| otherwise	
					= toInt ta > toInt tb
			(Just _,Nothing)	= True
			_					= False
			
		
	mkTabs active defs
		# (tabs,actions) = unzip [mkTab (i == active) d \\ d <- defs & i <- [0..]]
		= ((setDirection Horizontal o setHeight WrapSize o setBaseCls "x-tab-bar") (defaultContainer tabs),foldr (++) [] actions)

	mkTab active def=:{UIDef|attributes,actions}
		# taskId				= get TASK_ATTRIBUTE attributes
		# iconCls				= fmap (\i -> "icon-" +++ i) (get ICON_ATTRIBUTE attributes)
		# text					= fromMaybe "Untitled" (get TITLE_ATTRIBUTE attributes)
		# (close,actions)		= searchCloseAction actions
		# tabOpts				= {text = text ,focusTaskId = taskId,active = active,closeTaskId = close,iconCls=iconCls}
		= (UITab defaultSizeOpts tabOpts, if active actions [])
	
	searchCloseAction [] = (Nothing,[])
	searchCloseAction [{taskId,action=ActionClose,enabled}:as] = (if enabled (Just taskId) Nothing,as)
	searchCloseAction [a:as] = let (mbtask,as`) = searchCloseAction as in (mbtask,[a:as`])

	removeCloseAction def=:{UIDef|actions} = {UIDef|def & actions= filter notClose actions}
	where
		notClose {UIAction|action=ActionClose}	= False
		notClose _								= True
		
hideLayout :: Layout
hideLayout =
	{ editor	= \def				-> {UIDef|def & controls = []}
	, interact	= \prompt editor	-> {UIDef|mergeDefs prompt editor & controls = []}
	, step		= \def actions		-> {UIDef|def & controls = [], actions = def.UIDef.actions ++ actions}
	, parallel	= \prompt defs		-> {UIDef|foldr mergeDefs {UIDef|controls=[],actions=[],attributes = newMap} [prompt:defs] & controls = []}
	, final		= \def				-> {UIDef|def & controls = []}
	}
		
customMergeLayout :: ParallelMerger -> Layout
customMergeLayout merger = {autoLayout & parallel = merger}

partLayout :: Int -> Layout
partLayout idx = {autoLayout & parallel = layout}
where	
	layout prompt parts
		| idx < length parts
			# controls	= (parts !! idx).UIDef.controls
			# attributes = foldr mergeAttributes prompt.UIDef.attributes [d.UIDef.attributes \\ d <- parts]
			# actions = foldr (++) [] [d.UIDef.actions \\ d <- parts]
			= {UIDef|attributes=attributes,controls=controls,actions=actions}
		| otherwise
			= autoParallelLayout prompt parts

updSizeOpts :: (UISizeOpts -> UISizeOpts) UIControl -> UIControl
updSizeOpts f (UIViewString	sOpts vOpts)			= (UIViewString	(f sOpts) vOpts)
updSizeOpts f (UIViewHtml sOpts vOpts)				= (UIViewHtml (f sOpts) vOpts)
updSizeOpts f (UIViewDocument sOpts vOpts)			= (UIViewDocument (f sOpts) vOpts)
updSizeOpts f (UIViewCheckbox sOpts vOpts)			= (UIViewCheckbox (f sOpts) vOpts)
updSizeOpts f (UIViewSlider sOpts vOpts opts)		= (UIViewSlider (f sOpts) vOpts opts)
updSizeOpts f (UIViewProgress sOpts vOpts opts)		= (UIViewProgress (f sOpts) vOpts opts)
updSizeOpts f (UIEditString	sOpts eOpts)			= (UIEditString	(f sOpts) eOpts)
updSizeOpts f (UIEditNote sOpts eOpts)				= (UIEditNote (f sOpts) eOpts)
updSizeOpts f (UIEditPassword sOpts eOpts)			= (UIEditPassword (f sOpts) eOpts)
updSizeOpts f (UIEditInt sOpts eOpts)				= (UIEditInt (f sOpts) eOpts)
updSizeOpts f (UIEditDecimal sOpts eOpts)			= (UIEditDecimal (f sOpts) eOpts)
updSizeOpts f (UIEditCheckbox sOpts eOpts)			= (UIEditCheckbox (f sOpts) eOpts)
updSizeOpts f (UIEditSlider sOpts eOpts opts)		= (UIEditSlider (f sOpts) eOpts opts)
updSizeOpts f (UIEditDate sOpts eOpts)				= (UIEditDate (f sOpts) eOpts)
updSizeOpts f (UIEditTime sOpts eOpts)				= (UIEditTime (f sOpts) eOpts)
updSizeOpts f (UIEditDocument sOpts eOpts)			= (UIEditDocument (f sOpts) eOpts)
updSizeOpts f (UIEditButton	sOpts eOpts opts)		= (UIEditButton	(f sOpts) eOpts opts)
updSizeOpts f (UIEditGoogleMap sOpts eOpts opts)	= (UIEditGoogleMap (f sOpts) eOpts opts)
updSizeOpts f (UIDropdown sOpts cOpts)				= (UIDropdown (f sOpts) cOpts)
updSizeOpts f (UIGrid sOpts cOpts opts)				= (UIGrid (f sOpts) cOpts opts)
updSizeOpts f (UITree sOpts cOpts)					= (UITree (f sOpts) cOpts)
updSizeOpts f (UIActionButton sOpts aOpts opts)		= (UIActionButton (f sOpts) aOpts opts)	
updSizeOpts f (UIMenuButton	sOpts opts)				= (UIMenuButton	(f sOpts) opts)	
updSizeOpts f (UILabel sOpts opts)					= (UILabel (f sOpts) opts)
updSizeOpts f (UIIcon sOpts opts)					= (UIIcon (f sOpts) opts)
updSizeOpts f (UITab sOpts opts)					= (UITab (f sOpts) opts)
updSizeOpts f (UITasklet sOpts opts)				= (UITasklet (f sOpts) opts)
updSizeOpts f (UIContainer sOpts lOpts items opts)	= (UIContainer (f sOpts) lOpts items opts)
updSizeOpts f (UIPanel sOpts lOpts items opts)		= (UIPanel (f sOpts) lOpts items opts)
updSizeOpts f (UIFieldSet sOpts lOpts items opts)	= (UIFieldSet (f sOpts) lOpts items opts)
updSizeOpts f (UIWindow	sOpts lOpts items opts)		= (UIWindow	(f sOpts) lOpts items opts)

getSizeOpts :: UIControl -> UISizeOpts
getSizeOpts (UIViewString	sOpts vOpts)			= sOpts
getSizeOpts (UIViewHtml sOpts vOpts)				= sOpts
getSizeOpts (UIViewDocument sOpts vOpts)			= sOpts
getSizeOpts (UIViewCheckbox sOpts vOpts)			= sOpts
getSizeOpts (UIViewSlider sOpts vOpts opts)			= sOpts
getSizeOpts (UIViewProgress sOpts vOpts opts)		= sOpts
getSizeOpts (UIEditString	sOpts eOpts)			= sOpts
getSizeOpts (UIEditNote sOpts eOpts)				= sOpts
getSizeOpts (UIEditPassword sOpts eOpts)			= sOpts
getSizeOpts (UIEditInt sOpts eOpts)					= sOpts
getSizeOpts (UIEditDecimal sOpts eOpts)				= sOpts
getSizeOpts (UIEditCheckbox sOpts eOpts)			= sOpts
getSizeOpts (UIEditSlider sOpts eOpts opts)			= sOpts
getSizeOpts (UIEditDate sOpts eOpts)				= sOpts
getSizeOpts (UIEditTime sOpts eOpts)				= sOpts
getSizeOpts (UIEditDocument sOpts eOpts)			= sOpts
getSizeOpts (UIEditButton sOpts eOpts opts)			= sOpts
getSizeOpts (UIEditGoogleMap sOpts eOpts opts)		= sOpts
getSizeOpts (UIDropdown sOpts cOpts)				= sOpts
getSizeOpts (UIGrid sOpts cOpts opts)				= sOpts
getSizeOpts (UITree sOpts cOpts)					= sOpts
getSizeOpts (UIActionButton sOpts aOpts opts)		= sOpts	
getSizeOpts (UIMenuButton	sOpts opts)				= sOpts	
getSizeOpts (UILabel sOpts opts)					= sOpts
getSizeOpts (UIIcon sOpts opts)						= sOpts
getSizeOpts (UITab sOpts opts)						= sOpts
getSizeOpts (UITasklet sOpts opts)					= sOpts
getSizeOpts (UIContainer sOpts lOpts items opts)	= sOpts
getSizeOpts (UIPanel sOpts lOpts items opts)		= sOpts
getSizeOpts (UIFieldSet sOpts lOpts items opts)		= sOpts
getSizeOpts (UIWindow	sOpts lOpts items opts)		= sOpts


setSize :: !UISize !UISize !UIControl -> UIControl
setSize width height ctrl = updSizeOpts (\opts -> {UISizeOpts| opts & width = Just width, height = Just height}) ctrl

setWidth :: !UISize !UIControl -> UIControl
setWidth width ctrl = updSizeOpts (\opts -> {UISizeOpts| opts & width = Just width}) ctrl

setHeight :: !UISize !UIControl -> UIControl
setHeight height ctrl = updSizeOpts (\opts -> {UISizeOpts| opts & height = Just height}) ctrl

setMinSize :: !UIMinSize !UIMinSize !UIControl -> UIControl
setMinSize width height ctrl = updSizeOpts (\opts -> {UISizeOpts| opts & minWidth = Just width, minHeight = Just height}) ctrl

setMinWidth :: !UIMinSize !UIControl -> UIControl
setMinWidth width ctrl = updSizeOpts (\opts -> {UISizeOpts| opts & minWidth = Just width}) ctrl

setMinHeight :: !UIMinSize !UIControl -> UIControl
setMinHeight height ctrl = updSizeOpts (\opts -> {UISizeOpts| opts & minHeight = Just height}) ctrl

fill :: !UIControl -> UIControl
fill ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & width = Just FlexSize, height = Just FlexSize}) ctrl

fillHeight :: !UIControl -> UIControl
fillHeight ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & height = Just FlexSize}) ctrl

fillWidth :: !UIControl -> UIControl
fillWidth ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & width = Just FlexSize}) ctrl

fixedHeight	:: !Int !UIControl -> UIControl
fixedHeight size ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & height = Just (ExactSize size)}) ctrl

fixedWidth :: !Int !UIControl -> UIControl
fixedWidth size ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & width = Just (ExactSize size)}) ctrl

wrapHeight :: !UIControl -> UIControl
wrapHeight ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & height = Just WrapSize}) ctrl
 
wrapWidth :: !UIControl -> UIControl
wrapWidth ctrl = updSizeOpts (\opts -> {UISizeOpts|opts & width = Just WrapSize}) ctrl

setMargins :: !Int !Int !Int !Int !UIControl -> UIControl
setMargins top right bottom left ctrl
	= updSizeOpts (\opts -> {UISizeOpts|opts & margins = Just {top = top, right = right, bottom = bottom, left = left}}) ctrl

setTopMargin :: !Int !UIControl -> UIControl
setTopMargin top ctrl = updSizeOpts f ctrl
where
	f opts = case opts.margins of
		Nothing = {UISizeOpts|opts & margins = Just {top = top, right = 0, bottom = 0, left = 0}}
		Just m	= {UISizeOpts|opts & margins = Just {m & top = top}}

setRightMargin	:: !Int !UIControl -> UIControl
setRightMargin right ctrl = updSizeOpts f ctrl
where
	f opts = case opts.margins of
		Nothing = {UISizeOpts|opts & margins = Just {top = 0, right = right, bottom = 0, left = 0}}
		Just m	= {UISizeOpts|opts & margins = Just {m & right = right}}
	
setBottomMargin	:: !Int !UIControl -> UIControl
setBottomMargin bottom ctrl = updSizeOpts f ctrl
where
	f opts = case opts.margins of
		Nothing = {UISizeOpts|opts & margins = Just {top = 0, right = 0, bottom = bottom, left = 0}}
		Just m	= {UISizeOpts|opts & margins = Just {m & bottom = bottom}}
	
setLeftMargin :: !Int !UIControl -> UIControl
setLeftMargin left ctrl = updSizeOpts f ctrl
where
	f opts = case opts.margins of
		Nothing = {UISizeOpts|opts & margins = Just {top = 0, right = 0, bottom = 0, left = left}}
		Just m	= {UISizeOpts|opts & margins = Just {m & left = left}}

setPadding :: !Int !Int !Int !Int !UIControl -> UIControl
setPadding top right bottom left (UIContainer sOpts lOpts items opts)
	= UIContainer sOpts {UILayoutOpts|lOpts & padding = Just {top=top,right=right,bottom=bottom,left=left}} items opts
setPadding top right bottom left (UIPanel sOpts lOpts items opts)
	= UIPanel sOpts {UILayoutOpts|lOpts & padding = Just {top=top,right=right,bottom=bottom,left=left}} items opts
setPadding top right bottom left (UIWindow sOpts lOpts items opts)
	= UIWindow sOpts {UILayoutOpts|lOpts & padding = Just {top=top,right=right,bottom=bottom,left=left}} items opts
setPadding top right bottom left ctrl = ctrl

setTitle :: !String !UIControl -> UIControl
setTitle title (UIPanel sOpts lOpts items opts) = UIPanel sOpts lOpts items {UIPanelOpts|opts & title = Just title}
setTitle title (UIWindow sOpts lOpts items opts) = UIWindow sOpts lOpts items {UIWindowOpts|opts & title = Just title}
setTitle title (UIFieldSet sOpts lOpts items opts) = UIFieldSet sOpts lOpts items {UIFieldSetOpts|opts & title = title}
setTitle title ctrl = ctrl

setFramed :: !Bool !UIControl -> UIControl
setFramed frame (UIPanel sOpts lOpts items opts) = UIPanel sOpts lOpts items {UIPanelOpts|opts & frame = frame}
setFramed frame (UIWindow sOpts lOpts items opts) = UIWindow sOpts lOpts items {UIWindowOpts|opts & frame = frame}
setFramed frame ctrl = ctrl

setIconCls :: !String !UIControl -> UIControl
setIconCls iconCls (UIActionButton sOpts aOpts opts) = UIActionButton sOpts aOpts {UIButtonOpts|opts & iconCls = Just iconCls}
setIconCls iconCls (UIMenuButton sOpts opts) = UIMenuButton sOpts {UIMenuButtonOpts|opts & iconCls = Just iconCls}
setIconCls iconCls (UIIcon sOpts opts) = UIIcon sOpts  {UIIconOpts|opts & iconCls = iconCls}
setIconCls iconCls (UITab sOpts opts) = UITab sOpts  {UITabOpts|opts & iconCls = Just iconCls}
setIconCls iconCls (UIPanel sOpts lOpts items opts) = UIPanel sOpts lOpts items {UIPanelOpts|opts & iconCls = Just iconCls}
setIconCls iconCls (UIWindow sOpts lOpts items opts) = UIWindow sOpts lOpts items {UIWindowOpts|opts & baseCls = Just iconCls}
setIconCls iconCls ctrl = ctrl

setBaseCls :: !String !UIControl -> UIControl
setBaseCls baseCls (UIContainer sOpts lOpts items opts) = UIContainer sOpts lOpts items {UIContainerOpts|opts & baseCls = Just baseCls}
setBaseCls baseCls (UIPanel sOpts lOpts items opts) = UIPanel sOpts lOpts items {UIPanelOpts|opts & baseCls = Just baseCls}
setBaseCls baseCls (UIWindow sOpts lOpts items opts) = UIWindow sOpts lOpts items {UIWindowOpts|opts & baseCls = Just baseCls}
setBaseCls baseCls ctrl = ctrl

setDirection :: !UIDirection !UIControl -> UIControl
setDirection dir (UIContainer sOpts lOpts items opts)	= UIContainer sOpts {lOpts & direction = dir} items opts
setDirection dir (UIPanel sOpts lOpts items opts)		= UIPanel sOpts {lOpts & direction = dir} items opts
setDirection dir (UIWindow sOpts lOpts items opts)		= UIWindow sOpts {lOpts & direction = dir} items opts
setDirection dir ctrl									= ctrl

setHalign :: !UIHAlign !UIControl -> UIControl
setHalign align (UIContainer sOpts lOpts items opts)	= UIContainer sOpts {lOpts & halign = align} items opts
setHalign align (UIPanel sOpts lOpts items opts)		= UIPanel sOpts {lOpts & halign = align} items opts
setHalign align (UIWindow sOpts lOpts items opts)		= UIWindow sOpts {lOpts & halign = align} items opts
setHalign align ctrl									= ctrl

setValign :: !UIVAlign !UIControl -> UIControl
setValign align (UIContainer sOpts lOpts items opts)	= UIContainer sOpts {lOpts & valign = align} items opts
setValign align (UIPanel sOpts lOpts items opts)		= UIPanel sOpts {lOpts & valign = align} items opts
setValign align (UIWindow sOpts lOpts items opts)		= UIWindow sOpts {lOpts & valign = align} items opts
setValign align ctrl									= ctrl

//Container coercion
toPanel	:: !UIControl -> UIControl
//Panels are left untouched
toPanel ctrl=:(UIPanel _ _ _ _)		= ctrl
//Containers are coerced to panels
toPanel ctrl=:(UIContainer sOpts lOpts items {UIContainerOpts|baseCls,bodyCls})
	= UIPanel sOpts lOpts items {UIPanelOpts|title=Nothing,frame=False,tbar=Nothing,iconCls=Nothing,baseCls=baseCls,bodyCls=bodyCls}
//Uncoercable items are wrapped in a panel instead
toPanel ctrl = defaultPanel [ctrl]

toContainer :: !UIControl -> UIControl
//Containers are left untouched
toContainer ctrl=:(UIContainer _ _ _ _) = ctrl
//Panels can be coerced to containers
toContainer ctrl=:(UIPanel sOpts lOpts items {UIPanelOpts|baseCls,bodyCls})
	= UIContainer sOpts lOpts items {UIContainerOpts|baseCls=baseCls,bodyCls=bodyCls}
//Uncoercable items are wrapped in a container instead
toContainer ctrl = defaultContainer [ctrl]
	
//GUI combinators						
hjoin :: ![UIControl] -> UIControl
hjoin items = UIContainer defaultSizeOpts {defaultLayoutOpts & direction = Horizontal, halign = AlignLeft, valign = AlignMiddle} items {UIContainerOpts|baseCls=Nothing,bodyCls=Nothing}

vjoin :: ![UIControl] -> UIControl
vjoin items = UIContainer defaultSizeOpts {defaultLayoutOpts & direction = Vertical, halign = AlignLeft, valign = AlignTop} items {UIContainerOpts|baseCls=Nothing,bodyCls=Nothing}
						
//Container operations
addItemToUI :: (Maybe Int) UIControl UIControl -> UIControl
addItemToUI mbIndex item ctrl = case ctrl of
	UIContainer sOpts lOpts items opts	= UIContainer sOpts lOpts (add mbIndex item items) opts
	UIPanel sOpts lOpts items opts		= UIPanel sOpts lOpts (add mbIndex item items) opts
	UIWindow sOpts lOpts items opts		= UIWindow sOpts lOpts (add mbIndex item items) opts
	_									= ctrl
where
	add Nothing item items		= items ++ [item]
	add (Just pos) item items	= take pos items ++ [item] ++ drop pos items
	
getItemsOfUI :: UIControl -> [UIControl]
getItemsOfUI (UIContainer _ _ items _)	= items
getItemsOfUI (UIPanel _ _ items _)		= items
getItemsOfUI (UIWindow _ _ items _)	= items
getItemsOfUI ctrl						= [ctrl]
	
setItemsOfUI :: [UIControl] UIControl -> UIControl
setItemsOfUI items (UIContainer sOpts lOpts _ opts)	= UIContainer sOpts lOpts items opts
setItemsOfUI items (UIPanel sOpts lOpts _ opts)		= UIPanel sOpts lOpts items opts
setItemsOfUI items (UIWindow sOpts lOpts _ opts)		= UIWindow sOpts lOpts items opts
setItemsOfUI items ctrl								= ctrl

//Container for a set of horizontally layed out buttons
buttonPanel	:: ![UIControl] -> UIControl	
buttonPanel buttons
	= (/*setBaseCls "x-toolbar" o*/ wrapHeight o fillWidth o setPadding 2 2 2 0 o setDirection Horizontal o setHalign AlignRight) (defaultContainer buttons)

actionsToButtons :: ![UIAction] -> (![UIControl],![UIAction])
actionsToButtons [] = ([],[])
actionsToButtons [a=:{taskId,action,enabled}:as]
	# (buttons,actions)	= actionsToButtons as 
	= case split "/" (actionName action) of
		//Action name consist of only one part -> make a button
		[name]	= ([mkButton taskId action enabled : buttons],actions)
		//Action name consists of multiple parts -> pass through
		_		= (buttons,[a:actions])
where
	mkButton taskId action enabled
		= UIActionButton defaultSizeOpts {UIActionOpts|taskId = toString taskId,actionId= actionName action}
			{UIButtonOpts|text = Just (actionName action), iconCls = Just (actionIcon action), disabled = not enabled}
			
actionsToMenus :: ![UIAction] -> (![UIControl],![UIAction])
actionsToMenus actions = makeMenus [] actions
where
	makeMenus :: [UIControl] [UIAction] -> ([UIControl],[UIAction])
	makeMenus menus []	= (menus,[])	
	makeMenus menus [a=:{taskId,action,enabled}:as] = makeMenus (addToMenus (split "/" (actionName action)) taskId action enabled menus) as
	
	addToMenus [main:item] taskId action enabled [] //Create menu
		= [createButton main item taskId action enabled]
	addToMenus [main:item] taskId action enabled [m=:(UIMenuButton sOpts opts):ms] //Add to existing menu if it exists
		| opts.UIMenuButtonOpts.text == Just main //Found!
			= [UIMenuButton sOpts {UIMenuButtonOpts|opts & menu = addToItems item taskId action enabled opts.UIMenuButtonOpts.menu}:ms]
		| otherwise
			= [m:addToMenus [main:item] taskId action enabled ms]
			
	addToItems [item:sub] taskId action enabled [] //Create item
		= [createItem item sub taskId action enabled]
	addToItems [item:sub] taskId action enabled [i:is]
		| itemText i == item
			| isEmpty sub	//Duplicate item (just add it)
				= [i,createItem item sub taskId action enabled:is]
			| otherwise		//Add to the found item
				= [addToItem sub taskId action enabled i:is]
		| otherwise
			= [i:addToItems [item:sub] taskId action enabled is]
	addToItems [] _ _ _ _
		= []

	itemText (UIActionMenuItem _ {UIButtonOpts|text})	= fromMaybe "" text
	itemText (UISubMenuItem {UIMenuButtonOpts|text})	= fromMaybe "" text
	itemText _					= ""
	
	createButton item sub taskId action enabled
		= UIMenuButton defaultSizeOpts
			{UIMenuButtonOpts
			|text = Just item
			,iconCls = Just (icon item)
			,disabled	= if (isEmpty sub) (not enabled) False
			,menu = addToItems sub taskId action enabled []
			}
	createItem item [] taskId action enabled //Action item
		= UIActionMenuItem
			{UIActionOpts|taskId=taskId,actionId=actionName action}
			{UIButtonOpts|text=Just item,iconCls = Just (icon item), disabled = not enabled}
	createItem item sub taskId action enabled //Sub item
		= UISubMenuItem
				{ text = Just item
				, iconCls = Just (icon item)
				, disabled = False
				, menu = addToItems sub taskId action enabled []
				}
		
	addToItem sub taskId action enabled item=:(UISubMenuItem opts=:{UIMenuButtonOpts|menu})
		= UISubMenuItem {UIMenuButtonOpts|opts & menu = addToItems sub taskId action enabled menu}
	
	icon name = "icon-" +++ (replaceSubString " " "-" (toLowerCase name))

uiOf :: UIDef -> UIControl
uiOf {UIDef|controls} = case controls of
	[(c,_):_]	= c
	[]			= stringDisplay "-"

singleControl :: UIDef -> Bool
singleControl {UIDef|controls=[_]}	= True
singleControl _						= False

actionsOf :: UIDef -> [UIAction]
actionsOf {UIDef|actions} = actions

attributesOf :: UIDef -> UIAttributes
attributesOf {UIDef|attributes} = attributes

mergeAttributes :: UIAttributes UIAttributes -> UIAttributes
mergeAttributes attr1 attr2 = foldr (\(k,v) attr -> put k v attr) attr1 (toList attr2)

mergeDefs :: UIDef UIDef -> UIDef
mergeDefs {UIDef|controls=ct1,actions=ac1,attributes=at1} {UIDef|controls=ct2,actions=ac2,attributes=at2}
	= {UIDef|controls = ct1 ++ ct2, actions = ac1 ++ ac2, attributes = mergeAttributes at1 at2}

appControls :: (UIControl -> UIControl) UIDef -> UIDef
appControls f def=:{UIDef|controls} = {UIDef|def & controls = [(f c,a) \\ (c,a) <- controls]}

appDeep	:: [Int] (UIControl -> UIControl) UIControl -> UIControl
appDeep [] f ctrl = f ctrl
appDeep [s:ss] f ctrl = case ctrl of
	(UIContainer sOpts lOpts items cOpts) 	= UIContainer sOpts lOpts (update items) cOpts
	(UIPanel sOpts lOpts items pOpts)		= UIPanel sOpts lOpts (update items) pOpts
	(UIWindow sOpts lOpts items wOpts)		= UIWindow sOpts lOpts (update items) wOpts
	_										= ctrl
where
	update items = [if (i == s) (appDeep ss f item) item \\ item <- items & i <- [0..]]

tweakUI :: (UIControl -> UIControl) UIDef -> UIDef
tweakUI f def=:{UIDef|controls} = {UIDef|def & controls = [(f c,a) \\ (c,a) <- controls]}

tweakAttr :: (UIAttributes -> UIAttributes) UIDef -> UIDef
tweakAttr f def=:{UIDef|attributes} = {UIDef|def & attributes = f attributes}