[commit: haddock] v2.16: Add orphan instances link to contents box (ad66637)

[git at git.haskell.org]

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

On branch  : v2.16
Link       : http://git.haskell.org/haddock.git/commitdiff/ad66637174deeae6f2414b26dc384668b480eeb5

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

commit ad66637174deeae6f2414b26dc384668b480eeb5
Author: Oleg Grenrus <oleg.grenrus at iki.fi>
Date:   Mon Sep 28 07:40:54 2015 +0300

    Add orphan instances link to contents box


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

ad66637174deeae6f2414b26dc384668b480eeb5
 haddock-api/src/Haddock/Backends/Xhtml.hs | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index de4e8a1..819974a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -522,7 +522,7 @@ ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual debug = do
 
 ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html
 ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
-  = ppModuleContents qual exports +++
+  = ppModuleContents qual exports (not . null $ ifaceRnOrphanInstances iface) +++
     description +++
     synopsis +++
     divInterface (maybe_doc_hdr +++ bdy +++ orphans)
@@ -607,16 +607,22 @@ ppTyClBinderWithVarsMini mdl decl =
       ns = tyvarNames $ tcdTyVars decl -- it's safe to use tcdTyVars, see code above
   in ppTypeApp n [] ns (\is_infix -> ppNameMini is_infix mdl . nameOccName . getName) ppTyName
 
-ppModuleContents :: Qualification -> [ExportItem DocName] -> Html
-ppModuleContents qual exports
-  | null sections = noHtml
-  | otherwise     = contentsDiv
+ppModuleContents :: Qualification
+                 -> [ExportItem DocName]
+                 -> Bool -- ^ Orphans sections
+                 -> Html
+ppModuleContents qual exports orphan
+  | null sections && not orphan  = noHtml
+  | otherwise                    = contentsDiv
  where
   contentsDiv = divTableOfContents << (
     sectionName << "Contents" +++
-    unordList sections)
+    unordList (sections ++ orphanSection))
 
   (sections, _leftovers{-should be []-}) = process 0 exports
+  orphanSection
+    | orphan =  [ linkedAnchor "section.orphans" << "Orphan instances" ]
+    | otherwise = []
 
   process :: Int -> [ExportItem DocName] -> ([Html],[ExportItem DocName])
   process _ [] = ([], [])