Fix the ignore-exports option (haskell#1082)

The `ignore-exports` option has been broken since haskell#688, as mentioned in haskell#766 (comment). This PR fixes it.
MercuryTechnologies · Oct 1, 2019 · 9bbcd38 · 9bbcd38
1 parent 395205c
commit 9bbcd38
Show file tree

Hide file tree

Showing 4 changed files with 56 additions and 18 deletions.
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
@@ -83,8 +83,9 @@ createInterface tm flags modMap instIfaceMap = do
 
       (TcGblEnv { tcg_rdr_env = gre
                 , tcg_warns   = warnings
-                , tcg_exports = all_exports
+                , tcg_exports = all_exports0
                 }, md) = tm_internals_ tm
+      all_local_avails = gresToAvailInfo . filter isLocalGRE . globalRdrEnvElts $ gre
 
   -- The 'pkgName' is necessary to decide what package to mention in "@since"
   -- annotations. Not having it is not fatal though.
@@ -111,9 +112,9 @@ createInterface tm flags modMap instIfaceMap = do
   let declsWithDocs = topDecls group_
 
       exports0 = fmap (map (first unLoc)) mayExports
-      exports
-        | OptIgnoreExports `elem` opts = Nothing
-        | otherwise = exports0
+      (all_exports, exports)
+        | OptIgnoreExports `elem` opts = (all_local_avails, Nothing)
+        | otherwise = (all_exports0, exports0)
 
       unrestrictedImportedMods
         -- module re-exports are only possible with

diff --git a/html-test/Main.hs b/html-test/Main.hs
@@ -54,12 +54,6 @@ ingoredTests =
     -- we need a reliable way to deduplicate here.
     -- Happens since PR #688.
     "B"
-
-    -- ignore-exports flag broke with PR #688. We use
-    -- the Avails calculated by GHC now. Probably
-    -- requires a change to GHC to "ignore" a modules
-    -- export list reliably.
-  , "IgnoreExports"
   ]
 
 checkIgnore :: FilePath -> Bool

diff --git a/html-test/ref/IgnoreExports.html b/html-test/ref/IgnoreExports.html
@@ -4,12 +4,14 @@
      /><meta name="viewport" content="width=device-width, initial-scale=1"
      /><title
     >IgnoreExports</title
-    ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
+    ><link href="#" rel="stylesheet" type="text/css" title="Linuwial"
      /><link rel="stylesheet" type="text/css" href="#"
      /><link rel="stylesheet" type="text/css" href="#"
      /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
     ></script
-    ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+    ><script type="text/x-mathjax-config"
+    >MathJax.Hub.Config({ tex2jax: { processClass: &quot;mathjax&quot;, ignoreClass: &quot;.*&quot; } });</script
+    ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
     ></script
     ></head
   ><body
@@ -46,15 +48,23 @@
 	  >Synopsis</summary
 	  ><ul class="details-toggle" data-details-id="syn"
 	  ><li class="src short"
+	    ><span class="keyword"
+	      >data</span
+	      > <a href="#"
+	      >Foo</a
+	      > = <a href="#"
+	      >Bar</a
+	      ></li
+	    ><li class="src short"
 	    ><a href="#"
 	      >foo</a
-	      > :: <a href="#"
+	      > :: <a href="#" title="Data.Int"
 	      >Int</a
 	      ></li
 	    ><li class="src short"
 	    ><a href="#"
 	      >bar</a
-	      > :: <a href="#"
+	      > :: <a href="#" title="Data.Int"
 	      >Int</a
 	      ></li
 	    ></ul
@@ -64,10 +74,40 @@
       ><h1
 	>Documentation</h1
 	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data</span
+	    > <a id="t:Foo" class="def"
+	    >Foo</a
+	    > <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >documentation for Foo</p
+	    ></div
+	  ><div class="subs constructors"
+	  ><p class="caption"
+	    >Constructors</p
+	    ><table
+	    ><tr
+	      ><td class="src"
+		><a id="v:Bar" class="def"
+		  >Bar</a
+		  ></td
+		><td class="doc"
+		><p
+		  >Documentation for Bar</p
+		  ></td
+		></tr
+	      ></table
+	    ></div
+	  ></div
+	><div class="top"
 	><p class="src"
 	  ><a id="v:foo" class="def"
 	    >foo</a
-	    > :: <a href="#"
+	    > :: <a href="#" title="Data.Int"
 	    >Int</a
 	    > <a href="#" class="selflink"
 	    >#</a
@@ -81,7 +121,7 @@
 	><p class="src"
 	  ><a id="v:bar" class="def"
 	    >bar</a
-	    > :: <a href="#"
+	    > :: <a href="#" title="Data.Int"
 	    >Int</a
 	    > <a href="#" class="selflink"
 	    >#</a
@@ -97,4 +137,4 @@
     ></div
     ></body
   ></html
->
+>
diff --git a/html-test/src/IgnoreExports.hs b/html-test/src/IgnoreExports.hs
@@ -1,5 +1,8 @@
 {-# OPTIONS_HADDOCK ignore-exports #-}
-module IgnoreExports (foo) where
+module IgnoreExports (Foo, foo) where
+
+-- | documentation for Foo
+data Foo = Bar -- ^ Documentation for Bar
 
 -- | documentation for foo
 foo :: Int