Commit 8d5dfc3f authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'stringEditorValidation' into 'master'

validate string length of editors also on server

See merge request !239
parents 0c7ad62e 9eef7c11
Pipeline #20527 passed with stage
in 5 minutes and 32 seconds
...@@ -124,7 +124,9 @@ tree :: Editor ([ChoiceNode], [Int]) ...@@ -124,7 +124,9 @@ tree :: Editor ([ChoiceNode], [Int])
*/ */
withConstantChoices :: !choices !(Editor (!choices, ![Int])) -> Editor [Int] withConstantChoices :: !choices !(Editor (!choices, ![Int])) -> Editor [Int]
fieldComponent :: !UIType !(Maybe a) -> Editor a | JSONDecode{|*|}, JSONEncode{|*|}, gEq{|*|} a & JSDecode{|*|} a fieldComponent
:: !UIType !(Maybe a) !(UIAttributes a -> Bool) -> Editor a
| JSONDecode{|*|}, JSONEncode{|*|}, gEq{|*|} a & JSDecode{|*|} a
//Convenient types for describing the values of grids and trees //Convenient types for describing the values of grids and trees
:: ChoiceText = :: ChoiceText =
......
...@@ -2,7 +2,7 @@ implementation module iTasks.UI.Editor.Controls ...@@ -2,7 +2,7 @@ implementation module iTasks.UI.Editor.Controls
import StdEnv import StdEnv
import iTasks.UI.Definition, iTasks.UI.Editor import iTasks.UI.Definition, iTasks.UI.Editor
import Data.GenEq, Data.Error, Text.GenJSON, Text.HTML, Data.Func, Data.Functor, Data.Tuple, Data.List, Data.Maybe import Data.GenEq, Data.Error, Text.GenJSON, Text.HTML, Data.Func, Data.Functor, Data.Tuple, Data.List, Data.Maybe, Data.Map.GenJSON
import qualified Data.Map as DM import qualified Data.Map as DM
import iTasks.UI.Definition import iTasks.UI.Definition
...@@ -11,31 +11,42 @@ import iTasks.UI.Editor.Modifiers ...@@ -11,31 +11,42 @@ import iTasks.UI.Editor.Modifiers
disableOnView e = selectByMode (e <<@ enabledAttr False) e e disableOnView e = selectByMode (e <<@ enabledAttr False) e e
textField :: Editor String textField :: Editor String
textField = fieldComponent UITextField Nothing textField = fieldComponent UITextField (Just "") isValidString
textArea :: Editor String textArea :: Editor String
textArea = fieldComponent UITextArea Nothing textArea = fieldComponent UITextArea (Just "") isValidString
passwordField :: Editor String passwordField :: Editor String
passwordField = fieldComponent UIPasswordField Nothing passwordField = fieldComponent UIPasswordField (Just "") isValidString
isValidString :: !UIAttributes !String -> Bool
isValidString attrs str
= lStr >= getLengthAttr 0 "minlength" && lStr <= getLengthAttr lStr "maxlength"
where
getLengthAttr :: !Int !String -> Int
getLengthAttr default attr = case 'DM'.get attr attrs of
Just (JSONInt l) = l
_ = default
lStr = size str
integerField :: Editor Int integerField :: Editor Int
integerField = fieldComponent UIIntegerField Nothing integerField = fieldComponent UIIntegerField Nothing (\_ _ -> True)
decimalField :: Editor Real decimalField :: Editor Real
decimalField = fieldComponent UIDecimalField Nothing decimalField = fieldComponent UIDecimalField Nothing (\_ _ -> True)
documentField :: Editor (!String,!String,!String,!String,!Int) documentField :: Editor (!String,!String,!String,!String,!Int)
documentField = fieldComponent UIDocumentField Nothing documentField = fieldComponent UIDocumentField Nothing (\_ _ -> True)
checkBox :: Editor Bool checkBox :: Editor Bool
checkBox = fieldComponent UICheckbox $ Just False checkBox = fieldComponent UICheckbox (Just False) (\_ _ -> True)
slider :: Editor Int slider :: Editor Int
slider = fieldComponent UISlider Nothing slider = fieldComponent UISlider Nothing (\_ _ -> True)
button :: Editor Bool button :: Editor Bool
button = fieldComponent UIButton Nothing button = fieldComponent UIButton Nothing (\_ _ -> True)
label :: Editor String label :: Editor String
label = viewComponent textAttr UILabel label = viewComponent textAttr UILabel
...@@ -109,30 +120,36 @@ where ...@@ -109,30 +120,36 @@ where
editModeFor other = other editModeFor other = other
//Field like components for which simply knowing the UI type is sufficient //Field like components for which simply knowing the UI type is sufficient
fieldComponent :: !UIType !(Maybe a) -> Editor a | JSONDecode{|*|}, JSONEncode{|*|}, gEq{|*|} a & JSDecode{|*|} a fieldComponent
fieldComponent type mbEditModeInitValue = disableOnView $ editorWithJSONEncode (leafEditorToEditor o leafEditor) :: !UIType !(Maybe a) !(UIAttributes a -> Bool) -> Editor a
| JSONDecode{|*|}, JSONEncode{|*|}, gEq{|*|} a & JSDecode{|*|} a
fieldComponent type mbEditModeInitValue isValid = disableOnView $ editorWithJSONEncode (leafEditorToEditor o leafEditor)
where where
leafEditor toJSON = leafEditor toJSON =
{LeafEditor|genUI=genUI toJSON,onEdit=onEdit,onRefresh=onRefresh toJSON,valueFromState=valueFromState} {LeafEditor|genUI=genUI toJSON,onEdit=onEdit,onRefresh=onRefresh toJSON,valueFromState=valueFromState}
genUI toJSON attr dp mode vst=:{VSt|taskId,optional} genUI toJSON attr dp mode vst=:{VSt|taskId,optional}
# mbVal = maybe mbEditModeInitValue Just $ editModeValue mode # mbVal = maybe mbEditModeInitValue Just $ editModeValue mode
# jsonVal = maybe JSONNull toJSON mbVal # mbVal = maybe Nothing (\val -> if (isValid attr val) (Just val) Nothing) mbVal
# attr = 'DM'.unions [ optionalAttr optional # attr = 'DM'.unions [ optionalAttr optional
, taskIdAttr taskId , taskIdAttr taskId
, editorIdAttr $ editorId dp , editorIdAttr $ editorId dp
, valueAttr jsonVal , valueAttr $ maybe JSONNull toJSON mbVal
, attr , attr
] ]
= (Ok (uia type attr, mbVal), vst) = (Ok (uia type attr, (mbVal, attr)), vst)
onEdit _ (_, mbVal) _ vst = (Ok (NoChange, mbVal), vst) onEdit _ (_, mbVal) (_, attrs) vst = (Ok (NoChange, (mbVal`, attrs)), vst)
where
mbVal` = case mbVal of
Just val | isValid attrs val = Just val
_ = Nothing
onRefresh toJSON dp new mbOld vst onRefresh toJSON dp new (mbOld, attrs) vst
| mbOld === Just new = (Ok (NoChange, mbOld), vst) | mbOld === Just new = (Ok (NoChange, (mbOld, attrs)), vst)
| otherwise = (Ok (ChangeUI [SetAttribute "value" (toJSON new)] [], Just new), vst) | otherwise = (Ok (ChangeUI [SetAttribute "value" (toJSON new)] [], (if (isValid attrs new) (Just new) Nothing, attrs)), vst)
valueFromState mbVal = mbVal valueFromState (mbVal, _) = mbVal
editorWithJSONEncode :: !((a -> JSONNode) -> Editor a) -> Editor a | JSONEncode{|*|} a editorWithJSONEncode :: !((a -> JSONNode) -> Editor a) -> Editor a | JSONEncode{|*|} a
editorWithJSONEncode genFunc = genFunc toJSON editorWithJSONEncode genFunc = genFunc toJSON
......
...@@ -251,7 +251,7 @@ compute :: !String a -> Task a | iTask a ...@@ -251,7 +251,7 @@ compute :: !String a -> Task a | iTask a
compute s a = enterInformation s [EnterUsing id ed] >>~ \_->return a compute s a = enterInformation s [EnterUsing id ed] >>~ \_->return a
where where
ed :: Editor Bool ed :: Editor Bool
ed = fieldComponent UILoader Nothing ed = fieldComponent UILoader Nothing (\_ _ -> True)
valToMaybe :: (TaskValue a) -> Maybe a valToMaybe :: (TaskValue a) -> Maybe a
valToMaybe (Value v _) = Just v valToMaybe (Value v _) = Just v
......
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