preventing error messages from the sub thread.

This commit is contained in:
Kazu Yamamoto 2014-03-27 12:58:35 +09:00
parent d7b9b83857
commit b49bb4d5ab

View File

@ -56,7 +56,7 @@ main = E.handle handler $ do
ls = lineSeparator opt ls = lineSeparator opt
LineSeparator lsc = ls LineSeparator lsc = ls
handler (E.SomeException e) = do handler (E.SomeException e) = do
putStr "ghc-modi:0:0:Error:" putStr "ghc-modi:0:0:"
let x = intercalate lsc $ lines $ show e let x = intercalate lsc $ lines $ show e
putStrLn x putStrLn x
putStrLn "NG" putStrLn "NG"
@ -72,13 +72,14 @@ run cradle mlibdir opt body = runGhc mlibdir $ do
---------------------------------------------------------------- ----------------------------------------------------------------
setupDB :: Cradle -> Maybe FilePath -> Options -> MVar DB -> IO () setupDB :: Cradle -> Maybe FilePath -> Options -> MVar DB -> IO ()
setupDB cradle mlibdir opt mvar = do setupDB cradle mlibdir opt mvar = E.handle handler $ do
sm <- run cradle mlibdir opt $ \_ -> getSessionDynFlags >>= browseAll sm <- run cradle mlibdir opt $ \_ -> getSessionDynFlags >>= browseAll
let sms = map tieup $ groupBy ((==) `on` fst) $ sort sm let sms = map tieup $ groupBy ((==) `on` fst) $ sort sm
m = M.fromList sms m = M.fromList sms
putMVar mvar m putMVar mvar m
where where
tieup x = (head (map fst x), map snd x) tieup x = (head (map fst x), map snd x)
handler (E.SomeException _) = return ()
---------------------------------------------------------------- ----------------------------------------------------------------