Commit 905dc8bc authored by patrickdoc's avatar patrickdoc Committed by Ben Gamari

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
parent 31ceaba3
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -102,7 +102,7 @@ module TysWiredIn (
-- * Equality predicates
heqTyCon, heqClass, heqDataCon,
coercibleTyCon, coercibleDataCon, coercibleClass,
coercibleTyCon, coercibleTyConName, coercibleDataCon, coercibleClass,
-- * RuntimeRep and friends
runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
......
......@@ -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.
......
......@@ -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
......
{-
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’
......
Subproject commit a9f774fa3c12f9b8e093e46d58e7872d3d478951
Subproject commit 7cecbd969298d5aa576750864a69fa5f70f71c32
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment