Commit c42865f1 authored by Bas Lijnse's avatar Bas Lijnse

Standardised selection type of all choice editors to [Int]

parent 96504386
......@@ -87,8 +87,8 @@ updateInformationWithShared d _ shared m
//Core choice tasks
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 (AutoChoice f):_] container target mbSel = editChoiceAsSingle d f dropdown container target mbSel
editChoiceAs d [ChooseWith (ChooseFromDropdown f):_] container target mbSel = editChoiceAsSingle d f dropdown 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
......@@ -104,10 +104,10 @@ editChoiceAsSingle d f editor container target mbSel
(\_ l v -> (l,v,Nothing))
(Just editor) @? result
where
findIdx Nothing options = Nothing
findIdx (Just val) options = listToMaybe [i \\ o <- options & i <- [0..] | o === val]
findIdx Nothing options = []
findIdx (Just val) options = [i \\ o <- options & i <- [0..] | o === val]
result (Value (options,(labels,Just idx)) _)
result (Value (options,(labels,[idx])) _)
| idx < length options = Value (options !! idx) False
= NoValue
result _ = NoValue
......@@ -119,12 +119,12 @@ editChoiceAsGrid d f containerf share target mbSel
(\v l _ -> (l,v,Nothing)) //Maybe map selection to share
(\r l v -> (l,v,Nothing))
(Just choiceGrid) @? result
(Just grid) @? result
where
findIdx Nothing options = Nothing
findIdx (Just val) options = listToMaybe [i \\ o <- options & i <- [0..] | o === val]
findIdx Nothing options = []
findIdx (Just val) options = [i \\ o <- options & i <- [0..] | o === val]
result (Value (options,(labels,Just idx)) _)
result (Value (options,(labels,[idx])) _)
| idx < length options = Value (options !! idx) False
| otherwise = NoValue
result _ = NoValue
......@@ -140,17 +140,17 @@ where
derive class iTask ChoiceNode
editChoiceAsTree d f container target mbSel
# options = map target container
# tree = treeModel f container
# model = treeModel f container
# selIdx = findIdx mbSel options
= interact d (if (isNothing mbSel) Enter Update) null (const (options,(tree,selIdx)))
= interact d (if (isNothing mbSel) Enter Update) null (const (options,(model,selIdx)))
(\v l _ -> (l,v,Nothing))
(\_ l v -> (l,v,Nothing))
(Just choiceTree) @? result
(Just tree) @? result
where
findIdx Nothing options = Nothing
findIdx (Just val) options = listToMaybe [i \\ o <- options & i <- [0..] | o === val]
findIdx Nothing options = []
findIdx (Just val) options = [i \\ o <- options & i <- [0..] | o === val]
result (Value (options,(labels,Just idx)) _)
result (Value (options,(labels,[idx])) _)
| idx < length options = Value (options !! idx) False
| otherwise = NoValue
result _ = NoValue
......
......@@ -611,32 +611,11 @@ derive gEditor ButtonState
//* Table consisting of headers, the displayed data cells & possibly a selection
gText{|Table|} _ _ = ["<Table>"]
gEditor{|Table|} = liftEditor toGrid fromGrid choiceGrid
where
toGrid (Table header rows mbSel) = ({ChoiceGrid|header=header,rows=rows},mbSel)
fromGrid ({ChoiceGrid|header,rows},mbSel) = Table header rows mbSel
/*
{Editor|genUI=genUI,onEdit=onEdit,onRefresh}
gEditor{|Table|} = liftEditor toGrid fromGrid grid
where
genUI dp val vst=:{VSt|taskId}
# attr = 'DM'.unions [choiceAttrs taskId (editorId dp) (value val) (options val),columnsAttr (columns val)]
= (Ok (uia UIGrid attr,newFieldMask),vst)
where
value (Table _ _ mbSel) = maybe [] (\s->[s]) mbSel
columns (Table headers _ _) = headers
options (Table _ cells _) = map (toJSON o (map toString)) cells
onEdit = basicEdit (\json (Table headers cells _) -> case fromJSON json of Just i = Just (Table headers cells (Just i)); _ = Just (Table headers cells Nothing))
onRefresh dp new old mask vst
| old === new
= (Ok (NoChange,mask),new,vst)
= case genUI dp new vst of
(Ok (ui,mask),vst) = (Ok (ReplaceUI ui,mask),new,vst)
(Error e,vst) = (Error e,old,vst)
toGrid (Table header rows mbSel) = ({ChoiceGrid|header=header,rows=rows},maybeToList mbSel)
fromGrid ({ChoiceGrid|header,rows},sel) = Table header rows (listToMaybe sel)
*/
gDefault{|Table|} = Table [] [] Nothing
toTable :: ![a] -> Table | gText{|*|} a
......
......@@ -29,19 +29,19 @@ htmlView :: Editor HtmlTag
progressBar :: Editor Int
// ## Selection components ##
dropdownBox :: Editor ([String],Maybe Int)
radioGroup :: Editor ([String],Maybe Int)
choiceList :: Editor ([String], Maybe Int)
// UIDropdown, UIRadioGroup, UICheckboxGroup, UIChoiceList, UIGrid, UITree
dropdown :: Editor ([String], [Int])
radioGroup :: Editor ([String], [Int])
checkboxGroup :: Editor ([String], [Int])
choiceList :: Editor ([String], [Int])
grid :: Editor (ChoiceGrid, [Int])
tree :: Editor ([ChoiceNode], [Int])
:: ChoiceGrid =
{ header :: [String]
, rows :: [[HtmlTag]]
}
choiceGrid :: Editor (ChoiceGrid, Maybe Int)
:: ChoiceNode =
{ id :: Int
, label :: String
......@@ -49,6 +49,3 @@ choiceGrid :: Editor (ChoiceGrid, Maybe Int)
, expanded :: Bool
, children :: [ChoiceNode]
}
choiceTree :: Editor ([ChoiceNode], Maybe Int)
......@@ -32,22 +32,28 @@ slider = fieldComponent toJSON UISlider
label :: Editor String
label = fieldComponent toJSON UILabel
dropdownBox :: Editor ([String], Maybe Int)
dropdownBox = choiceComponent (const 'DM'.newMap) id JSONString (\i o -> i >= 0 && i < length o) UIDropdown
icon :: Editor String
icon = fieldComponent toJSON UIIcon
dropdown :: Editor ([String], [Int])
dropdown = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UIDropdown
radioGroup :: Editor ([String],[Int])
radioGroup = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UIRadioGroup
radioGroup :: Editor ([String],Maybe Int)
radioGroup = choiceComponent (const 'DM'.newMap) id JSONString (\i o -> i >= 0 && i < length o) UIRadioGroup
checkboxGroup :: Editor ([String],[Int])
checkboxGroup = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UICheckboxGroup
choiceList :: Editor ([String],Maybe Int)
choiceList = choiceComponent (const 'DM'.newMap) id JSONString (\i o -> i >= 0 && i < length o) UIChoiceList
choiceList :: Editor ([String],[Int])
choiceList = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UIChoiceList
choiceGrid :: Editor (ChoiceGrid, Maybe Int)
choiceGrid = choiceComponent (\{ChoiceGrid|header} -> columnsAttr header) (\{ChoiceGrid|rows} -> rows) toOption (\i o -> i >= 0 && i < length o) UIGrid
grid :: Editor (ChoiceGrid, [Int])
grid = choiceComponent (\{ChoiceGrid|header} -> columnsAttr header) (\{ChoiceGrid|rows} -> rows) toOption (\o i -> i >= 0 && i < length o) UIGrid
where
toOption opt = JSONArray (map (JSONString o toString) opt)
choiceTree :: Editor ([ChoiceNode], Maybe Int)
choiceTree = choiceComponent (const 'DM'.newMap) id toOption checkBounds UITree
tree :: Editor ([ChoiceNode], [Int])
tree = choiceComponent (const 'DM'.newMap) id toOption checkBounds UITree
where
toOption {ChoiceNode|id,label,icon,expanded,children}
= JSONObject [("text",JSONString label)
......@@ -58,7 +64,7 @@ where
,("children",JSONArray (map toOption children))
]
checkBounds idx options
checkBounds options idx
= or (map (checkNode idx) options)
checkNode idx {ChoiceNode|id,children}
| idx == id = True
......@@ -74,8 +80,6 @@ textView = fieldComponent toJSON UITextView
htmlView :: Editor HtmlTag
htmlView = fieldComponent (JSONString o toString) UIHtmlView
icon :: Editor String
icon = fieldComponent toJSON UIIcon
//Field like components for which simply knowing the UI type is sufficient
fieldComponent toValue type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
......@@ -104,22 +108,23 @@ 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))]
# attr = 'DM'.unions [attr val,choiceAttrs taskId (editorId dp) 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)
= (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),(val,[]),vst)
(JSONArray indices)
# selection = [i \\ JSONInt i <- indices]
| all (checkBounds options) selection
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONArray indices}),(val,selection),vst)
| otherwise
= (Error ("Choice event out of bounds: " +++ toString idx),(val,sel),vst)
= (Error ("Choice event out of bounds: " +++ toString (JSONArray indices)),(val,sel),vst)
(JSONInt idx)
| checkBounds idx options
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONInt idx}),(val,Just idx),vst)
| checkBounds options idx
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONInt idx}),(val,[idx]),vst)
| otherwise
= (Error ("Choice event out of bounds: " +++ toString idx),(val,sel),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