display errors when any named thread crashes

This commit is contained in:
Joey Hess 2012-09-06 14:56:04 -04:00
parent d11ded822c
commit a00f1d26bc
18 changed files with 133 additions and 64 deletions

View file

@ -50,8 +50,8 @@ webAppThread
-> TransferSlots
-> Maybe (IO String)
-> Maybe (Url -> FilePath -> IO ())
-> IO ()
webAppThread mst dstatus scanremotes transferqueue transferslots postfirstrun onstartup = do
-> NamedThread
webAppThread mst dstatus scanremotes transferqueue transferslots postfirstrun onstartup = thread $ do
webapp <- WebApp
<$> pure mst
<*> pure dstatus
@ -72,6 +72,7 @@ webAppThread mst dstatus scanremotes transferqueue transferslots postfirstrun on
Nothing -> withTempFile "webapp.html" $ \tmpfile _ -> go port webapp tmpfile
Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim)
where
thread = NamedThread thisThread
getreldir Nothing = return Nothing
getreldir (Just st) = Just <$>
(relHome =<< absPath