[server] Implement shared editing module

This commit is contained in:
Joscha 2020-02-18 00:43:30 +00:00
parent e917893a9b
commit f2e77b7c03
3 changed files with 100 additions and 18 deletions

View file

@ -2,13 +2,15 @@
module Main where
import qualified Network.WebSockets as WS
import Control.Concurrent.MVar
import qualified Network.WebSockets as WS
import Forest.Broadcast
import Forest.Node
import Forest.Server
import Forest.TreeModule.Animate
import Forest.TreeModule.Const
import Forest.TreeModule.Fork
import Forest.TreeModule.SharedEditing
pingDelay :: Int
pingDelay = 10
@ -23,24 +25,13 @@ options = WS.defaultServerOptions
main :: IO ()
main = do
putStrLn "Preparing shared edit module"
sharedEditNodeVar <- newMVar $ txtNode "r" ""
sharedEditBroadcaster <- newBroadcaster
putStrLn "Starting server"
WS.runServerWithOptions options $ serverApp pingDelay $ forkModule "Forest"
[ ProngConstructor "Test" $ constModule $ newNode "" "" [txtNode "" "Bla"]
, ProngConstructor "Animation" $ animateModule 200000 $ map (newNode "" "")
[ [txtNode "" "|> |", txtNode "" "Ping!"]
, [txtNode "" "|-> |", txtNode "" "Ping!"]
, [txtNode "" "| -> |", txtNode "" "Ping!"]
, [txtNode "" "| -> |", txtNode "" "Ping!"]
, [txtNode "" "| ->|", txtNode "" "Ping!"]
, [txtNode "" "| -|", txtNode "" "Ping!"]
, [txtNode "" "| |", txtNode "" "Ping!"]
, [txtNode "" "| <|", txtNode "" "Pong!"]
, [txtNode "" "| <-|", txtNode "" "Pong!"]
, [txtNode "" "| <- |", txtNode "" "Pong!"]
, [txtNode "" "| <- |", txtNode "" "Pong!"]
, [txtNode "" "|<- |", txtNode "" "Pong!"]
, [txtNode "" "|- |", txtNode "" "Pong!"]
, [txtNode "" "| |", txtNode "" "Pong!"]
]
, ProngConstructor "Sandbox" $ sharedEditingModule sharedEditNodeVar sharedEditBroadcaster
, ProngConstructor "About" $ constModule projectDescriptionNode
]