From 75c8b6b9745ea8e64383e28d3f18b1609be00fa3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 21 Apr 2017 22:23:00 -0400
Subject: 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.
---
 Role/Downloader.hs | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)
 create mode 100644 Role/Downloader.hs

(limited to 'Role/Downloader.hs')

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
-- 
cgit v1.2.3