aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs23
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs33
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs14
4 files changed, 57 insertions, 16 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index a9bc9a8b..f3749a85 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -29,6 +29,8 @@ import Data.Char
import Data.List
import Data.Maybe
import Data.Version
+
+import System.Directory
import System.FilePath
import System.IO
@@ -47,6 +49,7 @@ ppHoogle dflags package version synopsis prologue ifaces odir = do
["@version " ++ showVersion version
| not (null (versionBranch version)) ] ++
concat [ppModule dflags i | i <- ifaces, OptHide `notElem` ifaceOptions i]
+ createDirectoryIfMissing True odir
h <- openFile (odir </> filename) WriteMode
hSetEncoding h utf8
hPutStr h (unlines contents)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 1554a33c..660bbe90 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -522,10 +522,10 @@ 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)
+ 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 =
+ ppOrphanInstances linksInfo (ifaceRnOrphanInstances iface) False unicode qual
+
linksInfo = (maybe_source_url, maybe_wiki_url)
@@ -604,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 _ [] = ([], [])
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index e20c9813..a7a0a2d6 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 09:08:59 +0000