summaryrefslogtreecommitdiff
path: root/Assistant/Common.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/Common.hs')
-rw-r--r--Assistant/Common.hs24
1 files changed, 24 insertions, 0 deletions
diff --git a/Assistant/Common.hs b/Assistant/Common.hs
index c1a346e75..d6df77f69 100644
--- a/Assistant/Common.hs
+++ b/Assistant/Common.hs
@@ -8,14 +8,38 @@
module Assistant.Common (
module X,
ThreadName,
+ NamedThread(..),
+ runNamedThread,
debug
) where
import Common.Annex as X
+import Assistant.DaemonStatus
+import Assistant.Alert
import System.Log.Logger
+import qualified Control.Exception as E
type ThreadName = String
+data NamedThread = NamedThread ThreadName (IO ())
debug :: ThreadName -> [String] -> IO ()
debug threadname ws = debugM threadname $ unwords $ (threadname ++ ":") : ws
+
+runNamedThread :: DaemonStatusHandle -> NamedThread -> IO ()
+runNamedThread dstatus (NamedThread name a) = go
+ where
+ go = do
+ r <- E.try a :: 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 dstatus $
+ warningAlert name msg