Commit e969bcf9 authored by Bas Lijnse's avatar Bas Lijnse

Extended editor simulation to allow basic composition

parent 65ef2120
Pipeline #16683 failed with stage
in 53 seconds
...@@ -5,7 +5,7 @@ module EditorSim ...@@ -5,7 +5,7 @@ module EditorSim
import iTasks import iTasks
import Data.Maybe import Data.Maybe
import qualified Data.Map as DM import qualified Data.Map as DM
import Text.HTML import Text, Text.HTML
//Definition of editors //Definition of editors
:: NxtEditor v s c m = :: NxtEditor v s c m =
...@@ -15,7 +15,7 @@ import Text.HTML ...@@ -15,7 +15,7 @@ import Text.HTML
:: NxtEditorClient c m = :: NxtEditorClient c m =
{ init :: c NxtDOMRef NxtDOM -> NxtDOM { init :: c NxtDOMRef NxtDOM -> NxtDOM
, onEvent :: String NxtDOMRef NxtDOM -> (Maybe m,NxtDOM) , onEvent :: (NxtDOMRef,String) NxtDOMRef NxtDOM -> (Maybe m,NxtDOM)
, onMessage :: m NxtDOMRef NxtDOM -> (Maybe m,NxtDOM) , onMessage :: m NxtDOMRef NxtDOM -> (Maybe m,NxtDOM)
} }
...@@ -27,7 +27,7 @@ import Text.HTML ...@@ -27,7 +27,7 @@ import Text.HTML
} }
//Simulated DOM/JSWorld //Simulated DOM/JSWorld
:: NxtDOMRef :== Int :: NxtDOMRef :== [Int]
:: NxtDOM :== Map String String :: NxtDOM :== Map String String
//Untyped clientside configuration //Untyped clientside configuration
...@@ -53,21 +53,22 @@ where ...@@ -53,21 +53,22 @@ where
decodeEditMessage :: NxtChange -> m decodeEditMessage :: NxtChange -> m
//Definitions of a test editor //Definitions of a test editor
numberField :: NxtEditor Int String String String nxtNumberField :: NxtEditor Int String String String
numberField = {client=client,server=server} nxtNumberField = {client=client,server=server}
where where
client = {init=init,onEvent=onEvent,onMessage=onMessage} client = {init=init,onEvent=onEvent,onMessage=onMessage}
where where
init c ref dom init c ref dom
= 'DM'.put ("value-" +++ toString ref) (fromString c) dom = 'DM'.put ("value-" +++ join "-" (map toString ref)) (fromString c) dom
onEvent e ref dom onEvent (eref,e) ref dom
| eref =!= ref = (Nothing,dom)
# msg = Just e # msg = Just e
# dom = 'DM'.put ("value-" +++ toString ref) (fromString e) dom # dom = 'DM'.put ("value-" +++ join "-" (map toString ref)) (fromString e) dom
= (msg,dom) = (msg,dom)
onMessage m ref dom onMessage m ref dom
# dom = 'DM'.put ("value-" +++ toString ref) m dom # dom = 'DM'.put ("value-" +++ join "-" (map toString ref)) m dom
= (Nothing,dom) = (Nothing,dom)
server = {value=value,configure=configure,onRefresh=onRefresh,onMessage=onMessage} server = {value=value,configure=configure,onRefresh=onRefresh,onMessage=onMessage}
...@@ -77,11 +78,126 @@ where ...@@ -77,11 +78,126 @@ where
onRefresh s _ = (Just s, s) onRefresh s _ = (Just s, s)
onMessage m _ = (Nothing, m) onMessage m _ = (Nothing, m)
nxtButton :: NxtEditor Bool Bool (String,Bool) Bool
nxtButton = {client=client,server=server}
where
client = {init=init,onEvent=onEvent,onMessage=onMessage}
where
init (label,clicked) ref dom
# dom = 'DM'.put ("label-" +++ join "-" (map toString ref)) label dom
# dom = 'DM'.put ("clicked-" +++ join "-" (map toString ref)) (if clicked "true" "false") dom
= dom
onEvent (eref,"click") ref dom
| eref =!= ref = (Nothing,dom)
# msg = Just True
# dom = 'DM'.put ("clicked-" +++ join "-" (map toString ref)) "true" dom
= (msg,dom)
onMessage m ref dom
# dom = 'DM'.put ("clicked-" +++ join "-" (map toString ref)) (if m "true" "false") dom
= (Nothing,dom)
server = {value=value,configure=configure,onRefresh=onRefresh,onMessage=onMessage}
where
configure s = ("Click me",s)
value = (fromMaybe False, Just)
onRefresh s _ = (Just s, s)
onMessage m _ = (Nothing, m)
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 v = NxtChange [NxtSetAttr "value" v] [] encodeEditMessage v = NxtChange [NxtSetAttr "value" v] []
decodeEditMessage (NxtChange [NxtSetAttr "value" v] []) = v decodeEditMessage (NxtChange [NxtSetAttr "value" v] []) = v
instance EditMessage Bool //If strings are used as edit type, it's just the value attribute
where
encodeEditMessage v = NxtChange [NxtSetAttr "value" (if v "true" "false")] []
decodeEditMessage (NxtChange [NxtSetAttr "value" "true"] []) = True
decodeEditMessage (NxtChange [NxtSetAttr "value" "false"] []) = False
instance EditMessage (Maybe a,Maybe b) | EditMessage a & EditMessage b
where
encodeEditMessage (mba, mbb)
= NxtChange [] (maybe [] (\a -> [NxtUpdChild 0 (encodeEditMessage a)]) mba
++ maybe [] (\b -> [NxtUpdChild 1 (encodeEditMessage b)]) mbb)
decodeEditMessage (NxtChange [] [NxtUpdChild 0 enca,NxtUpdChild 1 encb]) = (Just (decodeEditMessage enca),Just (decodeEditMessage encb))
decodeEditMessage (NxtChange [] [NxtUpdChild 0 enca]) = (Just (decodeEditMessage enca),Nothing)
decodeEditMessage (NxtChange [] [NxtUpdChild 1 encb]) = (Nothing,Just (decodeEditMessage encb))
decodeEditMessage _ = (Nothing,Nothing)
// Composition
//Compose by juxtaposition, no need to specify interdependency
glue :: (NxtEditor v1 s1 c1 m1)
(NxtEditor v2 s2 c2 m2)
->
(NxtEditor (Maybe v1, Maybe v2) (s1,s2) (c1,c2) (Maybe m1, Maybe m2))
glue e1 e2 = {NxtEditor|server=server,client=client}
where
server = {value=value,configure=configure,onRefresh=onRefresh,onMessage=onMessage}
where
value = (fromv,tov)
where
fromv Nothing = (fst e1.server.NxtEditorServer.value Nothing, fst e2.server.NxtEditorServer.value Nothing)
fromv (Just (mv1,mv2)) = (fst e1.server.NxtEditorServer.value mv1, fst e2.server.NxtEditorServer.value mv2)
tov (s1,s2)
# mv1 = snd e1.server.NxtEditorServer.value s1
# mv2 = snd e2.server.NxtEditorServer.value s2
= (if (mv1 =: Nothing && mv2 =: Nothing) Nothing (Just (mv1,mv2)))
configure (s1,s2) = (e1.server.NxtEditorServer.configure s1, e2.server.NxtEditorServer.configure s2)
onRefresh (s1n,s2n) (s1o,s2o)
# (mb1, s1) = e1.server.NxtEditorServer.onRefresh s1n s1o
# (mb2, s2) = e2.server.NxtEditorServer.onRefresh s2n s2o
= (if (mb1 =: Nothing && mb2 =: Nothing) Nothing (Just (mb1,mb2)), (s1,s2))
onMessage (mb1,mb2) (s1,s2)
# (mb1,s1) = maybe (Nothing,s1) (\m1 -> e1.server.NxtEditorServer.onMessage m1 s1) mb1
# (mb2,s2) = maybe (Nothing,s2) (\m2 -> e2.server.NxtEditorServer.onMessage m2 s2) mb2
= (if (mb1 =: Nothing && mb2 =: Nothing) Nothing (Just (mb1,mb2)), (s1,s2))
client = {init=init,onEvent=onEvent,onMessage=onMessage}
where
init (c1,c2) ref dom = e2.client.init c2 ref (e1.client.init c1 ref dom)
onEvent event ref dom
# (mb1,dom) = e1.client.NxtEditorClient.onEvent event (ref ++ [0]) dom
# (mb2,dom) = e2.client.NxtEditorClient.onEvent event (ref ++ [1]) dom
= (if (mb1 =: Nothing && mb2 =: Nothing) Nothing (Just (mb1,mb2)), dom)
onMessage (mb1,mb2) ref dom
# (mb1,dom) = maybe (Nothing,dom) (\m1 -> e1.client.NxtEditorClient.onMessage m1 (ref ++ [0]) dom) mb1
# (mb2,dom) = maybe (Nothing,dom) (\m2 -> e2.client.NxtEditorClient.onMessage m2 (ref ++ [1]) dom) mb2
= (if (mb1 =: Nothing && mb2 =: Nothing) Nothing (Just (mb1,mb2)), dom)
/*
//Define the dependencies by defining feedback on messages
link ::
//Rewrite the initial client configuration
((c1,c2) -> (c1,c2))
//Rewrite from server to client with feedback to server
(s1 s2 (Maybe m1, Maybe m2) -> ([(Maybe m1,Maybe m2)],[(Maybe m1, Maybe m2)])
//Rewrite from client to server with feedback to client
(c1 c2 (Either m1 m2) -> ([Either m1 m2],[Either m1 m2]))
(Editor v s (c1,c2) (Maybe m1, Maybe m2))
->
(Editor v s (c1,c2) (Maybe m1, Maybe m2))
//Get rid of the tuples and combine the parts into a unified state, configuration and
fuse ::
((c1,c2) -> c, c -> (c1,c2)) //Unify client configuration
((s1,s2) -> s, s -> (s1,s2)) //Unify server state
(m -> (Maybe m1, Maybe m2), (Maybe m1, Maybe m2) -> Maybe m) //Unify messages
(EditorValue v -> (EditorValue v1, EditorValue v2), (EditorValue v1,EditorValue v2) -> EditorValue v) //Unity checked interface
(Editor (EditorValue v1, EditorValue v2) (s1,s2) (c1,c2) (Maybe m1, Maybe m2))
->
(Editor v s c m)
*/
//Simulation //Simulation
simulate :: (NxtEditor v s c m) (Maybe v) -> Task () | iTask v & iTask s & iTask c & iTask m & EditMessage m simulate :: (NxtEditor v s c m) (Maybe v) -> Task () | iTask v & iTask s & iTask c & iTask m & EditMessage m
simulate editor value simulate editor value
...@@ -97,7 +213,7 @@ simulate editor value ...@@ -97,7 +213,7 @@ simulate editor value
@! () @! ()
initServerState editor v = (fst editor.server.NxtEditorServer.value) v initServerState editor v = (fst editor.server.NxtEditorServer.value) v
initClientState editor v = editor.client.NxtEditorClient.init c 1 'DM'.newMap initClientState editor v = editor.client.NxtEditorClient.init c [1] 'DM'.newMap
where where
s = (fst editor.server.NxtEditorServer.value) v s = (fst editor.server.NxtEditorServer.value) v
c = editor.server.NxtEditorServer.configure s c = editor.server.NxtEditorServer.configure s
...@@ -147,7 +263,7 @@ where ...@@ -147,7 +263,7 @@ where
>>= \e -> upd (setStates e) (clientState >*< networkState) >>= \e -> upd (setStates e) (clientState >*< networkState)
where where
setStates e (dom,(s2c,c2s)) setStates e (dom,(s2c,c2s))
# (mbMsg,dom) = editor.client.onEvent e 1 dom # (mbMsg,dom) = editor.client.onEvent e [1] dom
= (dom,maybe (s2c,c2s) (\m -> (s2c,c2s++[encodeEditMessage m])) mbMsg) = (dom,maybe (s2c,c2s) (\m -> (s2c,c2s++[encodeEditMessage m])) mbMsg)
doClientMessage doClientMessage
...@@ -155,9 +271,14 @@ where ...@@ -155,9 +271,14 @@ where
where where
setStates (dom,(s2c,c2s)) = case s2c of setStates (dom,(s2c,c2s)) = case s2c of
[m:ms] [m:ms]
# (mbMsg,dom) = editor.client.NxtEditorClient.onMessage (decodeEditMessage m) 1 dom # (mbMsg,dom) = editor.client.NxtEditorClient.onMessage (decodeEditMessage m) [1] dom
= (dom,(ms,maybe c2s (\m -> c2s ++ [encodeEditMessage m]) mbMsg)) = (dom,(ms,maybe c2s (\m -> c2s ++ [encodeEditMessage m]) mbMsg))
_ _
= (dom,(s2c,c2s)) = (dom,(s2c,c2s))
Start world = doTasks (simulate numberField (Just 42)) world
//Test editor
testEditor = glue nxtNumberField nxtButton
testValue = Nothing
Start world = doTasks (simulate testEditor testValue) 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