add --download mode

Nice, was able to reuse all the protocol stuff from Role.Developer for
this.

This commit was sponsored by Fernando Jimenez on Patreon.

1 files changed, 31 insertions, 0 deletions

diff --git a/Role/Downloader.hs b/Role/Downloader.hs
new file mode 100644
index 0000000..3981227
--- /dev/null
+++ b/Role/Downloader.hs
@@ -0,0 +1,31 @@
+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(..))
+
+run :: DownloadOpts -> IO ()
+run os = runClientApp $ clientApp (ConnectMode (T.pack (downloadUrl os))) downloader
+
+downloader :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()
+downloader _ichan ochan sid = do
+	let logfile = sessionLogFile "." sid
+	putStrLn $ "Starting download to " ++ logfile
+	putStrLn "(Will keep downloading until the debug-me session is done.)"
+	withLogger logfile $ \logger -> do
+		st <- processSessionStart ochan logger
+		go logger st
+  where
+	go logger st = do
+		(o, msg) <- atomically $ getUserMessage ochan st
+		_ <- logger $ User msg
+		case o of
+			ProtocolError e -> error ("Protocol error: " ++ e)
+			_ -> return ()
+		go logger st