Displaying a qualified name if two unqualified names are conflict (#130).

Language/Haskell/GhcMod/Browse.hs

@@ -12,7 +12,7 @@ import Data.Maybe (catMaybes)
 import FastString (mkFastString)
 import GHC (Ghc, GhcException(CmdLineError), ModuleInfo, Name, TyThing, DynFlags, Type, TyCon, Module)
 import qualified GHC as G
-import Language.Haskell.GhcMod.Doc (showUnqualifiedPage, showUnqualifiedOneLine)
+import Language.Haskell.GhcMod.Doc (showPage, showOneLine, styleUnqualified)
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Gap
 import Language.Haskell.GhcMod.Types
@@ -130,7 +130,7 @@ removeForAlls' ty (Just (pre, ftype))
     | otherwise           = ty
 
 showOutputable :: Outputable a => DynFlags -> a -> String
-showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . ppr
+showOutputable dflag = unwords . lines . showPage dflag styleUnqualified . ppr
 
 ----------------------------------------------------------------
 
@@ -147,4 +147,4 @@ toNameModule dflag (m,Just inf) = map (\name -> (toStr name, mdl)) names
   where
     mdl = G.moduleNameString (G.moduleName m)
     names = G.modInfoExports inf
-    toStr = showUnqualifiedOneLine dflag . ppr
+    toStr = showOneLine dflag styleUnqualified . ppr

Language/Haskell/GhcMod/Doc.hs

@@ -1,43 +1,22 @@
 module Language.Haskell.GhcMod.Doc where
 
 import DynFlags (DynFlags)
+import GHC (Ghc)
+import qualified GHC as G
 import Language.Haskell.GhcMod.Gap (withStyle, showDocWith)
-import Outputable (SDoc, PprStyle, Depth(AllTheWay), mkUserStyle, alwaysQualify, neverQualify)
+import Outputable (SDoc, PprStyle, mkUserStyle, Depth(AllTheWay), neverQualify)
 import Pretty (Mode(..))
 
-----------------------------------------------------------------
+showPage :: DynFlags -> PprStyle -> SDoc -> String
+showPage dflag style = showDocWith dflag PageMode . withStyle dflag style
 
-{-
+showOneLine :: DynFlags -> PprStyle -> SDoc -> String
-pretty :: Outputable a => a -> String
+showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
-pretty = showSDocForUser neverQualify . ppr
 
-debug :: Outputable a => a -> b -> b
+getStyle :: Ghc PprStyle
-debug x v = trace (pretty x) v
+getStyle = do
--}
+    unqual <- G.getPrintUnqual
-
+    return $ mkUserStyle unqual AllTheWay
-----------------------------------------------------------------
-
-styleQualified :: PprStyle
-styleQualified = mkUserStyle alwaysQualify AllTheWay
 
 styleUnqualified :: PprStyle
 styleUnqualified = mkUserStyle neverQualify AllTheWay
-
-----------------------------------------------------------------
-
--- For "ghc-mod type"
-showQualifiedPage :: DynFlags -> SDoc -> String
-showQualifiedPage dflag = showDocWith dflag PageMode . withStyle dflag styleQualified
-
--- For "ghc-mod browse" and show GHC's error messages.
-showUnqualifiedPage :: DynFlags -> SDoc -> String
-showUnqualifiedPage dflag = showDocWith dflag PageMode
-                          . withStyle dflag styleUnqualified
-
--- Not used
-showQualifiedOneLine :: DynFlags -> SDoc -> String
-showQualifiedOneLine dflag = showDocWith dflag OneLineMode . withStyle dflag styleQualified
-
--- To write Haskell code in a buffer
-showUnqualifiedOneLine :: DynFlags -> SDoc -> String
-showUnqualifiedOneLine dflag = showDocWith dflag OneLineMode . withStyle dflag styleUnqualified

Language/Haskell/GhcMod/ErrMsg.hs

@@ -15,10 +15,10 @@ import ErrUtils (ErrMsg, errMsgShortDoc, errMsgExtraInfo)
 import GHC (Ghc, DynFlags, SrcSpan, Severity(SevError))
 import qualified GHC as G
 import HscTypes (SourceError, srcErrorMessages)
-import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
+import Language.Haskell.GhcMod.Doc (showPage, getStyle)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types (LineSeparator(..))
-import Outputable (SDoc)
+import Outputable (PprStyle, SDoc)
 import System.FilePath (normalise)
 
 ----------------------------------------------------------------
@@ -41,9 +41,9 @@ readAndClearLogRef (LogRef ref) = do
     writeIORef ref id
     return $! b []
 
-appendLogRef :: DynFlags -> LineSeparator -> LogRef -> a -> Severity -> SrcSpan -> b -> SDoc -> IO ()
+appendLogRef :: DynFlags -> LineSeparator -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
-appendLogRef df ls (LogRef ref) _ sev src _ msg = do
+appendLogRef df ls (LogRef ref) _ sev src style msg = do
-        let !l = ppMsg src sev df ls msg
+        let !l = ppMsg src sev df ls style msg
         modifyIORef ref (\b -> b . (l:))
 
 ----------------------------------------------------------------
@@ -63,24 +63,25 @@ setLogger True  df ls = do
 handleErrMsg :: LineSeparator -> SourceError -> Ghc [String]
 handleErrMsg ls err = do
     dflag <- G.getSessionDynFlags
-    return . errBagToStrList dflag ls . srcErrorMessages $ err
+    style <- getStyle
+    return . errBagToStrList dflag ls style . srcErrorMessages $ err
 
-errBagToStrList :: DynFlags -> LineSeparator -> Bag ErrMsg -> [String]
+errBagToStrList :: DynFlags -> LineSeparator -> PprStyle -> Bag ErrMsg -> [String]
-errBagToStrList dflag ls = map (ppErrMsg dflag ls) . reverse . bagToList
+errBagToStrList dflag ls style = map (ppErrMsg dflag ls style) . reverse . bagToList
 
 ----------------------------------------------------------------
 
-ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String
+ppErrMsg :: DynFlags -> LineSeparator -> PprStyle -> ErrMsg -> String
-ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext
+ppErrMsg dflag ls style err = ppMsg spn SevError dflag ls style msg ++ ext
    where
      spn = Gap.errorMsgSpan err
      msg = errMsgShortDoc err
-     ext = showMsg dflag ls (errMsgExtraInfo err)
+     ext = showMsg dflag ls style (errMsgExtraInfo err)
 
-ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> SDoc -> String
+ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> PprStyle -> SDoc -> String
-ppMsg spn sev dflag ls msg = prefix ++ cts
+ppMsg spn sev dflag ls style msg = prefix ++ cts
   where
-    cts  = showMsg dflag ls msg
+    cts  = showMsg dflag ls style msg
     defaultPrefix
       | dopt Gap.dumpSplicesFlag dflag = ""
       | otherwise                      = "Dummy:0:0:Error:"
@@ -92,8 +93,8 @@ ppMsg spn sev dflag ls msg = prefix ++ cts
 
 ----------------------------------------------------------------
 
-showMsg :: DynFlags -> LineSeparator -> SDoc -> String
+showMsg :: DynFlags -> LineSeparator -> PprStyle -> SDoc -> String
-showMsg dflag (LineSeparator lsep) sdoc = replaceNull $ showUnqualifiedPage dflag sdoc
+showMsg dflag (LineSeparator lsep) style sdoc = replaceNull $ showPage dflag style sdoc
   where
     replaceNull []        = []
     replaceNull ('\n':xs) = lsep ++ replaceNull xs

Language/Haskell/GhcMod/Info.hs

@@ -24,13 +24,13 @@ import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), DynFlags, Sr
 import qualified GHC as G
 import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged)
 import HscTypes (ms_imps)
-import Language.Haskell.GhcMod.Doc (showUnqualifiedPage, showUnqualifiedOneLine, showQualifiedPage)
+import Language.Haskell.GhcMod.Doc (showPage, showOneLine, getStyle)
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.GHCChoice ((||>), goNext)
 import Language.Haskell.GhcMod.Gap (HasType(..))
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Language.Haskell.GhcMod.Types
-import Outputable (ppr)
+import Outputable (PprStyle, ppr)
 import TcHsSyn (hsPatType)
 
 ----------------------------------------------------------------
@@ -61,7 +61,8 @@ info opt cradle file modstr expr =
     exprToInfo = do
         dflag <- G.getSessionDynFlags
         sdoc <- Gap.infoThing expr
-        return $ showUnqualifiedPage dflag sdoc
+        style <- getStyle
+        return $ showPage dflag style sdoc
 
 ----------------------------------------------------------------
 
@@ -108,11 +109,12 @@ typeOf opt cradle file modstr lineNo colNo =
       ets <- mapM (getType tcm) es
       pts <- mapM (getType tcm) ps
       dflag <- G.getSessionDynFlags
-      let sss = map (toTup dflag) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts]
+      style <- getStyle
+      let sss = map (toTup dflag style) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts]
       return $ convert opt sss
 
-    toTup :: DynFlags -> (SrcSpan, Type) -> ((Int,Int,Int,Int),String)
+    toTup :: DynFlags -> PprStyle -> (SrcSpan, Type) -> ((Int,Int,Int,Int),String)
-    toTup dflag (spn, typ) = (fourInts spn, pretty dflag typ)
+    toTup dflag style (spn, typ) = (fourInts spn, pretty dflag style typ)
 
     fourInts :: SrcSpan -> (Int,Int,Int,Int)
     fourInts = fromMaybe (0,0,0,0) . Gap.getSrcSpan
@@ -132,8 +134,8 @@ listifySpans tcs lc = listifyStaged TypeChecker p tcs
 listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r]
 listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x]))
 
-pretty :: DynFlags -> Type -> String
+pretty :: DynFlags -> PprStyle -> Type -> String
-pretty dflag = showUnqualifiedOneLine dflag . Gap.typeForUser
+pretty dflag style = showOneLine dflag style . Gap.typeForUser
 
 ----------------------------------------------------------------
 
@@ -154,7 +156,8 @@ inModuleContext _ opt cradle file modstr action errmsg =
     setTargetBuffer = do
         modgraph <- G.depanal [G.mkModuleName modstr] True
         dflag <- G.getSessionDynFlags
-        let imports = concatMap (map (showQualifiedPage dflag . ppr . G.unLoc)) $
+        style <- getStyle
+        let imports = concatMap (map (showPage dflag style . ppr . G.unLoc)) $
                       map ms_imps modgraph ++ map G.ms_srcimps modgraph
             moddef = "module " ++ sanitize modstr ++ " where"
             header = moddef : imports