aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml.hs
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-03-23 09:25:33 -0400
committerBen Gamari <ben@smart-cactus.org>2017-03-23 09:25:33 -0400
commit606da884355527051afe0058c2f8b0ac2005e01b (patch)
tree9388f16cb30761dd3f37c0bd3b6e251f9ebc2f87 /haddock-api/src/Haddock/Backends/Xhtml.hs
parent4eb765ca4205c79539d60b7afa9b7e261a4a49fe (diff)
parent240bc38b94ed2d0af27333b23392d03eeb615e82 (diff)
Merge commit '240bc38b94ed2d0af27333b23392d03eeb615e82' into HEAD
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs59
1 files changed, 16 insertions, 43 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 10b69a68..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)
@@ -275,9 +283,6 @@ ppHtmlContents dflags odir doctitle _maybe_package
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
@@ -334,41 +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
- -- TODO: Arguably should split up signatures and modules here too...
- -- but who uses frames? Fix this if someone complains. -- ezyang
- 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
@@ -709,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