hi haddock: Lex and store haddock docs in interface fileswip/hi-haddock2021

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, 45 insertions, 49 deletions

diff --git a/compiler/GHC/Unit/Module/ModGuts.hs b/compiler/GHC/Unit/Module/ModGuts.hs
index 4fc683d844..d54e836d71 100644
--- a/compiler/GHC/Unit/Module/ModGuts.hs
+++ b/compiler/GHC/Unit/Module/ModGuts.hs
@@ -72,7 +72,7 @@ data ModGuts
         mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module
         mg_foreign_files :: ![(ForeignSrcLang, FilePath)],
         -- ^ Files to be compiled with the C compiler
-        mg_warns     :: !Warnings,       -- ^ Warnings declared in the module
+        mg_warns     :: !(Warnings GhcRn),  -- ^ Warnings declared in the module
         mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
         mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches
         mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
@@ -97,9 +97,7 @@ data ModGuts
                                                 -- See Note [Trust Own Package]
                                                 -- in "GHC.Rename.Names"
 
-        mg_doc_hdr       :: !(Maybe HsDocString), -- ^ Module header.
-        mg_decl_docs     :: !DeclDocMap,     -- ^ Docs on declarations.
-        mg_arg_docs      :: !ArgDocMap       -- ^ Docs on arguments.
+        mg_docs         :: !(Maybe Docs)       -- ^ Documentation.
     }
 
 mg_mnwib :: ModGuts -> ModuleNameWithIsBoot
diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs
index db7c4ce362..5a3cfe71c9 100644
--- a/compiler/GHC/Unit/Module/ModIface.hs
+++ b/compiler/GHC/Unit/Module/ModIface.hs
@@ -109,7 +109,7 @@ data ModIfaceBackend = ModIfaceBackend
     -- other fields and are not put into the interface file.
     -- Not really produced by the backend but there is no need to create them
     -- any earlier.
-  , mi_warn_fn :: !(OccName -> Maybe WarningTxt)
+  , mi_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn))
     -- ^ Cached lookup for 'mi_warns'
   , mi_fix_fn :: !(OccName -> Maybe Fixity)
     -- ^ Cached lookup for 'mi_fixities'
@@ -184,7 +184,7 @@ data ModIface_ (phase :: ModIfacePhase)
                 -- ^ Fixities
                 -- NOT STRICT!  we read this field lazily from the interface file
 
-        mi_warns    :: Warnings,
+        mi_warns    :: (Warnings GhcRn),
                 -- ^ Warnings
                 -- NOT STRICT!  we read this field lazily from the interface file
 
@@ -235,14 +235,11 @@ data ModIface_ (phase :: ModIfacePhase)
                 -- See Note [Trust Own Package] in GHC.Rename.Names
         mi_complete_matches :: ![IfaceCompleteMatch],
 
-        mi_doc_hdr :: Maybe HsDocString,
-                -- ^ Module header.
-
-        mi_decl_docs :: DeclDocMap,
-                -- ^ Docs on declarations.
-
-        mi_arg_docs :: ArgDocMap,
-                -- ^ Docs on arguments.
+        mi_docs :: Maybe Docs,
+                -- ^ Docstrings and related data for use by haddock, the ghci
+                -- @:doc@ command, and other tools.
+                --
+                -- @Just _@ @<=>@ the module was built with @-haddock@.
 
         mi_final_exts :: !(IfaceBackendExts phase),
                 -- ^ Either `()` or `ModIfaceBackend` for
@@ -359,9 +356,7 @@ instance Binary ModIface where
                  mi_trust     = trust,
                  mi_trust_pkg = trust_pkg,
                  mi_complete_matches = complete_matches,
-                 mi_doc_hdr   = doc_hdr,
-                 mi_decl_docs = decl_docs,
-                 mi_arg_docs  = arg_docs,
+                 mi_docs      = docs,
                  mi_ext_fields = _ext_fields, -- Don't `put_` this in the instance so we
                                               -- can deal with it's pointer in the header
                                               -- when we write the actual file
@@ -405,9 +400,7 @@ instance Binary ModIface where
         put_ bh trust
         put_ bh trust_pkg
         put_ bh complete_matches
-        lazyPut bh doc_hdr
-        lazyPut bh decl_docs
-        lazyPut bh arg_docs
+        lazyPutMaybe bh docs
 
    get bh = do
         mod         <- get bh
@@ -438,9 +431,7 @@ instance Binary ModIface where
         trust       <- get bh
         trust_pkg   <- get bh
         complete_matches <- get bh
-        doc_hdr     <- lazyGet bh
-        decl_docs   <- lazyGet bh
-        arg_docs    <- lazyGet bh
+        docs        <- lazyGetMaybe bh
         return (ModIface {
                  mi_module      = mod,
                  mi_sig_of      = sig_of,
@@ -464,9 +455,7 @@ instance Binary ModIface where
                  mi_trust_pkg   = trust_pkg,
                         -- And build the cached values
                  mi_complete_matches = complete_matches,
-                 mi_doc_hdr     = doc_hdr,
-                 mi_decl_docs   = decl_docs,
-                 mi_arg_docs    = arg_docs,
+                 mi_docs        = docs,
                  mi_ext_fields  = emptyExtensibleFields, -- placeholder because this is dealt
                                                          -- with specially when the file is read
                  mi_final_exts = ModIfaceBackend {
@@ -510,9 +499,7 @@ emptyPartialModIface mod
                mi_trust       = noIfaceTrustInfo,
                mi_trust_pkg   = False,
                mi_complete_matches = [],
-               mi_doc_hdr     = Nothing,
-               mi_decl_docs   = emptyDeclDocMap,
-               mi_arg_docs    = emptyArgDocMap,
+               mi_docs        = Nothing,
                mi_final_exts  = (),
                mi_ext_fields  = emptyExtensibleFields
              }
@@ -554,11 +541,11 @@ emptyIfaceHashCache _occ = Nothing
 -- avoid major space leaks.
 instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where
   rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12
-                f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24 f25) =
+                f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23) =
     rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq`
     f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq`
     rnf f16 `seq` f17 `seq` rnf f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23
-    `seq` rnf f24 `seq` f25 `seq` ()
+    `seq` ()
 
 instance NFData (ModIfaceBackend) where
   rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13)
diff --git a/compiler/GHC/Unit/Module/Warnings.hs b/compiler/GHC/Unit/Module/Warnings.hs
index d8847be72c..6936702b2a 100644
--- a/compiler/GHC/Unit/Module/Warnings.hs
+++ b/compiler/GHC/Unit/Module/Warnings.hs
@@ -1,4 +1,8 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 -- | Warnings for a module
 module GHC.Unit.Module.Warnings
@@ -16,25 +20,31 @@ import GHC.Prelude
 import GHC.Types.SourceText
 import GHC.Types.Name.Occurrence
 import GHC.Types.SrcLoc
+import GHC.Hs.Doc
+import GHC.Hs.Extension
 
 import GHC.Utils.Outputable
 import GHC.Utils.Binary
 
+import Language.Haskell.Syntax.Extension
+
 import Data.Data
 
 -- | Warning Text
 --
 -- reason/explanation from a WARNING or DEPRECATED pragma
-data WarningTxt
+data WarningTxt pass
    = WarningTxt
       (Located SourceText)
-      [Located StringLiteral]
+      [Located (WithHsDocIdentifiers StringLiteral pass)]
    | DeprecatedTxt
       (Located SourceText)
-      [Located StringLiteral]
-   deriving (Eq, Data)
+      [Located (WithHsDocIdentifiers StringLiteral pass)]
+
+deriving instance Eq (IdP pass) => Eq (WarningTxt pass)
+deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
 
-instance Outputable WarningTxt where
+instance Outputable (WarningTxt pass) where
     ppr (WarningTxt    lsrc ws)
       = case unLoc lsrc of
           NoSourceText   -> pp_ws ws
@@ -45,7 +55,7 @@ instance Outputable WarningTxt where
           NoSourceText   -> pp_ws ds
           SourceText src -> text src <+> pp_ws ds <+> text "#-}"
 
-instance Binary WarningTxt where
+instance Binary (WarningTxt GhcRn) where
     put_ bh (WarningTxt s w) = do
             putByte bh 0
             put_ bh s
@@ -66,7 +76,7 @@ instance Binary WarningTxt where
                       return (DeprecatedTxt s d)
 
 
-pp_ws :: [Located StringLiteral] -> SDoc
+pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc
 pp_ws [l] = ppr $ unLoc l
 pp_ws ws
   = text "["
@@ -74,19 +84,19 @@ pp_ws ws
     <+> text "]"
 
 
-pprWarningTxtForMsg :: WarningTxt -> SDoc
+pprWarningTxtForMsg :: WarningTxt p -> SDoc
 pprWarningTxtForMsg (WarningTxt    _ ws)
-                     = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))
+                     = doubleQuotes (vcat (map (ftext . sl_fs . hsDocString . unLoc) ws))
 pprWarningTxtForMsg (DeprecatedTxt _ ds)
                      = text "Deprecated:" <+>
-                       doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))
+                       doubleQuotes (vcat (map (ftext . sl_fs . hsDocString . unLoc) ds))
 
 
 -- | Warning information for a module
-data Warnings
+data Warnings pass
   = NoWarnings                          -- ^ Nothing deprecated
-  | WarnAll WarningTxt                  -- ^ Whole module deprecated
-  | WarnSome [(OccName,WarningTxt)]     -- ^ Some specific things deprecated
+  | WarnAll (WarningTxt pass)                  -- ^ Whole module deprecated
+  | WarnSome [(OccName,WarningTxt pass)]     -- ^ Some specific things deprecated
 
      -- Only an OccName is needed because
      --    (1) a deprecation always applies to a binding
@@ -108,9 +118,10 @@ data Warnings
      --
      --        this is in contrast with fixity declarations, where we need to map
      --        a Name to its fixity declaration.
-  deriving( Eq )
 
-instance Binary Warnings where
+deriving instance Eq (IdP pass) => Eq (Warnings pass)
+
+instance Binary (Warnings GhcRn) where
     put_ bh NoWarnings     = putByte bh 0
     put_ bh (WarnAll t) = do
             putByte bh 1
@@ -129,15 +140,15 @@ instance Binary Warnings where
                       return (WarnSome aa)
 
 -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface'
-mkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt
+mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p)
 mkIfaceWarnCache NoWarnings  = \_ -> Nothing
 mkIfaceWarnCache (WarnAll t) = \_ -> Just t
 mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs)
 
-emptyIfaceWarnCache :: OccName -> Maybe WarningTxt
+emptyIfaceWarnCache :: OccName -> Maybe (WarningTxt p)
 emptyIfaceWarnCache _ = Nothing
 
-plusWarns :: Warnings -> Warnings -> Warnings
+plusWarns :: Warnings p -> Warnings p -> Warnings p
 plusWarns d NoWarnings = d
 plusWarns NoWarnings d = d
 plusWarns _ (WarnAll t) = WarnAll t