split remaining assistant types
This commit is contained in:
parent
f78ca9bc58
commit
68118b8986
19 changed files with 192 additions and 146 deletions
30
Assistant/NamedThread.hs
Normal file
30
Assistant/NamedThread.hs
Normal file
|
@ -0,0 +1,30 @@
|
|||
{- git-annex assistant named threads.
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Assistant.NamedThread where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.Alert
|
||||
|
||||
import qualified Control.Exception as E
|
||||
|
||||
runNamedThread :: NamedThread -> Assistant ()
|
||||
runNamedThread (NamedThread name a) = do
|
||||
d <- getAssistant id
|
||||
liftIO . go $ d { threadName = name }
|
||||
where
|
||||
go d = do
|
||||
r <- E.try (runAssistant a d) :: IO (Either E.SomeException ())
|
||||
case r of
|
||||
Right _ -> noop
|
||||
Left e -> do
|
||||
let msg = unwords [name, "crashed:", show e]
|
||||
hPutStrLn stderr msg
|
||||
-- TODO click to restart
|
||||
void $ addAlert (daemonStatusHandle d) $
|
||||
warningAlert name msg
|
Loading…
Add table
Add a link
Reference in a new issue