Commit d4e59ae0 authored by Bas Lijnse's avatar Bas Lijnse

Implemented basic server-side validation for new editors

parent ae8623a2
Pipeline #19587 passed with stage
in 4 minutes and 48 seconds
...@@ -3,12 +3,13 @@ module EditorSim ...@@ -3,12 +3,13 @@ module EditorSim
* Simulation of messages passing between editors to figure out the design details * Simulation of messages passing between editors to figure out the design details
*/ */
import iTasks import iTasks
import Data.Maybe, Data.Either, Data.Tuple, Data.Functor, Data.List, Data.Func import Data.Maybe, Data.Either, Data.Tuple, Data.Functor, Data.List, Data.Func, Data.Error
import qualified Data.Map as DM import qualified Data.Map as DM
import Text, Text.HTML import Text, Text.HTML
from StdFunc import seqList, :: St(..) from StdFunc import seqList, :: St(..)
from Data.Foldable import maximumBy from Data.Foldable import maximumBy
import StdArray import StdArray
import Data.Map.GenJSON
import qualified Graphics.Scalable.Image as GI import qualified Graphics.Scalable.Image as GI
from Graphics.Scalable.Image import :: FillAttr(..), <@<, :: Image, :: Host(..) from Graphics.Scalable.Image import :: FillAttr(..), <@<, :: Image, :: Host(..)
...@@ -17,7 +18,6 @@ from Graphics.Scalable.Image import class margin, instance margin (!Span, !Span, ...@@ -17,7 +18,6 @@ from Graphics.Scalable.Image import class margin, instance margin (!Span, !Span,
import iTasks.Extensions.SVG.SVGEditor import iTasks.Extensions.SVG.SVGEditor
//TODOS: //TODOS:
// - Add a consistency checking / synchronization mechanism for data protection
// - Model an example with input field validation for mandatory fields etc. such as 'empty','validated', etc // - Model an example with input field validation for mandatory fields etc. such as 'empty','validated', etc
//PROBLEMS: //PROBLEMS:
...@@ -85,6 +85,15 @@ import iTasks.Extensions.SVG.SVGEditor ...@@ -85,6 +85,15 @@ import iTasks.Extensions.SVG.SVGEditor
:: NxtServerOutMessage m = NxtServerOut m NxtPartialVersionTree NxtPartialVersionTree :: NxtServerOutMessage m = NxtServerOut m NxtPartialVersionTree NxtPartialVersionTree
instance Functor NxtServerInMessage
where
fmap f (NxtServerInRemote m v) = NxtServerInRemote (f m) v
fmap f (NxtServerInLocal m v) = NxtServerInLocal (f m) v
instance Functor NxtClientInMessage
where
fmap f (NxtClientInRemote m ov nv) = NxtClientInRemote (f m) ov nv
fmap f (NxtClientInLocal m) = NxtClientInLocal (f m)
//TODO: this is not minimal enough: We create a partial version info structure, but it actually contains all versions! //TODO: this is not minimal enough: We create a partial version info structure, but it actually contains all versions!
toPartialVersion (NVTBasic v) = NVPVersion (Just v) [] toPartialVersion (NVTBasic v) = NVPVersion (Just v) []
...@@ -98,6 +107,10 @@ selectPartialVersion pos (NVPVersion _ items) = case [v \\ (i,v) <- items | i == ...@@ -98,6 +107,10 @@ selectPartialVersion pos (NVPVersion _ items) = case [v \\ (i,v) <- items | i ==
maxMajorVersion (NVPVersion mbv vs) = foldr max (maybe 0 fst mbv) (map (maxMajorVersion o snd) vs) maxMajorVersion (NVPVersion mbv vs) = foldr max (maybe 0 fst mbv) (map (maxMajorVersion o snd) vs)
getVersion:: NxtVersionTree -> NxtVersion
getVersion (NVTBasic v) = v
getVersion (NVTMultiple v _) = v
//Simulated DOM/JSWorld //Simulated DOM/JSWorld
:: NxtDOMRef :== [Int] :: NxtDOMRef :== [Int]
:: NxtDOM :== NxtDOMNode :: NxtDOM :== NxtDOMNode
...@@ -406,6 +419,14 @@ where ...@@ -406,6 +419,14 @@ where
,newVersion = getOverlayedVersions "new-version" enc ,newVersion = getOverlayedVersions "new-version" enc
} }
instance EditMessage (Either a b) | EditMessage a & EditMessage b
where
encodeEditMessage (Left value) = NxtChange [] [NxtUpdChild 0 (encodeEditMessage value)]
encodeEditMessage (Right value) = NxtChange [] [NxtUpdChild 1 (encodeEditMessage value)]
decodeEditMessage (NxtChange _ [NxtUpdChild 0 dec:_]) = Left (decodeEditMessage dec)
decodeEditMessage (NxtChange _ [NxtUpdChild 1 dec:_]) = Right (decodeEditMessage dec)
instance EditMessage String //If strings are used as edit type, it's just the value attribute instance EditMessage String //If strings are used as edit type, it's just the value attribute
where where
encodeEditMessage value = NxtChange [NxtSetAttr "value" value] [] encodeEditMessage value = NxtChange [NxtSetAttr "value" value] []
...@@ -924,6 +945,53 @@ mapg :: ...@@ -924,6 +945,53 @@ mapg ::
mapg mp (mw,mr) mc ms (mmt,mmf) editor mapg mp (mw,mr) mc ms (mmt,mmf) editor
= mapm (fromJust o mmt, mmf) $ maps ms $ mapc mc $ mapw mw $ mapr mr $ mapp mp $ editor = mapm (fromJust o mmt, mmf) $ maps ms $ mapc mc $ mapw mw $ mapr mr $ mapp mp $ editor
validate :: (s -> Bool) (NxtEditor p r w s c m) -> (NxtEditor p r w (s,Bool) (c,Bool) (Either m Bool))
validate checkfun editor = {client=client,server=server}
where
server = {init=init,parameter=parameter,value=value,onRefresh=onRefresh,onMessage=onMessage}
where
init p rv
# (s,v,c) = editor.server.NxtEditorServer.init p rv
# valid = checkfun s
= ((s,valid),v,(c,valid))
parameter s
= editor.server.NxtEditorServer.parameter (fst s)
value (s,valid)
= if (not valid) Nothing (editor.server.NxtEditorServer.value s)
onRefresh rs rv (s,valid) v
# (msgs, s, v`, mbw) = editor.server.NxtEditorServer.onRefresh rs rv s v
# valid` = checkfun s
# msgs` = [NxtServerOut (Left m) ov nv \\ (NxtServerOut m ov nv) <- msgs]
++ if (valid <> valid`) [NxtServerOut (Right valid`) (toPartialVersion v) (toPartialVersion v`)] []
= (msgs`, (s,valid`), v`, mbw)
onMessage (NxtServerInRemote (Left m) mv) (s,valid) v
# (msgs, s, v`, mbw) = editor.server.NxtEditorServer.onMessage (NxtServerInRemote m mv) s v
# valid` = checkfun s
# msgs` = [NxtServerOut (Left m) ov nv \\ (NxtServerOut m ov nv) <- msgs]
++ if (valid <> valid`) [NxtServerOut (Right valid`) (toPartialVersion v) (toPartialVersion v`)] []
= (msgs`, (s,valid`), v`, mbw)
client = {init=init,onEvent=onEvent,onMessage=onMessage,state=state}
where
init (Just (c,valid))
# dom = editor.client.NxtEditorClient.init (Just c)
= {NxtDOMNode|dom & attributes = 'DM'.put "valid" (if valid "true" "false") dom.NxtDOMNode.attributes}
init Nothing = editor.client.NxtEditorClient.init Nothing
state dom = (editor.client.NxtEditorClient.state dom, False)
onEvent ref event dom
# (msgs,dom) = editor.client.NxtEditorClient.onEvent ref event dom
= ([NxtClientOut (Left m) v \\ (NxtClientOut m v) <- msgs],dom)
onMessage (NxtClientInRemote (Right valid) ov nv) dom
= ([],{NxtDOMNode|dom & attributes = 'DM'.put "valid" (if valid "true" "false") dom.NxtDOMNode.attributes})
onMessage (NxtClientInRemote (Left m) ov nv) dom
# (msgs,dom) = editor.client.NxtEditorClient.onMessage (NxtClientInRemote m ov nv) dom
= ([NxtClientOut (Left m) v \\ (NxtClientOut m v) <- msgs],dom)
//Simulation //Simulation
simulate :: (NxtEditor p r w s c m) p (Maybe r) -> Task () | iTask r & iTask w & iTask s & iTask c & iTask m & EditMessage m simulate :: (NxtEditor p r w s c m) p (Maybe r) -> Task () | iTask r & iTask w & iTask s & iTask c & iTask m & EditMessage m
...@@ -1119,4 +1187,5 @@ testListItemEditor = glue nxtNumberField nxtButton ...@@ -1119,4 +1187,5 @@ testListItemEditor = glue nxtNumberField nxtButton
//Start world = doTasks (simulate nxtNumberField () (Just 42)) world //Start world = doTasks (simulate nxtNumberField () (Just 42)) world
//Start world = doTasks (simulate (glue nxtNumberField nxtButton) ((),()) (Just (Just 12, Just False)) ) world //Start world = doTasks (simulate (glue nxtNumberField nxtButton) ((),()) (Just (Just 12, Just False)) ) world
Start world = doTasks (simulate testCounterEditor ((),()) (Just (Just 12, Just False))) world //Start world = doTasks (simulate testCounterEditor ((),()) (Just (Just 12, Just False))) world
Start world = doTasks (simulate (validate (\x -> toInt x > 42) nxtNumberField) () (Just 12)) world
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