diff options
Diffstat (limited to 'WebSockets.hs')
| -rw-r--r-- | WebSockets.hs | 12 |
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 |