use async to track and manage threads
This commit is contained in:
parent
7fc6ebb765
commit
1713ed95f7
11 changed files with 77 additions and 61 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue