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

Revert way to report errors when deferred as warnings

Browse Source 
Fixes #310
This commit is contained in:
Alejandro Serrano 2014-08-18 17:32:14 +02:00
parent 0fd8b9afd8
commit 5b78711842
2 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Language/Haskell/GhcMod/Check.hs
View File

@ -32,13 +32,9 @@ check :: IOish m
=> [FilePath] -- ^ The target files. => [FilePath] -- ^ The target files.
-> GhcModT m (Either String String) -> GhcModT m (Either String String)
check fileNames = overrideGhcUserOptions $ \ghcOpts -> do check fileNames = overrideGhcUserOptions $ \ghcOpts -> do
withLoggerTwice withLogger (setAllWaringFlags . setNoMaxRelevantBindings . Gap.setWarnTypedHoles . Gap.setDeferTypeErrors) $ do
setAllWaringFlags _ <- G.setSessionDynFlags =<< addCmdOpts ghcOpts =<< G.getSessionDynFlags
(do _ <- G.setSessionDynFlags =<< addCmdOpts ghcOpts =<< G.getSessionDynFlags setTargetFiles fileNames
setTargetFiles fileNames)
(setAllWaringFlags . setNoMaxRelevantBindings . Gap.setWarnTypedHoles . Gap.setDeferTypeErrors)
(do _ <- G.setSessionDynFlags =<< addCmdOpts ghcOpts =<< G.getSessionDynFlags
setTargetFiles fileNames)
---------------------------------------------------------------- ----------------------------------------------------------------

16
Language/Haskell/GhcMod/Logger.hs
View File

@ -207,10 +207,10 @@ ppMsg :: SrcSpan -> Severity-> DynFlags -> PprStyle -> SDoc -> String
ppMsg spn sev dflag style msg = prefix ++ cts ppMsg spn sev dflag style msg = prefix ++ cts
where where
cts = showPage dflag style msg cts = showPage dflag style msg
prefix = ppMsgPrefix spn sev dflag style prefix = ppMsgPrefix spn sev dflag style cts
ppMsgPrefix :: SrcSpan -> Severity-> DynFlags -> PprStyle -> String ppMsgPrefix :: SrcSpan -> Severity-> DynFlags -> PprStyle -> String -> String
ppMsgPrefix spn sev dflag _style = ppMsgPrefix spn sev dflag _style cts =
let defaultPrefix let defaultPrefix
| Gap.isDumpSplices dflag = "" | Gap.isDumpSplices dflag = ""
| otherwise = checkErrorPrefix | otherwise = checkErrorPrefix
@ -218,7 +218,15 @@ ppMsgPrefix spn sev dflag _style =
(line,col,_,_) <- Gap.getSrcSpan spn (line,col,_,_) <- Gap.getSrcSpan spn
file <- normalise <$> Gap.getSrcFile spn file <- normalise <$> Gap.getSrcFile spn
let severityCaption = Gap.showSeverityCaption sev let severityCaption = Gap.showSeverityCaption sev
return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption pref0 | or (map (\x -> x `isPrefixOf` cts) warningAsErrorPrefixes)
= file ++ ":" ++ show line ++ ":" ++ show col ++ ":"
| otherwise = file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption
return pref0
checkErrorPrefix :: String checkErrorPrefix :: String
checkErrorPrefix = "Dummy:0:0:Error:" checkErrorPrefix = "Dummy:0:0:Error:"
warningAsErrorPrefixes :: [String]
warningAsErrorPrefixes = ["Couldn't match expected type"
, "Couldn't match type"
, "No instance for"]