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, 36 insertions, 4 deletions

diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
index fa982b45e..ef9e7a4cb 100644
--- a/Assistant/Monad.hs
+++ b/Assistant/Monad.hs
@@ -13,7 +13,12 @@ module Assistant.Monad (
 	newAssistantData,
 	runAssistant,
 	getAssistant,
-	liftAnnex
+	liftAnnex,
+	(<~>),
+	(<<~),
+	daemonStatus,
+	asIO,
+	asIO2,
 ) where
 
 import "mtl" Control.Monad.Reader
@@ -43,8 +48,9 @@ instance MonadBase IO Assistant where
 	liftBase = Assistant . liftBase
 
 data AssistantData = AssistantData
-	{ threadState :: ThreadState
-	, daemonStatus :: DaemonStatusHandle
+	{ threadName :: String
+	, threadState :: ThreadState
+	, daemonStatusHandle :: DaemonStatusHandle
 	, scanRemoteMap :: ScanRemoteMap
 	, transferQueue :: TransferQueue
 	, transferSlots :: TransferSlots
@@ -57,7 +63,8 @@ data AssistantData = AssistantData
 
 newAssistantData :: ThreadState -> DaemonStatusHandle -> IO AssistantData
 newAssistantData st dstatus = AssistantData
-	<$> pure st
+	<$> pure "main"
+	<*> pure st
 	<*> pure dstatus
 	<*> newScanRemoteMap
 	<*> newTransferQueue
@@ -81,3 +88,28 @@ liftAnnex :: Annex a -> Assistant a
 liftAnnex a = do
 	st <- reader threadState
 	liftIO $ runThreadState st a
+
+{- Runs an IO action, passing it an IO action that runs an Assistant action. -}
+(<~>) :: (IO a -> IO b) -> Assistant a -> Assistant b
+io <~> a = do
+	d <- reader id
+	liftIO $ io $ runAssistant a d
+
+{- Creates an IO action that will run an Assistant action when run. -}
+asIO :: (a -> Assistant b) -> Assistant (a -> IO b)
+asIO a = do
+	d <- reader id
+	return $ \v -> runAssistant (a v) d
+
+{- Creates an IO action that will run an Assistant action when run. -}
+asIO2 :: (a -> b -> Assistant c) -> Assistant (a -> b -> IO c)
+asIO2 a = do
+	d <- reader id
+	return $ \v1 v2 -> runAssistant (a v1 v2) d
+
+{- Runs an IO action on a selected field of the AssistantData. -}
+(<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
+io <<~ v = reader v >>= liftIO . io
+
+daemonStatus :: Assistant DaemonStatus
+daemonStatus = getDaemonStatus <<~ daemonStatusHandle