Commit e8fdb4cf authored by Bas Lijnse's avatar Bas Lijnse

Completed list editor with version checking of element, but not yet of structure changes

parent d4e59ae0
Pipeline #19805 failed with stage
in 2 minutes and 23 seconds
...@@ -16,6 +16,7 @@ from Graphics.Scalable.Image import :: FillAttr(..), <@<, :: Image, :: Host(..) ...@@ -16,6 +16,7 @@ from Graphics.Scalable.Image import :: FillAttr(..), <@<, :: Image, :: Host(..)
from Graphics.Scalable.Image import class tuneImage, instance tuneImage FillAttr from Graphics.Scalable.Image import class tuneImage, instance tuneImage FillAttr
from Graphics.Scalable.Image import class margin, instance margin (!Span, !Span, !Span, !Span), instance margin Span from Graphics.Scalable.Image import class margin, instance margin (!Span, !Span, !Span, !Span), instance margin Span
import iTasks.Extensions.SVG.SVGEditor import iTasks.Extensions.SVG.SVGEditor
import StdMisc, StdDebug
//TODOS: //TODOS:
// - 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
...@@ -593,7 +594,6 @@ where ...@@ -593,7 +594,6 @@ where
//New read list has less (remove existing) //New read list has less (remove existing)
compare i ss _ [] = (repeatn (length ss) (NxtServerOut (NxtRemoveChild i) emptyPartialVersion emptyPartialVersion),[],[],False) //TODO: versions... compare i ss _ [] = (repeatn (length ss) (NxtServerOut (NxtRemoveChild i) emptyPartialVersion emptyPartialVersion),[],[],False) //TODO: versions...
onMessage (NxtServerInRemote (NxtUpdateChild pos m) (NVPVersion _ mv)) (p,ss) (NVTMultiple stv vs)//Route to the corresponding child onMessage (NxtServerInRemote (NxtUpdateChild pos m) (NVPVersion _ mv)) (p,ss) (NVTMultiple stv vs)//Route to the corresponding child
| pos >= length ss || pos < 0 = ([],(p,ss),NVTMultiple stv vs,False) //Out of bounds, (maybe abort instead for the simulation) | pos >= length ss || pos < 0 = ([],(p,ss),NVTMultiple stv vs,False) //Out of bounds, (maybe abort instead for the simulation)
# (ms,s,v,write) = editor.server.NxtEditorServer.onMessage (NxtServerInRemote m (childversion pos mv)) (ss !! pos) (vs !! pos) # (ms,s,v,write) = editor.server.NxtEditorServer.onMessage (NxtServerInRemote m (childversion pos mv)) (ss !! pos) (vs !! pos)
...@@ -612,6 +612,9 @@ where ...@@ -612,6 +612,9 @@ where
# (s,v,_) = editor.server.NxtEditorServer.init p (fst stv) # (s,v,_) = editor.server.NxtEditorServer.init p (fst stv)
= ([], (p, insertAt pos s ss), NVTMultiple stv (insertAt pos v vs), True) = ([], (p, insertAt pos s ss), NVTMultiple stv (insertAt pos v vs), True)
onMessage msg (p,ss) state
= abort "OEPS.."
client = {init = init, onEvent = onEvent, onMessage = onMessage, state = state} client = {init = init, onEvent = onEvent, onMessage = onMessage, state = state}
where where
init Nothing = {NxtDOMNode|attributes = attributes, children = [], history = []} init Nothing = {NxtDOMNode|attributes = attributes, children = [], history = []}
...@@ -630,15 +633,25 @@ where ...@@ -630,15 +633,25 @@ where
# child = editor.client.NxtEditorClient.init c # child = editor.client.NxtEditorClient.init c
= ([],{NxtDOMNode|dom & children = insertAt pos child children}) = ([],{NxtDOMNode|dom & children = insertAt pos child children})
onMessage (NxtClientInLocal (NxtInsertChild pos c)) dom=:{NxtDOMNode|children} //TODO: Revert and versioning
# child = editor.client.NxtEditorClient.init c
= ([NxtClientOut (NxtInsertChild pos c) emptyPartialVersion],{NxtDOMNode|dom & children = insertAt pos child children})
onMessage (NxtClientInRemote (NxtRemoveChild pos) oldVersion newVersion) dom=:{NxtDOMNode|children} //TODO: Check structure versions... onMessage (NxtClientInRemote (NxtRemoveChild pos) oldVersion newVersion) dom=:{NxtDOMNode|children} //TODO: Check structure versions...
= ([],{NxtDOMNode|dom & children = removeAt pos children}) = ([],{NxtDOMNode|dom & children = removeAt pos children})
onMessage (NxtClientInLocal (NxtRemoveChild pos)) dom=:{NxtDOMNode|children} //TODO: should be able to revert to older version and send versions...
= ([NxtClientOut (NxtRemoveChild pos) emptyPartialVersion],{NxtDOMNode|dom & children = removeAt pos children})
onMessage (NxtClientInRemote (NxtUpdateChild pos m) oldVersion newVersion) dom=:{NxtDOMNode|children} onMessage (NxtClientInRemote (NxtUpdateChild pos m) oldVersion newVersion) dom=:{NxtDOMNode|children}
# (ms,child) = editor.client.NxtEditorClient.onMessage # (ms,child) = editor.client.NxtEditorClient.onMessage
(NxtClientInRemote m (selectPartialVersion pos oldVersion) (selectPartialVersion pos newVersion)) (children !! pos) (NxtClientInRemote m (selectPartialVersion pos oldVersion) (selectPartialVersion pos newVersion)) (children !! pos)
= ([(NxtClientOut (NxtUpdateChild pos message) emptyPartialVersion) \\ (NxtClientOut message version) <- ms] //TODO: Determine version = ([(NxtClientOut (NxtUpdateChild pos message) emptyPartialVersion) \\ (NxtClientOut message version) <- ms] //TODO: Determine version
,{NxtDOMNode|dom & children = updateAt pos child children}) ,{NxtDOMNode|dom & children = updateAt pos child children})
onMessage (NxtClientInLocal m) dom
= trace_n "UNIMPLEMENTED" ([],dom)
state dom=:{NxtDOMNode|children} state dom=:{NxtDOMNode|children}
= map editor.client.NxtEditorClient.state children = map editor.client.NxtEditorClient.state children
...@@ -861,13 +874,13 @@ where ...@@ -861,13 +874,13 @@ where
where where
onRefresh r s = e.server.NxtEditorServer.onRefresh (t r) s onRefresh r s = e.server.NxtEditorServer.onRefresh (t r) s
mapw :: (wa -> wb) (NxtEditor p r wa s c m) -> (NxtEditor p r wb s c m) mapw :: (wa -> Maybe wb) (NxtEditor p r wa s c m) -> (NxtEditor p r wb s c m)
mapw f e = {NxtEditor|server = server, client = e.client} mapw f e = {NxtEditor|server = server, client = e.client}
where where
server = {init = e.server.NxtEditorServer.init, parameter = e.server.NxtEditorServer.parameter, value = value server = {init = e.server.NxtEditorServer.init, parameter = e.server.NxtEditorServer.parameter, value = value
, onRefresh = e.server.NxtEditorServer.onRefresh, onMessage = e.server.NxtEditorServer.onMessage} , onRefresh = e.server.NxtEditorServer.onRefresh, onMessage = e.server.NxtEditorServer.onMessage}
where where
value s = fmap f (e.server.NxtEditorServer.value s) value s = maybe Nothing f (e.server.NxtEditorServer.value s)
maps :: (sa -> sb, sb -> sa) (NxtEditor p r w sa c m) -> (NxtEditor p r w sb c m) maps :: (sa -> sb, sb -> sa) (NxtEditor p r w sa c m) -> (NxtEditor p r w sb c m)
maps (t,f) e = {NxtEditor|server = server, client = e.client} maps (t,f) e = {NxtEditor|server = server, client = e.client}
...@@ -934,7 +947,7 @@ where ...@@ -934,7 +947,7 @@ where
= ([NxtClientOut (t m) version \\ NxtClientOut m version <- ms],dom) = ([NxtClientOut (t m) version \\ NxtClientOut m version <- ms],dom)
mapg :: mapg ::
((p1,p2) -> p, p -> (p1,p2)) //Fuse parameter ((p1,p2) -> p, p -> (p1,p2)) //Fuse parameter
((Maybe w1, Maybe w2) -> w, r -> (r1,r2)) //Fuse read/write ((Maybe w1, Maybe w2) -> Maybe w, r -> (r1,r2)) //Fuse read/write
((c1,c2) -> c, c -> (c1,c2)) //Fuse client configuration ((c1,c2) -> c, c -> (c1,c2)) //Fuse client configuration
((s1,s2) -> s, s -> (s1,s2)) //Fuse server state ((s1,s2) -> s, s -> (s1,s2)) //Fuse server state
((Maybe m1, Maybe m2) -> (Maybe m), m -> (Maybe m1, Maybe m2)) //Fuse messages ((Maybe m1, Maybe m2) -> (Maybe m), m -> (Maybe m1, Maybe m2)) //Fuse messages
...@@ -1147,45 +1160,64 @@ where ...@@ -1147,45 +1160,64 @@ where
mapw = fst mapw = fst
mapr x = (x,False) mapr x = (x,False)
/*
//More complex test editor: A list of numbers where each element has a delete button and there is a global add button //More complex test editor: A list of numbers where each element has a delete button and there is a global add button
testListEditor ::
NxtEditor
() //p
[Maybe Int] //r
[Maybe Int] //w
[String] //s
([(String,Bool)],Bool) //c
(Maybe (ContainerMsg (String,(String,Bool)) (Maybe String, Maybe Bool)), Maybe Bool) //m
testListEditor
= mapp (const (), const (((),()),()))
$ mapr (\rs -> ( map (fmap (\i -> (i,False))) rs, False))
$ mapw ((map (fmap (\(Just i,_) -> i))) o fromMaybe [] o fst)
$ maps (\((_,ss),_) -> map fst ss, \ss -> ((((),()),[(s,False)\\ s <- ss]),False))
$ mapc (\(cs,(_,a)) -> (map (appSnd snd) cs,a), \(cs,a) ->([(s,("Removed",d))\\ (s,d) <-cs],("Add item",a)))
$ listWithAddAndDelete
*/
listWithAddAndDelete = linkg rserver rclient (glue listWithDelete nxtButton) testListWithAddAndDelete :: NxtEditor () [Maybe Int] [Maybe Int] [String] [String] (ContainerMsg String String)
testListWithAddAndDelete
= mapp (const (), const ((),()))
$ mapr (\x -> (Just x,Nothing))
$ mapw (\w -> fst w)
$ maps (fst,\x -> (x,False))
$ mapc (fst,\x -> (x,("Add",False)))
$ mapm (\(Just m,_) -> m, \m -> (Just m,Nothing))
$ linkg rserver rclient (glue testListWithDelete nxtButton)
where where
//Ignore messages from the server
rserver s1 s2 m = (True,[]) rserver s1 s2 m = (True,[])
rclient c1 c2 (_,Just True) = (False,[(Just (NxtInsertChild (length c1) Nothing), Just False)]) rclient c1 c2 (_,Just True) = (False,[(Just (NxtInsertChild (length c1) Nothing), Just False)])
rclient c1 c2 m = (True,[]) rclient c1 c2 m = (True,[])
listWithDelete = linkm rserver rclient (multiple testListItemEditor) testListWithDelete :: NxtEditor () [Maybe Int] [Maybe Int] [String] [String] (ContainerMsg String String)
testListWithDelete
= maps (snd,\x -> ((),x))
$ mapm (tom,fromm)
$ linkm rserver rclient (multiple testListItemEditor)
where where
//Ignore messages from the server //Ignore messages from the server
rserver ss m = (True,[]) rserver ss m = (True,[])
//Turn a click of the button into the appropriate remove messages: remove locally and remote //Turn a click of the button into the appropriate remove messages: remove locally and remote
rclient c (NxtUpdateChild n (mbx,Just True)) = (False,[NxtRemoveChild n]) rclient c (NxtUpdateChild n (Right True)) = (False,[NxtRemoveChild n])
rclient c m = (True,[]) //Ignore other messages rclient c m = (True,[]) //Ignore other messages
testListItemEditor :: NxtEditor ((),()) (Maybe Int,Maybe Bool) (Maybe Int,Maybe Bool) (String,Bool) (String,(String,Bool)) (Maybe String, Maybe Bool) //Simplify message type (delete clicks are client-side so never occur outside the editor)
testListItemEditor = glue nxtNumberField nxtButton tom (NxtInsertChild pos c) = NxtInsertChild pos c
tom (NxtRemoveChild pos) = NxtRemoveChild pos
tom (NxtUpdateChild pos (Left m)) = NxtUpdateChild pos m
fromm (NxtInsertChild pos c) = NxtInsertChild pos c
fromm (NxtRemoveChild pos) = NxtRemoveChild pos
fromm (NxtUpdateChild pos m) = NxtUpdateChild pos (Left m)
testListItemEditor :: NxtEditor () Int Int String String (Either String Bool)
testListItemEditor
= mapp (const (), const ((),()))
$ mapr (\x -> (Just x,Nothing))
$ mapw (\w -> fst w)
$ maps (fst,\x -> (x,False))
$ mapc (fst,\x -> (x,("Delete",False)))
$ mapm (toEither,fromEither)
$ glue nxtNumberField nxtButton
where
toEither (Just l,_) = Left l
toEither (_,Just r) = Right r
fromEither (Left l) = (Just l,Nothing)
fromEither (Right r) = (Nothing,Just r)
//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 //Start world = doTasks (simulate (validate (\x -> toInt x > 42) nxtNumberField) () (Just 12)) world
//Start world = doTasks (simulate listWithDelete () (Just [Just n \\ n <- [1..4]])) world
//Start world = doTasks (simulate testListItemEditor () (Just 42)) world
Start world = doTasks (simulate testListWithAddAndDelete () (Just [Just n \\ n <- [1..3]])) 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