display errors when any named thread crashes
This commit is contained in:
parent
d11ded822c
commit
a00f1d26bc
18 changed files with 133 additions and 64 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue