Commit a077490d authored by Bas Lijnse's avatar Bas Lijnse

Refactored selection components to always use explicit identification

parent cfb68c34
This diff is collapsed.
......@@ -4,9 +4,7 @@ import iTasks.API.Core.Tasks
from iTasks.API.Core.Types import :: Date, :: Time, :: DateTime, :: Action
from Data.Functor import class Functor
from iTasks.UI.Editor.Builtin import :: ChoiceNode, :: ChoiceGrid
//from iTasks.API.Core.Types import :: ChoiceTree, :: ChoiceTreeValue, :: Date, :: Time, :: DateTime, :: Action
//import Data.Functor
from iTasks.UI.Editor.Builtin import :: ChoiceText, :: ChoiceGrid, :: ChoiceNode
/*** General input/update/output tasks ***/
......@@ -26,9 +24,9 @@ from iTasks.UI.Editor.Builtin import :: ChoiceNode, :: ChoiceGrid
| E.v: UpdateSharedAs (a -> v) (a v -> b) (v v -> v) & iTask v
//Selection in arbitrary containers (explicit identification is needed)
:: SelectOption c s = SelectInDropdown (c -> [String]) (c [Int] -> [s])
| SelectInCheckGroup (c -> [String]) (c [Int] -> [s])
| SelectInList (c -> [String]) (c [Int] -> [s])
:: SelectOption c s = SelectInDropdown (c -> [ChoiceText]) (c [Int] -> [s])
| SelectInCheckGroup (c -> [ChoiceText]) (c [Int] -> [s])
| SelectInList (c -> [ChoiceText]) (c [Int] -> [s])
| SelectInGrid (c -> ChoiceGrid) (c [Int] -> [s])
| SelectInTree (c -> [ChoiceNode]) (c [Int] -> [s])
......
......@@ -15,7 +15,7 @@ import iTasks._Framework.Tonic
import iTasks.UI.Layout, iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Prompt, iTasks.UI.Editor.Builtin
import Text.HTML
derive class iTask ChoiceGrid, ChoiceNode
derive class iTask ChoiceText, ChoiceGrid, ChoiceRow, ChoiceNode
enterInformation :: !d ![EnterOption m] -> Task m | toPrompt d & iTask m
enterInformation d [EnterAs fromf:_]
......@@ -255,14 +255,14 @@ editSharedMultipleChoiceWithSharedAs d vopts sharedContainer target sharedSel
//Helper functions for the edit*Choice* tasks
selectOption target opts = case opts of
[(ChooseFromDropdown f):_] = SelectInDropdown (toLabels f) (findSelection target)
[(ChooseFromCheckGroup f):_] = SelectInCheckGroup (toLabels f) (findSelection target)
[(ChooseFromList f):_] = SelectInList (toLabels f) (findSelection target)
[(ChooseFromDropdown f):_] = SelectInDropdown (toTexts f) (findSelection target)
[(ChooseFromCheckGroup f):_] = SelectInCheckGroup (toTexts f) (findSelection target)
[(ChooseFromList f):_] = SelectInList (toTexts f) (findSelection target)
[(ChooseFromGrid f):_] = SelectInGrid (toGrid f) (findSelection target)
_ = SelectInDropdown (toLabels id) (findSelection target)
_ = SelectInDropdown (toTexts id) (findSelection target)
toLabels f options = map (toSingleLineText o f) options
toGrid f options = {ChoiceGrid|header=gText{|*|} AsHeader (fixtype vals),rows = [map Text (gText{|*|} AsRow (Just v)) \\ v <- vals]}
toTexts f options = [{ChoiceText|id=i,text=toSingleLineText (f o)} \\ o <- options & i <- [0..]]
toGrid f options = {ChoiceGrid|header=gText{|*|} AsHeader (fixtype vals),rows = [{ChoiceRow|id=i,cells=map Text (gText{|*|} AsRow (Just v))} \\ v <- vals & i <- [0..]]}
where
vals = map f options
......
......@@ -585,8 +585,8 @@ derive gEditor ButtonState
gText{|Table|} _ _ = ["<Table>"]
gEditor{|Table|} = liftEditor toGrid fromGrid (grid (multipleAttr False))
where
toGrid (Table header rows mbSel) = ({ChoiceGrid|header=header,rows=rows},maybeToList mbSel)
fromGrid ({ChoiceGrid|header,rows},sel) = Table header rows (listToMaybe sel)
toGrid (Table header rows mbSel) = ({ChoiceGrid|header=header,rows=[{ChoiceRow|id=i,cells=cells} \\ cells <- rows & i <- [0..]]},maybeToList mbSel)
fromGrid ({ChoiceGrid|header,rows},sel) = Table header [cells \\ {ChoiceRow|cells} <- rows] (listToMaybe sel)
gDefault{|Table|} = Table [] [] Nothing
......
......@@ -34,16 +34,24 @@ progressBar :: UIAttributes -> Editor (Maybe Int,Maybe String) //Percentage, d
// ## Selection components ##
// UIDropdown, UIRadioGroup, UICheckboxGroup, UIChoiceList, UIGrid, UITree
dropdown :: UIAttributes -> Editor ([String], [Int])
checkGroup :: UIAttributes -> Editor ([String], [Int])
choiceList :: UIAttributes -> Editor ([String], [Int])
dropdown :: UIAttributes -> Editor ([ChoiceText], [Int])
checkGroup :: UIAttributes -> Editor ([ChoiceText], [Int])
choiceList :: UIAttributes -> Editor ([ChoiceText], [Int])
grid :: UIAttributes -> Editor (ChoiceGrid, [Int])
tree :: UIAttributes -> Editor ([ChoiceNode], [Int])
//Convenient types for describing the values of grids and trees
:: ChoiceText =
{ id :: Int
, text :: String
}
:: ChoiceGrid =
{ header :: [String]
, rows :: [[HtmlTag]]
, rows :: [ChoiceRow]
}
:: ChoiceRow =
{ id :: Int
, cells :: [HtmlTag]
}
:: ChoiceNode =
......
......@@ -49,19 +49,23 @@ progressBar attr = viewComponent combine UIProgressBar
where
combine (amount,text) = 'DM'.unions ((maybe [] (\t -> [textAttr t]) text) ++ (maybe [] (\v -> [valueAttr (JSONInt v)]) amount) ++ [attr])
dropdown :: UIAttributes -> Editor ([String], [Int])
dropdown attr = choiceComponent (const attr) id JSONString (\o i -> i >= 0 && i < length o) UIDropdown
dropdown :: UIAttributes -> Editor ([ChoiceText], [Int])
dropdown attr = choiceComponent (const attr) id toOptionText checkBoundsText UIDropdown
checkGroup :: UIAttributes -> Editor ([String],[Int])
checkGroup attr = choiceComponent (const attr) id JSONString (\o i -> i >= 0 && i < length o) UICheckGroup
checkGroup :: UIAttributes -> Editor ([ChoiceText], [Int])
checkGroup attr = choiceComponent (const attr) id toOptionText checkBoundsText UICheckGroup
choiceList :: UIAttributes -> Editor ([String],[Int])
choiceList attr = choiceComponent (const attr) id JSONString (\o i -> i >= 0 && i < length o) UIChoiceList
choiceList :: UIAttributes -> Editor ([ChoiceText], [Int])
choiceList attr = choiceComponent (const attr) id toOptionText checkBoundsText UIChoiceList
toOptionText {ChoiceText|id,text}= JSONObject [("id",JSONInt id),("text",JSONString text)]
checkBoundsText options idx = or [id == idx \\ {ChoiceText|id} <- options]
grid :: UIAttributes -> Editor (ChoiceGrid, [Int])
grid attr = choiceComponent (\{ChoiceGrid|header} -> 'DM'.union attr (columnsAttr header)) (\{ChoiceGrid|rows} -> rows) toOption (\o i -> i >= 0 && i < length o) UIGrid
grid attr = choiceComponent (\{ChoiceGrid|header} -> 'DM'.union attr (columnsAttr header)) (\{ChoiceGrid|rows} -> rows) toOption checkBounds UIGrid
where
toOption opt = JSONArray (map (JSONString o toString) opt)
toOption {ChoiceRow|id,cells}= JSONObject [("id",JSONInt id),("cells",JSONArray (map (JSONString o toString) cells))]
checkBounds options idx = or [id == idx \\ {ChoiceRow|id} <- options]
tree :: UIAttributes -> Editor ([ChoiceNode], [Int])
tree attr = choiceComponent (const attr) id toOption checkBounds UITree
......@@ -69,9 +73,8 @@ where
toOption {ChoiceNode|id,label,icon,expanded,children}
= JSONObject [("text",JSONString label)
,("iconCls",maybe JSONNull (\i -> JSONString ("icon-"+++i)) icon)
,("value",JSONInt id)
,("id",JSONInt id)
,("expanded",JSONBool expanded)
,("leaf",JSONBool (isEmpty children))
,("children",JSONArray (map toOption children))
]
......@@ -130,17 +133,12 @@ where
= case e of
JSONNull
= (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),(val,[]),vst)
(JSONArray indices)
# selection = [i \\ JSONInt i <- indices]
(JSONArray ids)
# selection = [i \\ JSONInt i <- ids]
| 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 (JSONArray indices)),(val,sel),vst)
(JSONInt idx)
| checkBounds options idx
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONInt idx}),(val,[idx]),vst)
= (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONArray ids}),(val,selection),vst)
| otherwise
= (Error ("Choice event out of bounds: " +++ toString idx),(val,sel),vst)
= (Error ("Choice event out of bounds: " +++ toString (JSONArray ids)),(val,sel),vst)
_
= (Error ("Invalid choice event: " +++ toString e), (val,sel),vst)
......
......@@ -112,7 +112,8 @@ where
= (viz,{vst & selectedConsIndex = selectedConsIndex})
| otherwise
//Initially only generate a UI to choose a constructor
# consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) [] [JSONString gdc.gcd_name \\ gdc <- gtd_conses])
# consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gdc.gcd_name)] \\ gdc <- gtd_conses & i <- [0..]]
# consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) [] consOptions)
# consChooseMask = FieldMask {touched=False,valid=optional,state=JSONNull}
= (Ok (UI UIVarCons 'DM'.newMap [consChooseUI],CompoundMask [consChooseMask]),{vst & selectedConsIndex = selectedConsIndex})
Update
......@@ -122,7 +123,8 @@ where
| otherwise
= case ex.Editor.genUI dp x vst of
(Ok (UI UICons attr items, CompoundMask masks),vst)
# consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) [vst.selectedConsIndex] [JSONString gdc.gcd_name \\ gdc <- gtd_conses])
# consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gdc.gcd_name)] \\ gdc <- gtd_conses & i <- [0..]]
# consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) [vst.selectedConsIndex] consOptions)
# consChooseMask = FieldMask {touched=False,valid=True,state=JSONInt vst.selectedConsIndex}
= (Ok (UI UIVarCons attr [consChooseUI:items],CompoundMask [consChooseMask:masks]),{vst & selectedConsIndex = selectedConsIndex})
(Error e,vst) = (Error e,vst)
......@@ -145,7 +147,7 @@ where
# consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
= (Ok (change,CompoundMask [consChooseMask:masks]),OBJECT val, vst)
onEdit dp ([],JSONInt consIdx) (OBJECT val) (CompoundMask [FieldMask {FieldMask|touched,valid,state}:masks]) vst=:{VSt|mode} //Update is a constructor switch
onEdit dp ([],JSONArray [JSONInt consIdx]) (OBJECT val) (CompoundMask [FieldMask {FieldMask|touched,valid,state}:masks]) vst=:{VSt|mode} //Update is a constructor switch
| consIdx < 0 || consIdx >= gtd_num_conses
= (Error "Constructor selection out of bounds",OBJECT val,vst)
//Create a default value for the selected constructor
......
......@@ -5,7 +5,7 @@ import iTasks.UI.Editor.Builtin, iTasks.UI.Definition
import qualified Data.Map as DM
import Text.HTML
derive class iTask ChoiceGrid, ChoiceNode
derive class iTask ChoiceText, ChoiceGrid, ChoiceRow, ChoiceNode
testBuiltinEditors :: TestSuite
testBuiltinEditors = testsuite "Builtin editors" "These tests check if the builtin editors work"
......@@ -89,23 +89,25 @@ where
testDropdown = itest "Dropdown" "Check if the dropdown works" "You should be able to edit" tut
where
tut :: Task ([String],[Int])
tut = testEditor (dropdown (multipleAttr False)) (["A","B","C"],[]) Update
tut :: Task ([ChoiceText],[Int])
tut = testEditor (dropdown (multipleAttr False)) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
testCheckGroup = itest "Check group" "Check if the checkgroup works" "You should be able to edit" tut
where
tut :: Task ([String],[Int])
tut = testEditor (checkGroup (multipleAttr False)) (["A","B","C"],[]) Update
tut :: Task ([ChoiceText],[Int])
tut = testEditor (checkGroup (multipleAttr False)) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
testChoiceList = itest "Choice list" "Check if the choice list works" "You should be able to edit" tut
where
tut :: Task ([String],[Int])
tut = testEditor (choiceList (multipleAttr False)) (["A","B","C"],[]) Update
tut :: Task ([ChoiceText],[Int])
tut = testEditor (choiceList (multipleAttr False)) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
testGrid = itest "Grid" "Check if the grid works" "You should be able to edit" tut
where
tut :: Task (ChoiceGrid,[Int])
tut = testEditor (grid (multipleAttr False)) ({ChoiceGrid|header=["Key","Value"],rows=[[Text "A",Text "1"],[Text "B",Text "2"],[Text "C",Text "3"]]},[]) Update
tut = testEditor (grid (multipleAttr False)) ({ChoiceGrid|header=["Key","Value"],rows=rows},[]) Update
rows = [{ChoiceRow|id=1,cells=[Text "A",Text "1"]},{ChoiceRow|id=2,cells=[Text "B",Text "2"]},{ChoiceRow|id=3,cells=[Text "C",Text "3"]}]
testTree = itest "Tree" "Check if the tree works" "You should be able to edit" tut
where
......@@ -118,18 +120,20 @@ where
testCheckGroupMulti = itest "Check group (multiple)" "Check if the checkgroup works" "You should be able to select multiple" tut
where
tut :: Task ([String],[Int])
tut = testEditor (checkGroup (multipleAttr True)) (["A","B","C"],[]) Update
tut :: Task ([ChoiceText],[Int])
tut = testEditor (checkGroup (multipleAttr True)) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
testChoiceListMulti = itest "Choice list (multiple)" "Check if the choice list works" "You should be able to select multiple" tut
where
tut :: Task ([String],[Int])
tut = testEditor (choiceList (multipleAttr True)) (["A","B","C"],[]) Update
tut :: Task ([ChoiceText],[Int])
tut = testEditor (choiceList (multipleAttr True)) ([{ChoiceText|id=0,text="A"},{ChoiceText|id=1,text="B"},{ChoiceText|id=2,text="C"}],[]) Update
testGridMulti = itest "Grid (multiple)" "Check if the grid works" "You should be able to select multiple" tut
where
tut :: Task (ChoiceGrid,[Int])
tut = testEditor (grid (multipleAttr True)) ({ChoiceGrid|header=["Key","Value"],rows=[[Text "A",Text "1"],[Text "B",Text "2"],[Text "C",Text "3"]]},[]) Update
tut = testEditor (grid (multipleAttr True)) ({ChoiceGrid|header=["Key","Value"],rows=rows},[]) Update
rows = [{ChoiceRow|id=1,cells=[Text "A",Text "1"]},{ChoiceRow|id=2,cells=[Text "B",Text "2"]},{ChoiceRow|id=3,cells=[Text "C",Text "3"]}]
testTreeMulti = itest "Tree (multiple)" "Check if the tree works" "You should be able to select multiple" tut
where
......
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