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
* Simulation of messages passing between editors to figure out the design details
*/
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 Text, Text.HTML
from StdFunc import seqList, :: St(..)
from Data.Foldable import maximumBy
import StdArray
import Data.Map.GenJSON
import qualified Graphics.Scalable.Image as GI
from Graphics.Scalable.Image import :: FillAttr(..), <@<, :: Image, :: Host(..)
......@@ -17,7 +18,6 @@ from Graphics.Scalable.Image import class margin, instance margin (!Span, !Span,
import iTasks.Extensions.SVG.SVGEditor
//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
//PROBLEMS:
......@@ -85,6 +85,15 @@ import iTasks.Extensions.SVG.SVGEditor
:: 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!
toPartialVersion (NVTBasic v) = NVPVersion (Just v) []
......@@ -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)
getVersion:: NxtVersionTree -> NxtVersion
getVersion (NVTBasic v) = v
getVersion (NVTMultiple v _) = v
//Simulated DOM/JSWorld
:: NxtDOMRef :== [Int]
:: NxtDOM :== NxtDOMNode
......@@ -406,6 +419,14 @@ where
,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
where
encodeEditMessage value = NxtChange [NxtSetAttr "value" value] []
......@@ -924,6 +945,53 @@ mapg ::
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
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
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
//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 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