showUnqualifiedPage is now in Doc.hs.

Language/Haskell/GhcMod/Browse.hs

@@ -6,7 +6,7 @@ import Data.List
 import Data.Maybe (fromMaybe)
 import DataCon (dataConRepType)
 import GHC
-import qualified Language.Haskell.GhcMod.Gap as Gap
+import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Types
 import Name
@@ -102,4 +102,4 @@ removeForAlls' ty (Just (pre, ftype))
     | otherwise           = ty
 
 showOutputable :: Outputable a => DynFlags -> a -> String
-showOutputable dflag = unwords . lines . Gap.showUnqualifiedPage dflag . ppr
+showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . ppr

Language/Haskell/GhcMod/Doc.hs

@@ -1,17 +1,39 @@
 module Language.Haskell.GhcMod.Doc where
 
 import DynFlags (DynFlags)
-import Language.Haskell.GhcMod.Gap (withStyle, styleUnqualified)
+import Language.Haskell.GhcMod.Gap (withStyle)
 import Outputable
 import Pretty
 
+----------------------------------------------------------------
+
+{-
+pretty :: Outputable a => a -> String
+pretty = showSDocForUser neverQualify . ppr
+
+debug :: Outputable a => a -> b -> b
+debug x v = trace (pretty x) v
+-}
+
+----------------------------------------------------------------
+
 styleQualified :: PprStyle
 styleQualified = mkUserStyle alwaysQualify AllTheWay
 
+styleUnqualified :: PprStyle
+styleUnqualified = mkUserStyle neverQualify AllTheWay
+
+----------------------------------------------------------------
+
 -- For "ghc-mod type"
 showQualifiedPage :: DynFlags -> SDoc -> String
 showQualifiedPage dflag = showDocWith PageMode . withStyle dflag styleQualified
 
+-- For "ghc-mod browse" and show GHC's error messages.
+showUnqualifiedPage :: DynFlags -> SDoc -> String
+showUnqualifiedPage dflag = Pretty.showDocWith Pretty.PageMode
+                          . withStyle dflag styleUnqualified
+
 -- Not used
 showQualifiedOneLine :: DynFlags -> SDoc -> String
 showQualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleQualified

Language/Haskell/GhcMod/ErrMsg.hs

@@ -14,6 +14,7 @@ import DynFlags
 import ErrUtils
 import GHC
 import HscTypes
+import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 import Outputable
 import System.FilePath (normalise)
@@ -72,7 +73,7 @@ ppMsg spn sev dflag msg = prefix ++ cts ++ "\0"
 ----------------------------------------------------------------
 
 showMsg :: DynFlags -> SDoc -> String
-showMsg dflag sdoc = map toNull $ Gap.showUnqualifiedPage dflag sdoc
+showMsg dflag sdoc = map toNull $ showUnqualifiedPage dflag sdoc
   where
     toNull '\n' = '\0'
     toNull x = x

Language/Haskell/GhcMod/Gap.hs

@@ -4,8 +4,6 @@ module Language.Haskell.GhcMod.Gap (
     Language.Haskell.GhcMod.Gap.ClsInst
   , mkTarget
   , withStyle
-  , styleUnqualified
-  , showUnqualifiedPage
   , setLogAction
   , supportedExtensions
   , getSrcSpan
@@ -29,20 +27,20 @@ module Language.Haskell.GhcMod.Gap (
 
 import Control.Applicative hiding (empty)
 import Control.Monad
-import Data.Time.Clock
 import Data.List
 import Data.Maybe
+import Data.Time.Clock
 import DynFlags
 import ErrUtils
 import FastString
+import HscTypes
 import Language.Haskell.GhcMod.GHCChoice
 import Language.Haskell.GhcMod.Types hiding (convert)
+import NameSet
 import Outputable
+import PprTyThing
 import StringBuffer
 import TcType
-import NameSet
-import HscTypes
-import PprTyThing
 
 import qualified InstEnv
 import qualified Pretty
@@ -70,14 +68,6 @@ import Control.Arrow hiding ((<+>))
 import Data.Convertible
 #endif
 
-{-
-pretty :: Outputable a => a -> String
-pretty = showSDocForUser neverQualify . ppr
-
-debug :: Outputable a => a -> b -> b
-debug x v = trace (pretty x) v
--}
-
 ----------------------------------------------------------------
 ----------------------------------------------------------------
 --
@@ -117,16 +107,6 @@ setLogAction df f =
 ----------------------------------------------------------------
 ----------------------------------------------------------------
 
-showUnqualifiedPage :: DynFlags -> SDoc -> String
-showUnqualifiedPage dflag = Pretty.showDocWith Pretty.PageMode
-                          . withStyle dflag styleUnqualified
-
-styleUnqualified :: PprStyle
-styleUnqualified = mkUserStyle neverQualify AllTheWay
-
-----------------------------------------------------------------
-----------------------------------------------------------------
-
 supportedExtensions :: [String]
 #if __GLASGOW_HASKELL__ >= 700
 supportedExtensions = supportedLanguagesAndExtensions
@@ -231,9 +211,9 @@ addDevPkgs df pkgs = df''
   where
 #if __GLASGOW_HASKELL__ >= 707
     df' = gopt_set df Opt_HideAllPackages
-#else    
+#else
     df' = dopt_set df Opt_HideAllPackages
-#endif          
+#endif
     df'' = df' {
         packageFlags = map ExposePackage pkgs ++ packageFlags df
       }
@@ -249,9 +229,9 @@ instance HasType (LHsBind Id) where
 #if __GLASGOW_HASKELL__ >= 707
     getType _ (L spn FunBind{fun_matches = MG _ in_tys out_typ}) = return $ Just (spn, typ)
       where typ = mkFunTys in_tys out_typ
-#else    
+#else
     getType _ (L spn FunBind{fun_matches = MatchGroup _ typ}) = return $ Just (spn, typ)
-#endif                                                                
+#endif
     getType _ _ = return Nothing
 
 ----------------------------------------------------------------
@@ -264,19 +244,17 @@ filterOutChildren get_thing xs
   where
     implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
 
-
+infoThing :: String -> Ghc SDoc
-infoThing :: String -> Ghc String
 infoThing str = do
     names <- parseName str
 #if __GLASGOW_HASKELL__ >= 707
     mb_stuffs <- mapM (getInfo False) names
     let filtered = filterOutChildren (\(t,_f,_i,_fam) -> t) (catMaybes mb_stuffs)
-#else    
+#else
     mb_stuffs <- mapM getInfo names
     let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
 #endif
-    dflag <- getSessionDynFlags
+    return $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
-    return $ showUnqualifiedPage dflag $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
 
 #if __GLASGOW_HASKELL__ >= 707
 pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc
@@ -289,7 +267,7 @@ pprInfo pefas (thing, fixity, insts, famInsts)
     show_fixity fx
       | fx == defaultFixity = Outputable.empty
       | otherwise           = ppr fx <+> ppr (getName thing)
-#else    
+#else
 pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst]) -> SDoc
 pprInfo pefas (thing, fixity, insts)
     = pprTyThingInContextLoc pefas thing

Language/Haskell/GhcMod/Info.hs

@@ -58,7 +58,10 @@ info :: Options
 info opt cradle file modstr expr =
     inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info"
   where
-    exprToInfo = Gap.infoThing expr
+    exprToInfo = do
+        dflag <- getSessionDynFlags
+        sdoc <- Gap.infoThing expr
+        return $ showUnqualifiedPage dflag sdoc
 
 ----------------------------------------------------------------