From a80d4e2d36b377b3466db3b2628b9dec71fcfce2 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 9 Aug 2026 17:22:22 -0600 Subject: I'm not even sure. --- src/Rahm/Desktop/Server.hs | 39 ++++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 17 deletions(-) (limited to 'src/Rahm/Desktop/Server.hs') diff --git a/src/Rahm/Desktop/Server.hs b/src/Rahm/Desktop/Server.hs index 4bf1cbd..d137603 100644 --- a/src/Rahm/Desktop/Server.hs +++ b/src/Rahm/Desktop/Server.hs @@ -109,23 +109,28 @@ forkServer handler = do return ctx handleClient :: ServerContext c -> Socket -> IO () -handleClient chan conn = forever $ do - h <- socketToHandle conn ReadWriteMode - hSetBuffering h LineBuffering - hSetEncoding h utf8 - - finally - ( fix $ \loop -> do - result <- try (hGetLine h) - case result of - Left e - | isEOFError e -> return () - | otherwise -> throwIO (e :: IOError) - Right line -> do - handleLine chan line - loop - ) - (hClose h) +handleClient chan conn = + finally (loop BS.empty) (close conn) + where + loop buf = do + chunk <- recv conn 4096 + if BS.null chunk + then return () -- connection closed + else do + let buf' = buf <> chunk + (lines, rest) = splitLines buf' + mapM_ (handleLine chan . BSC.unpack) lines + loop rest + + splitLines :: BS.ByteString -> ([BS.ByteString], BS.ByteString) + splitLines bs = + case BSC.break (== '\n') bs of + (line, rest) + | BS.null rest -> ([], bs) + | otherwise -> + let remaining = BS.drop 1 rest + (ls, r) = splitLines remaining + in (line : ls, r) handleLine :: ServerContext c -> String -> IO () handleLine ctx line = case parser (commandHandler ctx) line of -- cgit