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 Data.Maybe (fromMaybe)
|
||||||
import DataCon (dataConRepType)
|
import DataCon (dataConRepType)
|
||||||
import GHC
|
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.GHCApi
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
import Name
|
import Name
|
||||||
@ -102,4 +102,4 @@ removeForAlls' ty (Just (pre, ftype))
|
|||||||
| otherwise = ty
|
| otherwise = ty
|
||||||
|
|
||||||
showOutputable :: Outputable a => DynFlags -> a -> String
|
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
|
module Language.Haskell.GhcMod.Doc where
|
||||||
|
|
||||||
import DynFlags (DynFlags)
|
import DynFlags (DynFlags)
|
||||||
import Language.Haskell.GhcMod.Gap (withStyle, styleUnqualified)
|
import Language.Haskell.GhcMod.Gap (withStyle)
|
||||||
import Outputable
|
import Outputable
|
||||||
import Pretty
|
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 :: PprStyle
|
||||||
styleQualified = mkUserStyle alwaysQualify AllTheWay
|
styleQualified = mkUserStyle alwaysQualify AllTheWay
|
||||||
|
|
||||||
|
styleUnqualified :: PprStyle
|
||||||
|
styleUnqualified = mkUserStyle neverQualify AllTheWay
|
||||||
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
|
||||||
-- For "ghc-mod type"
|
-- For "ghc-mod type"
|
||||||
showQualifiedPage :: DynFlags -> SDoc -> String
|
showQualifiedPage :: DynFlags -> SDoc -> String
|
||||||
showQualifiedPage dflag = showDocWith PageMode . withStyle dflag styleQualified
|
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
|
-- Not used
|
||||||
showQualifiedOneLine :: DynFlags -> SDoc -> String
|
showQualifiedOneLine :: DynFlags -> SDoc -> String
|
||||||
showQualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleQualified
|
showQualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleQualified
|
||||||
|
@ -14,6 +14,7 @@ import DynFlags
|
|||||||
import ErrUtils
|
import ErrUtils
|
||||||
import GHC
|
import GHC
|
||||||
import HscTypes
|
import HscTypes
|
||||||
|
import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
import Outputable
|
import Outputable
|
||||||
import System.FilePath (normalise)
|
import System.FilePath (normalise)
|
||||||
@ -72,7 +73,7 @@ ppMsg spn sev dflag msg = prefix ++ cts ++ "\0"
|
|||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
showMsg :: DynFlags -> SDoc -> String
|
showMsg :: DynFlags -> SDoc -> String
|
||||||
showMsg dflag sdoc = map toNull $ Gap.showUnqualifiedPage dflag sdoc
|
showMsg dflag sdoc = map toNull $ showUnqualifiedPage dflag sdoc
|
||||||
where
|
where
|
||||||
toNull '\n' = '\0'
|
toNull '\n' = '\0'
|
||||||
toNull x = x
|
toNull x = x
|
||||||
|
@ -4,8 +4,6 @@ module Language.Haskell.GhcMod.Gap (
|
|||||||
Language.Haskell.GhcMod.Gap.ClsInst
|
Language.Haskell.GhcMod.Gap.ClsInst
|
||||||
, mkTarget
|
, mkTarget
|
||||||
, withStyle
|
, withStyle
|
||||||
, styleUnqualified
|
|
||||||
, showUnqualifiedPage
|
|
||||||
, setLogAction
|
, setLogAction
|
||||||
, supportedExtensions
|
, supportedExtensions
|
||||||
, getSrcSpan
|
, getSrcSpan
|
||||||
@ -29,20 +27,20 @@ module Language.Haskell.GhcMod.Gap (
|
|||||||
|
|
||||||
import Control.Applicative hiding (empty)
|
import Control.Applicative hiding (empty)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Time.Clock
|
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Time.Clock
|
||||||
import DynFlags
|
import DynFlags
|
||||||
import ErrUtils
|
import ErrUtils
|
||||||
import FastString
|
import FastString
|
||||||
|
import HscTypes
|
||||||
import Language.Haskell.GhcMod.GHCChoice
|
import Language.Haskell.GhcMod.GHCChoice
|
||||||
import Language.Haskell.GhcMod.Types hiding (convert)
|
import Language.Haskell.GhcMod.Types hiding (convert)
|
||||||
|
import NameSet
|
||||||
import Outputable
|
import Outputable
|
||||||
|
import PprTyThing
|
||||||
import StringBuffer
|
import StringBuffer
|
||||||
import TcType
|
import TcType
|
||||||
import NameSet
|
|
||||||
import HscTypes
|
|
||||||
import PprTyThing
|
|
||||||
|
|
||||||
import qualified InstEnv
|
import qualified InstEnv
|
||||||
import qualified Pretty
|
import qualified Pretty
|
||||||
@ -70,14 +68,6 @@ import Control.Arrow hiding ((<+>))
|
|||||||
import Data.Convertible
|
import Data.Convertible
|
||||||
#endif
|
#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]
|
supportedExtensions :: [String]
|
||||||
#if __GLASGOW_HASKELL__ >= 700
|
#if __GLASGOW_HASKELL__ >= 700
|
||||||
supportedExtensions = supportedLanguagesAndExtensions
|
supportedExtensions = supportedLanguagesAndExtensions
|
||||||
@ -264,8 +244,7 @@ filterOutChildren get_thing xs
|
|||||||
where
|
where
|
||||||
implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
|
implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
|
||||||
|
|
||||||
|
infoThing :: String -> Ghc SDoc
|
||||||
infoThing :: String -> Ghc String
|
|
||||||
infoThing str = do
|
infoThing str = do
|
||||||
names <- parseName str
|
names <- parseName str
|
||||||
#if __GLASGOW_HASKELL__ >= 707
|
#if __GLASGOW_HASKELL__ >= 707
|
||||||
@ -275,8 +254,7 @@ infoThing str = do
|
|||||||
mb_stuffs <- mapM getInfo names
|
mb_stuffs <- mapM getInfo names
|
||||||
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
|
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
|
||||||
#endif
|
#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
|
#if __GLASGOW_HASKELL__ >= 707
|
||||||
pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc
|
pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc
|
||||||
|
@ -58,7 +58,10 @@ info :: Options
|
|||||||
info opt cradle file modstr expr =
|
info opt cradle file modstr expr =
|
||||||
inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info"
|
inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info"
|
||||||
where
|
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