aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2015-12-20 01:14:35 +0100
committerBen Gamari <ben@smart-cactus.org>2015-12-20 01:14:35 +0100
commit19692aab1913730fc10ffda515b77db7308bcf11 (patch)
tree64408b3be93858108759eb85ddbc6c956778cfa4 /haddock-api/src/Haddock/Backends/Xhtml
parentedb3feb49d7d87365abac961368367944d85022d (diff)
parent52bc03a00cf57764cdab5124ee2b12acd5ad3780 (diff)
Merge remote-tracking branch 'phadej/orphans' into ghc-head
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs33
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs14
2 files changed, 38 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 49149b8c..f8599355 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
@@ -561,14 +561,32 @@ ppInstances links origin instances splice unicode qual
instName = getOccString origin
instDecl :: Int -> DocInstance DocName -> (SubDecl,Located DocName)
instDecl no (inst, mdoc, loc) =
- ((ppInstHead links splice unicode qual mdoc origin no inst), loc)
+ ((ppInstHead links splice unicode qual mdoc origin False 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) True no inst), loc)
ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
-> Maybe (MDoc DocName)
- -> InstOrigin DocName -> Int -> InstHead DocName
+ -> InstOrigin DocName
+ -> Bool -- ^ Is instance orphan
+ -> Int -- ^ Normal
+ -> InstHead DocName
-> SubDecl
-ppInstHead links splice unicode qual mdoc origin no ihd@(InstHead {..}) =
+ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
case ihdInstType of
ClassInst { .. } ->
( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ
@@ -576,7 +594,7 @@ ppInstHead links splice unicode qual mdoc origin no ihd@(InstHead {..}) =
, [subInstDetails iid ats sigs]
)
where
- iid = instanceId origin no ihd
+ iid = instanceId origin no orphan ihd
sigs = ppInstanceSigs links splice unicode qual clsiSigs
ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys
TypeInst rhs ->
@@ -618,8 +636,9 @@ lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
-instanceId :: InstOrigin DocName -> Int -> InstHead DocName -> String
-instanceId origin no ihd = concat
+instanceId :: InstOrigin DocName -> Int -> Bool -> InstHead DocName -> String
+instanceId origin no orphan ihd = concat $
+ [ "o:" | orphan ] ++
[ qual origin
, ":" ++ getOccString origin
, ":" ++ (occNameString . getOccName . ihdClsName) ihd
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index d24ed9c4..98df09fe 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,17 @@ 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 wrap . instTable
+ where
+ wrap = ((h1 << "Orphan instances") +++)
+ 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