Assistant monad, stage 2.5

Converted several threads to run in the monad.

Added a lot of useful combinators for working with the monad.

Now the monad includes the name of the thread.

Some debugging messages are disabled pending converting other threads.

1 files changed, 63 insertions, 69 deletions

diff --git a/Assistant/Threads/NetWatcher.hs b/Assistant/Threads/NetWatcher.hs
index ed64541c3..2af880e02 100644
--- a/Assistant/Threads/NetWatcher.hs
+++ b/Assistant/Threads/NetWatcher.hs
@@ -11,9 +11,6 @@
 module Assistant.Threads.NetWatcher where
 
 import Assistant.Common
-import Assistant.ThreadedMonad
-import Assistant.DaemonStatus
-import Assistant.ScanRemotes
 import Assistant.Sync
 import Assistant.Pushes
 import Utility.ThreadScheduler
@@ -29,72 +26,67 @@ import Data.Word (Word32)
 #warning Building without dbus support; will poll for network connection changes
 #endif
 
-thisThread :: ThreadName
-thisThread = "NetWatcher"
-
-netWatcherThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
+netWatcherThread :: NamedThread
 #if WITH_DBUS
-netWatcherThread st dstatus scanremotes pushnotifier = thread $
-	dbusThread st dstatus scanremotes pushnotifier
+netWatcherThread = thread dbusThread
 #else
-netWatcherThread _ _ _ _ = thread noop
+netWatcherThread = thread noop
 #endif
-	where
-		thread = NamedThread thisThread
+  where
+	thread = NamedThread "NetWatcher"
 
 {- This is a fallback for when dbus cannot be used to detect
  - network connection changes, but it also ensures that
  - any networked remotes that may have not been routable for a
  - while (despite the local network staying up), are synced with
  - periodically. -}
-netWatcherFallbackThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> NamedThread
-netWatcherFallbackThread st dstatus scanremotes pushnotifier = thread $
-	runEvery (Seconds 3600) $
-		handleConnection st dstatus scanremotes pushnotifier
-	where
-		thread = NamedThread thisThread
+netWatcherFallbackThread :: NamedThread
+netWatcherFallbackThread = NamedThread "NetWatcherFallback" $
+	runEvery (Seconds 3600) <~> handleConnection
 
 #if WITH_DBUS
 
-dbusThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
-dbusThread st dstatus scanremotes pushnotifier =
-	persistentClient getSystemAddress () onerr go
-	where
-		go client = ifM (checkNetMonitor client)
-			( do
-				listenNMConnections client handleconn
-				listenWicdConnections client handleconn
-			, do
-				runThreadState st $
-					warning "No known network monitor available through dbus; falling back to polling"
-			)
-		handleconn = do
-			debug thisThread ["detected network connection"]
-			notifyRestart pushnotifier
-			handleConnection st dstatus scanremotes pushnotifier
-		onerr e _ = do
-			runThreadState st $
-				warning $ "lost dbus connection; falling back to polling (" ++ show e ++ ")"
-			{- Wait, in hope that dbus will come back -}
-			threadDelaySeconds (Seconds 60)
+dbusThread :: Assistant ()
+dbusThread = do
+	handleerr <- asIO2 onerr
+	runclient <- asIO go
+	liftIO $ persistentClient getSystemAddress () handleerr runclient
+  where
+	go client = ifM (checkNetMonitor client)
+		( do
+			listenNMConnections client <~> handleconn
+			listenWicdConnections client <~> handleconn
+		, do
+			liftAnnex $
+				warning "No known network monitor available through dbus; falling back to polling"
+		)
+	handleconn = do
+		debug ["detected network connection"]
+		notifyRestart <<~ pushNotifier
+		handleConnection
+	onerr e _ = do
+		liftAnnex $
+			warning $ "lost dbus connection; falling back to polling (" ++ show e ++ ")"
+		{- Wait, in hope that dbus will come back -}
+		liftIO $ threadDelaySeconds (Seconds 60)
 
 {- Examine the list of services connected to dbus, to see if there
  - are any we can use to monitor network connections. -}
-checkNetMonitor :: Client -> IO Bool
+checkNetMonitor :: Client -> Assistant Bool
 checkNetMonitor client = do
-	running <- filter (`elem` [networkmanager, wicd])
+	running <- liftIO $ filter (`elem` [networkmanager, wicd])
 		<$> listServiceNames client
 	case running of
 		[] -> return False
 		(service:_) -> do
-			debug thisThread [ "Using running DBUS service"
+			debug [ "Using running DBUS service"
 				, service
 				, "to monitor network connection events."
 				]
 			return True
-	where
-		networkmanager = "org.freedesktop.NetworkManager"
-		wicd = "org.wicd.daemon"
+  where
+	networkmanager = "org.freedesktop.NetworkManager"
+	wicd = "org.wicd.daemon"
 
 {- Listens for new NetworkManager connections. -}
 listenNMConnections :: Client -> IO () -> IO ()
@@ -102,18 +94,18 @@ listenNMConnections client callback =
 	listen client matcher $ \event ->
 		when (Just True == anyM activeconnection (signalBody event)) $
 			callback
-	where
-		matcher = matchAny
-			{ matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active"
-			, matchMember = Just "PropertiesChanged"
-			}
-		nm_connection_activated = toVariant (2 :: Word32)
-		nm_state_key = toVariant ("State" :: String)
-		activeconnection v = do
-			m <- fromVariant v
-			vstate <- lookup nm_state_key $ dictionaryItems m
-			state <- fromVariant vstate
-			return $ state == nm_connection_activated
+  where
+	matcher = matchAny
+		{ matchInterface = Just "org.freedesktop.NetworkManager.Connection.Active"
+		, matchMember = Just "PropertiesChanged"
+		}
+	nm_connection_activated = toVariant (2 :: Word32)
+	nm_state_key = toVariant ("State" :: String)
+	activeconnection v = do
+		m <- fromVariant v
+		vstate <- lookup nm_state_key $ dictionaryItems m
+		state <- fromVariant vstate
+		return $ state == nm_connection_activated
 
 {- Listens for new Wicd connections. -}
 listenWicdConnections :: Client -> IO () -> IO ()
@@ -121,21 +113,23 @@ listenWicdConnections client callback =
 	listen client matcher $ \event ->
 		when (any (== wicd_success) (signalBody event)) $
 			callback
-	where
-		matcher = matchAny
-			{ matchInterface = Just "org.wicd.daemon"
-			, matchMember = Just "ConnectResultsSent"
-			}
-		wicd_success = toVariant ("success" :: String)
+  where
+	matcher = matchAny
+		{ matchInterface = Just "org.wicd.daemon"
+		, matchMember = Just "ConnectResultsSent"
+		}
+	wicd_success = toVariant ("success" :: String)
 
 #endif
 
-handleConnection :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> PushNotifier -> IO ()
-handleConnection st dstatus scanremotes pushnotifier =
-	reconnectRemotes thisThread st dstatus scanremotes (Just pushnotifier)
-		=<< networkRemotes st
+handleConnection :: Assistant ()
+handleConnection = do
+	d <- getAssistant id
+	liftIO . reconnectRemotes (threadName d) (threadState d)
+		(daemonStatusHandle d) (scanRemoteMap d) (Just $ pushNotifier d)
+		=<< networkRemotes
 
 {- Finds network remotes. -}
-networkRemotes :: ThreadState -> IO [Remote]
-networkRemotes st = runThreadState st $
+networkRemotes :: Assistant [Remote]
+networkRemotes = liftAnnex $
 	filter (isNothing . Remote.localpath) <$> remoteList