diff options
Diffstat (limited to 'Role')
| -rw-r--r-- | Role/Developer.hs | 15 | ||||
| -rw-r--r-- | Role/Downloader.hs | 6 | ||||
| -rw-r--r-- | Role/User.hs | 6 | ||||
| -rw-r--r-- | Role/Watcher.hs | 6 |
4 files changed, 21 insertions, 12 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index 89f6ea9..4248591 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -19,14 +19,23 @@ import qualified Data.Text as T import Data.List run :: DeveloperOpts -> IO () -run os = runClientApp $ clientApp (ConnectMode (T.pack (debugUrl os))) developer +run = run' developer . debugUrl + +run' :: (TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()) -> UrlString -> IO () +run' runner url = runClientApp $ clientApp connect Developer userMessages runner + where + connect = ConnectMode (T.pack url) + +userMessages :: LogMessage -> Maybe (Message Seen) +userMessages (User m) = Just m +userMessages (Developer _) = Nothing developer :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO () -developer ichan ochan _ = inRawMode $ withLogger "debug-me-developer.log" $ \logger -> do +developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do devstate <- processSessionStart ochan logger ok <- authUser ichan ochan devstate logger if ok - then do + then inRawMode $ do _ <- sendTtyInput ichan devstate logger `concurrently` sendTtyOutput ochan devstate logger return () diff --git a/Role/Downloader.hs b/Role/Downloader.hs index 3981227..d327c8c 100644 --- a/Role/Downloader.hs +++ b/Role/Downloader.hs @@ -3,15 +3,13 @@ module Role.Downloader where import Types import Log import CmdLine -import WebSockets import SessionID import Control.Concurrent.STM -import qualified Data.Text as T -import Role.Developer (processSessionStart, getUserMessage, Output(..)) +import Role.Developer (run', processSessionStart, getUserMessage, Output(..)) run :: DownloadOpts -> IO () -run os = runClientApp $ clientApp (ConnectMode (T.pack (downloadUrl os))) downloader +run = run' downloader . downloadUrl downloader :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO () downloader _ichan ochan sid = do diff --git a/Role/User.hs b/Role/User.hs index daaaa71..1d1702e 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -33,7 +33,7 @@ run os = do putStr "Connecting to debug-me server..." hFlush stdout esv <- newEmptyTMVarIO - runClientApp $ clientApp (InitMode mempty) $ \ichan ochan sid -> do + runClientApp $ clientApp (InitMode mempty) User developerMessages $ \ichan ochan sid -> do let url = sessionIDUrl sid "localhost" 8081 putStrLn "" putStrLn "Others can connect to this session and help you debug by running:" @@ -47,6 +47,10 @@ run os = do sessionDone fromMaybe (ExitFailure 101) <$> atomically (tryReadTMVar esv) +developerMessages :: LogMessage -> Maybe (Message Entered) +developerMessages (Developer m) = Just m +developerMessages (User _) = Nothing + shellCommand :: UserOpts -> IO (String, [String]) shellCommand os = case cmdToRun os of Just v -> return v diff --git a/Role/Watcher.hs b/Role/Watcher.hs index fddd59f..620733c 100644 --- a/Role/Watcher.hs +++ b/Role/Watcher.hs @@ -4,15 +4,13 @@ import Types import Log import Pty import CmdLine -import WebSockets import SessionID import Control.Concurrent.STM -import qualified Data.Text as T -import Role.Developer (processSessionStart, getUserMessage, emitOutput) +import Role.Developer (run', processSessionStart, getUserMessage, emitOutput) run :: WatchOpts -> IO () -run os = runClientApp $ clientApp (ConnectMode (T.pack (watchUrl os))) watcher +run = run' watcher . watchUrl watcher :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO () watcher _ichan ochan _ = inRawMode $ do |