/quit

This commit was sponsored by Jake Vosloo on Patreon.

1 files changed, 24 insertions, 18 deletions

diff --git a/ControlWindow.hs b/ControlWindow.hs
index 3f050aa..e561017 100644
--- a/ControlWindow.hs
+++ b/ControlWindow.hs
@@ -25,8 +25,7 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMChan
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.ByteString.UTF8 (fromString, toString)
+import Data.ByteString.UTF8 (fromString)
 import Data.Char
 import Control.Monad
 import Data.Monoid
@@ -42,6 +41,7 @@ displayInControlWindow ichan msg = atomically $
 controlWindow :: ControlOpts -> IO ()
 controlWindow _ = do
 	putStrLn $ "** " ++ winDesc
+	putStrLn "(Enter /quit here at any time to end the debug-me session.)"
 	socketfile <- defaultSocketFile
 	ichan <- newTMChanIO
 	ochan <- newTMChanIO
@@ -80,7 +80,7 @@ openControlWindow = do
 	return (ichan, ochan)
 
 type Prompt = ()
-type Response = B.ByteString
+type Response = String
 
 type PromptChan = TChan Prompt
 type ResponseChan = TChan Response
@@ -88,21 +88,27 @@ type ResponseChan = TChan Response
 collectOutput :: TMChan ControlOutput -> PromptChan -> ResponseChan -> IO ()
 collectOutput ochan promptchan responsechan = do
 	myusername <- fromString <$> getLoginName
-	withLines stdin $ mapM_ $ processline myusername
+	loop myusername
   where
-	processline myusername l = do
-		mc <- atomically $ do
-			-- Is any particular input being prompted for now?
-			mp <- tryReadTChan promptchan
-			case mp of
-				Just _ -> do
-					writeTChan responsechan $ L.toStrict l
-					return Nothing
-				Nothing -> do
-					let c = ChatMessage (Val myusername) (Val $ L.toStrict l)
-					writeTMChan ochan $ ControlOutputAction c
-					return (Just c)
-		maybe (return ()) displayChatMessage mc
+	loop myusername = do
+		l <- getLine
+		if map toLower l == "/quit"
+			then atomically $
+				writeTMChan ochan ControlWindowRequestedImmediateQuit
+			else do
+				mc <- atomically $ do
+					-- Is any particular input being prompted for now?
+					mp <- tryReadTChan promptchan
+					case mp of
+						Just _ -> do
+							writeTChan responsechan l
+							return Nothing
+						Nothing -> do
+							let c = ChatMessage (Val myusername) (Val $ fromString l)
+							writeTMChan ochan $ ControlOutputAction c
+							return (Just c)
+				maybe (return ()) displayChatMessage mc
+				loop myusername
 
 displayInput :: TMChan ControlOutput -> TMChan ControlInput -> PromptChan -> ResponseChan -> IO ()
 displayInput ochan ichan promptchan responsechan = loop
@@ -150,7 +156,7 @@ askToAllow ochan promptchan responsechan k@(GpgSigned pk _) = do
 		putStr "Let them connect to the debug-me session and run commands? [y/n] "
 		hFlush stdout
 		r <- atomically $ readTChan responsechan
-		case map toLower (toString r) of
+		case map toLower r of
 			"y" -> accept
 			"yes" -> accept
 			"n" -> reject