hi haddock: Lex and store haddock docs in interface files

Names appearing in Haddock docstrings are lexed and renamed like any other names
appearing in the AST. We currently rename names irrespective of the namespace,
so both type and constructor names corresponding to an identifier will appear in
the docstring. Haddock will select a given name as the link destination based on
its own heuristics.

This patch also restricts the limitation of `-haddock` being incompatible with
`Opt_KeepRawTokenStream`.

The export and documenation structure is now computed in GHC and serialised in
.hi files. This can be used by haddock to directly generate doc pages without
reparsing or renaming the source. At the moment the operation of haddock
is not modified, that's left to a future patch.

Updates the haddock submodule with the minimum changes needed.

3 files changed, 41 insertions, 39 deletions

diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 60885ae7ee..73ad2a09b7 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -205,7 +205,7 @@ call and just recurse directly in to the subexpressions.
 -- These synonyms match those defined in compiler/GHC.hs
 type RenamedSource     = ( HsGroup GhcRn, [LImportDecl GhcRn]
                          , Maybe [(LIE GhcRn, Avails)]
-                         , Maybe LHsDocString )
+                         , Maybe (LHsDoc GhcRn) )
 type TypecheckedSource = LHsBinds GhcTc
 
 
@@ -316,12 +316,13 @@ getCompressedAsts ts rs top_ev_binds insts tcs =
 
 enrichHie :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon]
   -> HieASTs Type
-enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs =
+enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs =
   runIdentity $ flip evalStateT initState $ flip runReaderT SourceInfo $ do
     tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts
     rasts <- processGrp hsGrp
     imps <- toHie $ filter (not . ideclImplicit . unLoc) imports
     exps <- toHie $ fmap (map $ IEC Export . fst) exports
+    docs <- toHie docs
     -- Add Instance bindings
     forM_ insts $ \i ->
       addUnlocatedEvBind (is_dfun i) (EvidenceVarBind (EvInstBind False (is_cls_nm i)) ModuleScope Nothing)
@@ -341,6 +342,7 @@ enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs =
           , rasts
           , imps
           , exps
+          , docs
           ]
 
         modulify (HiePath file) xs' = do
@@ -387,6 +389,7 @@ enrichHie ts (hsGrp, imports, exports, _) ev_bs insts tcs =
       , toHie $ hs_warnds grp
       , toHie $ hs_annds grp
       , toHie $ hs_ruleds grp
+      , toHie $ hs_docs grp
       ]
 
 getRealSpanA :: SrcSpanAnn' ann -> Maybe Span
@@ -1596,7 +1599,8 @@ instance ToHie a => ToHie (HsScaled GhcRn a) where
 instance ToHie (LocatedA (ConDecl GhcRn)) where
   toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of
       ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs
-                  , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ } ->
+                  , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ
+                  , con_doc = doc} ->
         [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names
         , case outer_bndrs of
             HsOuterImplicit{hso_ximplicit = imp_vars} ->
@@ -1607,6 +1611,7 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
         , toHie ctx
         , toHie args
         , toHie typ
+        , toHie doc
         ]
         where
           rhsScope = combineScopes argsScope tyScope
@@ -1617,11 +1622,13 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
           tyScope = mkLScopeA typ
           resScope = ResolvedScopes [ctxScope, rhsScope]
       ConDeclH98 { con_name = name, con_ex_tvs = qvars
-                 , con_mb_cxt = ctx, con_args = dets } ->
+                 , con_mb_cxt = ctx, con_args = dets
+                 , con_doc = doc} ->
         [ toHie $ C (Decl ConDec $ getRealSpan (locA span)) name
         , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars
         , toHie ctx
         , toHie dets
+        , toHie doc
         ]
         where
           rhsScope = combineScopes ctxScope argsScope
@@ -1780,8 +1787,9 @@ instance ToHie (LocatedA (HsType GhcRn)) where
       HsSpliceTy _ a ->
         [ toHie $ L span a
         ]
-      HsDocTy _ a _ ->
+      HsDocTy _ a doc ->
         [ toHie a
+        , toHie doc
         ]
       HsBangTy _ _ ty ->
         [ toHie ty
@@ -1832,9 +1840,10 @@ instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where
 
 instance ToHie (LocatedA (ConDeclField GhcRn)) where
   toHie (L span field) = concatM $ makeNode field (locA span) : case field of
-      ConDeclField _ fields typ _ ->
+      ConDeclField _ fields typ doc ->
         [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields
         , toHie typ
+        , toHie doc
         ]
 
 instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where
@@ -2088,8 +2097,8 @@ instance ToHie (IEContext (LocatedA (IE GhcRn))) where
       IEModuleContents _ n ->
         [ toHie $ IEC c n
         ]
-      IEGroup _ _ _ -> []
-      IEDoc _ _ -> []
+      IEGroup _ _ d -> [toHie d]
+      IEDoc _ d -> [toHie d]
       IEDocNamed _ _ -> []
 
 instance ToHie (IEContext (LIEWrappedName Name)) where
@@ -2109,3 +2118,13 @@ instance ToHie (IEContext (Located FieldLabel)) where
       [ makeNode lbl span
       , toHie $ C (IEThing c) $ L span (flSelector lbl)
       ]
+
+instance ToHie (LocatedA (DocDecl GhcRn)) where
+  toHie (L span d) = concatM $ makeNodeA d span : case d of
+    DocCommentNext d -> [ toHie d ]
+    DocCommentPrev d -> [ toHie d ]
+    DocCommentNamed _ d -> [ toHie d ]
+    DocGroup _ d -> [ toHie d ]
+
+instance ToHie (LHsDoc GhcRn) where
+  toHie (L span d@(WithHsDocIdentifiers _ ids)) = concatM $ makeNode d span : [toHie $ map (C Use) ids]
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 0055cea807..18554fdc50 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -21,7 +21,7 @@ module GHC.Iface.Load (
         -- RnM/TcM functions
         loadModuleInterface, loadModuleInterfaces,
         loadSrcInterface, loadSrcInterface_maybe,
-        loadInterfaceForName, loadInterfaceForNameMaybe, loadInterfaceForModule,
+        loadInterfaceForName, loadInterfaceForModule,
 
         -- IfM functions
         loadInterface,
@@ -349,15 +349,6 @@ loadInterfaceForName doc name
       ; assertPpr (isExternalName name) (ppr name) $
         initIfaceTcRn $ loadSysInterface doc (nameModule name) }
 
--- | Only loads the interface for external non-local names.
-loadInterfaceForNameMaybe :: SDoc -> Name -> TcRn (Maybe ModIface)
-loadInterfaceForNameMaybe doc name
-  = do { this_mod <- getModule
-       ; if nameIsLocalOrFrom this_mod name || not (isExternalName name)
-         then return Nothing
-         else Just <$> (initIfaceTcRn $ loadSysInterface doc (nameModule name))
-       }
-
 -- | Loads the interface for a given Module.
 loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
 loadInterfaceForModule doc m
@@ -1025,7 +1016,7 @@ ghcPrimIface
         mi_decls    = [],
         mi_fixities = fixities,
         mi_final_exts = (mi_final_exts empty_iface){ mi_fix_fn = mkIfaceFixCache fixities },
-        mi_decl_docs = ghcPrimDeclDocs -- See Note [GHC.Prim Docs]
+        mi_docs = Just ghcPrimDeclDocs -- See Note [GHC.Prim Docs]
         }
   where
     empty_iface = emptyFullModIface gHC_PRIM
@@ -1142,9 +1133,7 @@ pprModIface unit_state iface@ModIface{ mi_final_exts = exts }
         , pprTrustInfo (mi_trust iface)
         , pprTrustPkg (mi_trust_pkg iface)
         , vcat (map ppr (mi_complete_matches iface))
-        , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface))
-        , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface))
-        , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface))
+        , text "docs:" $$ nest 2 (ppr (mi_docs iface))
         , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface))
         ]
   where
@@ -1209,13 +1198,13 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust
 pprTrustPkg :: Bool -> SDoc
 pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg
 
-instance Outputable Warnings where
+instance Outputable (Warnings pass) where
     ppr = pprWarns
 
-pprWarns :: Warnings -> SDoc
+pprWarns :: Warnings pass -> SDoc
 pprWarns NoWarnings         = Outputable.empty
 pprWarns (WarnAll txt)  = text "Warn all" <+> ppr txt
-pprWarns (WarnSome prs) = text "Warnings"
+pprWarns (WarnSome prs) = text "Warnings:"
                         <+> vcat (map pprWarning prs)
     where pprWarning (name, txt) = ppr name <+> ppr txt
 
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 19739ff3e3..7cf782a18d 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -125,12 +125,10 @@ mkPartialIface hsc_env mod_details mod_summary
          , mg_hpc_info     = hpc_info
          , mg_safe_haskell = safe_mode
          , mg_trust_pkg    = self_trust
-         , mg_doc_hdr      = doc_hdr
-         , mg_decl_docs    = decl_docs
-         , mg_arg_docs     = arg_docs
+         , mg_docs         = docs
          }
   = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust
-             safe_mode usages doc_hdr decl_docs arg_docs mod_summary mod_details
+             safe_mode usages docs mod_summary mod_details
 
 -- | Fully instantiate an interface. Adds fingerprints and potentially code
 -- generator produced information.
@@ -222,34 +220,32 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary
           usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names
                       dep_files merged needed_links needed_pkgs
 
-          (doc_hdr', doc_map, arg_map) <- extractDocs tc_result
+          docs <- extractDocs (ms_hspp_opts mod_summary) tc_result
 
           let partial_iface = mkIface_ hsc_env
                    this_mod hsc_src
                    used_th deps rdr_env
                    fix_env warns hpc_info
                    (imp_trust_own_pkg imports) safe_mode usages
-                   doc_hdr' doc_map arg_map mod_summary
+                   docs mod_summary
                    mod_details
 
           mkFullIface hsc_env partial_iface Nothing
 
 mkIface_ :: HscEnv -> Module -> HscSource
          -> Bool -> Dependencies -> GlobalRdrEnv
-         -> NameEnv FixItem -> Warnings -> HpcInfo
+         -> NameEnv FixItem -> Warnings GhcRn -> HpcInfo
          -> Bool
          -> SafeHaskellMode
          -> [Usage]
-         -> Maybe HsDocString
-         -> DeclDocMap
-         -> ArgDocMap
+         -> Maybe Docs
          -> ModSummary
          -> ModDetails
          -> PartialModIface
 mkIface_ hsc_env
          this_mod hsc_src used_th deps rdr_env fix_env src_warns
          hpc_info pkg_trust_req safe_mode usages
-         doc_hdr decl_docs arg_docs mod_summary
+         docs mod_summary
          ModDetails{  md_insts     = insts,
                       md_fam_insts = fam_insts,
                       md_rules     = rules,
@@ -322,9 +318,7 @@ mkIface_ hsc_env
           mi_trust       = trust_info,
           mi_trust_pkg   = pkg_trust_req,
           mi_complete_matches = icomplete_matches,
-          mi_doc_hdr     = doc_hdr,
-          mi_decl_docs   = decl_docs,
-          mi_arg_docs    = arg_docs,
+          mi_docs        = docs,
           mi_final_exts  = (),
           mi_ext_fields  = emptyExtensibleFields,
           mi_src_hash = ms_hs_hash mod_summary