From 02e633a6f9b7ccb53a92a838c1b717ef9f3737fc Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Sun, 27 Sep 2015 20:50:15 +0300
Subject: Generate docs for orphan instances
---
haddock-api/src/Haddock/Backends/Xhtml.hs | 5 ++++-
haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 17 ++++++++++++++++-
haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 13 +++++++++++--
3 files changed, 31 insertions(+), 4 deletions(-)
(limited to 'haddock-api/src/Haddock/Backends')
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index e5e4db3f..fce95814 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -525,7 +525,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
= ppModuleContents qual exports +++
description +++
synopsis +++
- divInterface (maybe_doc_hdr +++ bdy)
+ divInterface (maybe_doc_hdr +++ bdy +++ orphans)
where
exports = numberSectionHeadings (ifaceRnExportItems iface)
@@ -564,6 +564,9 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
foldr (+++) noHtml $
mapMaybe (processExport False linksInfo unicode qual) exports
+ orphans = (h1 << "Orphan instances") +++
+ ppOrphanInstances linksInfo (ifaceRnOrphanInstances iface) False unicode qual
+
linksInfo = (maybe_source_url, maybe_wiki_url)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index e536ae4b..031b40e5 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -16,7 +16,7 @@
module Haddock.Backends.Xhtml.Decl (
ppDecl,
- ppTyName, ppTyFamHeader, ppTypeApp,
+ ppTyName, ppTyFamHeader, ppTypeApp, ppOrphanInstances,
tyvarNames
) where
@@ -548,6 +548,21 @@ ppInstances links origin instances splice unicode qual
((ppInstHead links splice unicode qual mdoc origin no inst), loc)
+ppOrphanInstances :: LinksInfo
+ -> [DocInstance DocName]
+ -> Splice -> Unicode -> Qualification
+ -> Html
+ppOrphanInstances links instances splice unicode qual
+ = subOrphanInstances qual links True (zipWith instDecl [1..] instances)
+ where
+ instOrigin :: InstHead name -> InstOrigin name
+ instOrigin inst = OriginClass (ihdClsName inst)
+
+ instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
+ instDecl no (inst, mdoc, loc) =
+ ((ppInstHead links splice unicode qual mdoc (instOrigin inst) no inst), loc)
+
+
ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
-> Maybe (MDoc DocName)
-> InstOrigin DocName -> Int -> InstHead DocName
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index d624a1d0..b20cd172 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Layout (
subConstructors,
subEquations,
subFields,
- subInstances, subInstHead, subInstDetails,
+ subInstances, subOrphanInstances, subInstHead, subInstDetails,
subMethods,
subMinimal,
@@ -200,7 +200,16 @@ subInstances qual nm lnks splice = maybe noHtml wrap . instTable
subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
id_ = makeAnchorId $ "i:" ++ nm
-
+
+subOrphanInstances :: Qualification
+ -> LinksInfo -> Bool
+ -> [(SubDecl,Located DocName)] -> Html
+subOrphanInstances qual lnks splice = maybe noHtml id . instTable
+ where
+ instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice
+ id_ = makeAnchorId $ "orphans"
+
+
subInstHead :: String -- ^ Instance unique id (for anchor generation)
-> Html -- ^ Header content (instance name and type)
-> Html
--
cgit v1.2.3