summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPatrick Dougherty <patrick.doc@ameritech.net>2017-07-11 11:53:40 -0400
committerBen Gamari <ben@smart-cactus.org>2017-07-11 13:41:44 -0400
commit905dc8bc74bebf5370eb9237cc8756cd9fe871ae (patch)
tree2d758be7928ef4ca2a1450f73b5301aa94b46628
parent31ceaba3edac536d8a8d97d49bb797d4f5bedac6 (diff)
downloadhaskell-905dc8bc74bebf5370eb9237cc8756cd9fe871ae.tar.gz
Make ':info Coercible' display an arbitrary string (fixes #12390)
This change enables the addition of an arbitrary string to the output of GHCi's ':info'. It was made for Coercible in particular but could be extended if desired. Updates haddock submodule. Test Plan: Modified test 'ghci059' to match new output. Reviewers: austin, bgamari Reviewed By: bgamari Subscribers: goldfire, rwbarton, thomie GHC Trac Issues: #12390 Differential Revision: https://phabricator.haskell.org/D3634
-rw-r--r--compiler/main/HscMain.hs3
-rw-r--r--compiler/main/InteractiveEval.hs7
-rw-r--r--compiler/prelude/PrelInfo.hs19
-rw-r--r--compiler/prelude/TysWiredIn.hs2
-rw-r--r--compiler/typecheck/TcRnDriver.hs7
-rw-r--r--ghc/GHCi/UI.hs14
-rw-r--r--testsuite/tests/ghci/scripts/ghci059.stdout5
m---------utils/haddock0
8 files changed, 43 insertions, 14 deletions
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 0f0ea4dc51..196e309caa 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -275,7 +275,8 @@ hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do
-- "name not found", and the Maybe in the return type
-- is used to indicate that.
-hscTcRnGetInfo :: HscEnv -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst]))
+hscTcRnGetInfo :: HscEnv -> Name
+ -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
hscTcRnGetInfo hsc_env0 name
= runInteractiveHsc hsc_env0 $
do { hsc_env <- getHscEnv
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 8e396cc16a..88d5dbe57d 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -726,20 +726,21 @@ moduleIsInterpreted modl = withSession $ \h ->
-- are in scope (qualified or otherwise). Otherwise we list a whole lot too many!
-- The exact choice of which ones to show, and which to hide, is a judgement call.
-- (see Trac #1581)
-getInfo :: GhcMonad m => Bool -> Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst]))
+getInfo :: GhcMonad m => Bool -> Name
+ -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst], SDoc))
getInfo allInfo name
= withSession $ \hsc_env ->
do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name
case mb_stuff of
Nothing -> return Nothing
- Just (thing, fixity, cls_insts, fam_insts) -> do
+ Just (thing, fixity, cls_insts, fam_insts, docs) -> do
let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env)
-- Filter the instances based on whether the constituent names of their
-- instance heads are all in scope.
let cls_insts' = filter (plausible rdr_env . orphNamesOfClsInst) cls_insts
fam_insts' = filter (plausible rdr_env . orphNamesOfFamInst) fam_insts
- return (Just (thing, fixity, cls_insts', fam_insts'))
+ return (Just (thing, fixity, cls_insts', fam_insts', docs))
where
plausible rdr_env names
-- Dfun involving only names that are in ic_rn_glb_env
diff --git a/compiler/prelude/PrelInfo.hs b/compiler/prelude/PrelInfo.hs
index 8e26d80a6a..47f41fbf73 100644
--- a/compiler/prelude/PrelInfo.hs
+++ b/compiler/prelude/PrelInfo.hs
@@ -21,6 +21,7 @@ module PrelInfo (
-- * Known-key names
isKnownKeyName,
lookupKnownKeyName,
+ lookupKnownNameInfo,
-- ** Internal use
-- | 'knownKeyNames' is exported to seed the original name cache only;
@@ -59,6 +60,7 @@ import Id
import Name
import NameEnv
import MkId
+import Outputable
import TysPrim
import TysWiredIn
import HscTypes
@@ -66,7 +68,6 @@ import Class
import TyCon
import UniqFM
import Util
-import Panic
import {-# SOURCE #-} TcTypeNats ( typeNatTyCons )
import Control.Applicative ((<|>))
@@ -197,6 +198,22 @@ isKnownKeyName n =
knownKeysMap :: UniqFM Name
knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]
+-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
+-- GHCi's ':info' command.
+lookupKnownNameInfo :: Name -> SDoc
+lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
+ -- If we do find a doc, we add comment delimeters to make the output
+ -- of ':info' valid Haskell.
+ Nothing -> empty
+ Just doc -> vcat [text "{-", doc, text "-}"]
+
+-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
+knownNamesInfo :: NameEnv SDoc
+knownNamesInfo = unitNameEnv coercibleTyConName $
+ vcat [ text "Coercible is a special constraint with custom solving rules."
+ , text "It is not a class."
+ , text "Please see section 9.14.4 of the user's guide for details." ]
+
{-
We let a lot of "non-standard" values be visible, so that we can make
sense of them in interface pragmas. It's cool, though they all have
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 71ff0e18c6..28c6629a91 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -102,7 +102,7 @@ module TysWiredIn (
-- * Equality predicates
heqTyCon, heqClass, heqDataCon,
- coercibleTyCon, coercibleDataCon, coercibleClass,
+ coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
-- * RuntimeRep and friends
runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 35f767d1da..c9c259e992 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -66,6 +66,7 @@ import HsSyn
import IfaceSyn ( ShowSub(..), showToHeader )
import IfaceType( ShowForAllFlag(..) )
import PrelNames
+import PrelInfo
import RdrName
import TcHsSyn
import TcExpr
@@ -2419,7 +2420,8 @@ tcRnLookupName' name = do
tcRnGetInfo :: HscEnv
-> Name
- -> IO (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst]))
+ -> IO ( Messages
+ , Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
-- Used to implement :info in GHCi
--
@@ -2439,7 +2441,8 @@ tcRnGetInfo hsc_env name
; thing <- tcRnLookupName' name
; fixity <- lookupFixityRn name
; (cls_insts, fam_insts) <- lookupInsts thing
- ; return (thing, fixity, cls_insts, fam_insts) }
+ ; let info = lookupKnownNameInfo name
+ ; return (thing, fixity, cls_insts, fam_insts, info) }
-- Lookup all class and family instances for a type constructor.
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 40bd0e59c3..d58724037f 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1338,7 +1338,8 @@ infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
infoThing allInfo str = do
names <- GHC.parseName str
mb_stuffs <- mapM (GHC.getInfo allInfo) names
- let filtered = filterOutChildren (\(t,_f,_ci,_fi) -> t) (catMaybes mb_stuffs)
+ let filtered = filterOutChildren (\(t,_f,_ci,_fi,_sd) -> t)
+ (catMaybes mb_stuffs)
return $ vcat (intersperse (text "") $ map pprInfo filtered)
-- Filter out names whose parent is also there Good
@@ -1353,9 +1354,10 @@ filterOutChildren get_thing xs
Just p -> getName p `elemNameSet` all_names
Nothing -> False
-pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
-pprInfo (thing, fixity, cls_insts, fam_insts)
- = pprTyThingInContextLoc thing
+pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc
+pprInfo (thing, fixity, cls_insts, fam_insts, docs)
+ = docs
+ $$ pprTyThingInContextLoc thing
$$ show_fixity
$$ vcat (map GHC.pprInstance cls_insts)
$$ vcat (map GHC.pprFamInst fam_insts)
@@ -2828,8 +2830,8 @@ showBindings = do
mb_stuff <- GHC.getInfo False (getName tt)
return $ maybe (text "") pprTT mb_stuff
- pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
- pprTT (thing, fixity, _cls_insts, _fam_insts)
+ pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc
+ pprTT (thing, fixity, _cls_insts, _fam_insts, _docs)
= pprTyThing showToHeader thing
$$ show_fixity
where
diff --git a/testsuite/tests/ghci/scripts/ghci059.stdout b/testsuite/tests/ghci/scripts/ghci059.stdout
index 9f4e65b344..9e9adb9ff1 100644
--- a/testsuite/tests/ghci/scripts/ghci059.stdout
+++ b/testsuite/tests/ghci/scripts/ghci059.stdout
@@ -1,3 +1,8 @@
+{-
+Coercible is a special constraint with custom solving rules.
+It is not a class.
+Please see section 9.14.4 of the user's guide for details.
+-}
type role Coercible representational representational
class Coercible a b => Coercible (a :: k0) (b :: k0)
-- Defined in ‘GHC.Types’
diff --git a/utils/haddock b/utils/haddock
-Subproject a9f774fa3c12f9b8e093e46d58e7872d3d47895
+Subproject 7cecbd969298d5aa576750864a69fa5f70f71c3