summaryrefslogtreecommitdiffhomepage
path: root/Role
diff options
context:
space:
mode:
Diffstat (limited to 'Role')
-rw-r--r--Role/Developer.hs4
-rw-r--r--Role/User.hs8
2 files changed, 6 insertions, 6 deletions
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