use async to track and manage threads

1 files changed, 20 insertions, 0 deletions

diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
index a676bc8fb..3b1eb86ec 100644
--- a/Assistant/Monad.hs
+++ b/Assistant/Monad.hs
@@ -19,10 +19,15 @@ module Assistant.Monad (
 	asIO,
 	asIO1,
 	asIO2,
+	NamedThread(..),
+	ThreadName,
+	debug,
+	notice
 ) where
 
 import "mtl" Control.Monad.Reader
 import Control.Monad.Base (liftBase, MonadBase)
+import System.Log.Logger
 
 import Common.Annex
 import Assistant.Types.ThreadedMonad
@@ -37,6 +42,10 @@ import Assistant.Types.Changes
 import Assistant.Types.Buddies
 import Assistant.Types.NetMessager
 
+{- Information about a named thread that can be run. -}
+data NamedThread = NamedThread ThreadName (Assistant ())
+type ThreadName = String
+
 newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }
 	deriving (
 		Monad,
@@ -118,3 +127,14 @@ asIO2 a = do
 {- Runs an IO action on a selected field of the AssistantData. -}
 (<<~) :: (a -> IO b) -> (AssistantData -> a) -> Assistant b
 io <<~ v = reader v >>= liftIO . io
+
+debug :: [String] -> Assistant ()
+debug = logaction debugM
+
+notice :: [String] -> Assistant ()
+notice = logaction noticeM
+
+logaction :: (String -> String -> IO ()) -> [String] -> Assistant ()
+logaction a ws = do
+	name <- getAssistant threadName
+	liftIO $ a name $ unwords $ (name ++ ":") : ws