use async to track and manage threads

This commit is contained in:
Joey Hess 2013-01-26 14:14:32 +11:00
parent 7fc6ebb765
commit 1713ed95f7
11 changed files with 77 additions and 61 deletions

View file

@ -16,12 +16,15 @@ import Utility.NotificationBroadcaster
import Logs.Transfer
import Control.Concurrent.STM
import Control.Concurrent.Async
import Data.Time.Clock.POSIX
import qualified Data.Map as M
data DaemonStatus = DaemonStatus
-- All the named threads that comprise the daemon.
{ startedThreads :: M.Map String (Async ())
-- False when the daemon is performing its startup scan
{ scanComplete :: Bool
, scanComplete :: Bool
-- Time when a previous process of the daemon was running ok
, lastRunning :: Maybe POSIXTime
-- True when the sanity checker is running
@ -58,7 +61,8 @@ type DaemonStatusHandle = TMVar DaemonStatus
newDaemonStatus :: IO DaemonStatus
newDaemonStatus = DaemonStatus
<$> pure False
<$> pure M.empty
<*> pure False
<*> pure Nothing
<*> pure False
<*> pure Nothing

View file

@ -1,32 +0,0 @@
{- git-annex assistant named threads.
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.Types.NamedThread (
ThreadName,
NamedThread(..),
debug,
notice,
) where
import Common.Annex
import Assistant.Monad
import System.Log.Logger
type ThreadName = String
data NamedThread = NamedThread ThreadName (Assistant ())
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