Merge pull request #1280 from 414owen/os/revamp-detailed-deps-page

feat: Specify component types in detailed deps page
haskell · Sep 8, 2024 · 4796040 · 4796040
2 parents 88b384a + fc4ec43
commit 4796040
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 15 deletions.
diff --git a/src/Distribution/Server/Features/Html.hs b/src/Distribution/Server/Features/Html.hs
@@ -1461,7 +1461,7 @@ mkHtmlCandidates ServerEnv{..} utilities@HtmlUtilities{..}
 dependenciesPage :: Bool -> PackageRender -> URL -> Resource.XHtml
 dependenciesPage isCandidate render docURL =
     Resource.XHtml $ hackagePage (pkg ++ ": dependencies") $
-      [h2 << heading, Pages.renderDetailedDependencies render]
+      [h1 << heading, Pages.renderDetailedDependencies render]
        ++ Pages.renderPackageFlags render docURL
   where
     pkg = display $ rendPkgId render

diff --git a/src/Distribution/Server/Packages/Render.hs b/src/Distribution/Server/Packages/Render.hs
@@ -67,10 +67,11 @@ data ModSigIndex = ModSigIndex {
 data PackageRender = PackageRender {
     rendPkgId        :: PackageIdentifier,
     rendLibName      :: LibraryName -> String,
+    rendComponentName :: ComponentName -> String,
     rendDepends      :: [Dependency],
     rendExecNames    :: [String],
     rendLibraryDeps  :: [(LibraryName, DependencyTree)],
-    rendExecutableDeps :: [(String, DependencyTree)],
+    rendExecutableDeps :: [(ComponentName, DependencyTree)],
     rendLicenseName  :: String,
     rendLicenseFiles :: [FilePath],
     rendMaintainer   :: Maybe String,
@@ -100,8 +101,9 @@ doPackageRender users info = PackageRender
     { rendPkgId        = packageId'
     , rendDepends      = flatDependencies genDesc
     , rendLibName      = renderLibName
+    , rendComponentName = renderComponentName
     , rendExecNames    = map (unUnqualComponentName . exeName) (executables flatDesc)
-    , rendExecutableDeps = (unUnqualComponentName *** depTree buildInfo)
+    , rendExecutableDeps = (CExeName *** depTree buildInfo)
                                 `map` condExecutables genDesc
     , rendLibraryDeps = second (depTree libBuildInfo) <$> allCondLibs genDesc
     , rendLicenseName  = prettyShow (license desc) -- maybe make this a bit more human-readable
@@ -182,6 +184,10 @@ doPackageRender users info = PackageRender
     renderLibName (LSubLibName name) =
       packageName' ++ ":" ++ unUnqualComponentName name
 
+    renderComponentName :: ComponentName -> String
+    renderComponentName (CLibName name) = renderLibName name
+    renderComponentName name@(CNotLibName _) = componentNameRaw name
+
 allCondLibs :: GenericPackageDescription -> [(LibraryName, CondTree ConfVar [Dependency] Library)]
 allCondLibs desc = maybeToList ((LMainLibName,) <$> condLibrary desc)
   ++ (first LSubLibName <$> condSubLibraries desc)

diff --git a/src/Distribution/Server/Pages/Package.hs b/src/Distribution/Server/Pages/Package.hs
@@ -37,7 +37,7 @@ import qualified Text.XHtml.Strict
 import Data.Bool (bool)
 import Data.Maybe               (fromMaybe, isJust, mapMaybe, catMaybes)
 import Data.List                (intersperse, intercalate, partition)
-import Control.Arrow            (second, Arrow (..))
+import Control.Arrow            (Arrow (..))
 import System.FilePath.Posix    ((</>), (<.>))
 
 import qualified Documentation.Haddock.Markup as Haddock
@@ -201,11 +201,6 @@ moduleSection render mdocIndex docURL mPkgId quickNav = case renderedModules of
         renderedModules :: [(LibraryName, ModSigIndex)]
         renderedModules = rendModules render mdocIndex
 
-tabulate :: [(String, Html)] -> Html
-tabulate items = table ! [theclass "properties"] <<
-        [tr << [th << t, td << d] | (t, d) <- items]
-
-
 renderDependencies :: PackageRender -> (String, Html)
 renderDependencies render =
     ("Dependencies", summary +++ detailsLink)
@@ -236,12 +231,23 @@ nonbreakingSpan :: Html -> Html
 nonbreakingSpan str = thespan ! [thestyle "white-space: nowrap"] << str
 
 renderDetailedDependencies :: PackageRender -> Html
-renderDetailedDependencies pkgRender =
-    tabulate $ map (second (fromMaybe noDeps . render)) targets
+renderDetailedDependencies pkgRender
+  = mconcat (mapMaybe renderComponentType componentsByType)
+
   where
-    targets :: [(String, DependencyTree)]
-    targets = (first (rendLibName pkgRender) <$> rendLibraryDeps pkgRender)
-        ++ rendExecutableDeps pkgRender
+    componentsByType :: [(String, [(ComponentName, DependencyTree)])]
+    componentsByType =
+      [ ("Libraries", first CLibName <$> rendLibraryDeps pkgRender)
+      , ("Executables", rendExecutableDeps pkgRender)
+      ]
+
+    renderComponentType :: (String, [(ComponentName, DependencyTree)]) -> Maybe Html
+    renderComponentType (_, []) = Nothing
+    renderComponentType (componentType, items) = Just $ mconcat
+      [ h2 << componentType
+      , flip foldMap items $ \(componentName, deptree) ->
+        h3 << rendComponentName pkgRender componentName +++ fromMaybe noDeps (render deptree)
+      ]
 
     noDeps = list [toHtml "No dependencies"]
 
@@ -257,7 +263,7 @@ renderDetailedDependencies pkgRender =
                       NotBuildable -> [strong << "buildable:" +++ " False"]
 
     list :: [Html] -> Html
-    list items = thediv ! [identifier "detailed-dependencies"] << unordList items
+    list items = unordList items ! [identifier "detailed-dependencies"]
 
     renderComponent :: CondBranch ConfVar [Dependency] IsBuildable
                     -> Maybe Html