From f584bf5d5b161beb780e3430318359dcc89e1ccb Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Fri, 15 Aug 2014 10:43:07 +0200 Subject: [PATCH 1/3] Show error messages without qualification --- Language/Haskell/GhcMod/Logger.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index 4931118..a58ecc0 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -11,7 +11,7 @@ import Control.Applicative ((<$>)) import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef) import Data.List (isPrefixOf, find, nub, isInfixOf) import Data.Maybe (fromMaybe, isJust) -import ErrUtils (ErrMsg, WarnMsg, errMsgShortDoc, errMsgExtraInfo, mkPlainWarnMsg) +import ErrUtils (ErrMsg, WarnMsg, errMsgShortDoc, errMsgExtraInfo, mkWarnMsg) import Exception (ghandle) import GHC (DynFlags, SrcSpan, Severity(SevError)) import qualified GHC as G @@ -22,7 +22,7 @@ import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Convert (convert') import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Types -import Outputable (PprStyle, SDoc) +import Outputable (PprStyle, SDoc, qualName, qualModule, mkErrStyle, neverQualify) import System.FilePath (normalise) ---------------------------------------------------------------- @@ -73,7 +73,8 @@ readAndClearLogBagRef (LogBagRef ref) = do appendLogBagRef :: DynFlags -> LogBagRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO () appendLogBagRef df (LogBagRef ref) _ sev src style msg = modifyIORef ref update where - warnMsg = mkPlainWarnMsg df src msg + qstyle = (qualName style, qualModule style) + warnMsg = mkWarnMsg df src qstyle msg warnBag = consBag warnMsg emptyBag update lg@(LogBag b) = let (b1,b2) = mergeErrors df style b warnBag in LogBag $ b1 `unionBags` b2 @@ -152,7 +153,8 @@ errBagToStr' f err = do errAndWarnBagToStr :: IOish m => (String -> a) -> Bag ErrMsg -> Bag WarnMsg -> GhcModT m a errAndWarnBagToStr f err warn = do dflags <- G.getSessionDynFlags - style <- toGhcModT getStyle + -- style <- toGhcModT getStyle + let style = mkErrStyle dflags neverQualify ret <- convert' $ nub (errBagToStrList dflags style err ++ warnBagToStrList dflags style warn) return $ f ret From 57db768ed092b36f8d5724da6b85bbf1b7ce4ec7 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Fri, 15 Aug 2014 10:46:52 +0200 Subject: [PATCH 2/3] Fix for GHC 7.4 --- Language/Haskell/GhcMod/Logger.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index a58ecc0..a0e0e0b 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -74,7 +74,11 @@ appendLogBagRef :: DynFlags -> LogBagRef -> DynFlags -> Severity -> SrcSpan -> P appendLogBagRef df (LogBagRef ref) _ sev src style msg = modifyIORef ref update where qstyle = (qualName style, qualModule style) +#if __GLASGOW_HASKELL__ >= 706 warnMsg = mkWarnMsg df src qstyle msg +#else + warnMsg = mkWarnMsg src qstyle msg +#endif warnBag = consBag warnMsg emptyBag update lg@(LogBag b) = let (b1,b2) = mergeErrors df style b warnBag in LogBag $ b1 `unionBags` b2 From 10042c6b0cea3e790bd7432c2e342054dc7c4ac4 Mon Sep 17 00:00:00 2001 From: Alejandro Serrano Date: Fri, 15 Aug 2014 11:00:48 +0200 Subject: [PATCH 3/3] Fix for GHC 7.4 --- Language/Haskell/GhcMod/Logger.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index a0e0e0b..beccd1b 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -158,7 +158,11 @@ errAndWarnBagToStr :: IOish m => (String -> a) -> Bag ErrMsg -> Bag WarnMsg -> G errAndWarnBagToStr f err warn = do dflags <- G.getSessionDynFlags -- style <- toGhcModT getStyle +#if __GLASGOW_HASKELL__ >= 706 let style = mkErrStyle dflags neverQualify +#else + let style = mkErrStyle neverQualify +#endif ret <- convert' $ nub (errBagToStrList dflags style err ++ warnBagToStrList dflags style warn) return $ f ret