diff options
Diffstat (limited to 'Role')
-rw-r--r-- | Role/User.hs | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/Role/User.hs b/Role/User.hs index 3eb2ebc..ef56a6a 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -19,6 +19,7 @@ import System.Exit import qualified Data.ByteString as B import Data.List.NonEmpty (NonEmpty(..), toList) import Data.Monoid +import Data.Maybe import Data.Time.Clock.POSIX import System.IO import System.Environment @@ -26,13 +27,12 @@ import System.Environment run :: UserOpts -> IO ExitCode run os = do (cmd, cmdparams) <- shellCommand os - exitstatus <- go cmd cmdparams startSession - sessionDone - return exitstatus + go cmd cmdparams startSession where go cmd cmdparams startmsg = do putStr "Connecting to debug-me server..." hFlush stdout + esv <- newEmptyTMVarIO runClientApp $ clientApp (InitMode mempty) $ \ichan ochan sid -> do let url = sessionIDUrl sid "localhost" 8081 putStrLn "" @@ -42,7 +42,9 @@ run os = do uthread <- async (user startmsg p ichan ochan) exitstatus <- waitForProcess ph cancel uthread - return exitstatus + atomically $ putTMVar esv exitstatus + sessionDone + fromMaybe (ExitFailure 101) <$> atomically (tryReadTMVar esv) shellCommand :: UserOpts -> IO (String, [String]) shellCommand os = case cmdToRun os of |