From 389d9a46096256ee6de08e42d1d083507a000573 Mon Sep 17 00:00:00 2001
From: "Edward Z. Yang" <ezyang@mit.edu>
Date: Tue, 21 Mar 2017 07:55:01 +0000
Subject: [PATCH] Support listing signatures and reexported modules.

This is a partial patch which improves Hackage package
description rendering of modules.  Now, instead of
ignoring reexported-modules and signatures, they get
displayed.

This is incomplete because:

    - reexported-module links will always be broken, because
      we'll be testing for HTML files which will never exist
      (Haddock doesn't currently generate HTML for reexported
      modules, although it may in the future.)

    - Signatures might be inherited from dependencies (and
      even get Haddock documentation for them), but we won't
      display them unless they are explicitly listed in
      signatures.

Signed-off-by: Edward Z. Yang <ezyang@mit.edu>
---
 Distribution/Server/Packages/Render.hs | 31 ++++++++++++++++++++------
 Distribution/Server/Pages/Package.hs   | 15 ++++++++-----
 2 files changed, 34 insertions(+), 12 deletions(-)

diff --git a/Distribution/Server/Packages/Render.hs b/Distribution/Server/Packages/Render.hs
index b9a8ec4d3..7090ea4d5 100644
--- a/Distribution/Server/Packages/Render.hs
+++ b/Distribution/Server/Packages/Render.hs
@@ -7,6 +7,7 @@ module Distribution.Server.Packages.Render (
   , DependencyTree
   , IsBuildable (..)
   , doPackageRender
+  , ModSigIndex(..)
 
     -- * Utils
   , categorySplit,
@@ -43,6 +44,11 @@ import Distribution.Server.Users.Types
 import qualified Data.TarIndex as TarIndex
 import Data.TarIndex (TarIndex, TarEntryOffset)
 
+data ModSigIndex = ModSigIndex {
+        modIndex :: ModuleForest,
+        sigIndex :: ModuleForest
+    }
+
 -- This should provide the caller enough information to encode the package information
 -- in its particular format (text, html, json) with minimal effort on its part.
 -- This is why some fields of PackageDescription are preprocessed, and others aren't.
@@ -57,7 +63,11 @@ data PackageRender = PackageRender {
     rendMaintainer   :: Maybe String,
     rendCategory     :: [String],
     rendRepoHeads    :: [(RepoType, String, SourceRepo)],
-    rendModules      :: Maybe TarIndex -> Maybe ModuleForest,
+    -- | The optional 'TarIndex' is of the documentation tarball; we use this
+    -- to test if a module actually has a corresponding documentation HTML
+    -- file we can link to.  If no 'TarIndex' is provided, it is assumed
+    -- all links are dead.
+    rendModules      :: Maybe TarIndex -> Maybe ModSigIndex,
     rendHasTarball   :: Bool,
     rendChangeLog    :: Maybe (FilePath, ETag, TarEntryOffset, FilePath),
     rendReadme       :: Maybe (FilePath, ETag, TarEntryOffset, FilePath),
@@ -91,11 +101,7 @@ doPackageRender users info = PackageRender
                            []  -> []
                            str -> categorySplit str
     , rendRepoHeads    = catMaybes (map rendRepo $ sourceRepos desc)
-    , rendModules      = \docindex ->
-                             fmap (moduleForest
-                           . map (\m -> (m, moduleHasDocs docindex m))
-                           . exposedModules)
-                          (library flatDesc)
+    , rendModules      = renderModules
     , rendHasTarball   = not . Vec.null $ pkgTarballRevisions info
     , rendChangeLog    = Nothing -- populated later
     , rendReadme       = Nothing -- populated later
@@ -124,7 +130,18 @@ doPackageRender users info = PackageRender
         isBuildable ctData = if buildable $ getBuildInfo ctData
                                then Buildable
                                else NotBuildable
-    
+
+    renderModules docindex
+      | Just lib <- library flatDesc
+      = let mod_ix = mkForest $ exposedModules lib
+                           -- Assumes that there is an HTML per reexport
+                           ++ map moduleReexportName (reexportedModules lib)
+            sig_ix = mkForest $ signatures lib
+            mkForest = moduleForest . map (\m -> (m, moduleHasDocs docindex m))
+        in Just (ModSigIndex { modIndex = mod_ix, sigIndex = sig_ix })
+      | otherwise
+      = Nothing
+
     moduleHasDocs :: Maybe TarIndex -> ModuleName -> Bool
     moduleHasDocs Nothing       = const False
     moduleHasDocs (Just doctar) = isJust . TarIndex.lookup doctar
diff --git a/Distribution/Server/Pages/Package.hs b/Distribution/Server/Pages/Package.hs
index f9fd64eb2..09dc9685e 100644
--- a/Distribution/Server/Pages/Package.hs
+++ b/Distribution/Server/Pages/Package.hs
@@ -262,11 +262,16 @@ renderPackageFlags render =
 moduleSection :: PackageRender -> Maybe TarIndex -> URL -> [Html]
 moduleSection render mdocIndex docURL =
     maybeToList $ fmap msect (rendModules render mdocIndex)
-  where msect libModuleForrest = toHtml
-            [ h2 << "Modules"
-            , renderModuleForest docURL libModuleForrest
-            , renderDocIndexLink
-            ]
+  where msect ModSigIndex{ modIndex = m, sigIndex = s } = toHtml $
+            (if not (null s)
+                then [ h2 << "Signatures"
+                     , renderModuleForest docURL s ]
+                else []) ++
+            (if not (null m)
+                then [ h2 << "Modules"
+                     , renderModuleForest docURL m ]
+                else []) ++
+            [renderDocIndexLink]
         renderDocIndexLink
           | isJust mdocIndex =
             let docIndexURL = docURL </> "doc-index.html"