diff options
Diffstat (limited to 'Assistant/NamedThread.hs')
-rw-r--r-- | Assistant/NamedThread.hs | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/Assistant/NamedThread.hs b/Assistant/NamedThread.hs new file mode 100644 index 000000000..8871ee6c8 --- /dev/null +++ b/Assistant/NamedThread.hs @@ -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 |