clean up connection closing

For some reason, runClient throws ConnectionClosed on apparently clean
shutdown. This happens even though clientApp uses sendClose, and the
server receives it and shuts down entirely cleanly.

1 files changed, 10 insertions, 2 deletions

diff --git a/WebSockets.hs b/WebSockets.hs
index 25f2162..0ec0c10 100644
--- a/WebSockets.hs
+++ b/WebSockets.hs
@@ -15,8 +15,15 @@ import qualified Data.Text as T
 import Data.List
 import Data.Maybe
 
-runClientApp :: ClientApp a -> IO a
-runClientApp = runClient "localhost" 8081 "/"
+runClientApp :: ClientApp () -> IO ()
+runClientApp app = catchJust catchconnclosed
+	(runClient "localhost" 8081 "/" app)
+	(\_ -> return ())
+  where
+	-- For some reason, runClient throws ConnectionClosed
+	-- when the server hangs up cleanly. Catch this unwanted exception.
+	catchconnclosed ConnectionClosed = Just ()
+	catchconnclosed _ = Nothing
 
 -- | Make a client that sends and receives Messages over a websocket.
 clientApp
@@ -39,6 +46,7 @@ clientApp mode a conn = do
 			Just <$> atomically (readTChan schan)
 		return (schan, rchan, sthread, rthread)
 	cleanup (_, _, sthread, rthread) = do
+		sendClose conn ("done" :: T.Text)
 		cancel sthread
 		cancel rthread
 	go sid (schan, rchan, _, _) = a schan rchan sid