From 9cff067a27f8dc8b735d6fd741a62c2c498fa9c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 14 Aug 2015 09:47:45 +0200 Subject: [PATCH] Catch errors in legacy-interactive loop --- src/GHCMod.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 094e0de..46d858d 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -411,7 +411,7 @@ legacyInteractiveLoop symdbreq world = do cmd = dropWhileEnd isSpace cmd' args = dropWhileEnd isSpace `map` args' - res <- case dropWhileEnd isSpace cmd of + res <- flip gcatches interactiveHandlers $ case dropWhileEnd isSpace cmd of "check" -> checkSyntaxCmd [arg] "lint" -> lintCmd [arg] "find" -> do @@ -435,6 +435,11 @@ legacyInteractiveLoop symdbreq world = do gmPutStr res >> gmPutStrLn "OK" >> liftIO (hFlush stdout) legacyInteractiveLoop symdbreq world + where + interactiveHandlers = + [ GHandler $ \e@(FatalError _) -> throw e + , GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return "" + ] ghcCommands :: IOish m => [String] -> GhcModT m () ghcCommands [] = fatalError "No command given (try --help)"