From 1cd83ce2e0ab47a234bcd4d6ccf319eb9120fa63 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Sun, 14 Jul 2013 17:07:30 +0900 Subject: [PATCH] showUnqualifiedPage is now in Doc.hs. --- Language/Haskell/GhcMod/Browse.hs | 4 +-- Language/Haskell/GhcMod/Doc.hs | 24 +++++++++++++++- Language/Haskell/GhcMod/ErrMsg.hs | 3 +- Language/Haskell/GhcMod/Gap.hs | 46 ++++++++----------------------- Language/Haskell/GhcMod/Info.hs | 5 +++- 5 files changed, 43 insertions(+), 39 deletions(-) diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index 5f7e5ce..11da849 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Doc.hs b/Language/Haskell/GhcMod/Doc.hs index c7ef01a..d6ad4e2 100644 --- a/Language/Haskell/GhcMod/Doc.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/ErrMsg.hs b/Language/Haskell/GhcMod/ErrMsg.hs index 16ad824..cdf363a 100644 --- a/Language/Haskell/GhcMod/ErrMsg.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index 6726973..e985f0a 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/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 String +infoThing :: String -> Ghc SDoc 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 $ showUnqualifiedPage dflag $ vcat (intersperse (text "") $ map (pprInfo False) filtered) + return $ 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 diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 79410e9..1bfbd4d 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/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 ----------------------------------------------------------------