SimpleTCPServer interface improvements

backend/CloogleServer.icl

@@ -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

backend/SimpleTCPServer.dcl

@@ -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

backend/SimpleTCPServer.icl

@@ -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)