implementation module iTasks.UI.Layout.Common

import StdEnv
import StdOverloadedList => qualified All, Sum, Any, Last

import iTasks.UI.Layout, iTasks.UI.Layout.Default
import iTasks.UI.Definition
import iTasks.UI.Tune
import iTasks.WF.Tasks.Interaction
import Data.List, Text.GenJSON, StdString, Data.GenEq
import Data.Monoid
import qualified Data.Map as DM
import Control.Monad
import Data.Map.GenJSON
import Data.Maybe
from Data.Func import $
from iTasks.Internal.TaskEval import :: TaskEvalOpts(..), :: TaskTime
import qualified Data.Foldable
import qualified Text as T
from Text import class Text (startsWith, dropChars), instance Text String

addCSSClass :: String -> LayoutRule
addCSSClass className = modifyUIAttributes (SelectKeys ["class"]) add
where
	add attr = 'DM'.put "class" (maybe
		(JSONArray [JSONString className])
		(\v->case v of
			(JSONArray classNames) = JSONArray (classNames ++ [JSONString className])
			(JSONString s) = JSONArray [JSONString s, JSONString className]
		) ('DM'.get "class" attr)) attr

removeCSSClass :: String -> LayoutRule
removeCSSClass className = modifyUIAttributes (SelectKeys ["class"]) remove
where
	remove attr = case 'DM'.get "class" attr of
		(?Just (JSONArray items)) = 'DM'.put "class" (JSONArray [item \\ item=:(JSONString name) <- items | name <> className]) attr
		_ = attr

arrangeWithTabs :: Bool -> LayoutRule
arrangeWithTabs closeable = layoutSubUIs
	(SelectAND (SelectByPath []) (SelectOR (SelectByClass "parallel") (SelectByClass "parallel-actions")))
	(sequenceLayouts
		[setUIType UITabSet
		,layoutSubUIs SelectChildren scrollContent
		,modifyUIAttributes (SelectKeys ["class"]) (removeClassAttr "parallel-actions")
		:if closeable [moveCloseToTab] []
		])
where
	moveCloseToTab = layoutSubUIs //Only on children directly containing a close action
		(SelectAND
			SelectChildren
			(SelectByContains
				(SelectAND
					(SelectByDepth 2)
					selectCloseButton
				)
			)
		)
		reallyMoveCloseToTab

	selectCloseButton = SelectAND
		(SelectByType UIAction)
		(SelectByAttribute "actionId" ((==) (JSONString "Close")))

	reallyMoveCloseToTab = sequenceLayouts
		[moveSubUIs (SelectAND SelectChildren selectCloseButton) [] 0
		,layoutSubUIs (SelectByPath [0]) (modifyUIAttributes SelectAll
			(\ui->case 'DM'.get "taskId" ui of
				?None = ui
				?Just tid = 'DM'.put "closeTaskId" tid ui))
		,copySubUIAttributes (SelectKeys ["closeTaskId"]) [0] []
		,removeSubUIs (SelectByPath [0])
		]

arrangeWithHeader :: !Int -> LayoutRule
arrangeWithHeader index = setAside "itasks-headerbar" index TopSide False

arrangeWithSideBar :: !Int !UISide !Bool -> LayoutRule
arrangeWithSideBar index side resize = setAside ("itasks-sidebar" +++ suffix side) index side resize
where
	suffix TopSide = "-top"
	suffix BottomSide = "-bottom"
	suffix LeftSide = "-left"
	suffix RightSide = "-right"

setAside className index side resize = sequenceLayouts
	[wrapUI UIPanel //Push the current container down a level
	,copySubUIAttributes SelectAll [0] [] //Keep the attributes from the original UI
	,addCSSClass className
	,moveSubUIs (SelectByPath [0,index]) [] sidePanelIndex
	,layoutSubUIs (SelectByPath [sidePanelIndex]) (sequenceLayouts
		(if resize
		[wrapUI UIPanel
		,addCSSClass "aside"
		,setUIAttributes (resizableAttr (resizers side))
		]
		[addCSSClass "aside"]
		)
	)
	]
where
	sidePanelIndex = if (side === TopSide || side === LeftSide) 0 1

	resizers TopSide = [BottomSide]
	resizers BottomSide = [TopSide]
	resizers LeftSide = [RightSide]
	resizers RightSide = [LeftSide]

arrangeAsMenu :: ![!Menu] -> LayoutRule
arrangeAsMenu menus
	//Only apply to a top-level step
	= sequenceLayouts $
		[ layoutSubUIs (SelectAND (SelectByPath []) (SelectByClass "step-actions"))
			$ sequenceLayouts
			// Insert a toolbar which contains all menus and wrap it in a panel.
			[ wrapUI UIPanel
			, insertChildUI 0
				(uic UIToolBar
					[ uia UIMenu $ textAttr $
						if (startsWith "/" menuName)
							(dropChars 1 menuName)
							("INVALID MENU NAME, name does not start with /. ")
					\\ (Menu menuName) <!- menus
					]
				)
			// Move the menu items to the corresponding menu and edit the layout of the menu items.
			: Map (\(i,m) -> sequenceLayouts [layoutMenuItems (i, m), moveMenuItems (i, m)]) $ Zip2 [!0..] menus
			]
	]
where
	moveMenuItems :: (!Int, !Menu) -> LayoutRule
	moveMenuItems (index,menu) = moveSubUIs (matchingMenuItemsSelector menu) [0,index] 0

	layoutMenuItems  :: (!Int, !Menu) -> LayoutRule
	layoutMenuItems (index, menu=:(Menu menuName)) =
		layoutSubUIs (matchingMenuItemsSelector menu) $
		sequenceLayouts
			[  modifyUIAttributes
				(SelectKeys ["text", "style", "actionId", "width"])
					(\attrs -> removeMenuNamePrefix menu $
						// Width should be 100% to make menu items have the same size.
						// Nowrap makes sure that menu item labels are shown on a single line.
						'DM'.unions [(widthAttr $ PercentSize 100), styleAttr "white-space: nowrap;", attrs])
			]
	where
		removeMenuNamePrefix :: !Menu !UIAttributes -> UIAttributes
		removeMenuNamePrefix (Menu menuName) attrs =
			maybe
				attrs
				(\(JSONString actionId) -> 'DM'.union (textAttr $ dropChars (size menuName + 1) actionId) attrs)
				('DM'.get "actionId" attrs)

	matchingMenuItemsSelector :: !Menu -> UISelection
	matchingMenuItemsSelector (Menu menuName) =
		(SelectAND
			(SelectByDepth 2)
			(SelectAND
				(SelectByType UIAction)
				(SelectByAttribute "actionId" (matchName menuName)
			)
		))
	where
		matchName name (JSONString s) = startsWith name s
		matchName _ _ = False

arrangeSplit :: !UIDirection !Bool -> LayoutRule
arrangeSplit direction resize
	= sequenceLayouts
		[layoutSubUIs (SelectByPath []) (if (direction === Horizontal) arrangeHorizontal arrangeVertical)
		,layoutSubUIs SelectChildren (setUIAttributes (sizeAttr FlexSize FlexSize))
		]

arrangeVertical :: LayoutRule
arrangeVertical = addCSSClass "itasks-vertical"

arrangeHorizontal :: LayoutRule
arrangeHorizontal = addCSSClass "itasks-horizontal"

frameCompact :: LayoutRule
frameCompact = sequenceLayouts
	[addCSSClass "itasks-frame-compact-inner"
	,wrapUI UIContainer
	,addCSSClass "itasks-frame-compact-outer"
	]

scrollContent :: LayoutRule
scrollContent = addCSSClass "itasks-scroll-content"

toWindow :: UIWindowType UIVAlign UIHAlign -> LayoutRule
toWindow windowType vpos hpos = sequenceLayouts
	[layoutSubUIs (SelectAND (SelectByPath []) (SelectByClass "step-actions")) convertStep
	//General case, only if the previous rule did not apply
	,layoutSubUIs (SelectAND (SelectByPath []) (SelectNOT (SelectByType UIWindow))) wrapInWindow
	]
where
	convertStep = sequenceLayouts
		[setUIType UIWindow
		,setUIAttributes ('DM'.unions [windowTypeAttr windowType,vposAttr vpos, hposAttr hpos])
		]

	wrapInWindow = sequenceLayouts
		[wrapUI UIWindow
		//Move title and class attributes to window
		,copySubUIAttributes (SelectKeys ["title"]) [0] []
		,layoutSubUIs (SelectByPath [0]) (delUIAttributes (SelectKeys ["title"]))
		//Set window specific attributes
		,setUIAttributes ('DM'.unions [windowTypeAttr windowType,vposAttr vpos, hposAttr hpos])
		]

insertToolBar :: [String] -> LayoutRule
insertToolBar actions = insertUIElement UIToolBar actions

insertButtonBar :: [String] -> LayoutRule
insertButtonBar actions = insertUIElement UIButtonBar actions

insertUIElement :: UIType [String] -> LayoutRule
insertUIElement type actions = sequenceLayouts
	[insertChildUI 0 (ui type)
	,moveSubUIs ('Data.Foldable'.foldl1 SelectOR [SelectByAttribute "actionId" ((==) (JSONString action))\\ action <- actions]) [0] 0
	,layoutSubUIs (SelectByPath [0]) (layoutSubUIs (SelectByType UIAction) actionToButton)
	]

toEmpty :: LayoutRule
toEmpty = setUIType UIEmpty

toContainer :: LayoutRule
toContainer = setUIType UIContainer

toPanel :: Bool -> LayoutRule
toPanel fs = sequenceLayouts
	[setUIType UIPanel
	:if fs [setUIAttributes ('DM'.put "fullscreenable" (JSONBool True) 'DM'.newMap)] []
	]

actionToButton :: LayoutRule
actionToButton = sequenceLayouts
	[setUIType UIButton
	,modifyUIAttributes (SelectKeys ["actionId"]) (\attr -> maybe 'DM'.newMap
		(\(JSONString a) -> 'DM'.unions [valueAttr (JSONString a),textAttr a,icon a])
		('DM'.get "actionId" attr))
	]
where
	//Set default icons
	icon "Ok" = iconClsAttr "icon-ok"
	icon "Cancel" = iconClsAttr "icon-cancel"
	icon "Yes" = iconClsAttr "icon-yes"
	icon "No" = iconClsAttr "icon-no"
	icon "Next" = iconClsAttr "icon-next"
	icon "Previous" = iconClsAttr "icon-previous"
	icon "Finish" = iconClsAttr "icon-finish"
	icon "Continue" = iconClsAttr "icon-next"
	icon "/File/Open" = iconClsAttr "icon-open"
	icon "/File/Save" = iconClsAttr "icon-save"
	icon "/File/Save as" = iconClsAttr "icon-save"
	icon "/File/Quit" = iconClsAttr "icon-quit"
	icon "/Help/Help" = iconClsAttr "icon-help"
	icon "/Help/About" = iconClsAttr "icon-about"
	icon "/Edit/Find" = iconClsAttr "icon-find"
	icon "New" = iconClsAttr "icon-new"
	icon "Edit" = iconClsAttr "icon-edit"
	icon "Delete" = iconClsAttr "icon-delete"
	icon "Refresh" = iconClsAttr "icon-refresh"
	icon "Close" = iconClsAttr "icon-close"
	icon _ = 'DM'.newMap

setActionIcon :: (Map String String) -> LayoutRule
setActionIcon icons = sequenceLayouts
	// Buttons and actions
	[layoutSubUIs (SelectOR (SelectByType UIAction) (SelectByType UIButton))
		$ ic "actionId"
	,layoutSubUIs (SelectByType UIMenu)
		$ ic "text"
	]
where
	ic field = modifyUIAttributes (SelectKeys [field]) $ \attr->fromMaybe attr
		$ 'DM'.get field attr
		  >>= \(JSONString f) -> 'DM'.get f icons
		  >>= \icon ->           return ('DM'.union (iconClsAttr ("icon-" +++ icon)) attr)

instance tune ArrangeWithTabs (Task a)
where tune (ArrangeWithTabs b) t = tune (ApplyLayout (arrangeWithTabs b)) t

instance tune ArrangeWithSideBar (Task a)
where
    tune (ArrangeWithSideBar index side resize) t = tune (ApplyLayout (arrangeWithSideBar index side resize)) t

instance tune ArrangeWithHeader (Task a)
where
    tune (ArrangeWithHeader index) t = tune (ApplyLayout (arrangeWithHeader index)) t

instance tune ArrangeAsMenu (Task a)
where
	tune (ArrangeAsMenu i) t = tune (ApplyLayout (arrangeAsMenu i)) t

instance tune ArrangeSplit (Task a)
where
    tune (ArrangeSplit direction resize) t = tune (ApplyLayout (arrangeSplit direction resize)) t

instance tune ArrangeVertical (Task a)
where
    tune ArrangeVertical t = tune (ApplyLayout arrangeVertical)  t

instance tune ArrangeHorizontal (Task a)
where
    tune ArrangeHorizontal t = tune (ApplyLayout arrangeHorizontal) t

instance tune ScrollContent (Task a)
where
    tune ScrollContent t = tune (ApplyLayout scrollContent) t

instance tune AddCSSClass (Task a)
where
	tune (AddCSSClass s) t = tune (ApplyLayout (addCSSClass s)) t

instance tune CSSStyle (Task a)
where
	tune (CSSStyle s) t = tune ("style",JSONString s) t

instance tune ToWindow (Task a)
where
	tune (ToWindow windowType vpos hpos) t = tune (ApplyLayout (toWindow windowType vpos hpos)) t

instance tune InPanel (Task a)
where
	tune (InPanel fullscreenable) t =  tune (ApplyLayout (toPanel fullscreenable)) t

instance tune InContainer (Task a)
where
	tune InContainer t = tune (ApplyLayout toContainer) t

instance tune NoUserInterface (Task a)
where
    tune NoUserInterface task = Task (eval task)
    where
	    eval task event repOpts iworld = case apTask task event repOpts iworld of
			(ValueResult taskvalue evalinfo _ newtask, iworld)
				# change = case event of
					ResetEvent = ReplaceUI (ui UIEmpty)
					_          = NoChange
				= (ValueResult taskvalue evalinfo change (Task (eval newtask)), iworld)
			other = other

toFormItem :: LayoutRule
toFormItem = layoutSubUIs
	(SelectAND
		(SelectByPath [])
		(SelectOR
			(SelectByHasAttribute LABEL_ATTRIBUTE)
			(SelectByHasAttribute TOOLTIP_ATTRIBUTE)))
	(sequenceLayouts
		//Create the 'row' that holds the form item
		[wrapUI UIContainer
		,copySubUIAttributes (SelectKeys [HINT_ATTRIBUTE]) [0] []
		,layoutSubUIs (SelectChildren) (delUIAttributes (SelectKeys [HINT_ATTRIBUTE]))
		,addCSSClass "itasks-form-item"
		//If there is a label attribute, create a label
		,optAddLabel
		//If there is tooltip attribute, create an extra icon
		,optAddIcon
		,removeLabelAttribute
		]
	)
where
	optAddLabel = layoutSubUIs (SelectByContains (SelectAND (SelectByPath [0]) (SelectByHasAttribute LABEL_ATTRIBUTE))) addLabel
	addLabel = sequenceLayouts
		[insertChildUI 0 (uia UILabel (widthAttr WrapSize))
		,sequenceLayouts
			[copySubUIAttributes (SelectKeys ["label","optional","mode","colon"]) [1] [0]
			,layoutSubUIs (SelectByPath [0]) (modifyUIAttributes (SelectKeys ["label","optional","mode","colon"]) createLabelText)
			]
		]
	where
		createLabelText attr = textAttr text
		where
			text = label +++ (if (enterOrUpdate && not optional) "*" "") +++ (if colon ":" "")
			enterOrUpdate = maybe False (\(JSONString m) -> isMember m ["enter","update"]) ('DM'.get "mode" attr)
			optional = maybe False (\(JSONBool b) -> b) ('DM'.get "optional" attr)
			colon = maybe True (\(JSONBool b) -> b) ('DM'.get "colon" attr)
			label = maybe "-" (\(JSONString s) -> s) ('DM'.get "label" attr)

	optAddIcon = layoutSubUIs (SelectByContains (SelectAND SelectChildren (SelectByHasAttribute TOOLTIP_ATTRIBUTE)))
					(sequenceLayouts
						[layoutSubUIs (SelectAND (SelectByPath []) (SelectByNumChildren 2)) (addIcon 2) //A label was added
						,layoutSubUIs (SelectAND (SelectByPath []) (SelectByNumChildren 1)) (addIcon 1) //No label was added
						]
					)

	addIcon iconIndex = sequenceLayouts
		[insertChildUI iconIndex (ui UIIcon)
		,copySubUIAttributes (SelectKeys [TOOLTIP_ATTRIBUTE,TOOLTIP_TYPE_ATTRIBUTE]) [iconIndex - 1] [iconIndex]
		,layoutSubUIs (SelectByPath [iconIndex]) (modifyUIAttributes (SelectKeys [TOOLTIP_TYPE_ATTRIBUTE]) createIconAttr)
		]
	where
		createIconAttr attr = iconClsAttr $ maybe "icon-info" (\(JSONString t) -> "icon-" +++ t) ('DM'.get TOOLTIP_TYPE_ATTRIBUTE attr)

	removeLabelAttribute = layoutSubUIs (SelectAND SelectChildren (SelectByHasAttribute "label"))
	                                    (delUIAttributes (SelectKeys ["label"]))
