aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Server.hs
diff options
context:
space:
mode:
authorJosh Rahm <rahm@josher.dev>2026-08-09 17:22:22 -0600
committerJosh Rahm <rahm@josher.dev>2026-08-09 17:22:22 -0600
commita80d4e2d36b377b3466db3b2628b9dec71fcfce2 (patch)
treea9109869c6bc4516ebeccc80b68fc314031e08aa /src/Rahm/Desktop/Server.hs
parenta66a73ebe45cbad857f8a2e30050cb94cc1ace39 (diff)
downloadrde-a80d4e2d36b377b3466db3b2628b9dec71fcfce2.tar.gz
rde-a80d4e2d36b377b3466db3b2628b9dec71fcfce2.tar.bz2
rde-a80d4e2d36b377b3466db3b2628b9dec71fcfce2.zip
I'm not even sure.HEADmain
Diffstat (limited to 'src/Rahm/Desktop/Server.hs')
-rw-r--r--src/Rahm/Desktop/Server.hs39
1 files changed, 22 insertions, 17 deletions
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