[commit: haddock] ghc-head, ghc-head1, master, wip/revert-ttg-2017-11-20, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13: Include subordinates in content index (24ccb9b)

git at git.haskell.org git at git.haskell.org
Mon Nov 20 21:10:36 UTC 2017


Repository : ssh://git@git.haskell.org/haddock

On branches: ghc-head,ghc-head1,master,wip/revert-ttg-2017-11-20,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13
Link       : http://git.haskell.org/haddock.git/commitdiff/24ccb9b706e3555bf06f35e2f4007565d76fa1b8

>---------------------------------------------------------------

commit 24ccb9b706e3555bf06f35e2f4007565d76fa1b8
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Tue Aug 29 07:55:38 2017 +0200

    Include subordinates in content index


>---------------------------------------------------------------

24ccb9b706e3555bf06f35e2f4007565d76fa1b8
 haddock-api/resources/html/index.js       |  3 ++-
 haddock-api/src/Haddock/Backends/Xhtml.hs | 19 +++++++++++--------
 2 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/haddock-api/resources/html/index.js b/haddock-api/resources/html/index.js
index da1b8cf..6d5b2bf 100644
--- a/haddock-api/resources/html/index.js
+++ b/haddock-api/resources/html/index.js
@@ -82,7 +82,8 @@ var App = createClass({
           threshold: 0.4,
           caseSensitive: true,
           includeScore: true,
-          keys: ["name"]
+          tokenize: true,
+          keys: ["name", "module"]
         }),
         moduleResults: []
       });
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 0297f9e..8046992 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -374,19 +374,22 @@ ppJsonIndex odir maybe_source_url maybe_wiki_url unicode qual_opt ifaces = do
         mdl     = ifaceMod iface
 
     goExport :: Module -> Qualification -> ExportItem DocName -> [Value]
-    goExport mdl qual item =
-      case processExport True links_info unicode qual item of
-        Nothing -> []
-        Just html ->
-          [ Object
-            [ "display_html" .= String (showHtmlFragment html)
+    goExport mdl qual item
+      | Just item_html <- processExport True links_info unicode qual item
+      = [ Object
+            [ "display_html" .= String (showHtmlFragment item_html)
             , "name"         .= String (intercalate " " (map nameString names))
             , "module"       .= String (moduleString mdl)
             , "link"         .= String (fromMaybe "" (listToMaybe (map (nameLink mdl) names)))
             ]
-          ]
+        ]
+      | otherwise = []
       where
-        names = exportName item
+        names = exportName item ++ exportSubs item
+
+    exportSubs :: ExportItem DocName -> [DocName]
+    exportSubs ExportDecl { expItemSubDocs } = map fst expItemSubDocs
+    exportSubs _ = []
 
     exportName :: ExportItem DocName -> [DocName]
     exportName ExportDecl { expItemDecl } = getMainDeclBinder $ unLoc expItemDecl



More information about the ghc-commits mailing list