showUnqualifiedPage is now in Doc.hs.
This commit is contained in:
parent
cbcbae052b
commit
1cd83ce2e0
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user