better workaround for https://github.com/jaspervdj/websockets/issues/142

1 files changed, 13 insertions, 6 deletions

diff --git a/WebSockets.hs b/WebSockets.hs
index 4b05fdb..ea6e251 100644
--- a/WebSockets.hs
+++ b/WebSockets.hs
@@ -37,13 +37,20 @@ connectionOptions = defaultConnectionOptions
 		PermessageDeflateCompression defaultPermessageDeflate
 	}
 
-runClientApp :: ClientApp () -> IO ()
-runClientApp app = catchJust catchconnclosed
-	(runClientWith "localhost" 8081 "/" connectionOptions [] app)
-	(\_ -> return ())
+-- For some reason, runClient throws ConnectionClosed
+-- when the server hangs up cleanly. Catch this unwanted exception.
+-- See https://github.com/jaspervdj/websockets/issues/142
+runClientApp :: ClientApp a -> IO (Maybe a)
+runClientApp app = do
+	rv <- newEmptyTMVarIO
+	let go conn = do
+		r <- app conn
+		atomically $ putTMVar rv r
+	catchJust catchconnclosed
+		(runClientWith "localhost" 8081 "/" connectionOptions [] go)
+		(\_ -> return ())
+	atomically (tryReadTMVar rv)
   where
-	-- For some reason, runClient throws ConnectionClosed
-	-- when the server hangs up cleanly. Catch this unwanted exception.
 	catchconnclosed ConnectionClosed = Just ()
 	catchconnclosed _ = Nothing