Commit 16e30a0c authored by Bas Lijnse's avatar Bas Lijnse

Completed versioning of editors. All functions now support versioning, but it is not yet bugfree

parent 89a2df04
......@@ -41,23 +41,62 @@ import iTasks.Extensions.SVG.SVGEditor
:: NxtEditorClient c m =
{ init :: (Maybe c) -> NxtDOM
, state :: NxtDOM -> c
, onEvent :: NxtDOMRef String NxtDOM -> ([NxtWithVersion m],NxtDOM)
, onMessage :: (NxtWithVersions m) NxtDOM -> ([NxtWithVersion m],NxtDOM)
, onEvent :: NxtDOMRef String NxtDOM -> ([NxtClientOutMessage m],NxtDOM)
, onMessage :: (NxtClientInMessage m) NxtDOM -> ([NxtClientOutMessage m],NxtDOM)
}
:: NxtEditorServer p r w s c m =
{ init :: p -> (s,c)
{ init :: p NxtMajorVersion -> (s, NxtVersionTree, c)
, parameter :: s -> p
, value :: s -> Maybe w
, onRefresh :: r s NxtVersion -> ([NxtWithVersions m], s, NxtVersion, NxtWrite)
, onMessage :: (NxtWithVersion m) s NxtVersion -> ([NxtWithVersions m], s, NxtVersion, Bool)
, onRefresh :: r NxtMajorVersion s NxtVersionTree -> ([NxtServerOutMessage m], s, NxtVersionTree, NxtWrite)
, onMessage :: (NxtServerInMessage m) s NxtVersionTree -> ([NxtServerOutMessage m], s, NxtVersionTree, Bool)
}
:: NxtWrite :== Bool //The Bool is a 'write' signal that indicates if something significant has changed
:: NxtVersion :== (!Int,!Int) //First: which read from sds, Second: which revision by edits
:: NxtWithVersion m = { message :: m, version :: NxtVersion }
:: NxtWithVersions m = { message :: m, oldVersion :: NxtVersion, newVersion :: NxtVersion }
:: NxtVersion :== (!NxtMajorVersion,!NxtMinorVersion) //First: which read from sds, Second: which revision by edits
:: NxtMajorVersion :== Int
:: NxtMinorVersion :== Int
//Together with the served side state we need to track all versions explicitly
//(the client versions are encoded in the DOM)
:: NxtVersionTree
= NVTBasic !NxtVersion
| NVTGlue !NxtVersionTree !NxtVersionTree
| NVTMultiple !NxtVersion [NxtVersionTree]
//Messages commonly only affect part of a datastructure, so no complete version tree is communicated
:: NxtPartialVersionTree
= NVPVersion !(Maybe NxtVersion) ![(Int,NxtPartialVersionTree)]
:: NxtWithPartialVersion m = { message :: m, version :: NxtPartialVersionTree }
:: NxtWithPartialVersions m = { message :: m, oldVersion :: NxtPartialVersionTree, newVersion :: NxtPartialVersionTree}
:: NxtClientInMessage m
= NxtClientInRemote m NxtPartialVersionTree NxtPartialVersionTree //(message, oldVersion, newVersion)
| NxtClientInLocal m //local loopback on client
:: NxtClientOutMessage m = NxtClientOut m NxtPartialVersionTree //(message, version)
:: NxtServerInMessage m
= NxtServerInRemote m NxtPartialVersionTree
| NxtServerInLocal m NxtMajorVersion //When we feedback messages, we need to pass along the major version of message that created the feedback
:: NxtServerOutMessage m = NxtServerOut m NxtPartialVersionTree NxtPartialVersionTree
//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 (NVTGlue v1 v2) = NVPVersion Nothing [(0,toPartialVersion v1),(1,toPartialVersion v2)]
toPartialVersion (NVTMultiple v vs) = NVPVersion (Just v) [(n,toPartialVersion cv) \\ cv <- vs & n <- [0..]]
emptyPartialVersion = NVPVersion Nothing []
selectPartialVersion pos (NVPVersion _ items) = case [v \\ (i,v) <- items | i == pos] of
[v:_] = v
_ = emptyPartialVersion
maxMajorVersion (NVPVersion mbv vs) = foldr max (maybe 0 fst mbv) (map (maxMajorVersion o snd) vs)
//Simulated DOM/JSWorld
:: NxtDOMRef :== [Int]
......@@ -66,16 +105,18 @@ import iTasks.Extensions.SVG.SVGEditor
:: NxtDOMNode =
{ attributes :: Map String String
, children :: [NxtDOMNode]
, history :: [(NxtVersion,NxtDOMNode)] //Would normally be tracked in JS outside the DOM
}
:: VersionedServerState s =
{ state :: s
, readVersion :: Int //Increments each time the linked sds refreshes
, editVersion :: Int //Increments each time an edit message is received from the client, resets when readVersion is incremented
, readVersion :: NxtMajorVersion //Increments each time the linked sds refreshes
, stateVersion :: NxtVersionTree //Holds the versions of all parts of an editor
}
//Untyped clientside configuration
:: NxtUI :== Map String String
//:: NxtUI = { attributes :: Map String String, children :: [NxtUI]}
//Untyped message for transfer and configuration
:: NxtChange
......@@ -89,7 +130,10 @@ import iTasks.Extensions.SVG.SVGEditor
| NxtRemChild Int
| NxtUpdChild Int NxtChange
derive class iTask NxtDOMNode, NxtWithVersion, NxtWithVersions, VersionedServerState, NxtChange, NxtAttrChange, NxtStructureChange
derive class iTask NxtDOMNode, VersionedServerState, NxtChange, NxtAttrChange, NxtStructureChange
derive class iTask NxtWithPartialVersion, NxtWithPartialVersions, NxtVersionTree, NxtPartialVersionTree
derive class iTask NxtServerInMessage, NxtServerOutMessage, NxtClientInMessage, NxtClientOutMessage
derive JSEncode NxtDOMNode, Map
derive JSDecode NxtDOMNode, Map
......@@ -113,9 +157,32 @@ where
encodeEditUI :: c -> NxtUI
decodeEditUI :: NxtUI -> c
nextVersion (version,_) = (version + 1, 0)
nextRevision (version,revision) = (version, revision + 1)
checkRevision (v1,r1) (v2,r2) = (v1 == v2) && (r1 == r2 + 1) //Only accept the next revision
checkRevision (NVPVersion (Just (v1,r1)) _) (v2,r2) = (v1 == v2) && (r1 == r2 + 1) //Only accept the next revision
checkRevision _ _ = False
getVersionFromDOM {NxtDOMNode|attributes}
# major = maybe 0 toInt ('DM'.get "major-version" attributes)
# minor = maybe 0 toInt ('DM'.get "minor-version" attributes)
= (major,minor)
setVersionInDOM (major,minor) dom=:{NxtDOMNode|attributes}
# attributes = 'DM'.put "major-version" (toString major) attributes
# attributes = 'DM'.put "minor-version" (toString minor) attributes
= {NxtDOMNode|dom & attributes = attributes}
pushHistoryInDOM dom=:{attributes,children,history}
# version = getVersionFromDOM dom
= {NxtDOMNode|attributes = attributes, children = children, history = [(version,dom):history]}
resetHistoryInDOM dom = {NxtDOMNode|dom & history = []}
//Get the version of a child element in a compound structure
childversion pos mv = case [v \\ (n,v) <- mv | n == pos] of
[] = NVPVersion Nothing []
vs = last vs
//Definitions of a test editor
nxtNumberField :: NxtEditor () Int Int String String String
......@@ -124,33 +191,69 @@ where
client = {init=init,onEvent=onEvent,onMessage=onMessage,state=state}
where
init c
= {NxtDOMNode|attributes = 'DM'.fromList [("type","numberfield"),("value",maybe "" fromString c)], children = []}
= {NxtDOMNode|attributes = 'DM'.fromList [("type","numberfield"),("value",maybe "" fromString c)], children = [], history = []}
state dom=:{NxtDOMNode|attributes} = fromMaybe "" ('DM'.get "value" attributes)
onEvent [] e dom=:{NxtDOMNode|attributes}
# version = maybe (0,0) (nextRevision o fromVersionAttr) ('DM'.get "version" attributes)
# msg = [{message=e,version=version}]
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "value" (fromString e) $ 'DM'.put "version" (toVersionAttr version) attributes}
# version = nextRevision $ getVersionFromDOM dom
# msg = [NxtClientOut e (NVPVersion (Just version) [])]
# dom = pushHistoryInDOM dom
# dom = setVersionInDOM version {NxtDOMNode|dom & attributes = 'DM'.put "value" (fromString e) attributes}
= (msg,dom)
onEvent _ _ dom = ([],dom)
onMessage {message,oldVersion,newVersion} dom=:{NxtDOMNode|attributes}
//TODO: Revert to old version, apply value and replay edits
# attributes = 'DM'.put "value" message attributes
# attributes = 'DM'.put "version" (toVersionAttr newVersion) attributes
= ([],{NxtDOMNode|dom & attributes = attributes})
onMessage (NxtClientInLocal message) dom=:{NxtDOMNode|attributes,history}
# version = nextRevision $ getVersionFromDOM dom
# msg = [NxtClientOut message (NVPVersion (Just version) [])]
# dom = pushHistoryInDOM dom
# dom = setVersionInDOM version {NxtDOMNode|dom & attributes = 'DM'.put "value" message attributes}
= (msg,dom)
onMessage (NxtClientInRemote message (NVPVersion (Just oldVersion) _) (NVPVersion (Just newVersion) _)) dom=:{NxtDOMNode|attributes,history}
# version = getVersionFromDOM dom
| version <> oldVersion //The server was not up-to date, mitigate potential conflict
# curValue = fromJust ('DM'.get "value" attributes)
# oldValue = firstJust ['DM'.get "value" attributes \\ (v,{NxtDOMNode|attributes}) <- history | v == oldVersion]
//If we only extended the message, we can add the extension
| startsWith oldValue curValue
# extension = subString (textSize oldValue) (textSize curValue) curValue
# newValue = message +++ extension
//Set message value as first step in history
# dom = setVersionInDOM newVersion dom
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "value" message attributes}
# dom = pushHistoryInDOM $ resetHistoryInDOM dom
//Retore the extension and set as message
# newVersion = nextRevision newVersion
# dom = setVersionInDOM newVersion dom
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "value" newValue attributes}
# msg = [NxtClientOut newValue (NVPVersion (Just newVersion) [])]
= (msg,dom)
| otherwise //Too bad, we have lost our edits, best notify the user somehow by a visual or audible cue
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "value" message attributes}
# dom = setVersionInDOM newVersion dom
# dom = resetHistoryInDOM dom
= ([],dom)
| otherwise //Everything was as expected
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "value" message attributes}
# dom = setVersionInDOM newVersion dom
# dom = resetHistoryInDOM dom
= ([],dom)
where
firstJust [Just x:_] = x
server = {init=init,parameter=parameter,value=value,onRefresh=onRefresh,onMessage=onMessage}
where
init () = ("","")
init () v = ("",NVTBasic (v,0), "")
parameter _ = ()
value s = Just (toInt s)
onRefresh s _ v = ([{message=toString s, oldVersion = v, newVersion = nextVersion v}], toString s, nextVersion v, False)
onMessage {message,version} c v
| checkRevision version v = ([], message, nextRevision v, True)
| otherwise = ([], c, v, False)
onRefresh r rv _ (NVTBasic v)
= ([NxtServerOut (toString r) (NVPVersion (Just v) []) (NVPVersion (Just (rv,0)) [])], toString r,NVTBasic (rv,0), False)
onMessage (NxtServerInRemote message version) c (NVTBasic v )
| checkRevision version v = ([], message, NVTBasic (nextRevision v), True)
| otherwise = ([], c, NVTBasic v, False)
nxtButton :: NxtEditor () Bool Bool Bool (String,Bool) Bool
nxtButton = {client=client,server=server}
......@@ -159,7 +262,7 @@ where
where
init c
# (label,clicked) = fromMaybe ("button",False) c
= {NxtDOMNode|attributes = 'DM'.fromList [("type","button"),("label",label),("clicked",if clicked "true" "false")],children = []}
= {NxtDOMNode|attributes = 'DM'.fromList [("type","button"),("label",label),("clicked",if clicked "true" "false")],children = [], history = []}
state dom=:{NxtDOMNode|attributes}
# clicked = case 'DM'.get "clicked" attributes of
......@@ -169,51 +272,139 @@ where
= (label,clicked)
onEvent [] "click" dom=:{NxtDOMNode|attributes}
# msg = [{message = True, version = (0,0)}]
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "clicked" "true" attributes}
# major = maybe 0 toInt ('DM'.get "major-version" attributes)
# minor = maybe 1 (inc o toInt) ('DM'.get "minor-version" attributes)
# msg = [NxtClientOut True (NVPVersion (Just (major,minor)) [])]
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "minor-version" (toString minor) $'DM'.put "clicked" "true" attributes}
= (msg,dom)
onEvent _ _ dom
= ([],dom)
onMessage {message,oldVersion,newVersion} dom=:{NxtDOMNode|attributes}
= ([],{NxtDOMNode|dom & attributes = 'DM'.put "clicked" (if message "true" "false") attributes})
onMessage (NxtClientInLocal value) dom=:{NxtDOMNode|attributes} //Similar to onEvent, but can also set value to False
# major = maybe 0 toInt ('DM'.get "major-version" attributes)
# minor = maybe 1 (inc o toInt) ('DM'.get "minor-version" attributes)
# msg = [NxtClientOut value (NVPVersion (Just (major,minor)) [])]
# dom = {NxtDOMNode|dom & attributes = 'DM'.put "minor-version" (toString minor) $'DM'.put "clicked" "false" attributes}
= (msg,dom)
onMessage (NxtClientInRemote message oldVersion newVersion) dom=:{NxtDOMNode|attributes}
# attributes = 'DM'.put "clicked" (if message "true" "false") attributes
//Update version
# attributes = case newVersion of
(NVPVersion (Just (major,minor)) _)
= 'DM'.put "minor-version" (toString minor) $ 'DM'.put "major-version" (toString major) attributes
_
= attributes
= ([],{NxtDOMNode|dom & attributes = attributes})
server = {init=init,parameter=parameter,value=value,onRefresh=onRefresh,onMessage=onMessage}
where
init _ = (False,("Click me",False))
init () v = (False,NVTBasic (v,0),("Click me",False))
parameter _ = ()
value s = Just s
onRefresh s _ v = ([{message = s, oldVersion = v, newVersion = nextVersion v}], s, nextVersion v, False)
onRefresh r rv _ (NVTBasic v) = ([NxtServerOut r (NVPVersion (Just v) []) (NVPVersion (Just (rv,0)) [])], r, NVTBasic (rv,0), False)
onMessage {message,version} c v
| checkRevision version v = ([], message, nextRevision v, True)
| otherwise = ([], c, v, False)
onMessage (NxtServerInRemote message version) c (NVTBasic v)
| checkRevision version v = ([], message, NVTBasic (nextRevision v), True)
| otherwise = ([], c, NVTBasic v, False)
toVersionAttr (x,y) = toString x +++ "-" +++ toString y
fromVersionAttr s = case split "-" s of
[x,"-",y:_] = (toInt x,toInt y)
_ = (0,0)
[x,y:_] = (toInt x,toInt y)
_ = (0,0)
addVersionAttr key (Just version) (NxtNoChange) = NxtChange [NxtSetAttr key (toVersionAttr version)] []
addVersionAttr key (Just version) (NxtChange attrChanges childChanges) = NxtChange (attrChanges ++ [NxtSetAttr key (toVersionAttr version)]) childChanges
addVersionAttr key (Just version) (NxtReplace attrs) = NxtReplace ('DM'.put key (toVersionAttr version) attrs)
addVersionAttr key Nothing message = message
getVersionAttr key (NxtChange attrChanges childChanges)
= case [fromVersionAttr v \\ NxtSetAttr k v <- attrChanges | key == k] of
[] = Nothing
versions = Just (last versions)
getVersionAttr key (NxtReplace attrs)
= fmap fromVersionAttr ('DM'.get key attrs)
getVersionAttr key enc = Nothing
overlayVersions key (NVPVersion Nothing []) (NxtNoChange) = NxtNoChange
overlayVersions key (NVPVersion mbv cvs) (NxtNoChange) = NxtChange attrChanges childChanges
where
attrChanges = maybe [] (\version -> [NxtSetAttr key (toVersionAttr version)]) mbv
childChanges = [NxtUpdChild n (overlayVersions key cv NxtNoChange) \\ (n,cv) <- cvs]
addVersionAttr key version (NxtNoChange) = NxtChange [NxtSetAttr key (toVersionAttr version)] []
addVersionAttr key version (NxtChange attrChanges childChanges) = NxtChange (attrChanges ++ [NxtSetAttr key (toVersionAttr version)]) childChanges
addVersionAttr key version (NxtReplace attrs) = NxtReplace ('DM'.put key (toVersionAttr version) attrs)
overlayVersions key (NVPVersion mbv cvs) (NxtChange attrChanges childChanges) = NxtChange attrChanges` childChanges`
where
attrChanges` = attrChanges ++ maybe [] (\version -> [NxtSetAttr key (toVersionAttr version)]) mbv
childChanges` = childChanges ++ [NxtUpdChild n (overlayVersions key cv NxtNoChange) \\ (n,cv) <- cvs]
overlayVersions key (NVPVersion mbv cvs) (NxtReplace attrs) = NxtReplace attrs` //TODO: Cannot handle nested versions yet
where
attrs` = maybe attrs (\version -> 'DM'.put key (toVersionAttr version) attrs) mbv
getOverlayedVersions key NxtNoChange = NVPVersion Nothing []
getOverlayedVersions key (NxtReplace attrs)
= NVPVersion (fmap fromVersionAttr ('DM'.get key attrs)) []
getOverlayedVersions key (NxtChange attrChanges childChanges)
# version = foldl setVersion Nothing attrChanges
# childVersions = [(n, getOverlayedVersions key change) \\ (NxtUpdChild n change) <- childChanges]
= NVPVersion version (filter (not o emptyChange o snd) childVersions)
where
setVersion cur (NxtSetAttr k v) = if (k == key) (Just (fromVersionAttr v)) cur
setVersion cur _ = cur
getVersionAttr key enc = (0,0) //TODO
emptyChange (NVPVersion Nothing []) = True
emptyChange _ = False
instance EditMessage (NxtWithVersion m) | EditMessage m
instance EditMessage (NxtServerOutMessage m) | EditMessage m
where
encodeEditMessage {message,version} = addVersionAttr "version" version $ encodeEditMessage message
decodeEditMessage enc = {message=decodeEditMessage enc, version = getVersionAttr "version" enc}
encodeEditMessage (NxtServerOut message oldVersion newVersion)
= overlayVersions "old-version" oldVersion
$ overlayVersions "new-version" newVersion
$ encodeEditMessage message
instance EditMessage (NxtWithVersions m) | EditMessage m
decodeEditMessage enc
= let message = decodeEditMessage enc
oldVersion = getOverlayedVersions "old-version" enc
newVersion = getOverlayedVersions "new-version" enc
in (NxtServerOut message oldVersion newVersion)
instance EditMessage (NxtClientOutMessage m) | EditMessage m
where
encodeEditMessage (NxtClientOut message version)
= overlayVersions "version" version
$ encodeEditMessage message
decodeEditMessage enc
= let message = decodeEditMessage enc
version = getOverlayedVersions "version" enc
in (NxtClientOut message version)
instance EditMessage (NxtWithPartialVersion m) | EditMessage m
where
encodeEditMessage {message,version}
= overlayVersions "version" version
$ encodeEditMessage message
decodeEditMessage enc
= {message=decodeEditMessage enc
,version = getOverlayedVersions "version" enc
}
instance EditMessage (NxtWithPartialVersions m) | EditMessage m
where
encodeEditMessage {message,oldVersion,newVersion}
= addVersionAttr "old-version" oldVersion $ addVersionAttr "new-version" newVersion $ encodeEditMessage message
= overlayVersions "old-version" oldVersion
$ overlayVersions "new-version" newVersion
$ encodeEditMessage message
decodeEditMessage enc
= {message=decodeEditMessage enc, oldVersion = getVersionAttr "old-version" enc, newVersion = getVersionAttr "new-version" enc}
= {message=decodeEditMessage enc
,oldVersion = getOverlayedVersions "old-version" enc
,newVersion = getOverlayedVersions "new-version" enc
}
instance EditMessage String //If strings are used as edit type, it's just the value attribute
where
......@@ -271,7 +462,6 @@ where
decodeEditMessage (NxtChange _ [NxtRemChild pos:_]) = NxtRemoveChild pos
decodeEditMessage (NxtChange _ [NxtUpdChild pos m:_]) = NxtUpdateChild pos (decodeEditMessage m)
/*
// ### Composition
//Combine two editors into one that can do both
......@@ -284,6 +474,31 @@ alternative ::
(NxtEditor (Either p1 p2) (Either r1 r2) (Either w1 w2) (Either s1 s2) (Either c1 c2) (Either m1 m2))
alternative e1 e2 = {NxtEditor|server=server,client=client}
where
server = {init = init, parameter = parameter, value=value, onRefresh = onRefresh, onMessage = onMessage}
where
init (Left p) mv = let (s,vs,c) = (e1.server.NxtEditorServer.init p mv) in (Left s,vs,Left c)
init (Right p) mv = let (s,vs,c) = (e2.server.NxtEditorServer.init p mv) in (Right s,vs,Right c)
parameter (Left s) = Left (e1.server.NxtEditorServer.parameter s)
parameter (Right s) = Right (e2.server.NxtEditorServer.parameter s)
value (Left s) = fmap Left (e1.server.NxtEditorServer.value s)
value (Right s) = fmap Right (e2.server.NxtEditorServer.value s)
onRefresh (Left r) rv (Left s) sv
# (ms,s,sv,w) = e1.server.NxtEditorServer.onRefresh r rv s sv
= ([NxtServerOut (Left message) oldVersion newVersion \\ (NxtServerOut message oldVersion newVersion) <- ms], Left s, sv, w)
onRefresh (Right r) rv (Right s) sv
# (ms,s,sv,w) = e2.server.NxtEditorServer.onRefresh r rv s sv
= ([NxtServerOut (Right message) oldVersion newVersion \\ (NxtServerOut message oldVersion newVersion) <- ms], Right s, sv, w)
onMessage (NxtServerInRemote (Left m) version) (Left s) sv
# (ms,s,sv,w) = e1.server.NxtEditorServer.onMessage (NxtServerInRemote m version) s sv
= ([NxtServerOut (Left message) oldVersion newVersion \\ (NxtServerOut message oldVersion newVersion) <- ms], Left s, sv, w)
onMessage (NxtServerInRemote (Right m) version) (Right s) sv
# (ms,s,sv,w) = e2.server.NxtEditorServer.onMessage (NxtServerInRemote m version) s sv
= ([NxtServerOut (Right message) oldVersion newVersion \\ (NxtServerOut message oldVersion newVersion) <- ms], Right s, sv, w)
client = {init = init, onEvent = onEvent, onMessage = onMessage, state = state}
where
init Nothing
......@@ -307,136 +522,119 @@ where
# alt = fromJust ('DM'.get "alternative" attributes)
| alt == "left"
# (ms,dom) = e1.client.NxtEditorClient.onEvent ref event dom
= (map Left ms,dom)
= ([NxtClientOut (Left message) version \\ (NxtClientOut message version) <- ms], dom)
| otherwise
# (ms,dom) = e2.client.NxtEditorClient.onEvent ref event dom
= (map Right ms,dom)
= ([NxtClientOut (Right message) version \\ (NxtClientOut message version) <- ms], dom)
onMessage (Left msg) dom
# (ms,dom) = e1.client.NxtEditorClient.onMessage msg dom
= (map Left ms,dom)
onMessage (Right msg) dom
# (ms,dom) = e2.client.NxtEditorClient.onMessage msg dom
= (map Right ms,dom)
onMessage (NxtClientInRemote (Left m) oldVersion newVersion) dom
# (ms,dom) = e1.client.NxtEditorClient.onMessage (NxtClientInRemote m oldVersion newVersion) dom
= ([NxtClientOut (Left message) version \\ (NxtClientOut message version) <- ms], dom)
onMessage (NxtClientInRemote (Right m) oldVersion newVersion) dom
# (ms,dom) = e2.client.NxtEditorClient.onMessage (NxtClientInRemote m oldVersion newVersion) dom
= ([NxtClientOut (Right message) version \\ (NxtClientOut message version) <- ms], dom)
multiple :: (NxtEditor p r w s c m) -> (NxtEditor p [Maybe r] [Maybe w] (p,[s]) [c] (ContainerMsg c m))
multiple editor = {NxtEditor|server=server,client=client}
where
server = {init = init, parameter = parameter, value=value, onRefresh = onRefresh, onMessage = onMessage}
where
init (Left p) = (\(s,c) -> (Left s,Left c)) (e1.server.NxtEditorServer.init p)
init (Right p) = (\(s,c) -> (Right s,Right c)) (e2.server.NxtEditorServer.init p)
init p v = ((p,[]),NVTMultiple (v,0) [], [])
parameter (p,_) = p
value (_,ss) = Just (map editor.server.NxtEditorServer.value ss)
parameter (Left s) = Left (e1.server.NxtEditorServer.parameter s)
parameter (Right s) = Right (e2.server.NxtEditorServer.parameter s)
onRefresh mbrs rv (p,ss) (NVTMultiple stv vs)//A naive linear side by side diff to see what needs updating
# (msgs,ss,vs,write) = compare 0 ss vs mbrs
= (msgs, (p,ss), NVTMultiple stv vs, False)//By default we need to do a diff
where
//Compare first items side by side
compare i [s:ss] [v:vs] [Nothing:mbrs]
# (msgs, ss, vs, write) = compare (i + 1) ss vs mbrs
= (msgs, [s:ss], [v:vs], write)
value (Left s) = fmap Left (e1.server.NxtEditorServer.value s)
value (Right s) = fmap Right (e2.server.NxtEditorServer.value s)
compare i [s:ss] [vo:vs] [Just r:mbrs]
# (ms, s, vn, writes) = editor.server.NxtEditorServer.onRefresh r rv s vo
# (msgs, ss, vs, writess) = compare (i + 1) ss vs mbrs
= ([NxtServerOut (NxtUpdateChild i message) (toPartialVersion vo) (toPartialVersion vn) \\ (NxtServerOut message oldVersion newVersion) <- ms] ++ msgs
, [s:ss], [vn:vs], writes || writess) //TODO: determine proper versions...
onRefresh (Left r) (Left s)
# (ms,s,w) = e1.server.NxtEditorServer.onRefresh r s
= (map Left ms, Left s, w)
onRefresh (Right r) (Right s)
# (ms,s,w) = e2.server.NxtEditorServer.onRefresh r s
= (map Right ms, Right s, w)
onMessage (Left m) (Left s)
# (ms,s,w) = e1.server.NxtEditorServer.onMessage m s
= (map Left ms, Left s, w)
onMessage (Right m) (Right s)
# (ms,s,w) = e2.server.NxtEditorServer.onMessage m s
= (map Right ms, Right s, w)
*/
//New read list has more items
compare i [] _ mbrs
# (msgs, ss, vs, ws) = unzip4 [create i` mbr \\ mbr <- mbrs & i` <- [i..]]
= (flatten msgs, ss, vs, or ws)
where
create i mbr
# (s,vi,c) = editor.server.NxtEditorServer.init p (fst stv)
# (ms, s, v, write) = maybe ([],s,vi,False) (\r -> editor.server.NxtEditorServer.onRefresh r rv s vi) mbr
= ([NxtServerOut (NxtInsertChild i (Just c)) emptyPartialVersion (toPartialVersion vi)
:[NxtServerOut (NxtUpdateChild i message) (NVPVersion Nothing [(i,oldVersion)]) (NVPVersion Nothing [(i,newVersion)]) \\ (NxtServerOut message oldVersion newVersion) <- ms]], s, v, write)
//New read list has less (remove existing)
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
| 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)
= ([NxtServerOut (NxtUpdateChild pos message) (multiversion pos oldVersion) (multiversion pos newVersion)
\\ (NxtServerOut message oldVersion newVersion) <-ms ], (p, updateAt pos s ss), NVTMultiple stv (updateAt pos v vs), write)
//TODO: create the right version structure
where
multiversion pos v = NVPVersion Nothing [(pos,v)]
onMessage (NxtServerInRemote (NxtRemoveChild pos) (NVPVersion _ mv)) (p,ss) (NVTMultiple stv vs)
| pos >= length ss || pos < 0 = ([],(p,ss),NVTMultiple stv vs, False) //Out of bounds, (maybe abort instead for the simulation)
= ([], (p, removeAt pos ss), NVTMultiple stv (removeAt pos vs), True)
onMessage (NxtServerInRemote (NxtInsertChild pos Nothing) (NVPVersion _ mv)) (p,ss) (NVTMultiple stv vs)
| pos > length ss || pos < 0 = ([],(p,ss),NVTMultiple stv vs, False) //Out of bounds, (maybe abort instead for the simulation)
# (s,v,_) = editor.server.NxtEditorServer.init p (fst stv)
= ([], (p, insertAt pos s ss), NVTMultiple stv (insertAt pos v vs), True)
/*
multiple :: (NxtEditor p r w s c m) -> (NxtEditor p [Maybe r] [Maybe w] (p,[s]) [c] (ContainerMsg c m))
multiple editor = {NxtEditor|server=server,client=client}
where
client = {init = init, onEvent = onEvent, onMessage = onMessage, state = state}
where
init Nothing = {NxtDOMNode|attributes = attributes, children = []}
init Nothing = {NxtDOMNode|attributes = attributes, children = [], history = []}
init (Just cs)
= {NxtDOMNode|attributes = attributes, children = [editor.client.NxtEditorClient.init (Just c) \\ c <- cs]}
= {NxtDOMNode|attributes = attributes, children = [editor.client.NxtEditorClient.init (Just c) \\ c <- cs], history = []}
attributes = 'DM'.fromList [("type","multiple")]
onEvent [n:ref] event dom=:{NxtDOMNode|children}
| n < 0 || n >= length children = ([],dom)
# (ms,child) = editor.client.NxtEditorClient.onEvent ref event (children !! n)
= (map (NxtUpdateChild n) ms, {NxtDOMNode|dom & children = updateAt n child children})
= ([NxtClientOut (NxtUpdateChild n message) (NVPVersion Nothing [(n,version)]) \\ (NxtClientOut message version) <- ms], {NxtDOMNode|dom & children = updateAt n child children})
onEvent _ _ dom
= ([],dom)