Commit 89835d44 authored by Bas Lijnse's avatar Bas Lijnse

Standardised setting options for the builtin editors

parent 1ed4f2ee
......@@ -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, iTasks.UI.Editor.Builtin
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
......@@ -94,11 +94,11 @@ updateInformationWithShared d _ shared m
= updateInformation d [] m
editSelection :: !d !Bool !(SelectOption c a) c [Int] -> Task [a] | toPrompt d & iTask a
editSelection d multi (SelectInDropdown toView fromView) container sel = editSelection` d (dropdown multi) toView fromView container sel
editSelection d multi (SelectInCheckGroup toView fromView) container sel = editSelection` d (checkGroup multi) toView fromView container sel
editSelection d multi (SelectInList toView fromView) container sel = editSelection` d (choiceList multi) toView fromView container sel
editSelection d multi (SelectInGrid toView fromView) container sel = editSelection` d (grid multi) toView fromView container sel
editSelection d multi (SelectInTree toView fromView) container sel = editSelection` d (tree multi) toView fromView container sel
editSelection d multi (SelectInDropdown toView fromView) container sel = editSelection` d (dropdown (multipleAttr multi)) toView fromView container sel
editSelection d multi (SelectInCheckGroup toView fromView) container sel = editSelection` d (checkGroup (multipleAttr multi)) toView fromView container sel
editSelection d multi (SelectInList toView fromView) container sel = editSelection` d (choiceList (multipleAttr multi)) toView fromView container sel
editSelection d multi (SelectInGrid toView fromView) container sel = editSelection` d (grid (multipleAttr multi)) toView fromView container sel
editSelection d multi (SelectInTree toView fromView) container sel = editSelection` d (tree (multipleAttr multi)) toView fromView container sel
editSelection` d editor toView fromView container sel
= interact d (if (isEmpty sel) Enter Update) null
(\r -> ((),(toView container,sel)))
......@@ -107,11 +107,11 @@ editSelection` d editor toView fromView container sel
(Just editor) @ (\(_,(_,sel)) -> fromView container sel)
editSelectionWithShared :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (c -> [Int]) -> Task [a] | toPrompt d & iTask c & iTask a
editSelectionWithShared d multi (SelectInDropdown toView fromView) sharedContainer initSel = editSelectionWithShared` d (dropdown multi) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInCheckGroup toView fromView) sharedContainer initSel = editSelectionWithShared` d (checkGroup multi) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInList toView fromView) sharedContainer initSel = editSelectionWithShared` d (choiceList multi) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInGrid toView fromView) sharedContainer initSel = editSelectionWithShared` d (grid multi) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInTree toView fromView) sharedContainer initSel = editSelectionWithShared` d (tree multi) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInDropdown toView fromView) sharedContainer initSel = editSelectionWithShared` d (dropdown (multipleAttr multi)) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInCheckGroup toView fromView) sharedContainer initSel = editSelectionWithShared` d (checkGroup (multipleAttr multi)) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInList toView fromView) sharedContainer initSel = editSelectionWithShared` d (choiceList (multipleAttr multi)) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInGrid toView fromView) sharedContainer initSel = editSelectionWithShared` d (grid (multipleAttr multi)) toView fromView sharedContainer initSel
editSelectionWithShared d multi (SelectInTree toView fromView) sharedContainer initSel = editSelectionWithShared` d (tree (multipleAttr multi)) toView fromView sharedContainer initSel
editSelectionWithShared` d editor toView fromView sharedContainer initSel
= interact d Update sharedContainer
(\r -> (r,(toView r, initSel r)))
......@@ -120,11 +120,11 @@ editSelectionWithShared` d editor toView fromView sharedContainer initSel
(Just editor) @ (\(container,(_,sel)) -> fromView container sel)
editSharedSelection :: !d !Bool !(SelectOption c a) c (Shared [Int]) -> Task [a] | toPrompt d & iTask c & iTask a
editSharedSelection d multi (SelectInDropdown toView fromView) container sharedSel = editSharedSelection` d (dropdown multi) toView fromView container sharedSel
editSharedSelection d multi (SelectInCheckGroup toView fromView) container sharedSel = editSharedSelection` d (checkGroup multi) toView fromView container sharedSel
editSharedSelection d multi (SelectInList toView fromView) container sharedSel = editSharedSelection` d (choiceList multi) toView fromView container sharedSel
editSharedSelection d multi (SelectInGrid toView fromView) container sharedSel = editSharedSelection` d (grid multi) toView fromView container sharedSel
editSharedSelection d multi (SelectInTree toView fromView) container sharedSel = editSharedSelection` d (tree multi) toView fromView container sharedSel
editSharedSelection d multi (SelectInDropdown toView fromView) container sharedSel = editSharedSelection` d (dropdown (multipleAttr multi)) toView fromView container sharedSel
editSharedSelection d multi (SelectInCheckGroup toView fromView) container sharedSel = editSharedSelection` d (checkGroup (multipleAttr multi)) toView fromView container sharedSel
editSharedSelection d multi (SelectInList toView fromView) container sharedSel = editSharedSelection` d (choiceList (multipleAttr multi)) toView fromView container sharedSel
editSharedSelection d multi (SelectInGrid toView fromView) container sharedSel = editSharedSelection` d (grid (multipleAttr multi)) toView fromView container sharedSel
editSharedSelection d multi (SelectInTree toView fromView) container sharedSel = editSharedSelection` d (tree (multipleAttr multi)) toView fromView container sharedSel
editSharedSelection` d editor toView fromView container sharedSel
= interact d Update sharedSel
(\r -> ((),(toView container,r)))
......@@ -134,15 +134,15 @@ editSharedSelection` d editor toView fromView container sharedSel
editSharedSelectionWithShared :: !d !Bool !(SelectOption c a) (ReadWriteShared c w) (Shared [Int]) -> Task [a] | toPrompt d & iTask c & iTask a
editSharedSelectionWithShared d multi (SelectInDropdown toView fromView) sharedContainer sharedSel
= editSharedSelectionWithShared` d (dropdown multi) toView fromView sharedContainer sharedSel
= editSharedSelectionWithShared` d (dropdown (multipleAttr multi)) toView fromView sharedContainer sharedSel
editSharedSelectionWithShared d multi (SelectInCheckGroup toView fromView) sharedContainer sharedSel
= editSharedSelectionWithShared` d (checkGroup multi) toView fromView sharedContainer sharedSel
= editSharedSelectionWithShared` d (checkGroup (multipleAttr multi)) toView fromView sharedContainer sharedSel
editSharedSelectionWithShared d multi (SelectInList toView fromView) sharedContainer sharedSel
= editSharedSelectionWithShared` d (choiceList multi) toView fromView sharedContainer sharedSel
= editSharedSelectionWithShared` d (choiceList (multipleAttr multi)) toView fromView sharedContainer sharedSel
editSharedSelectionWithShared d multi (SelectInGrid toView fromView) sharedContainer sharedSel
= editSharedSelectionWithShared` d (grid multi) toView fromView sharedContainer sharedSel
= editSharedSelectionWithShared` d (grid (multipleAttr multi)) toView fromView sharedContainer sharedSel
editSharedSelectionWithShared d multi (SelectInTree toView fromView) sharedContainer sharedSel
= editSharedSelectionWithShared` d (tree multi) toView fromView sharedContainer sharedSel
= editSharedSelectionWithShared` d (tree (multipleAttr multi)) toView fromView sharedContainer sharedSel
editSharedSelectionWithShared` d editor toView fromView sharedContainer sharedSel
= interact d Update (sharedContainer |+< sharedSel)
(\(rc,rs) -> (rc,(toView rc,rs)))
......
......@@ -112,8 +112,8 @@ where
gText{|URL|} _ val = [maybe "" toString val]
gEditor{|URL|} = whenDisabled
(liftEditor (\(URL s) -> ATag [HrefAttr s] [Text s]) (\_ -> URL "") htmlView)
(liftEditor (\(URL s) -> s) (\s -> URL s) (withHintAttributes "uniform resource locator (URL)" textField))
(liftEditor (\(URL s) -> ATag [HrefAttr s] [Text s]) (\_ -> URL "") (htmlView 'DM'.newMap))
(liftEditor (\(URL s) -> s) (\s -> URL s) (withHintAttributes "uniform resource locator (URL)" (textField 'DM'.newMap)))
derive JSONEncode URL
derive JSONDecode URL
......@@ -137,8 +137,8 @@ JSONDecode{|Note|} _ c = (Nothing,c)
gText{|Note|} _ val = [maybe "" toString val]
gEditor{|Note|} = whenDisabled
(liftEditor noteToHtml (\_ -> Note "") htmlView)
(liftEditor (\(Note s) -> s) (\s -> Note s) (withHintAttributes "note" textArea))
(liftEditor noteToHtml (\_ -> Note "") (htmlView 'DM'.newMap))
(liftEditor (\(Note s) -> s) (\s -> Note s) (withHintAttributes "note" (textArea 'DM'.newMap)))
where
// THIS IS A HACK!
// The encoding of a Text constructor should escape newlines and convert them to <br> tags. Unfortunately it doesn't
......@@ -183,8 +183,8 @@ where
gText{|EUR|} _ val = [maybe "" toString val]
gEditor{|EUR|} = whenDisabled
(liftEditor toString (\_ -> EUR 0) textView)
(liftEditor (\(EUR v) -> toReal v / 100.0) (\v -> EUR (toInt (100.0 * v))) (withHintAttributes "amount in EUR" decimalField))
(liftEditor toString (\_ -> EUR 0) (textView 'DM'.newMap))
(liftEditor (\(EUR v) -> toReal v / 100.0) (\v -> EUR (toInt (100.0 * v))) (withHintAttributes "amount in EUR" (decimalField 'DM'.newMap)))
instance toString EUR
where
......@@ -217,8 +217,8 @@ where
gText{|USD|} _ val = [maybe "" toString val]
gEditor{|USD|} = whenDisabled
(liftEditor toString (\_ -> USD 0) textView)
(liftEditor (\(USD v) -> toReal v / 100.0) (\v -> USD (toInt (100.0 * v))) (withHintAttributes "amount in USD" decimalField))
(liftEditor toString (\_ -> USD 0) (textView 'DM'.newMap))
(liftEditor (\(USD v) -> toReal v / 100.0) (\v -> USD (toInt (100.0 * v))) (withHintAttributes "amount in USD" (decimalField 'DM'.newMap)))
instance toString USD
where
......@@ -264,8 +264,8 @@ isDateFormat s = size s == 10 && foldl (\ok i -> ok && (if (i == 4 || i == 7) (s
gText{|Date|} _ val = [maybe "" toString val]
gEditor{|Date|} = whenDisabled
(liftEditor toString fromString textView)
(liftEditorAsymmetric toString parseDate (withHintAttributes "date (yyyy-mm-dd)" textField))
(liftEditor toString fromString (textView 'DM'.newMap))
(liftEditorAsymmetric toString parseDate (withHintAttributes "date (yyyy-mm-dd)" (textField 'DM'.newMap)))
where
parseDate s = if (isDateFormat s) (Ok (fromString s)) (Error "you need to enter a date in the format yyyy-mm-dd")
......@@ -339,8 +339,8 @@ isTimeFormat s = size s == 8 && foldl (\ok i -> ok && (if (i == 2 || i == 5) (s.
gText{|Time|} _ val = [maybe "" toString val]
gEditor{|Time|} = whenDisabled
(liftEditor toString fromString textView)
(liftEditorAsymmetric toString parseTime (withHintAttributes "time (hh:mm:ss)" textField))
(liftEditor toString fromString (textView 'DM'.newMap))
(liftEditorAsymmetric toString parseTime (withHintAttributes "time (hh:mm:ss)" (textField 'DM'.newMap)))
where
parseTime s = if (isTimeFormat s) (Ok (fromString s)) (Error "you need to enter a time in the format hh:mm:ss")
......@@ -412,8 +412,8 @@ gText{|DateTime|} _ (Just (DateTime date time))
= [toSingleLineText date +++" "+++ toSingleLineText time]
gEditor{|DateTime|} = whenDisabled
(liftEditor toString fromString textView)
(liftEditorAsymmetric toString parseDateTime (withHintAttributes "date/time (yyyy-mm-dd hh:mm:ss)" textField))
(liftEditor toString fromString (textView 'DM'.newMap))
(liftEditorAsymmetric toString parseDateTime (withHintAttributes "date/time (yyyy-mm-dd hh:mm:ss)" (textField 'DM'.newMap)))
where
parseDateTime s = if True (Ok (fromString s)) (Error "you need to enter a date/time in the format yyyy-mm-dd hh:mm:ss")
......@@ -466,7 +466,7 @@ gText{|Document|} _ (Just val)
| otherwise = [val.Document.name]
gText{|Document|} _ Nothing = [""]
gEditor {|Document|} = documentField
gEditor {|Document|} = documentField 'DM'.newMap
derive JSONEncode Document
derive JSONDecode Document
......@@ -521,7 +521,7 @@ derive class iTask FileError
gText{|Scale|} _ (Just {Scale|cur}) = [toString cur]
gText{|Scale|} _ _ = [""]
gEditor{|Scale|} = liftEditor toSlider fromSlider (slider 1 5)
gEditor{|Scale|} = liftEditor toSlider fromSlider (slider ('DM'.fromList [("min",JSONInt 1),("max",JSONInt 5)]))
where
toSlider {Scale|cur} = cur
fromSlider cur = {Scale|min=1,cur=cur,max=5}
......@@ -611,7 +611,7 @@ derive gEditor ButtonState
//* Table consisting of headers, the displayed data cells & possibly a selection
gText{|Table|} _ _ = ["<Table>"]
gEditor{|Table|} = liftEditor toGrid fromGrid (grid False)
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)
......
implementation module iTasks.API.Extensions.Image
import iTasks
import iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Combinators
import iTasks.UI.Definition, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Combinators
import Text.HTML
gEditor{|WebImage|} = liftEditor (\{WebImage|src,alt,width,height} -> ImgTag [SrcAttr src,AltAttr alt,WidthAttr (toString width), HeightAttr (toString height)])
(const defaultValue) htmlView
(const defaultValue) (htmlView (paddingAttr 0 0 0 0))
derive gText WebImage
derive JSONEncode WebImage
......
......@@ -66,7 +66,7 @@ JSONEncode{|Username|} _ (Username u) = [JSONString u]
JSONDecode{|Username|} _ [JSONString u:c] = (Just (Username u),c)
JSONDecode{|Username|} _ c = (Nothing,c)
gEditor{|Username|} = liftEditor (\(Username u) -> u) (\s -> (Username s)) (whenDisabled textView (withHintAttributes "username" textField))
gEditor{|Username|} = liftEditor (\(Username u) -> u) (\s -> (Username s)) (whenDisabled (textView 'DM'.newMap) (withHintAttributes "username" (textField 'DM'.newMap)))
derive gDefault Username
derive gEq Username
......@@ -92,7 +92,7 @@ gText{|Password|} AsHeader _ = [""]
gText{|Password|} _ _ = ["********"]
gEditor{|Password|} = liftEditor (\(Password p) -> p) (\s -> (Password s))
(whenDisabled (constEditor "********" textView) (withHintAttributes "password" passwordField))
(whenDisabled (constEditor "********" (textView 'DM'.newMap)) (withHintAttributes "password" (passwordField 'DM'.newMap)))
derive gDefault Password
derive gEq Password
......
......@@ -209,8 +209,8 @@ focusTaskIdAttr :: !String -> UIAttributes
closeTaskIdAttr :: !String -> UIAttributes
activeTabAttr :: !Int -> UIAttributes
valueAttr :: !JSONNode -> UIAttributes
minValueAttr :: !Int -> UIAttributes
maxValueAttr :: !Int -> UIAttributes
minAttr :: !Int -> UIAttributes
maxAttr :: !Int -> UIAttributes
textAttr :: !String -> UIAttributes
enabledAttr :: !Bool -> UIAttributes
multipleAttr :: !Bool -> UIAttributes
......
......@@ -153,11 +153,11 @@ activeTabAttr activeTab = 'DM'.fromList [("activeTab",JSONInt activeTab)]
valueAttr :: !JSONNode -> UIAttributes
valueAttr value = 'DM'.fromList [("value",value)]
minValueAttr :: !Int -> UIAttributes
minValueAttr minValue = 'DM'.fromList [("minValue",JSONInt minValue)]
minAttr :: !Int -> UIAttributes
minAttr min = 'DM'.fromList [("min",JSONInt min)]
maxValueAttr :: !Int -> UIAttributes
maxValueAttr maxValue = 'DM'.fromList [("maxValue",JSONInt maxValue)]
maxAttr :: !Int -> UIAttributes
maxAttr max = 'DM'.fromList [("max",JSONInt max)]
textAttr :: !String -> UIAttributes
textAttr text = 'DM'.fromList [("text",JSONString text)]
......
......@@ -7,36 +7,37 @@ import iTasks.UI.Editor
from Data.Maybe import :: Maybe
from Text.HTML import :: HtmlTag
from iTasks.API.Core.Types import :: Document
from iTasks.UI.Definition import :: UIAttributes
// ## Form components ##
// UITextField, UITextArea, UIPasswordField, UIIntegerField, UIDecimalField, UIDocumentField
// UICheckbox, UISlider, UIButton, UILabel, UIIcon
textField :: Editor String
textArea :: Editor String
passwordField :: Editor String
integerField :: Editor Int
decimalField :: Editor Real
documentField :: Editor Document
checkBox :: Editor Bool
slider :: Int Int -> Editor Int //Min, max
button :: String -> Editor Bool
label :: Editor String
icon :: Editor (String,Maybe String)
textField :: UIAttributes -> Editor String
textArea :: UIAttributes -> Editor String
passwordField :: UIAttributes -> Editor String
integerField :: UIAttributes -> Editor Int
decimalField :: UIAttributes -> Editor Real
documentField :: UIAttributes -> Editor Document
checkBox :: UIAttributes -> Editor Bool
slider :: UIAttributes -> Editor Int
button :: UIAttributes -> Editor Bool
label :: UIAttributes -> Editor String
icon :: UIAttributes -> Editor (String,Maybe String)
// ## Display components ##
// UITextView, UIHtmlView, UIProgressBar
textView :: Editor String
htmlView :: Editor HtmlTag
progressBar :: Editor (Maybe Int,Maybe String) //Percentage, description
textView :: UIAttributes -> Editor String
htmlView :: UIAttributes -> Editor HtmlTag
progressBar :: UIAttributes -> Editor (Maybe Int,Maybe String) //Percentage, description
// ## Selection components ##
// UIDropdown, UIRadioGroup, UICheckboxGroup, UIChoiceList, UIGrid, UITree
dropdown :: Bool -> Editor ([String], [Int])
checkGroup :: Bool -> Editor ([String], [Int])
choiceList :: Bool -> Editor ([String], [Int])
grid :: Bool -> Editor (ChoiceGrid, [Int])
tree :: Bool -> Editor ([ChoiceNode], [Int])
dropdown :: UIAttributes -> Editor ([String], [Int])
checkGroup :: UIAttributes -> Editor ([String], [Int])
choiceList :: UIAttributes -> Editor ([String], [Int])
grid :: UIAttributes -> Editor (ChoiceGrid, [Int])
tree :: UIAttributes -> Editor ([ChoiceNode], [Int])
:: ChoiceGrid =
{ header :: [String]
......
......@@ -5,55 +5,66 @@ import StdFunc, StdBool, GenEq
import Data.Error, Text.JSON, Text.HTML
import qualified Data.Map as DM
textField :: Editor String
textField = fieldComponent [] toJSON UITextField
textField :: UIAttributes -> Editor String
textField attr = fieldComponent attr toJSON UITextField
integerField :: Editor Int
integerField = fieldComponent [] toJSON UIIntegerField
textArea :: UIAttributes -> Editor String
textArea attr = fieldComponent attr toJSON UITextArea
decimalField :: Editor Real
decimalField = fieldComponent [] toJSON UIDecimalField
passwordField :: UIAttributes -> Editor String
passwordField attr = fieldComponent attr toJSON UIPasswordField
documentField :: Editor Document
documentField = fieldComponent [] toJSON UIDocumentField
integerField :: UIAttributes -> Editor Int
integerField attr = fieldComponent attr toJSON UIIntegerField
passwordField :: Editor String
passwordField = fieldComponent [] toJSON UIPasswordField
decimalField :: UIAttributes -> Editor Real
decimalField attr = fieldComponent attr toJSON UIDecimalField
textArea :: Editor String
textArea = fieldComponent [] toJSON UITextArea
documentField :: UIAttributes -> Editor Document
documentField attr = fieldComponent attr toJSON UIDocumentField
checkBox :: Editor Bool
checkBox = fieldComponent [] toJSON UICheckbox
checkBox :: UIAttributes -> Editor Bool
checkBox attr = fieldComponent attr toJSON UICheckbox
slider :: Int Int -> Editor Int
slider min max = fieldComponent [("min",JSONInt min),("max",JSONInt max)] toJSON UISlider
slider :: UIAttributes -> Editor Int
slider attr = fieldComponent attr toJSON UISlider
label :: Editor String
label = viewComponent (\text -> [("text",JSONString text)]) UILabel
button :: UIAttributes -> Editor Bool
button attr = fieldComponent attr toJSON UIButton
button :: String -> Editor Bool
button text = fieldComponent [("text",JSONString text)] toJSON UIButton
label :: UIAttributes -> Editor String
label attr = viewComponent (\text -> 'DM'.union attr (textAttr text)) UILabel
icon :: Editor (String,Maybe String)
icon = viewComponent (\(text,tooltip) -> [("iconCls",JSONString text),("tooltip",maybe JSONNull JSONString tooltip)]) UIIcon
icon :: UIAttributes -> Editor (String,Maybe String)
icon attr = viewComponent (\(iconCls,tooltip) -> 'DM'.unions [iconClsAttr iconCls,maybe 'DM'.newMap tooltipAttr tooltip,attr]) UIIcon
dropdown :: Bool -> Editor ([String], [Int])
dropdown multi = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UIDropdown multi
textView :: UIAttributes -> Editor String
textView attr = viewComponent (\text -> 'DM'.fromList [("value",JSONString text)]) UITextView
checkGroup :: Bool -> Editor ([String],[Int])
checkGroup multi = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UIRadioGroup multi
htmlView :: UIAttributes -> Editor HtmlTag
htmlView attr = viewComponent (\html -> 'DM'.union (valueAttr (JSONString (toString html))) attr) UIHtmlView
choiceList :: Bool -> Editor ([String],[Int])
choiceList multi = choiceComponent (const 'DM'.newMap) id JSONString (\o i -> i >= 0 && i < length o) UIChoiceList multi
progressBar :: UIAttributes -> Editor (Maybe Int, Maybe String)
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
checkGroup :: UIAttributes -> Editor ([String],[Int])
checkGroup attr = choiceComponent (const attr) id JSONString (\o i -> i >= 0 && i < length o) UIRadioGroup
choiceList :: UIAttributes -> Editor ([String],[Int])
choiceList attr = choiceComponent (const attr) id JSONString (\o i -> i >= 0 && i < length o) UIChoiceList
grid :: Bool -> Editor (ChoiceGrid, [Int])
grid multi = choiceComponent (\{ChoiceGrid|header} -> columnsAttr header) (\{ChoiceGrid|rows} -> rows) toOption (\o i -> i >= 0 && i < length o) UIGrid multi
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
where
toOption opt = JSONArray (map (JSONString o toString) opt)
tree :: Bool -> Editor ([ChoiceNode], [Int])
tree multi = choiceComponent (const 'DM'.newMap) id toOption checkBounds UITree multi
tree :: UIAttributes -> Editor ([ChoiceNode], [Int])
tree attr = choiceComponent (const attr) id toOption checkBounds UITree
where
toOption {ChoiceNode|id,label,icon,expanded,children}
= JSONObject [("text",JSONString label)
......@@ -70,15 +81,6 @@ where
| idx == id = True
| otherwise = or (map (checkNode idx) children)
progressBar :: Editor (Maybe Int, Maybe String)
progressBar = viewComponent (\(amount,text) -> [("value",maybe JSONNull JSONInt amount),("text",maybe JSONNull JSONString text)]) UIProgressBar
textView :: Editor String
textView = viewComponent (\text -> [("value",JSONString text)]) UITextView
htmlView :: Editor HtmlTag
htmlView = viewComponent (\html -> [("value",JSONString (toString html))]) UIHtmlView
//Field like components for which simply knowing the UI type is sufficient
fieldComponent attr toValue type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
......@@ -86,7 +88,7 @@ where
# val = if (mode =: Enter) JSONNull (toValue val)
# 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 = val}
# attr = 'DM'.unions ['DM'.fromList attr,optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr val]
# attr = 'DM'.unions [attr,optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr val]
= (Ok (uia type attr,mask),vst)
onEdit dp (tp,e) val mask vst=:{VSt|optional}
......@@ -104,23 +106,23 @@ where
viewComponent toAttributes type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst
= (Ok (uia type ('DM'.fromList (toAttributes val)), FieldMask {touched = False, valid = True, state = JSONNull}),vst)
= (Ok (uia type (toAttributes val), FieldMask {touched = False, valid = True, state = JSONNull}),vst)
onEdit dp (tp,e) val mask vst
= (Error "Edit event for view component",val,vst)
onRefresh dp new old mask vst
= case [SetAttribute nk nv \\ ((ok,ov),(nk,nv)) <- zip (toAttributes old,toAttributes new) | ok == nk && ov =!= nv] of
= case [SetAttribute nk nv \\ ((ok,ov),(nk,nv)) <- zip ('DM'.toList (toAttributes old),'DM'.toList (toAttributes new)) | ok == nk && ov =!= nv] of
[] = (Ok (NoChange,mask),new,vst)
changes = (Ok (ChangeUI changes [],mask),new,vst)
//Choice components that have a set of options
choiceComponent attr getOptions toOption checkBounds type multi = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
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) sel (map toOption (getOptions val)),multipleAttr multi]
# 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}
......
......@@ -397,18 +397,18 @@ flattenPairDiff s n (ChangeUI _ [(_,ChangeChild l),(_,ChangeChild r)],CompoundMa
where
half = n / 2
gEditor{|Int|} = whenDisabled (liftEditor toString toInt textView) (withHintAttributes "whole number" integerField)
gEditor{|Real|} = whenDisabled (liftEditor toString toReal textView) (withHintAttributes "decimal number" decimalField)
gEditor{|Char|} = liftEditor toString (\c -> c.[0]) (whenDisabled textView (withHintAttributes "single character" textField))
gEditor{|String|} = whenDisabled textView (withHintAttributes "single line of text" textField)
gEditor{|Bool|} = checkBox
gEditor{|Int|} = whenDisabled (liftEditor toString toInt (textView 'DM'.newMap)) (withHintAttributes "whole number" (integerField 'DM'.newMap))
gEditor{|Real|} = whenDisabled (liftEditor toString toReal (textView 'DM'.newMap)) (withHintAttributes "decimal number" (decimalField 'DM'.newMap))
gEditor{|Char|} = liftEditor toString (\c -> c.[0]) (whenDisabled (textView 'DM'.newMap) (withHintAttributes "single character" (textField 'DM'.newMap)))
gEditor{|String|} = whenDisabled (textView 'DM'.newMap) (withHintAttributes "single line of text" (textField 'DM'.newMap))
gEditor{|Bool|} = checkBox 'DM'.newMap
gEditor{|[]|} ex _ dx _ _ = listEditor (Just (const dx)) True True (Just (\l -> toString (length l) +++ " items")) ex
gEditor{|()|} = emptyEditor
gEditor{|(->)|} _ _ _ _ _ _ _ _ _ _ = emptyEditor
gEditor{|Dynamic|} = emptyEditor
gEditor{|HtmlTag|} = htmlView
gEditor{|HtmlTag|} = htmlView 'DM'.newMap
gEditor{|RWShared|} _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = emptyEditor
derive gEditor JSONNode, Either, MaybeError, (,), (,,), (,,,), (,,,,), (,,,,,), Timestamp, Map
......
......@@ -4,6 +4,7 @@ import iTasks.API.Extensions.Image
import iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Common, iTasks.UI.Definition
import iTasks._Framework.Serialization
import Text.HTML
import qualified Data.Map as DM
// TEST FRAMEWORK
derive class iTask TestSuite, Test, InteractiveTest, TestResult, SuiteResult
......@@ -119,7 +120,7 @@ where
runUnitTests
= accWorld (runUnitTestsWorld suites)
>>- viewInformation () [ViewUsing toHtml htmlView]
>>- viewInformation () [ViewUsing toHtml (htmlView 'DM'.newMap)]
@! ()
toHtml results
......
implementation module Tests.Interactive.BuiltinEditors
import iTasks, TestFramework
import iTasks.UI.Editor.Builtin
import iTasks.UI.Editor.Builtin, iTasks.UI.Definition
import qualified Data.Map as DM
import Text.HTML
derive class iTask ChoiceGrid, ChoiceNode
......@@ -18,97 +19,98 @@ testBuiltinEditors = testsuite "Builtin editors" "These tests check if the built
testTextField = itest "Text field" "Check if the textfield is ok" "You should be able to edit" tut
where
tut :: Task String
tut = testEditor textField "Hello world" Update
tut = testEditor (textField 'DM'.newMap) "Hello world" Update
testTextArea = itest "Text area" "Check if the textarea is ok" "You should be able to edit" tut
where
tut :: Task String
tut = testEditor textArea "Hello world" Update
tut = testEditor (textArea 'DM'.newMap) "Hello world" Update
testPasswordField = itest "Password field" "Check if the password field is ok" "You should be able to edit" tut
where
tut :: Task String
tut = testEditor passwordField "Hello world" Update
tut = testEditor (passwordField 'DM'.newMap) "Hello world" Update
testIntegerField = itest "Integer field" "Check if the integer field is ok" "You should be able to edit" tut
where
tut :: Task Int
tut = testEditor integerField 42 Update
tut = testEditor (integerField 'DM'.newMap) 42 Update
testDecimalField = itest "Decimal field" "Check if the decimal field is ok" "You should be able to edit" tut
where
tut :: Task Real
tut = testEditor decimalField 3.14 Update
tut = testEditor (decimalField 'DM'.newMap) 3.14 Update
testDocumentField = itest "Document field" "Check if the decimal field is ok" "You should be able to edit" tut
where
tut :: Task Document
tut = testEditor documentField defaultValue Enter
tut = testEditor (documentField 'DM'.newMap) defaultValue Enter
testCheckbox = itest "Checkbox" "Check if the checkbox is ok" "You should be able to edit" tut
where
tut :: Task Bool
tut = testEditor checkBox False Update
tut = testEditor (checkBox 'DM'.newMap) False Update
testSlider = itest "Slider" "Check if the slider is ok" "You should be able to edit" tut
where
tut :: Task Int
tut = testEditor (slider 1 5) 3 Update
tut = testEditor (slider ('DM'.union (minAttr 1) (maxAttr 5))) 3 Update