From 9a8d3bc531647d8b96e66e6daabf2176a1df4afb Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 24 Apr 2017 15:24:52 -0400
Subject: switch to TMChans so they can be closed when a connection is Done

---
 Role/Downloader.hs | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

(limited to 'Role/Downloader.hs')

diff --git a/Role/Downloader.hs b/Role/Downloader.hs
index d327c8c..55d7b63 100644
--- a/Role/Downloader.hs
+++ b/Role/Downloader.hs
@@ -6,12 +6,13 @@ import CmdLine
 import SessionID
 
 import Control.Concurrent.STM
+import Control.Concurrent.STM.TMChan
 import Role.Developer (run', processSessionStart, getUserMessage, Output(..))
 
 run :: DownloadOpts -> IO ()
 run = run' downloader . downloadUrl
 
-downloader :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()
+downloader :: TMChan (Message Entered) -> TMChan (Message Seen) -> SessionID -> IO ()
 downloader _ichan ochan sid = do
 	let logfile = sessionLogFile "." sid
 	putStrLn $ "Starting download to " ++ logfile
@@ -21,9 +22,12 @@ downloader _ichan ochan sid = do
 		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
+		v <- atomically $ getUserMessage ochan st
+		case v of
+			Nothing -> return ()
+			Just (o, msg) -> do
+				_ <- logger $ User msg
+				case o of
+					ProtocolError e -> error ("Protocol error: " ++ e)
+					_ -> return ()
+				go logger st
-- 
cgit v1.2.3