[server] Add return value to tree modules

Now, tree modules can't just stop, they can Just stop. Sorry... But they can
return values now, with a tiny bit of type class trickery.
This commit is contained in:
Joscha 2020-02-13 23:38:26 +00:00
parent 220b5a3234
commit 2a2b148046
6 changed files with 55 additions and 39 deletions

View file

@ -1,3 +1,4 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Forest.Server
@ -29,8 +30,8 @@ sendUpdatesThread conn nodeChan nodeA = do
{- Main server application that receives and processes client packets -}
receivePackets :: TreeModule a => WS.Connection -> a -> IO ()
receivePackets conn treeModule = whileM $ do
receivePackets :: TreeModule a () => WS.Connection -> a () -> IO ()
receivePackets conn treeModule = runUntilJustM $ do
packet <- receivePacket conn
case packet of
ClientEdit path text -> do
@ -47,7 +48,7 @@ receivePackets conn treeModule = whileM $ do
act treeModule path
ClientHello _ -> closeWithErrorMessage conn "Invalid packet: Hello can only be sent once"
serverApp :: TreeModule a => Int -> ModuleConstructor a -> WS.ServerApp
serverApp :: TreeModule a () => Int -> ModuleConstructor (a ()) -> WS.ServerApp
serverApp pingDelay constructor pendingConnection = do
conn <- WS.acceptRequest pendingConnection
chan <- newChan