diff --git a/datafiles/static/hackage.css b/datafiles/static/hackage.css index a640d3d3..ce0e8810 100644 --- a/datafiles/static/hackage.css +++ b/datafiles/static/hackage.css @@ -1146,6 +1146,14 @@ a.deprecated[href]:visited { color: #61B01E; } +.lib-contents { + margin-left: 20px; +} + +.lib-contents > h3 { + margin: 0.7em 0; +} + /* Paginator */ #paginatorContainer { display: flex; diff --git a/src/Distribution/Server/Packages/Render.hs b/src/Distribution/Server/Packages/Render.hs index 8b40303e..9e6293c0 100644 --- a/src/Distribution/Server/Packages/Render.hs +++ b/src/Distribution/Server/Packages/Render.hs @@ -1,6 +1,7 @@ -- TODO: Review and possibly move elsewhere. This code was part of the -- RecentPackages (formerly "Check") feature, but that caused some cyclic -- dependencies. +{-# LANGUAGE TupleSections #-} module Distribution.Server.Packages.Render ( -- * Package render PackageRender(..) @@ -53,6 +54,7 @@ import Distribution.Utils.ShortText (fromShortText) import qualified Data.TarIndex as TarIndex import Data.TarIndex (TarIndex, TarEntryOffset) +import Data.Bifunctor (first, Bifunctor (..)) data ModSigIndex = ModSigIndex { modIndex :: ModuleForest, @@ -64,10 +66,10 @@ data ModSigIndex = ModSigIndex { -- This is why some fields of PackageDescription are preprocessed, and others aren't. data PackageRender = PackageRender { rendPkgId :: PackageIdentifier, + rendLibName :: LibraryName -> String, rendDepends :: [Dependency], rendExecNames :: [String], - rendLibraryDeps :: Maybe DependencyTree, - rendSublibraryDeps :: [(String, DependencyTree)], + rendLibraryDeps :: [(LibraryName, DependencyTree)], rendExecutableDeps :: [(String, DependencyTree)], rendLicenseName :: String, rendLicenseFiles :: [FilePath], @@ -78,7 +80,7 @@ data PackageRender = PackageRender { -- to test if a module actually has a corresponding documentation HTML -- file we can link to. If no 'TarIndex' is provided, it is assumed -- all links are dead. - rendModules :: Maybe TarIndex -> Maybe ModSigIndex, + rendModules :: Maybe TarIndex -> [(LibraryName, ModSigIndex)], rendHasTarball :: Bool, rendChangeLog :: Maybe (FilePath, ETag, TarEntryOffset, FilePath), rendReadme :: Maybe (FilePath, ETag, TarEntryOffset, FilePath), @@ -95,14 +97,13 @@ data PackageRender = PackageRender { doPackageRender :: Users.Users -> PkgInfo -> PackageRender doPackageRender users info = PackageRender - { rendPkgId = pkgInfoId info + { rendPkgId = packageId' , rendDepends = flatDependencies genDesc + , rendLibName = renderLibName , rendExecNames = map (unUnqualComponentName . exeName) (executables flatDesc) - , rendLibraryDeps = depTree libBuildInfo `fmap` condLibrary genDesc , rendExecutableDeps = (unUnqualComponentName *** depTree buildInfo) `map` condExecutables genDesc - , rendSublibraryDeps = (unUnqualComponentName *** depTree libBuildInfo) - `map` condSubLibraries genDesc + , rendLibraryDeps = second (depTree libBuildInfo) <$> allCondLibs genDesc , rendLicenseName = prettyShow (license desc) -- maybe make this a bit more human-readable , rendLicenseFiles = map getSymbolicPath $ licenseFiles desc , rendMaintainer = case fromShortText $ maintainer desc of @@ -144,17 +145,15 @@ doPackageRender users info = PackageRender then Buildable else NotBuildable - renderModules docindex - | Just lib <- library flatDesc - = let mod_ix = mkForest $ exposedModules lib + renderModules :: Maybe TarIndex -> [(LibraryName, ModSigIndex)] + renderModules docindex = flip fmap (allLibraries flatDesc) $ \lib -> + let mod_ix = mkForest $ exposedModules lib -- Assumes that there is an HTML per reexport ++ map moduleReexportName (reexportedModules lib) ++ virtualModules (libBuildInfo lib) - sig_ix = mkForest $ signatures lib - mkForest = moduleForest . map (\m -> (m, moduleHasDocs docindex m)) - in Just (ModSigIndex { modIndex = mod_ix, sigIndex = sig_ix }) - | otherwise - = Nothing + sig_ix = mkForest $ signatures lib + mkForest = moduleForest . map (\m -> (m, moduleHasDocs docindex m)) + in (libName lib, ModSigIndex { modIndex = mod_ix, sigIndex = sig_ix }) moduleHasDocs :: Maybe TarIndex -> ModuleName -> Bool moduleHasDocs Nothing = const False @@ -172,6 +171,21 @@ doPackageRender users info = PackageRender loc <- repoLocation r return (ty, loc, r) + packageId' :: PackageIdentifier + packageId' = pkgInfoId info + + packageName' :: String + packageName' = unPackageName $ pkgName packageId' + + renderLibName :: LibraryName -> String + renderLibName LMainLibName = packageName' + renderLibName (LSubLibName name) = + packageName' ++ ":" ++ unUnqualComponentName name + +allCondLibs :: GenericPackageDescription -> [(LibraryName, CondTree ConfVar [Dependency] Library)] +allCondLibs desc = maybeToList ((LMainLibName,) <$> condLibrary desc) + ++ (first LSubLibName <$> condSubLibraries desc) + type DependencyTree = CondTree ConfVar [Dependency] IsBuildable data IsBuildable = Buildable diff --git a/src/Distribution/Server/Pages/Package.hs b/src/Distribution/Server/Pages/Package.hs index 5813355e..f490a906 100644 --- a/src/Distribution/Server/Pages/Package.hs +++ b/src/Distribution/Server/Pages/Package.hs @@ -34,9 +34,10 @@ import Distribution.Utils.ShortText (fromShortText, ShortText) import Text.XHtml.Strict hiding (p, name, title, content) import qualified Text.XHtml.Strict -import Data.Maybe (fromMaybe, maybeToList, isJust, mapMaybe, catMaybes) +import Data.Bool (bool) +import Data.Maybe (fromMaybe, isJust, mapMaybe, catMaybes) import Data.List (intersperse, intercalate, partition) -import Control.Arrow (second) +import Control.Arrow (second, Arrow (..)) import System.FilePath.Posix ((), (<.>)) import qualified Documentation.Haddock.Markup as Haddock @@ -152,15 +153,19 @@ renderPackageFlags render docURL = whenNotNull xs a = if null xs then [] else a moduleSection :: PackageRender -> Maybe TarIndex -> URL -> Maybe PackageId -> Bool -> [Html] -moduleSection render mdocIndex docURL mPkgId quickNav = - maybeToList $ fmap msect (rendModules render mdocIndex) - where msect ModSigIndex{ modIndex = m, sigIndex = s } = toHtml $ +moduleSection render mdocIndex docURL mPkgId quickNav = case renderedModules of + [(LMainLibName, mods)] -> [msect mods] + renderedLibs -> concatMap renderNamedLib renderedLibs + + where msect (ModSigIndex{ modIndex = m, sigIndex = s }) = + let heading = bool h3 h2 containsSubLibraries in + toHtml $ (if not (null s) - then [ h2 << "Signatures" + then [ heading << "Signatures" , renderModuleForest docURL s ] else []) ++ (if not (null m) - then [ h2 << "Modules"] ++ + then [ heading << "Modules"] ++ [renderDocIndexLink] ++ [renderModuleForest docURL m ] else []) @@ -184,6 +189,18 @@ moduleSection render mdocIndex docURL mPkgId quickNav = concatLinks [h] = Just h concatLinks (h:hs) = (h +++) . ("] [" +++) <$> concatLinks hs + renderNamedLib :: (LibraryName, ModSigIndex) -> [Html] + renderNamedLib (name, mods) = + [ h2 << ("library " ++ rendLibName render name) + , thediv ! [theclass "lib-contents"] << msect mods + ] + + containsSubLibraries :: Bool + containsSubLibraries = map fst renderedModules == [LMainLibName] + + renderedModules :: [(LibraryName, ModSigIndex)] + renderedModules = rendModules render mdocIndex + tabulate :: [(String, Html)] -> Html tabulate items = table ! [theclass "properties"] << [tr << [th << t, td << d] | (t, d) <- items] @@ -223,11 +240,8 @@ renderDetailedDependencies pkgRender = tabulate $ map (second (fromMaybe noDeps . render)) targets where targets :: [(String, DependencyTree)] - targets = maybeToList library - ++ rendSublibraryDeps pkgRender + targets = (first (rendLibName pkgRender) <$> rendLibraryDeps pkgRender) ++ rendExecutableDeps pkgRender - where - library = (\lib -> ("library", lib)) `fmap` rendLibraryDeps pkgRender noDeps = list [toHtml "No dependencies"]