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/Hyperlinker/Ast.hs8
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs86
2 files changed, 46 insertions, 48 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index aff61cfc..b97f0ead 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -152,11 +152,11 @@ imports src@(_, imps, _, _) =
everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps
where
ie term = case cast term of
- (Just (GHC.IEVar v)) -> pure $ var v
- (Just (GHC.IEThingAbs t)) -> pure $ typ t
- (Just (GHC.IEThingAll t)) -> pure $ typ t
+ (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v
+ (Just (GHC.IEThingAbs t)) -> pure $ typ $ GHC.ieLWrappedName t
+ (Just (GHC.IEThingAll t)) -> pure $ typ $ GHC.ieLWrappedName t
(Just (GHC.IEThingWith t _ vs _fls)) ->
- [typ t] ++ map var vs
+ [typ $ GHC.ieLWrappedName t] ++ map (var . GHC.ieLWrappedName) vs
_ -> empty
typ (GHC.L sspan name) = (sspan, RtkType name)
var (GHC.L sspan name) = (sspan, RtkVar name)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 9fd55e49..7b5f9017 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -35,8 +35,8 @@ import Text.XHtml hiding ( name, title, p, quote )
import Haddock.GhcUtils
import Control.Monad ( when, unless )
-import Data.Char ( toUpper )
-import Data.List ( sortBy, groupBy, intercalate, isPrefixOf )
+import Data.Char ( toUpper, isSpace )
+import Data.List ( sortBy, intercalate, isPrefixOf, intersperse )
import Data.Maybe
import System.FilePath hiding ( (</>) )
import System.Directory
@@ -105,7 +105,8 @@ copyHtmlBits odir libdir themes = do
copyCssFile f = copyFile f (combine odir (takeFileName f))
copyLibFile f = copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])
mapM_ copyCssFile (cssFiles themes)
- mapM_ copyLibFile [ jsFile, framesFile ]
+ copyLibFile jsFile
+ return ()
headHtml :: String -> Maybe String -> Themes -> Maybe String -> Html
@@ -201,8 +202,7 @@ moduleInfo iface =
field info >>= \a -> return (th << fieldName <-> td << a)
entries :: [HtmlTable]
- entries = mapMaybe doOneEntry [
- ("Copyright",hmi_copyright),
+ entries = maybeToList copyrightsTable ++ mapMaybe doOneEntry [
("License",hmi_license),
("Maintainer",hmi_maintainer),
("Stability",hmi_stability),
@@ -216,6 +216,14 @@ moduleInfo iface =
Just Haskell98 -> Just "Haskell98"
Just Haskell2010 -> Just "Haskell2010"
+ multilineRow :: String -> [String] -> HtmlTable
+ multilineRow title xs = (th ! [valign "top"]) << title <-> td << (toLines xs)
+ where toLines = mconcat . intersperse br . map toHtml
+
+ copyrightsTable :: Maybe HtmlTable
+ copyrightsTable = fmap (multilineRow "Copyright" . split) (hmi_copyright info)
+ where split = map (trim . filter (/= ',')) . lines
+
extsForm
| OptShowExtensions `elem` ifaceOptions iface =
let fs = map (dropOpt . show) (hmi_extensions info)
@@ -256,21 +264,25 @@ ppHtmlContents dflags odir doctitle _maybe_package
themes mathjax_url maybe_index_url
maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do
let tree = mkModuleTree dflags showPkgs
- [(instMod iface, toInstalledDescription iface) | iface <- ifaces]
+ [(instMod iface, toInstalledDescription iface)
+ | iface <- ifaces
+ , not (instIsSig iface)]
+ sig_tree = mkModuleTree dflags showPkgs
+ [(instMod iface, toInstalledDescription iface)
+ | iface <- ifaces
+ , instIsSig iface]
html =
headHtml doctitle Nothing themes mathjax_url +++
bodyHtml doctitle Nothing
maybe_source_url maybe_wiki_url
Nothing maybe_index_url << [
ppPrologue qual doctitle prologue,
+ ppSignatureTree qual sig_tree,
ppModuleTree qual tree
]
createDirectoryIfMissing True odir
writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
- -- XXX: think of a better place for this?
- ppHtmlContentsFrame odir doctitle themes mathjax_url ifaces debug
-
ppPrologue :: Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
ppPrologue _ _ Nothing = noHtml
@@ -278,7 +290,13 @@ ppPrologue qual title (Just doc) =
divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml qual doc))
+ppSignatureTree :: Qualification -> [ModuleTree] -> Html
+ppSignatureTree qual ts =
+ divModuleList << (sectionName << "Signatures" +++ mkNodeList qual [] "n" ts)
+
+
ppModuleTree :: Qualification -> [ModuleTree] -> Html
+ppModuleTree _ [] = mempty
ppModuleTree qual ts =
divModuleList << (sectionName << "Modules" +++ mkNodeList qual [] "n" ts)
@@ -321,39 +339,6 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
--- | Turn a module tree into a flat list of full module names. E.g.,
--- @
--- A
--- +-B
--- +-C
--- @
--- becomes
--- @["A", "A.B", "A.B.C"]@
-flatModuleTree :: [InstalledInterface] -> [Html]
-flatModuleTree ifaces =
- map (uncurry ppModule' . head)
- . groupBy ((==) `on` fst)
- . sortBy (comparing fst)
- $ mods
- where
- mods = [ (moduleString mdl, mdl) | mdl <- map instMod ifaces ]
- ppModule' txt mdl =
- anchor ! [href (moduleHtmlFile mdl), target mainFrameName]
- << toHtml txt
-
-
-ppHtmlContentsFrame :: FilePath -> String -> Themes -> Maybe String
- -> [InstalledInterface] -> Bool -> IO ()
-ppHtmlContentsFrame odir doctitle themes maybe_mathjax_url ifaces debug = do
- let mods = flatModuleTree ifaces
- html =
- headHtml doctitle Nothing themes maybe_mathjax_url +++
- miniBody << divModuleList <<
- (sectionName << "Modules" +++
- ulist << [ li ! [theclass "module"] << m | m <- mods ])
- createDirectoryIfMissing True odir
- writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString debug html)
-
--------------------------------------------------------------------------------
-- * Generate the index
@@ -498,13 +483,20 @@ ppHtmlModule odir doctitle themes
mdl = ifaceMod iface
aliases = ifaceModuleAliases iface
mdl_str = moduleString mdl
+ mdl_str_annot = mdl_str ++ if ifaceIsSig iface
+ then " (signature)"
+ else ""
+ mdl_str_linked = mdl_str +++
+ " (signature" +++
+ sup << ("[" +++ anchor ! [href signatureDocURL] << "?" +++ "]" ) +++
+ ")"
real_qual = makeModuleQual qual aliases mdl
html =
- headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++
+ headHtml mdl_str_annot (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++
bodyHtml doctitle (Just iface)
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url << [
- divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)),
+ divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_linked)),
ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_qual
]
@@ -512,6 +504,9 @@ ppHtmlModule odir doctitle themes
writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
ppHtmlModuleMiniSynopsis odir doctitle themes maybe_mathjax_url iface unicode real_qual debug
+signatureDocURL :: String
+signatureDocURL = "https://wiki.haskell.org/Module_signature"
+
ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
-> Maybe String -> Interface -> Bool -> Qualification -> Bool -> IO ()
ppHtmlModuleMiniSynopsis odir _doctitle themes maybe_mathjax_url iface unicode qual debug = do
@@ -684,6 +679,9 @@ processDecl :: Bool -> Html -> Maybe Html
processDecl True = Just
processDecl False = Just . divTopDecl
+trim :: String -> String
+trim = f . f
+ where f = reverse . dropWhile isSpace
processDeclOneLiner :: Bool -> Html -> Maybe Html
processDeclOneLiner True = Just
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-23 20:05:17 +0000