hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Catch errors in legacy-interactive loop

Browse Source
This commit is contained in:
Daniel Gröber 2015-08-14 09:47:45 +02:00
parent e126db833a
commit 9cff067a27
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/GHCMod.hs
View File

@ -411,7 +411,7 @@ legacyInteractiveLoop symdbreq world = do
cmd = dropWhileEnd isSpace cmd' cmd = dropWhileEnd isSpace cmd'
args = dropWhileEnd isSpace `map` args' args = dropWhileEnd isSpace `map` args'
res <- case dropWhileEnd isSpace cmd of res <- flip gcatches interactiveHandlers $ case dropWhileEnd isSpace cmd of
"check" -> checkSyntaxCmd [arg] "check" -> checkSyntaxCmd [arg]
"lint" -> lintCmd [arg] "lint" -> lintCmd [arg]
"find" -> do "find" -> do
@ -435,6 +435,11 @@ legacyInteractiveLoop symdbreq world = do
gmPutStr res >> gmPutStrLn "OK" >> liftIO (hFlush stdout) gmPutStr res >> gmPutStrLn "OK" >> liftIO (hFlush stdout)
legacyInteractiveLoop symdbreq world legacyInteractiveLoop symdbreq world
where
interactiveHandlers =
[ GHandler $ \e@(FatalError _) -> throw e
, GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
]
ghcCommands :: IOish m => [String] -> GhcModT m () ghcCommands :: IOish m => [String] -> GhcModT m ()
ghcCommands [] = fatalError "No command given (try --help)" ghcCommands [] = fatalError "No command given (try --help)"