diff options
author | Joey Hess <joey@kitenet.net> | 2013-01-26 14:14:32 +1100 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-01-26 14:14:32 +1100 |
commit | 44d7913686ccfef4e6cbd0fdc2b5611aa944ec70 (patch) | |
tree | b8343b59f6730ff31fb7b88ffc11e13073d88c8e /Assistant/Monad.hs | |
parent | 28eb1f598b1f494b6de815593fa8bfb9aaaeb250 (diff) |
use async to track and manage threads
Diffstat (limited to 'Assistant/Monad.hs')
-rw-r--r-- | Assistant/Monad.hs | 20 |
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 |