From 7b2bcfab392d387b89c3c251f0c9a8b9c0203aa8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 24 Apr 2017 14:44:57 -0400
Subject: better workaround for
 https://github.com/jaspervdj/websockets/issues/142

---
 Role/Developer.hs | 4 +++-
 Role/User.hs      | 8 +++-----
 2 files changed, 6 insertions(+), 6 deletions(-)

(limited to 'Role')

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 4248591..0b8fdd9 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -17,14 +17,16 @@ import System.IO
 import qualified Data.ByteString as B
 import qualified Data.Text as T
 import Data.List
+import Control.Monad
 
 run :: DeveloperOpts -> IO ()
 run = run' developer . debugUrl
 
 run' :: (TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()) -> UrlString -> IO ()
-run' runner url = runClientApp $ clientApp connect Developer userMessages runner
+run' runner url = void $ runClientApp app
   where
 	connect = ConnectMode (T.pack url)
+	app = clientApp connect Developer userMessages runner
 
 userMessages :: LogMessage -> Maybe (Message Seen)
 userMessages (User m) = Just m
diff --git a/Role/User.hs b/Role/User.hs
index 1d1702e..49c263c 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -27,12 +27,11 @@ import System.Environment
 run :: UserOpts -> IO ExitCode
 run os = do
 	(cmd, cmdparams) <- shellCommand os
-	go cmd cmdparams startSession
+	fromMaybe (ExitFailure 101) <$> go cmd cmdparams startSession
   where
 	go cmd cmdparams startmsg = do
 		putStr "Connecting to debug-me server..."
 		hFlush stdout
-		esv <- newEmptyTMVarIO
 		runClientApp $ clientApp (InitMode mempty) User developerMessages $ \ichan ochan sid -> do
 			let url = sessionIDUrl sid "localhost" 8081
 			putStrLn ""
@@ -43,9 +42,8 @@ run os = do
 				uthread <- async (user startmsg p ichan ochan)
 				exitstatus <- waitForProcess ph
 				cancel uthread
-				atomically $ putTMVar esv exitstatus
-		sessionDone
-		fromMaybe (ExitFailure 101) <$> atomically (tryReadTMVar esv)
+				sessionDone
+				return exitstatus
 
 developerMessages :: LogMessage -> Maybe (Message Entered)
 developerMessages (Developer m) = Just m
-- 
cgit v1.2.3