Commit c25db9d5 authored by Bas Lijnse's avatar Bas Lijnse

Replaced other intermediate UI nodes by container with attributes, just as interact.

parent d9eb1cef
......@@ -341,18 +341,19 @@ uiToRefs :: UI -> TaskUITree
uiToRefs (UI _ _ subs) = case recurse [] subs of
[x : _] -> x
_ -> Ed []
where
uiToRefs` :: [Int] (Int, UI) -> [TaskUITree]
uiToRefs` path (i, UI UIParallel _ subs)
# curPath = path ++ [i]
= [Par curPath (recurse curPath subs)]
uiToRefs` path (i, UI UIStep _ subs)
# curPath = path ++ [i]
= [Step curPath (recurse curPath subs)]
uiToRefs` path (i, _)
# curPath = path ++ [i]
= [Ed curPath]
recurse curPath subs = flatten (map (uiToRefs` curPath) (zip2 [0..] subs))
where
uiToRefs` :: [Int] (Int, UI) -> [TaskUITree]
uiToRefs` path (i, UI type attr subs)
# curPath = path ++ [i]
| hasClass "parallel" attr || hasClass "parallel-actions" attr = [Par curPath (recurse curPath subs)]
| hasClass "step" attr || hasClass "step-actions" attr = [Step curPath (recurse curPath subs)]
| otherwise = [Ed curPath]
where
hasClass name attr = case 'DM'.get "class" attr of
(Just (JSONArray items)) = isMember name [item \\ JSONString item <- items]
_ = False
recurse curPath subs = flatten (map (uiToRefs` curPath) (zip2 [0..] subs))
getSubTree :: UI [Int] -> Maybe UI
getSubTree ui [] = Just ui
......
......@@ -2,6 +2,9 @@ div.itasks-container.manage-work-header {
padding: 2px 2px 2px 10px;
flex-direction: row;
}
div.itasks-container.manage-work-header > div.itasks-textview {
flex: 1 0 auto;
}
div.itasks-window.new-work-window {
min-width: 600px;
min-height: 350px;
......
......@@ -157,21 +157,18 @@ manageWorkOfCurrentUser welcomeMessage
>>* [OnValue (ifStable (const (return ())))]) <<@ ApplyLayout layout
where
layout = sequenceLayouts
[unwrapUI //Get rid of the step
,arrangeWithHeader 0
[arrangeWithHeader 0
,layoutSubUIs (SelectByPath [0]) layoutManageSession
,layoutSubUIs (SelectByPath [1]) (sequenceLayouts [unwrapUI,layoutWhatToDo])
,layoutSubUIs (SelectByPath [1]) layoutWhatToDo
//Use maximal screen space
,setUIAttributes (sizeAttr FlexSize FlexSize)
]
layoutManageSession = sequenceLayouts
[layoutSubUIs SelectChildren actionToButton
,layoutSubUIs (SelectByPath [0]) (setUIType UIContainer)
,setUIType UIContainer
,addCSSClass "manage-work-header"
[removeCSSClass "step-actions" //Don't layout as a regular step
,addCSSClass "manage-work-header"
]
layoutWhatToDo = sequenceLayouts [arrangeWithSideBar 0 LeftSide True, layoutSubUIs (SelectByPath [1]) unwrapUI]
layoutWhatToDo = sequenceLayouts [unwrapUI, arrangeWithSideBar 0 LeftSide True]
manageSession :: Task ()
manageSession =
......@@ -181,7 +178,8 @@ manageSession =
where
view user = "Welcome " +++ toString user
chooseWhatToDo welcomeMessage = Title "Menu" @>> updateChoiceWithShared [ChooseFromList workflowTitle] (mapRead addManageWork allowedTransientTasks) manageWorkWf
chooseWhatToDo welcomeMessage
= Title "Menu" @>> updateChoiceWithShared [ChooseFromList workflowTitle] (mapRead addManageWork allowedTransientTasks) manageWorkWf
where
addManageWork wfs = [manageWorkWf:wfs]
manageWorkWf = transientWorkflow "My Tasks" "Manage your worklist" (manageWork welcomeMessage)
......@@ -346,7 +344,6 @@ removeWhenStable task slist
= (task
>>* [OnValue (ifStable (\_ -> get (taskListSelfId slist) >>- \selfId -> removeTask selfId slist))]
@? const NoValue)
<<@ ApplyLayout unwrapUI
addWorkflows :: ![Workflow] -> Task [Workflow]
addWorkflows additional
......
......@@ -222,10 +222,10 @@ workAs asUser task
= get currentUser
>>- \prevUser ->
set asUser currentUser
>>| ((task
>>| (task
>>- \tvalue -> //TODO: What if the wrapped task never becomes stable? And what if the composition is terminated early because of a step?
set prevUser currentUser
@! tvalue) <<@ ApplyLayout unwrapUI)
@! tvalue)
/*
* When a task is assigned to a user a synchronous task instance process is created.
* It is created once and loaded and evaluated on later runs.
......
......@@ -59,19 +59,11 @@ derive class iTask UIChange, UIAttributeChange, UIChildChange
// --- Intermediate nodes: (implemented in itasks-components-raw.js) ---
= UIEmpty
| UIAction
| UIPair
| UIRecord
| UICons
| UIVarCons
| UIInteract
| UIStep
| UIParallel
// --- Client components: ---
// Core framework components (implemented in itasks-core.js)
| UIComponent // - Component (the client-side base class)
// Containers (implemented in itasks-components-container.js)
| UIViewport // - Viewport for embedding another task instance's UI (like an iframe for tasks)
| UIContainer
| UIContainer // - The base component that contains other components
| UIPanel
| UIWindow
| UITabSet
......@@ -174,7 +166,6 @@ LABEL_ATTRIBUTE :== "label"
PREFIX_ATTRIBUTE :== "prefix"
POSTFIX_ATTRIBUTE :== "postfix"
ICON_ATTRIBUTE :== "icon"
STEPPED_ATTRIBUTE :== "stepped"
//Construction functions
ui :: UIType -> UI
......@@ -185,7 +176,6 @@ uiac :: UIType UIAttributes [UI] -> UI
//Predefined attribute defintions
emptyAttr :: UIAttributes
taskTypeAttr :: !String -> UIAttributes
optionalAttr :: !Bool -> UIAttributes
sizeAttr :: !UISize !UISize -> UIAttributes
......@@ -219,12 +209,13 @@ taskIdAttr :: !String -> UIAttributes
labelAttr :: !String -> UIAttributes
styleAttr :: !String -> UIAttributes
classAttr :: ![String] -> UIAttributes
addClassAttr :: !String !UIAttributes -> UIAttributes
removeClassAttr :: !String !UIAttributes -> UIAttributes
resizableAttr :: ![UISide] -> UIAttributes
maxlengthAttr :: !Int -> UIAttributes
minlengthAttr :: !Int -> UIAttributes
boundedlengthAttr :: !Int !Int -> UIAttributes
eventTimeoutAttr :: !(Maybe Int) -> UIAttributes
steppedAttr :: !Bool -> UIAttributes
editAttrs :: !String !String !(Maybe JSONNode) -> UIAttributes
choiceAttrs :: !String !String ![Int] ![JSONNode] -> UIAttributes
......
......@@ -21,21 +21,6 @@ derive class iTask UI, UIType
derive class iTask UISize, UIBound, UIDirection, UIVAlign, UIHAlign, UISide, UIWindowType
derive class iTask UITreeNode
//SHOULD BE IN Text.GenJSON
jsonObjectPut :: String JSONNode JSONNode -> JSONNode
jsonObjectPut k v (JSONObject fields) = JSONObject (put k v fields)
where
put k v [] = [(k,v)]
put k v [(fk,fv):fs] = if (k == fk) [(fk,v):fs] [(fk,fv):put k v fs]
jsonObjectPut k v node = node
jsonObjectGet :: String JSONNode -> Maybe JSONNode
jsonObjectGet k (JSONObject fields) = get k fields
where
get k [] = Nothing
get k [(fk,fv):fs] = if (k == fk) (Just fv) (get k fs)
jsonObjectGet k node = Nothing
ui :: UIType -> UI
ui type = UI type 'DM'.newMap []
......@@ -51,116 +36,121 @@ uiac type attr items = UI type attr items
emptyAttr :: UIAttributes
emptyAttr = 'DM'.newMap
taskTypeAttr :: !String -> UIAttributes
taskTypeAttr type = 'DM'.fromList [("task-type",JSONString type)]
optionalAttr :: !Bool -> UIAttributes
optionalAttr optional = 'DM'.fromList [("optional",JSONBool optional)]
optionalAttr optional = 'DM'.singleton "optional" (JSONBool optional)
sizeAttr :: !UISize !UISize -> UIAttributes
sizeAttr width height = 'DM'.fromList [("width",encodeUI width),("height",encodeUI height)]
widthAttr :: !UISize -> UIAttributes
widthAttr width = 'DM'.fromList [("width",encodeUI width)]
widthAttr width = 'DM'.singleton "width" (encodeUI width)
heightAttr :: !UISize -> UIAttributes
heightAttr height = 'DM'.fromList [("height",encodeUI height)]
heightAttr height = 'DM'.singleton "height" (encodeUI height)
hintAttr :: !String -> UIAttributes
hintAttr hint = 'DM'.fromList [("hint",JSONString hint)]
hintAttr hint = 'DM'.singleton "hint" (JSONString hint)
titleAttr :: !String -> UIAttributes
titleAttr title = 'DM'.fromList [("title",JSONString title)]
titleAttr title = 'DM'.singleton "title" (JSONString title)
iconClsAttr :: !String -> UIAttributes
iconClsAttr iconCls = 'DM'.fromList [("iconCls",JSONString iconCls)]
iconClsAttr iconCls = 'DM'.singleton "iconCls" (JSONString iconCls)
tooltipAttr :: !String -> UIAttributes
tooltipAttr tooltip = 'DM'.fromList [("tooltip",JSONString tooltip)]
tooltipAttr tooltip = 'DM'.singleton "tooltip" (JSONString tooltip)
hposAttr :: !UIHAlign -> UIAttributes
hposAttr pos = 'DM'.fromList [("hpos",encodeUI pos)]
hposAttr pos = 'DM'.singleton "hpos" (encodeUI pos)
vposAttr :: !UIVAlign -> UIAttributes
vposAttr pos = 'DM'.fromList [("vpos",encodeUI pos)]
vposAttr pos = 'DM'.singleton "vpos" (encodeUI pos)
windowTypeAttr :: !UIWindowType -> UIAttributes
windowTypeAttr windowType = 'DM'.fromList [("windowType",encodeUI windowType)]
windowTypeAttr windowType = 'DM'.singleton "windowType" (encodeUI windowType)
focusTaskIdAttr :: !String -> UIAttributes
focusTaskIdAttr taskId = 'DM'.fromList [("focusTaskId",JSONString taskId)]
focusTaskIdAttr taskId = 'DM'.singleton "focusTaskId" (JSONString taskId)
closeTaskIdAttr :: !String -> UIAttributes
closeTaskIdAttr taskId = 'DM'.fromList [("closeTaskId",JSONString taskId)]
closeTaskIdAttr taskId = 'DM'.singleton "closeTaskId" (JSONString taskId)
activeTabAttr :: !Int -> UIAttributes
activeTabAttr activeTab = 'DM'.fromList [("activeTab",JSONInt activeTab)]
activeTabAttr activeTab = 'DM'.singleton "activeTab" (JSONInt activeTab)
valueAttr :: !JSONNode -> UIAttributes
valueAttr value = 'DM'.fromList [("value",value)]
valueAttr value = 'DM'.singleton "value" value
minAttr :: !Int -> UIAttributes
minAttr min = 'DM'.fromList [("min",JSONInt min)]
minAttr min = 'DM'.singleton "min" (JSONInt min)
maxAttr :: !Int -> UIAttributes
maxAttr max = 'DM'.fromList [("max",JSONInt max)]
maxAttr max = 'DM'.singleton "max" (JSONInt max)
textAttr :: !String -> UIAttributes
textAttr text = 'DM'.fromList [("text",JSONString text)]
textAttr text = 'DM'.singleton "text" (JSONString text)
enabledAttr :: !Bool -> UIAttributes
enabledAttr enabled = 'DM'.fromList [("enabled",JSONBool enabled)]
enabledAttr enabled = 'DM'.singleton "enabled" (JSONBool enabled)
multipleAttr :: !Bool -> UIAttributes
multipleAttr multiple = 'DM'.fromList [("multiple",JSONBool multiple)]
multipleAttr multiple = 'DM'.singleton "multiple" (JSONBool multiple)
instanceNoAttr :: !Int -> UIAttributes
instanceNoAttr instanceNo = 'DM'.fromList [("instanceNo",JSONInt instanceNo)]
instanceNoAttr instanceNo = 'DM'.singleton "instanceNo" (JSONInt instanceNo)
instanceKeyAttr :: !String -> UIAttributes
instanceKeyAttr instanceKey = 'DM'.fromList [("instanceKey",JSONString instanceKey)]
instanceKeyAttr instanceKey = 'DM'.singleton "instanceKey" (JSONString instanceKey)
columnsAttr :: ![String] -> UIAttributes
columnsAttr columns = 'DM'.fromList [("columns",JSONArray (map JSONString columns))]
columnsAttr columns = 'DM'.singleton "columns" (JSONArray (map JSONString columns))
doubleClickAttr :: !String !String -> UIAttributes
doubleClickAttr taskId actionId = 'DM'.fromList [("doubleClickAction",JSONArray [JSONString taskId,JSONString actionId])]
doubleClickAttr taskId actionId = 'DM'.singleton "doubleClickAction" (JSONArray [JSONString taskId,JSONString actionId])
actionIdAttr :: !String -> UIAttributes
actionIdAttr actionId = 'DM'.fromList [("actionId",JSONString actionId)]
actionIdAttr actionId = 'DM'.singleton "actionId" (JSONString actionId)
taskIdAttr :: !String -> UIAttributes
taskIdAttr taskId = 'DM'.fromList [("taskId",JSONString taskId)]
taskIdAttr taskId = 'DM'.singleton "taskId" (JSONString taskId)
editorIdAttr :: !String -> UIAttributes
editorIdAttr taskId = 'DM'.fromList [("editorId",JSONString taskId)]
editorIdAttr taskId = 'DM'.singleton "editorId" (JSONString taskId)
labelAttr :: !String -> UIAttributes
labelAttr taskId = 'DM'.fromList [(LABEL_ATTRIBUTE,JSONString taskId)]
labelAttr taskId = 'DM'.singleton "label" (JSONString taskId)
styleAttr :: !String -> UIAttributes
styleAttr style = 'DM'.fromList [("style",JSONString style)]
styleAttr style = 'DM'.singleton "style" (JSONString style)
classAttr :: ![String] -> UIAttributes
classAttr cls = 'DM'.fromList [("class",JSONArray (map JSONString cls))]
classAttr classes = 'DM'.singleton "class" (JSONArray (map JSONString classes))
addClassAttr :: !String !UIAttributes -> UIAttributes
addClassAttr classname attributes = 'DM'.put "class" (JSONArray [JSONString classname:classes]) attributes
where
classes = case 'DM'.get "class" attributes of (Just (JSONArray names)) = names ; _ = []
removeClassAttr :: !String !UIAttributes -> UIAttributes
removeClassAttr remove attributes
= case 'DM'.get "class" attributes of
(Just (JSONArray items)) = 'DM'.put "class" (JSONArray [i \\ i=:(JSONString name) <- items | name <> remove]) attributes
_ = attributes
resizableAttr :: ![UISide] -> UIAttributes
resizableAttr sides = 'DM'.fromList [("resizable",JSONArray (map encodeUI sides))]
resizableAttr sides = 'DM'.singleton "resizable" (JSONArray (map encodeUI sides))
maxlengthAttr :: !Int -> UIAttributes
maxlengthAttr l = 'DM'.fromList [("maxlength", JSONInt l)]
maxlengthAttr maxlength = 'DM'.singleton "maxlength" (JSONInt maxlength)
minlengthAttr :: !Int -> UIAttributes
minlengthAttr l = 'DM'.fromList [("minlength", JSONInt l)]
minlengthAttr minlength = 'DM'.singleton "minlength" (JSONInt minlength)
boundedlengthAttr :: !Int !Int -> UIAttributes
boundedlengthAttr min max = 'DM'.unions [minlengthAttr min, maxlengthAttr max]
eventTimeoutAttr :: !(Maybe Int) -> UIAttributes
eventTimeoutAttr to = 'DM'.fromList [("eventTimeout", maybe JSONNull JSONInt to)]
steppedAttr :: !Bool -> UIAttributes
steppedAttr stepped = 'DM'.fromList [(STEPPED_ATTRIBUTE, JSONBool stepped)]
eventTimeoutAttr timeout = 'DM'.singleton "eventTimeout" (maybe JSONNull JSONInt timeout)
editAttrs :: !String !String !(Maybe JSONNode) -> UIAttributes
editAttrs taskId editorId mbValue
......@@ -215,13 +205,6 @@ instance toString UIType
where
toString UIEmpty = "RawEmpty"
toString UIAction = "RawAction"
toString UIPair = "RawPair"
toString UIRecord = "RawRecord"
toString UICons = "RawCons"
toString UIVarCons = "RawVarCons"
toString UIInteract = "RawInteract"
toString UIStep = "RawStep"
toString UIParallel = "RawParallel"
toString UIComponent = "Component"
toString UIViewport = "Viewport"
......
......@@ -27,17 +27,17 @@ where
Enter
| optional //Just show the ui to enable the remaining fields
# (enableUI,enableSt) = genEnableUI taskId dp False
= (Ok (uiac UIRecord attr [enableUI], (False, optional), [enableSt]), vst)
= (Ok (uiac UIContainer (addClassAttr "record" attr) [enableUI], (False, optional), [enableSt]), vst)
| otherwise
= case exGenUI emptyAttr (pairPath grd_arity dp) Enter {VSt|vst & optional = False} of
(Ok viz, vst)
# (ui, childSts) = fromPairUI UIRecord attr grd_arity viz
# (ui, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity viz
= (Ok (ui, (False, optional), childSts), vst)
(Error e,vst) = (Error e,vst)
Update (RECORD x)
= case exGenUI emptyAttr (pairPath grd_arity dp) (Update x) {VSt|vst & optional = False} of
(Ok viz,vst)
# (UI type attr items, childSts) = fromPairUI UIRecord attr grd_arity viz
# (UI type attr items, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity viz
//When optional we add a checkbox to clear the record
| optional
# (enableUI, enableSt) = genEnableUI taskId dp True
......@@ -48,7 +48,7 @@ where
View (RECORD x)
= case exGenUI emptyAttr (pairPath grd_arity dp) (View x) {VSt|vst & optional = False} of
(Ok viz,vst)
# (ui, childSts) = fromPairUI UIRecord attr grd_arity viz
# (ui, childSts) = fromPairUI UIContainer (addClassAttr "record" attr) grd_arity viz
= (Ok (ui, (True, optional), childSts),vst)
(Error e,vst) = (Error e,vst)
......@@ -61,7 +61,7 @@ where
//Create and add the fields
= case exGenUI emptyAttr (pairPath grd_arity dp) Enter {vst & optional = False} of
(Ok viz,vst)
# (UI type attr items, childSts) = fromPairUI UIRecord emptyAttr grd_arity viz
# (UI type attr items, childSts) = fromPairUI UIContainer (classAttr ["record"]) grd_arity viz
# change = ChangeUI [] [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
# enableSt = LeafState {touched=True,state=JSONBool True}
= (Ok (change, (viewMode, optional), [enableSt:childSts]), vst)
......@@ -156,21 +156,21 @@ where
Enter
//Only generate a UI to select the constructor
# (consChooseUI, consChooseSt) = genConsChooseUI taskId dp gcd_names Nothing
= (Ok (UI UIVarCons attr [consChooseUI], False, [consChooseSt]),{vst & selectedConsIndex = selectedConsIndex})
= (Ok (UI UIContainer (addClassAttr "var-cons" attr) [consChooseUI], False, [consChooseSt]),{vst & selectedConsIndex = selectedConsIndex})
Update (OBJECT x)
//Generate the ui for the current value
= case exGenUI emptyAttr dp (Update x) vst of
(Ok (consUI=:(UI UICons attr` items), childSt),vst)
(Ok (consUI=:(UI _ attr` items), childSt),vst)
//Add the UI to select the constructor and change the type to UIVarCons
# (consChooseUI, consChooseSt) = genConsChooseUI taskId dp gcd_names (Just vst.selectedConsIndex)
= (Ok (UI UIVarCons ('DM'.union attr attr`) [consChooseUI:items], False, [consChooseSt, childSt])
= (Ok (UI UIContainer (addClassAttr "var-cons" ('DM'.union attr attr`)) [consChooseUI:items], False, [consChooseSt, childSt])
,{vst & selectedConsIndex = selectedConsIndex})
(Error e,vst) = (Error e, vst)
View (OBJECT x)
= case exGenUI emptyAttr dp (View x) vst of
(Ok (consUI=:(UI UICons attr` items), childSt),vst)
(Ok (consUI=:(UI _ attr` items), childSt),vst)
# (consViewUI,consViewSt) = genConsViewUI gcd_names vst.selectedConsIndex
= (Ok (UI UIVarCons ('DM'.union attr attr`) [consViewUI:items], True, [consViewSt, childSt])
= (Ok (UI UIContainer (addClassAttr "var-cons" ('DM'.union attr attr`)) [consViewUI:items], True, [consViewSt, childSt])
,{vst & selectedConsIndex = selectedConsIndex})
(Error e,vst) = (Error e,vst)
......@@ -191,7 +191,7 @@ where
# (ui, vst) = exGenUI emptyAttr dp Enter {vst & pathInEditMode = consCreatePath consIdx gtd_num_conses}
# vst = {vst & pathInEditMode = pathInEditMode}
= case ui of
Ok (UI UICons attr items, childSt)
Ok (UI _ attr items, childSt)
//Construct a UI change that does the following:
//1: If necessary remove the fields of the previously selected constructor
# removals = case state of
......@@ -313,7 +313,7 @@ gEditor{|CONS of {gcd_index,gcd_arity}|} {Editor|genUI=exGenUI,onEdit=exOnEdit,o
where
genUI attr dp mode vst = case exGenUI emptyAttr (pairPath gcd_arity dp) (mapEditMode (\(CONS x) -> x) mode) vst of
(Ok viz,vst)
# (ui, childSts) = fromPairUI UICons attr gcd_arity viz
# (ui, childSts) = fromPairUI UIContainer (addClassAttr "cons" attr) gcd_arity viz
= (Ok (ui, (), childSts), {VSt| vst & selectedConsIndex = gcd_index})
(Error e,vst) = (Error e,{VSt| vst & selectedConsIndex = gcd_index})
......@@ -350,7 +350,7 @@ where
# (vizy, vst) = eyGenUI emptyAttr dpy (mapEditMode (\(PAIR _ y) -> y) mode) vst
| vizy =: (Error _) = (vizy,vst)
# ((vizx, stx), (vizy, sty)) = (fromOk vizx, fromOk vizy)
= (Ok (uiac UIPair attr [vizx, vizy],CompoundState JSONNull [stx, sty]),vst)
= (Ok (uiac UIContainer attr [vizx, vizy],CompoundState JSONNull [stx, sty]),vst)
onEdit dp ([0:ds],e) stX ust
# (dpx,_) = pairPathSplit dp
......@@ -494,11 +494,11 @@ where
//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 UIPair _ [ul,ur], CompoundState _ [ml,mr])
fromPairUI type attr 2 (UI _ _ [ul,ur], CompoundState _ [ml,mr])
= (UI type attr [ul,ur],[ml,mr])
fromPairUI type attr 3 (UI UIPair _ [ul,UI UIPair _ [um,ur]], CompoundState _ [ml,CompoundState _ [mm,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 UIPair _ [ul,ur], CompoundState _ [ml,mr])
fromPairUI type attr n (UI _ _ [ul,ur], CompoundState _ [ml,mr])
= (UI type attr (uls ++ urs), (mls ++ mrs))
where
half = n / 2
......
......@@ -23,8 +23,6 @@ from StdOverloaded import class <
// we want to keep only minimal state. Using an opaque function would require
// keeping track of the full state
//Only match children
SelectChildren :== SelectByDepth 1
:: UISelection
//Select only nodes matching the exact path
= SelectByPath !UIPath
......@@ -38,6 +36,8 @@ SelectChildren :== SelectByDepth 1
| SelectByAttribute !String !(JSONNode -> Bool)
//Match nodes that have the attribute
| SelectByHasAttribute !String
//Match nodes that have a specific 'class' attribute
| SelectByClass !String
//Match nodes with exactly the given number of children
| SelectByNumChildren !Int
//Match nodes that match the given selection on traversal of the given path
......@@ -63,6 +63,11 @@ SelectChildren :== SelectByDepth 1
= SelectAll
| SelectKeys ![String]
//Only match children
SelectChildren :== SelectByDepth 1
// In specifications of layouts, sub-parts of UI's are commonly addressed as
// a path of child selections in the UI tree.
:: UIPath :== [Int]
......
......@@ -560,8 +560,16 @@ nodeSelected_ ruleNo (SelectByType t) _ lui moves = fromMaybe False
(fmap (\n -> nodeType_ ruleNo n === t) (selectNode_ ruleNo True fst (lui,moves)))
nodeSelected_ ruleNo (SelectByHasAttribute k) _ lui moves = fromMaybe False
(fmap (\n -> isJust ('DM'.get k (nodeAttributes_ ruleNo n))) (selectNode_ ruleNo True fst (lui,moves)))
nodeSelected_ ruleNo (SelectByAttribute k p) _ lui moves = fromMaybe False
(fmap (\n -> maybe False p ('DM'.get k (nodeAttributes_ ruleNo n))) (selectNode_ ruleNo True fst (lui,moves)))
nodeSelected_ ruleNo (SelectByClass c) _ lui moves = fromMaybe False
(fmap (\n -> maybe False (hasClass c) ('DM'.get "class" (nodeAttributes_ ruleNo n))) (selectNode_ ruleNo True fst (lui,moves)))
where
hasClass name (JSONArray items) = isMember name [item \\ JSONString item <- items]
hasClass _ _ = False
nodeSelected_ ruleNo (SelectByNumChildren num) _ lui moves = fromMaybe False
//TODO: selectChildNodes should also have selectable before/after effect
(fmap (\(LUINode node,m) -> length (selectChildNodes_ ruleNo (node.items,m)) == num)
......@@ -585,6 +593,7 @@ nodeSelected_ ruleNo (SelectOR sell selr) path ui moves = nodeSelected_ ruleNo s
nodeSelected_ ruleNo (SelectNOT sel) path ui moves = not (nodeSelected_ ruleNo sel path ui moves)
nodeSelected_ ruleNo _ _ _ moves = False
matchAttributeKey_ :: !UIAttributeSelection !UIAttributeKey -> Bool
matchAttributeKey_ (SelectAll) _ = True
matchAttributeKey_ (SelectKeys keys) k = isMember k keys
......
......@@ -17,17 +17,15 @@ basicFormsSessionLayout :: LayoutRule
basicFormsSessionLayout = layoutCombinatorContainers
layoutCombinatorContainers = sequenceLayouts
[layoutSubUIs (SelectByType UIInteract) layoutInteract
,layoutSubUIs (SelectByType UIStep) layoutStep
,layoutSubUIs (SelectByType UIParallel) layoutParallel
[layoutSubUIs (SelectByClass "interact") layoutInteract
,layoutSubUIs (SelectByClass "step-actions") layoutStep
,layoutSubUIs (SelectByType UIAction) layoutAsButton
,removeSubUIs (SelectByType UIEmpty)
]
layoutStep = sequenceLayouts
[setUIType UIContainer
,addButtonBar
,layoutSubUIs (SelectAND SelectDescendents (SelectByType UIStep)) layoutStep
[addButtonBar
,layoutSubUIs (SelectAND SelectDescendents (SelectByClass "step-actions")) layoutStep
]
where
addButtonBar = sequenceLayouts
......@@ -36,24 +34,9 @@ where
,layoutSubUIs (SelectByPath [1]) (layoutSubUIs SelectChildren layoutAsButton) //Transform actions to buttons
]
layoutParallel = sequenceLayouts
[setUIType UIContainer
,layoutSubUIs (SelectAND SelectDescendents (SelectByType UIParallel)) layoutParallel
]
layoutInteract = sequenceLayouts
[setUIType UIPanel
,layoutSubUIs (SelectAND SelectDescendents SelectFormElement) toFormItem
,layoutSubUIs (SelectAND SelectDescendents SelectEditorContainers) layoutEditorContainer
]
SelectFormElement = SelectByHasAttribute LABEL_ATTRIBUTE
SelectEditorContainers = 'DF'.foldr1 SelectOR
(map SelectByType [UIPair,UIRecord,UICons,UIVarCons])
layoutEditorContainer = sequenceLayouts
[setUIType UIContainer
,layoutSubUIs (SelectAND SelectDescendents SelectEditorContainers) layoutEditorContainer
,layoutSubUIs (SelectAND SelectDescendents (SelectByHasAttribute "label" )) toFormItem
]
layoutAsButton = sequenceLayouts
......
......@@ -14,6 +14,11 @@ from iTasks.UI.Tune import class tune
*/
addCSSClass :: String -> LayoutRule
/**
* Remove a CSS class (to prevent standard styling)
*/
removeCSSClass :: String -> LayoutRule
/**
* Create a tabset with all child items as separate tabs
* The flag denotes whether close buttons should be lifted to the tabs
......
......@@ -26,9 +26,16 @@ where
(\(JSONArray classNames) -> JSONArray (classNames ++ [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 []) (SelectByType UIParallel))
(SelectAND (SelectByPath []) (SelectOR (SelectByClass "parallel") (SelectByClass "parallel-actions")))
(sequenceLayouts
[setUIType UITabSet
,layoutSubUIs SelectChildren scrollContent
......@@ -199,20 +206,12 @@ scrollContent = addCSSClass "itasks-scroll-content"
toWindow :: UIWindowType UIVAlign UIHAlign -> LayoutRule
toWindow windowType vpos hpos = sequenceLayouts
[wrapUI UIWindow
,interactToWindow
//Move title and class attributes to window
,copySubUIAttributes (SelectKeys ["title","class"]) [0] []
,layoutSubUIs (SelectByPath [0]) (delUIAttributes (SelectKeys ["title","class"]))
,copySubUIAttributes (SelectKeys ["title"]) [0] []
,layoutSubUIs (SelectByPath [0]) (delUIAttributes (SelectKeys ["title"]))
//Set window specific attributes
,setUIAttributes ('DM'.unions [windowTypeAttr windowType,vposAttr vpos, hposAttr hpos])
]
where
//If the first child is an interact, move the title one level up
interactToWindow = layoutSubUIs (SelectAND (SelectByPath []) (SelectByContains (SelectAND (SelectByPath [0]) (SelectByType UIInteract))))
(sequenceLayouts [copySubUIAttributes (SelectKeys ["title"]) [0,0] []
,layoutSubUIs (SelectByPath [0,0]) (delUIAttributes (SelectKeys ["title"]))
])
insertToolBar :: [String] -> LayoutRule
insertToolBar actions = sequenceLayouts
......
......@@ -9,23 +9,13 @@ import iTasks.UI.Definition
import iTasks.UI.Layout
import Data.List, Data.Maybe, Text.GenJSON
import qualified Data.Map as DM
import qualified Data.Foldable as DF
minimalSessionLayout :: LayoutRule
minimalSessionLayout = layoutAny
layoutAny = sequenceLayouts
[layoutSubUIs SelectIntermediateContainers layoutAsContainer
,layoutSubUIs (SelectByType UIAction) layoutAsButton
minimalSessionLayout = sequenceLayouts
[layoutSubUIs (SelectByType UIAction) layoutAsButton
,removeSubUIs (SelectByType UIEmpty)
]
SelectIntermediateContainers = 'DF'.foldr1 SelectOR
(map SelectByType [UIPair,UIRecord,UICons,UIVarCons,UIInteract,UIStep,UIParallel])
layoutAsContainer = sequenceLayouts
[setUIType UIContainer
,layoutSubUIs SelectChildren layoutAny
]
layoutAsButton = sequenceLayouts
[setUIType UIButton
,modifyUIAttributes (SelectKeys ["actionId"]) toButtonAttributes
......
......@@ -15,26 +15,27 @@ standardFormsSessionLayout = sequenceLayouts
]
layoutCombinatorContainers = sequenceLayouts
[layoutSubUIs (SelectByAttribute "task-type" ((==) (JSONString "interact"))) layoutInteract
,layoutSubUIs (SelectByType UIStep) layoutStep
,layoutSubUIs (SelectByType UIParallel) layoutParallel
[layoutSubUIs (SelectByClass "interact") layoutInteract
,layoutSubUIs (SelectByClass "step-actions") layoutStepWithActions
,layoutSubUIs (SelectByClass "parallel-actions") layoutParallelWithActions
//There can still be buttons (e.g. when a parallel has been transformed to a tabset
,layoutSubUIs (SelectByType UIAction) layoutAsButton
]
layoutStep = sequenceLayouts
[layoutSubUIs (SelectAND SelectDescendents (SelectByType UIStep)) layoutStep
layoutStepWithActions = sequenceLayouts
[layoutSubUIs (SelectAND SelectDescendents (SelectByClass "step-actions")) layoutStepWithActions
,layoutSubUIs SelectNestedStep removeDisabledActions
,layoutSubUIs (SelectAND NotYetTransformed HasActions) layoutWithActions
,layoutSubUIs NotYetTransformed layoutWithoutActions
,layoutSubUIs (SelectAND (SelectByPath []) (SelectByType UIContainer)) (setUIType UIPanel)
,addButtonBar
,modifyUIAttributes (SelectKeys ["class"]) (removeClassAttr "step-actions")
]
where
SelectNestedStep =
(SelectAND // (Nested)
(SelectByType UIStep) // Steps (are steps)
(SelectByClass "step-actions") // Steps (are steps)
$ SelectByContains // having
$ SelectAND
(SelectByType UIStep) // steps
(SelectByClass "step-actions") // steps
SelectDescendents) // under them
SelectDisabledAction =
......@@ -47,49 +48,31 @@ where
removeDisabledActions = layoutSubUIs SelectDisabledAction hideUI
NotYetTransformed = SelectAND (SelectByPath []) (SelectByType UIStep)
HasActions = SelectByContains (SelectAND SelectChildren (SelectByType UIAction))
layoutWithoutActions = sequenceLayouts
[copySubUIAttributes SelectAll [] [0]
,unwrapUI
]
layoutWithActions = sequenceLayouts
[setUIType UIPanel
,addButtonBar
]
layoutParallel = sequenceLayouts
[layoutSubUIs (SelectAND NotYetTransformed HasActions) layoutWithActions
,layoutSubUIs NotYetTransformed layoutWithoutActions
,layoutSubUIs (SelectAND SelectDescendents (SelectByType UIParallel)) layoutParallel
layoutParallelWithActions = sequenceLayouts
[layoutSubUIs (SelectAND (SelectByPath []) (SelectByType UIContainer)) (setUIType UIPanel)
,addToolBar
,modifyUIAttributes (SelectKeys ["class"]) (removeClassAttr "parallel-actions")
]
where
NotYetTransformed = SelectAND (SelectByPath []) (SelectByType UIParallel)
HasActions = SelectByContains (SelectAND SelectChildren (SelectByType UIAction))
layoutWithoutActions = setUIType UIContainer
layoutWithActions = sequenceLayouts [setUIType UIPanel, addToolBar]
layoutInteract = sequenceLayouts
[delUIAttributes (SelectKeys ["task-type"]) //Make sure the rule won't trigger twice
[modifyUIAttributes (SelectKeys ["class"]) (removeClassAttr "interact") //Make sure the rule won't trigger twice
,layoutEditor
,decorateEditor
]
where
layoutEditor = sequenceLayouts
[layoutSubUIs SelectFormElement layoutFormItem
,layoutSubUIs (SelectByType UIRecord) layoutRecord
,layoutSubUIs (SelectByType UICons) layoutCons
,layoutSubUIs (SelectByType UIVarCons) layoutVarCons
,layoutSubUIs (SelectByClass "record") layoutRecord
,layoutSubUIs (SelectByClass "var-cons") layoutVarCons
,layoutSubUIs (SelectByType UIList) layoutList
,layoutSubUIs (SelectByType UIPair) layoutPair
]
layoutFormItem = sequenceLayouts
[toFormItem
,layoutSubUIs (SelectAND SelectDescendents SelectFormElement) layoutFormItem
]
SelectFormElement = SelectByHasAttribute "label"
decorateEditor = layoutSubUIs (SelectOR hasTitle hasPrompt) wrapEditor
where
hasTitle = SelectAND (SelectByPath []) (SelectByHasAttribute "title")
......@@ -111,35 +94,17 @@ where
where
promptToValue attr = 'DM'.fromList [("value",JSONString (maybe "" (\(JSONString s) -> escapeStr s) ('DM'.get "hint" attr)))]
SelectFormElement = SelectByHasAttribute LABEL_ATTRIBUTE
//TODO: consider flattening PAIRs somehow?
layoutPair = sequenceLayouts
[setUIType UIContainer
,layoutSubUIs (SelectAND SelectDescendents (SelectByType UIPair)) layoutPair
]
//Different types of editor containers
layoutRecord :: LayoutRule
layoutRecord = sequenceLayouts
[setUIType UIContainer
,setUIAttributes (heightAttr WrapSize)
,layoutSubUIs (SelectAND SelectDescendents (SelectByType UIRecord)) layoutRecord
]
layoutCons :: LayoutRule
layoutCons = sequenceLayouts
[setUIType UIContainer
,addCSSClass "itasks-cons"
,layoutSubUIs (SelectAND SelectDescendents (SelectByType UICons)) layoutCons
[setUIAttributes (heightAttr WrapSize)
,layoutSubUIs (SelectAND SelectDescendents (SelectByClass "record")) layoutRecord