Verified Commit fdbf1db5 authored by Camil Staps's avatar Camil Staps 🚀

SimpleTCPServer interface improvements

parent 64241f76
......@@ -30,8 +30,7 @@ import Type
import CloogleDB
import Search
from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
import SimpleTCPServer
import Cache
import Memory
......@@ -77,7 +76,12 @@ Start w
#! (db,f) = openDb f
#! db = eval_all_nodes db
#! (_,w) = fclose f w
= serve (handle db) (Just log) (toInt port) w
= serve
{ handler = handle db
, logger = Just log
, port = toInt port
, keepalive_timeout = Just 5000
} w
where
help :: *World -> *World
help w
......
......@@ -4,12 +4,19 @@ from StdOverloaded import class zero, class fromString, class toString
from StdMaybe import :: Maybe
from TCPIP import ::IPAddress, ::Port
:: LogMessage a b t = Connected IPAddress
| Received a
| Sent b t
| Disconnected
:: LogMessage a b t
= Connected IPAddress
| Received a
| Sent b t
| Disconnected
:: Logger a b s t :== (LogMessage a b t) (Maybe s) *World -> *(Maybe s, *World)
serve :: !(a *World -> *(b,t,*World)) !(Maybe (Logger a b s t)) !Port !*World
-> *World | fromString a & toString b
:: Server a b s t
= { handler :: !a *World -> *(!b, !t, !*World)
, logger :: !Maybe (Logger a b s t)
, port :: !Int
, keepalive_timeout :: !Maybe Int
}
serve :: !(Server a b s t) !*World -> *World | fromString a & toString b
......@@ -5,19 +5,16 @@ import StdEnv
import StdMaybe
import System._Posix
TIMEOUT :== Just 5000
instance zero (Logger a b s t) where zero = \_ _ w -> (undef, w)
serve :: !(a *World -> *(b,t,*World)) !(Maybe (Logger a b s t)) !Port !*World
-> *World | fromString a & toString b
serve f log port w
# (ok, mbListener, w) = openTCP_Listener port w
| not ok = abort ("Couldn't open port " +++ toString port +++ "\n")
serve :: !(Server a b s t) !*World -> *World | fromString a & toString b
serve server w
# (ok, mbListener, w) = openTCP_Listener server.port w
| not ok = abort ("Couldn't open port " +++ toString server.port +++ "\n")
# listener = fromJust mbListener
# log = if (isNothing log) zero (fromJust log)
# log = if (isNothing server.logger) zero (fromJust server.logger)
# (_,w) = signal 17 1 w // SIGCHLD, SIG_IGN: no notification if child ps dies
# (listener, w) = loop f log listener w
# (listener, w) = loop server.handler log listener w
= closeRChannel listener w
where
loop :: (a *World -> *(b,t,*World)) (Logger a b s t) TCP_Listener *World
......@@ -33,7 +30,7 @@ where
handle :: !(a *World-> (b,t,*World)) !(Logger a b s t) !(Maybe s) !TCP_DuplexChannel
!*World -> *(!TCP_Listener, !*World) | fromString a & toString b
handle f log st dupChannel=:{rChannel,sChannel} w
# (tRep,msg,rChannel,w) = receive_MT TIMEOUT rChannel w
# (tRep,msg,rChannel,w) = receive_MT server.keepalive_timeout rChannel w
| tRep <> TR_Success
# (st,w) = log Disconnected st w
# w = closeChannel sChannel (closeRChannel rChannel w)
......
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