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

8 files changed, 43 insertions, 14 deletions

diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 0f0ea4d..196e309 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 8e396cc..88d5dbe 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 8e26d80..47f41fb 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 71ff0e1..28c6629 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 35f767d..c9c259e 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 40bd0e5..d587240 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 9f4e65b..9e9adb9 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