Commit 6de1195a authored by Bas Lijnse's avatar Bas Lijnse

Added the builtin components for making choices to UI.Editor.Builtin and...

Added the builtin components for making choices to UI.Editor.Builtin and started to migrate Common.InteractionTasks to use them instead of DynamicChoice type
parent 34fb5f86
Pipeline #3731 skipped
......@@ -24,10 +24,12 @@ itasks.itwc_choice_grid = {
me.options.forEach(function(option,rowIdx) {
rowEl = document.createElement('div');
rowEl.addEventListener('click',function(e) {
me.setValue([rowIdx]);
me.doEditEvent(me.taskId,me.editorId,[rowIdx]);
},me);
if(me.doubleClickAction) {
rowEl.addEventListener('dblclick',function(e) {
me.setValue([rowIdx]);
me.doEditEvent(me.taskId,me.editorId,[rowIdx]);
me.sendActionEvent(me.doubleClickAction[0],me.doubleClickAction[1]);
......@@ -51,21 +53,26 @@ itasks.itwc_choice_grid = {
el.appendChild(bodyEl);
},
onAttributeChange: function(name,value) {
var me = this,
bodyEl = me.bodyEl;
var me = this;
if(name == 'value') {
//Remove old selection
me.value.forEach(function(selectedIdx) {
bodyEl.childNodes[selectedIdx].classList.remove(me.cssPrefix + 'selected');
});
//Indicate new selection
me.value = value;
me.value.forEach(function(selectedIdx) {
bodyEl.childNodes[selectedIdx].classList.add(me.cssPrefix + 'selected');
});
me.setValue(value);
}
}
},
setValue: function (value) {
var me = this,
bodyEl = me.bodyEl;
//Remove old selection
me.value.forEach(function(selectedIdx) {
bodyEl.childNodes[selectedIdx].classList.remove(me.cssPrefix + 'selected');
});
//Indicate new selection
me.value = value;
me.value.forEach(function(selectedIdx) {
bodyEl.childNodes[selectedIdx].classList.add(me.cssPrefix + 'selected');
});
}
};
itasks.itwc_choice_tree = {
......@@ -176,13 +183,26 @@ itasks.itwc_choice_list = {
optionEl.classList.add(me.cssPrefix + 'selected');
}
optionEl.addEventListener('click',function(e) {
me.showSelection(idx);
me.doEditEvent(me.taskId,me.editorId,idx);
});
optionEl.innerHTML = option;
el.appendChild(optionEl);
});
}
},
showSelection: function(idx) {
var me = this,
el = me.domEl,
num = el.children.length, i;
for(i = 0; i < num; i++) {
if(i == idx) {
el.children[i].classList.add(me.cssPrefix + 'selected');
} else {
el.children[i].classList.remove(me.cssPrefix + 'selected');
}
}
}
};
......@@ -16,5 +16,5 @@ $tab-base-color: $canvas-base-color;
$tab-text-color: $canvas-text-color;
$tab-border-color: #ccc;
$select-base-color: #eee;
$select-text-color: #000;
$select-base-color: #333;
$select-text-color: #fff;
......@@ -557,8 +557,8 @@ div.itasks-loader {
background-color: #eee; }
.itasks-choicegrid-body > div.itasks-selected {
background-color: #eee;
color: #000;
background-color: #333;
color: #fff;
border: 1px dotted #333; }
.itasks-choicegrid-body > div > div {
......@@ -631,7 +631,7 @@ div.itasks-loader {
.itasks-choice-list {
margin: 0;
border: 1px solid #eee;
border: 1px solid #333;
display: flex;
display: -webkit-flex;
overflow: auto;
......@@ -641,7 +641,7 @@ div.itasks-loader {
-webkit-align-items: stretch; }
.itasks-choice-list-option {
border: solid #eee;
border: solid #333;
border-width: 0 0 1px 0;
padding: 5px 10px;
flex-shrink: 0;
......@@ -650,8 +650,8 @@ div.itasks-loader {
border-width: 0; }
.itasks-choice-list-option.itasks-selected {
background-color: #eee;
color: #000; }
background-color: #333;
color: #fff; }
.itasks-button {
font-size: 8pt;
......
......@@ -12,7 +12,7 @@ import iTasks.API.Core.Tasks, iTasks.API.Core.TaskCombinators
import iTasks.API.Common.TaskCombinators, iTasks.API.Core.SDSs
import iTasks.API.Common.SDSCombinators
import iTasks._Framework.Tonic
import iTasks.UI.Layout, iTasks.UI.Editor, iTasks.UI.Prompt
import iTasks.UI.Layout, iTasks.UI.Editor, iTasks.UI.Prompt, iTasks.UI.Editor.Builtin
enterInformation :: !d ![EnterOption m] -> Task m | toPrompt d & iTask m
enterInformation d [EnterWith fromf:_]
......@@ -86,22 +86,91 @@ updateInformationWithShared d _ shared m
= updateInformation d [] m
//Core choice tasks
editChoiceAs :: !d [ChoiceOption o] ![o] !(o -> a) (Maybe a) -> Task a | toPrompt d & iTask o & iTask a
editChoiceAs d [ChooseWith type:_] container target mbSel
= interact d (if (isNothing mbSel) Enter Update) null (const (map target container,initChoiceView type container target mbSel))
(\v l _ -> (l,v,Nothing))
(\_ l v -> (l,v,Nothing))
Nothing @? choiceRes
editChoiceAs :: !d [ChoiceOption o] ![o] !(o -> a) (Maybe a) -> Task a | toPrompt d & iTask o & iTask a //EXPERIMENT
editChoiceAs d [ChooseWith (AutoChoice f):_] container target mbSel = editChoiceAsSingle d f dropdownBox container target mbSel
editChoiceAs d [ChooseWith (ChooseFromDropdown f):_] container target mbSel = editChoiceAsSingle d f dropdownBox container target mbSel
editChoiceAs d [ChooseWith (ChooseFromRadioButtons f):_] container target mbSel = editChoiceAsSingle d f radioGroup container target mbSel
editChoiceAs d [ChooseWith (ChooseFromList f):_] container target mbSel = editChoiceAsSingle d f choiceList container target mbSel
editChoiceAs d [ChooseWith (ChooseFromGrid f):_] container target mbSel = editChoiceAsGrid d f (const container) null target mbSel
editChoiceAs d [ChooseWith (ChooseFromTree f):_] container target mbSel = editChoiceAsTree d f container target mbSel
editChoiceAs d _ container target mbSel = editChoiceAs d [ChooseWith (AutoChoice id)] container target mbSel
editChoiceSimple :: !d ![o] (Maybe o) -> Task o | toPrompt d & iTask o
editChoiceSimple d container mbSel
= interact d (if (isNothing mbSel) Enter Update) null (const ((),initSimpleChoiceView container mbSel))
editChoiceAsSingle d f editor container target mbSel
# options = map target container
# labels = [toSingleLineText (f o) \\ o <- container]
# selIdx = findIdx mbSel options
= interact d (if (isNothing mbSel) Enter Update) null (const (options,(labels,selIdx)))
(\v l _ -> (l,v,Nothing))
(\_ l v -> (l,v,Nothing))
Nothing @ snd @? simpleChoiceRes
(Just editor) @? result
where
findIdx Nothing options = Nothing
findIdx (Just val) options = listToMaybe [i \\ o <- options & i <- [0..] | o === val]
result (Value (options,(labels,Just idx)) _)
| idx < length options = Value (options !! idx) False
= NoValue
result _ = NoValue
derive class iTask ChoiceGrid
editChoiceAsGrid d f containerf share target mbSel
= interact d (if (isNothing mbSel) Enter Update) share
(\r -> let options = map target (containerf r) in (options, (gridModel (map f (containerf r)), findIdx mbSel options)))
(\v l _ -> (l,v,Nothing)) //Maybe map selection to share
(\r l v -> (l,v,Nothing))
(Just choiceGrid) @? result
where
findIdx Nothing options = Nothing
findIdx (Just val) options = listToMaybe [i \\ o <- options & i <- [0..] | o === val]
result (Value (options,(labels,Just idx)) _)
| idx < length options = Value (options !! idx) False
| otherwise = NoValue
result _ = NoValue
//Create columns and rows in the same function to
//make sure overloading can be solved
gridModel :: [a] -> ChoiceGrid | iTask a
gridModel vals = {ChoiceGrid|header=gText{|*|} AsHeader (fix vals),rows = [gText{|*|} AsRow (Just v) \\ v <- vals]}
where
fix :: [a] -> Maybe a
fix _ = Nothing
derive class iTask ChoiceNode
editChoiceAsTree d f container target mbSel
# options = map target container
# tree = treeModel f container
# selIdx = findIdx mbSel options
= interact d (if (isNothing mbSel) Enter Update) null (const (options,(tree,selIdx)))
(\v l _ -> (l,v,Nothing))
(\_ l v -> (l,v,Nothing))
(Just choiceTree) @? result
where
findIdx Nothing options = Nothing
findIdx (Just val) options = listToMaybe [i \\ o <- options & i <- [0..] | o === val]
result (Value (options,(labels,Just idx)) _)
| idx < length options = Value (options !! idx) False
| otherwise = NoValue
result _ = NoValue
treeModel :: ([(Int,a)] [ChoiceTreeValue] -> [ChoiceTree v]) [a] -> [ChoiceNode] | iTask v
treeModel f container = map convert ( f [(i,o) \\ i <- [0..] & o <- container] [])
where
convert {ChoiceTree|label,icon,value,type}
# id = case value of
(ChoiceNode i) = i
(GroupNode s) = -1 //Incorrect, but needs to be fixed in the API. group nodes like this don't make sense anymore
# label = toSingleLineText label
# (expanded,children) = case type of
LeafNode = (False,[])
(CollapsedNode nodes) = (False,map convert nodes)
(ExpandedNode nodes) = (True, map convert nodes)
= {ChoiceNode| id = id, label = label, icon = icon, expanded = expanded, children = children}
editChoiceWithSharedAs :: !d ![ChoiceOption o] !(ReadWriteShared [o] w) (o -> a) (Maybe a) -> Task a | toPrompt d & iTask o & iTask w & iTask a
//editChoiceWithSharedAs d [ChooseWith (ChooseFromGrid f)] sharedContainer target mbSel = editChoiceAsGrid d f id sharedContainer target mbSel //EXPERIMENT
editChoiceWithSharedAs d [ChooseWith type:_] sharedContainer target mbSel
= interact d Update sharedContainer (\r -> (map target r, initChoiceView type r target mbSel))
(\v l _ -> (l,v,Nothing))
......@@ -109,6 +178,13 @@ editChoiceWithSharedAs d [ChooseWith type:_] sharedContainer target mbSel
Nothing @? choiceRes
editChoiceWithSharedAs d _ container target mbSel = editChoiceWithSharedAs d [ChooseWith (AutoChoice id)] container target mbSel
editChoiceSimple :: !d ![o] (Maybe o) -> Task o | toPrompt d & iTask o
editChoiceSimple d container mbSel
= interact d (if (isNothing mbSel) Enter Update) null (const ((),initSimpleChoiceView container mbSel))
(\v l _ -> (l,v,Nothing))
(\_ l v -> (l,v,Nothing))
Nothing @ snd @? simpleChoiceRes
editChoiceWithSharedSimple :: !d !(ReadWriteShared [o] w) (Maybe o) -> Task o | toPrompt d & iTask o & iTask w
editChoiceWithSharedSimple d sharedContainer mbSel
= interact d (if (isNothing mbSel) Enter Update) sharedContainer (\r -> (r,initSimpleChoiceView r mbSel))
......@@ -217,16 +293,6 @@ simpleChoiceRes (Value view _) = case getSelectionView view of
_ = NoValue
simpleChoiceRes _ = NoValue
mapSharedSel :: (TaskValue ([a],DynamicChoice v)) (Maybe a) -> (Maybe (Maybe a)) | gEq{|*|} a
mapSharedSel (Value (targets,view) _) (Just ov) = maybe Nothing (\idx -> let nv = targets !! idx in if (nv =!= ov) (Just (Just nv)) Nothing) (getSelectionIndex view)
mapSharedSel (Value (targets,view) _) _ = fmap (\idx -> Just (targets !! idx)) (getSelectionIndex view)
mapSharedSel _ _ = Nothing
mapSimpleSharedSel :: (TaskValue (DynamicChoice a)) (Maybe a) -> (Maybe (Maybe a)) | gEq{|*|} a
mapSimpleSharedSel (Value view _) (Just ov) = maybe Nothing (\nv -> if (nv =!= ov) (Just (Just nv)) Nothing) (getSelectionView view)
mapSimpleSharedSel (Value view _) _ = fmap Just (getSelectionView view)
mapSimpleSharedSel _ _ = Nothing
selectionFromChoiceView :: [a] (DynamicChoice v) -> (Maybe a)
selectionFromChoiceView targets dynChoice = fmap (\idx -> targets !! idx) (getSelectionIndex dynChoice)
......
definition module iTasks.UI.Definition
/**
* This module provides an abstract representation of user interfaces.
*
* It is the interface between UI's as specified by tasks and the Web-based UI framework that
* renders the task UI's in a web browser.
*
* This representation seeks a middle ground between being fine grained enough
* to describe rich user interfaces and being leaving rendering details to the client framework.
* to describe rich user interfaces and being abstract enough to leave rendering details to the client framework.
*/
from Text.JSON import :: JSONNode
from Data.Maybe import :: Maybe
......
......@@ -11,11 +11,32 @@ integerField :: Editor Int
decimalField :: Editor Real
passwordField :: Editor String
checkBox :: Editor Bool
textArea :: Editor String
slider :: Editor Int
dropdownBox :: Editor String
progressBar :: Editor Int
checkBox :: Editor Bool
textArea :: Editor String
slider :: Editor Int
progressBar :: Editor Int
dropdownBox :: Editor ([String],Maybe Int)
radioGroup :: Editor ([String],Maybe Int)
choiceList :: Editor ([String], Maybe Int)
:: ChoiceGrid =
{ header :: [String]
, rows :: [[String]]
}
choiceGrid :: Editor (ChoiceGrid, Maybe Int)
:: ChoiceNode =
{ id :: Int
, label :: String
, icon :: Maybe String
, expanded :: Bool
, children :: [ChoiceNode]
}
choiceTree :: Editor ([ChoiceNode], Maybe Int)
textView :: Editor String
htmlView :: Editor HtmlTag
......
implementation module iTasks.UI.Editor.Builtin
import iTasks.UI.Definition, iTasks.UI.Editor
import StdFunc, GenEq
import StdFunc, StdBool, GenEq
import Data.Error, Text.JSON, Text.HTML
import qualified Data.Map as DM
textField :: Editor String
textField = simpleComponent toJSON UITextField
textField = fieldComponent toJSON UITextField
integerField :: Editor Int
integerField = simpleComponent toJSON UIIntegerField
integerField = fieldComponent toJSON UIIntegerField
decimalField :: Editor Real
decimalField = simpleComponent toJSON UIDecimalField
decimalField = fieldComponent toJSON UIDecimalField
passwordField :: Editor String
passwordField = simpleComponent toJSON UIPasswordField
passwordField = fieldComponent toJSON UIPasswordField
textArea :: Editor String
textArea = simpleComponent toJSON UITextArea
textArea = fieldComponent toJSON UITextArea
checkBox :: Editor Bool
checkBox = simpleComponent toJSON UICheckbox
checkBox = fieldComponent toJSON UICheckbox
dropdownBox :: Editor ([String], Maybe Int)
dropdownBox = choiceComponent (const 'DM'.newMap) id JSONString (\i o -> i >= 0 && i < length o) UIDropdown
radioGroup :: Editor ([String],Maybe Int)
radioGroup = choiceComponent (const 'DM'.newMap) id JSONString (\i o -> i >= 0 && i < length o) UIRadioGroup
choiceList :: Editor ([String],Maybe Int)
choiceList = choiceComponent (const 'DM'.newMap) id JSONString (\i o -> i >= 0 && i < length o) UIListChoice
choiceGrid :: Editor (ChoiceGrid, Maybe Int)
choiceGrid = choiceComponent (\{ChoiceGrid|header} -> columnsAttr header) (\{ChoiceGrid|rows} -> rows) toOption (\i o -> i >= 0 && i < length o) UIGrid
where
toOption opt = JSONArray (map JSONString opt)
choiceTree :: Editor ([ChoiceNode], Maybe Int)
choiceTree = choiceComponent (const 'DM'.newMap) id toOption checkBounds UITree
where
toOption {ChoiceNode|id,label,icon,expanded,children}
= JSONObject [("text",JSONString label)
,("iconCls",maybe JSONNull (\i -> JSONString ("icon-"+++i)) icon)
,("value",JSONInt id)
,("expanded",JSONBool expanded)
,("leaf",JSONBool (isEmpty children))
,("children",JSONArray (map toOption children))
]
checkBounds idx options
= or (map (checkNode idx) options)
checkNode idx {ChoiceNode|id,children}
| idx == id = True
| otherwise = or (map (checkNode idx) children)
slider :: Editor Int
slider = integerField
dropdownBox :: Editor String
dropdownBox = textField
progressBar :: Editor Int
progressBar = integerField
textView :: Editor String
textView = simpleComponent toJSON UIViewString
textView = fieldComponent toJSON UIViewString
htmlView :: Editor HtmlTag
htmlView = simpleComponent (JSONString o toString) UIViewHtml
htmlView = fieldComponent (JSONString o toString) UIViewHtml
icon :: Editor String
icon = simpleComponent toJSON UIIcon
icon = fieldComponent toJSON UIIcon
//Simple components for which simply knowing the UI type is sufficient
simpleComponent toValue type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
//Field like components for which simply knowing the UI type is sufficient
fieldComponent toValue type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst=:{VSt|taskId,mode,optional}
# val = if (mode =: Enter) JSONNull (toValue val)
......@@ -62,3 +91,32 @@ where
| old === new = (Ok (NoChange,mask),new,vst)
| otherwise = (Ok (ChangeUI [SetAttribute "value" (toValue new)] [],mask),new,vst)
//Choice components that have a set of options
choiceComponent attr getOptions toOption checkBounds type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (val,sel) vst=:{VSt|taskId,mode,optional}
# valid = if (mode =: Enter) optional True //When entering data a value is initially only valid if it is optional
# mask = FieldMask {touched = False, valid = valid, state = JSONNull}
# attr = 'DM'.unions [attr val,choiceAttrs taskId (editorId dp) (maybeToList sel) (map toOption (getOptions val))]
= (Ok (uia type attr,mask), vst)
onEdit dp (tp,e) (val,sel) mask vst=:{VSt|optional}
# options = getOptions val
= case e of
JSONNull
= (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),(val,Nothing),vst)
(JSONArray [JSONInt idx])
| checkBounds idx options
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONInt idx}),(val,Just idx),vst)
| otherwise
= (Error ("Choice event out of bounds: " +++ toString idx),(val,sel),vst)
(JSONInt idx)
| checkBounds idx options
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONInt idx}),(val,Just idx),vst)
| otherwise
= (Error ("Choice event out of bounds: " +++ toString idx),(val,sel),vst)
_
= (Error ("Invalid choice event: " +++ toString e), (val,sel),vst)
onRefresh dp new old mask vst
= (Ok (NoChange,mask),new,vst)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment