From ae18b594c97782cc201ffa365f12064831b1ec93 Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Thu, 11 Jan 2024 20:42:57 -0500
Subject: Handle stickers, properly handle exceptions in threads

---
 fig-bus/src/Fig/Bus/Client.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

(limited to 'fig-bus/src/Fig/Bus')

diff --git a/fig-bus/src/Fig/Bus/Client.hs b/fig-bus/src/Fig/Bus/Client.hs
index 6d72ad4..18c1081 100644
--- a/fig-bus/src/Fig/Bus/Client.hs
+++ b/fig-bus/src/Fig/Bus/Client.hs
@@ -7,6 +7,7 @@ import Fig.Prelude
 import System.Exit (exitFailure)
 
 import qualified Control.Concurrent as Conc
+import qualified Control.Concurrent.Async as Async
 
 import Data.ByteString (hPut, hGetLine)
 
@@ -40,18 +41,18 @@ busClient loc@(host, port) onConn onData onQuit = catchFailure . client loc $ pu
       }
   in
     ( do
-        liftIO . void . Conc.forkIO $ onConn cmds
-        forever do
-          line <- throwLeft id . decodeUtf8' =<< liftIO (hGetLine h)
-          case parseSExpr line of
-            Nothing -> throwM . FigBusClientException $ "Server sent malformed s-expression: " <> line
-            Just x -> liftIO $ onData cmds x
+        liftIO $ Async.concurrently_ (onConn cmds) do
+          forever do
+            line <- throwLeft id . decodeUtf8' =<< liftIO (hGetLine h)
+            case parseSExpr line of
+              Nothing -> throwM . FigBusClientException $ "Server sent malformed s-expression: " <> line
+              Just x -> liftIO $ onData cmds x
     , liftIO onQuit
     )
   where
     catchFailure body = catch body \(e :: IOException) -> do
       log $ "Failed to connect to bus at " <> host <> ":" <> port <> ": " <> tshow e
-      liftIO $ exitFailure
+      liftIO exitFailure
 
 _testClient :: IO ()
 _testClient = busClient ("localhost", "32050")
-- 
cgit v1.2.3