[commit: haddock] ghc-head, ghc-head1, headdock-library-1.4.5, ie_avails, master, pr/cabal-desc, v2.18, wip/revert-ttg-2017-11-20, wip/ttg-2017-10-13, wip/ttg-2017-10-31, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13: Don't include names with empty subordinates in maps (#644) (2d919a3)

Mon Nov 20 21:08:45 UTC 2017

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

On branches: ghc-head,ghc-head1,headdock-library-1.4.5,ie_avails,master,pr/cabal-desc,v2.18,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,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/2d919a367139482cd76398ca1e90dff6f5427779

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

commit 2d919a367139482cd76398ca1e90dff6f5427779
Author: Alex Biehl <alexbiehl at gmail.com>
Date:   Fri Jun 23 18:30:45 2017 +0200

    Don't include names with empty subordinates in maps (#644)
    
    These are unecessary anyway and just blow up interface size


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

2d919a367139482cd76398ca1e90dff6f5427779
 haddock-api/src/Haddock/Interface/Create.hs | 10 +++++++++-
 html-test/ref/{Bug4.html => PR643.html}     | 22 +++++++++++-----------
 html-test/src/PR643.hs                      |  3 +++
 html-test/src/PR643_1.hs                    |  7 +++++++
 4 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 0984894..50643e2 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -317,7 +317,12 @@ mkMaps :: DynFlags
 mkMaps dflags gre instances decls =
   let
     (a, b, c, d) = unzip4 $ map mappings decls
-  in (f' $ map (nubByName fst) a , f b, f c, f d, instanceMap)
+  in ( f' (map (nubByName fst) a)
+     , f  (filterMapping (not . M.null) b)
+     , f  (filterMapping (not . null) c)
+     , f  (filterMapping (not . null) d)
+     , instanceMap
+     )
   where
     f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
     f = M.fromListWith (<>) . concat
@@ -325,6 +330,9 @@ mkMaps dflags gre instances decls =
     f' :: [[(Name, MDoc Name)]] -> Map Name (MDoc Name)
     f' = M.fromListWith metaDocAppend . concat
 
+    filterMapping :: (b -> Bool) ->  [[(a, b)]] -> [[(a, b)]]
+    filterMapping p = map (filter (p . snd))
+
     mappings :: (LHsDecl Name, [HsDocString])
              -> ( [(Name, MDoc Name)]
                 , [(Name, Map Int (MDoc Name))]
diff --git a/html-test/ref/Bug4.html b/html-test/ref/PR643.html
similarity index 86%
copy from html-test/ref/Bug4.html
copy to html-test/ref/PR643.html
index fe6f47d..46e1e7e 100644
--- a/html-test/ref/Bug4.html
+++ b/html-test/ref/PR643.html
@@ -2,7 +2,7 @@
 ><head
   ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
      /><title
-    >Bug4</title
+    >PR643</title
     ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
      /><script src="haddock-util.js" type="text/javascript"
     ></script
@@ -40,7 +40,7 @@ window.onload = function () {pageLoad();};
 	    ></tr
 	  ></table
 	><p class="caption"
-	>Bug4</p
+	>PR643</p
 	></div
       ><div id="synopsis"
       ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
@@ -48,10 +48,8 @@ window.onload = function () {pageLoad();};
 	><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
 	><li class="src short"
 	  ><a href="#"
-	    >foo</a
-	    > :: <a href="#"
-	    >Int</a
-	    ></li
+	    >test</a
+	    > :: ()</li
 	  ></ul
 	></div
       ><div id="interface"
@@ -59,16 +57,18 @@ window.onload = function () {pageLoad();};
 	>Documentation</h1
 	><div class="top"
 	><p class="src"
-	  ><a id="v:foo" class="def"
-	    >foo</a
-	    > :: <a href="#"
-	    >Int</a
+	  ><a id="v:test" class="def"
+	    >test</a
+	    > :: () <span class="fixity"
+	    >infixr 5</span
+	    ><span class="rightedge"
+	    ></span
 	    > <a href="#" class="selflink"
 	    >#</a
 	    ></p
 	  ><div class="doc"
 	  ><p
-	    >don't use apostrophe's in the wrong place's</p
+	    >Some big documentation</p
 	    ></div
 	  ></div
 	></div
diff --git a/html-test/src/PR643.hs b/html-test/src/PR643.hs
new file mode 100644
index 0000000..565e5b5
--- /dev/null
+++ b/html-test/src/PR643.hs
@@ -0,0 +1,3 @@
+module PR643 (test) where
+
+import PR643_1
diff --git a/html-test/src/PR643_1.hs b/html-test/src/PR643_1.hs
new file mode 100644
index 0000000..ecd0db9
--- /dev/null
+++ b/html-test/src/PR643_1.hs
@@ -0,0 +1,7 @@
+module PR643_1 where
+
+infixr 5 `test`
+
+-- | Some big documentation
+test :: ()
+test = ()

