From aedee1de9ea4f4c14b9a97a9bdd76737036f57d9 Mon Sep 17 00:00:00 2001 From: Joseph Price Date: Sun, 4 Oct 2020 15:01:57 -0400 Subject: [PATCH 1/2] add a link to definition package in results --- src/Handler/Search.hs | 68 +++++++++++++++++++++++++------------------ 1 file changed, 40 insertions(+), 28 deletions(-) diff --git a/src/Handler/Search.hs b/src/Handler/Search.hs index 76ba7a4..afe94ab 100644 --- a/src/Handler/Search.hs +++ b/src/Handler/Search.hs @@ -208,35 +208,44 @@ searchResultToJSON result@SearchResult{..} = do SourcePackage pn v -> (Bower.runPackageName pn, v) +moduleRoute :: SearchResult -> Text -> Route App +moduleRoute SearchResult{..} = + case srSource of + SourceBuiltin -> + BuiltinDocsR + SourcePackage pkgName version -> + PackageVersionModuleDocsR + (PathPackageName pkgName) + (PathVersion version) + +routeToModule :: SearchResult -> Text -> (Route App, Maybe Text) +routeToModule result modName = + ( moduleRoute result modName + , Nothing + ) + +routeToPackage :: SearchResult -> (Route App, Maybe a) +routeToPackage SearchResult{..} = + ( case srSource of + SourcePackage pkgName _ -> + PackageR (PathPackageName pkgName) + SourceBuiltin -> + -- this shouldn't happen + HomeR + , Nothing + ) + routeResult :: SearchResult -> (Route App, Maybe Text) -routeResult SearchResult{..} = +routeResult result@SearchResult{..} = case srInfo of PackageResult _ -> - ( case srSource of - SourcePackage pkgName _ -> - PackageR (PathPackageName pkgName) - SourceBuiltin -> - -- this shouldn't happen - HomeR - , Nothing - ) + routeToPackage result ModuleResult modName -> - ( moduleRoute modName - , Nothing - ) + routeToModule result modName DeclarationResult ns modName declTitle _ -> - ( moduleRoute modName + ( moduleRoute result modName , Just $ drop 1 $ makeFragment ns declTitle ) - where - moduleRoute = - case srSource of - SourceBuiltin -> - BuiltinDocsR - SourcePackage pkgName version -> - PackageVersionModuleDocsR - (PathPackageName pkgName) - (PathVersion version) -- | Like Prelude.take, except also returns a Bool indicating whether the -- original list has any additional elements after the returned prefix. @@ -314,15 +323,18 @@ searchResultHtml fr r = $of PackageResult _ $of ModuleResult _ - P - #{pkgName} + + P + #{pkgName} $of DeclarationResult _ moduleName _ _ - P - #{pkgName} + + P + #{pkgName} - M - #{moduleName} + + M + #{moduleName} |] where pkgName = From 45aa639794b1d3862039393b8c8513680775d0fb Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 6 Jul 2026 09:07:07 -0400 Subject: [PATCH 2/2] Only link the package badge when a package page exists Builtin modules such as Prim appear in search results but have no package page; the routeToPackage helper from #424 sent their package badge to the home page. Render the badge as plain text when the result has no package, reuse packageNameRoute from Foundation, and share the badge markup between the module and declaration result arms. --- CHANGELOG.md | 4 +++ src/Handler/Search.hs | 60 ++++++++++++++++++++++++------------------- 2 files changed, 37 insertions(+), 27 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3570528..d059d56 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ the most up-to-date version of this file. ## Unreleased +- The package and module badges on search results are now links to the + package page and module docs page (#424, @joprice). Builtin modules such + as Prim have no package page, so their package badge remains plain text. + ## v0.9.11 - Serialise decoding of large package files (@thomashoneyman) diff --git a/src/Handler/Search.hs b/src/Handler/Search.hs index afe94ab..a2332f6 100644 --- a/src/Handler/Search.hs +++ b/src/Handler/Search.hs @@ -218,30 +218,28 @@ moduleRoute SearchResult{..} = (PathPackageName pkgName) (PathVersion version) -routeToModule :: SearchResult -> Text -> (Route App, Maybe Text) -routeToModule result modName = - ( moduleRoute result modName - , Nothing - ) - -routeToPackage :: SearchResult -> (Route App, Maybe a) -routeToPackage SearchResult{..} = - ( case srSource of - SourcePackage pkgName _ -> - PackageR (PathPackageName pkgName) - SourceBuiltin -> - -- this shouldn't happen - HomeR - , Nothing - ) +-- | The package a result belongs to, if any; builtin modules such as Prim +-- have no package page. +resultPackageRoute :: SearchResult -> Maybe (Route App) +resultPackageRoute SearchResult{..} = + case srSource of + SourcePackage pkgName _ -> + Just (packageNameRoute pkgName) + SourceBuiltin -> + Nothing routeResult :: SearchResult -> (Route App, Maybe Text) routeResult result@SearchResult{..} = case srInfo of PackageResult _ -> - routeToPackage result + -- packages are never builtin, so the fallback is unreachable + ( fromMaybe HomeR (resultPackageRoute result) + , Nothing + ) ModuleResult modName -> - routeToModule result modName + ( moduleRoute result modName + , Nothing + ) DeclarationResult ns modName declTitle _ -> ( moduleRoute result modName , Just $ drop 1 $ makeFragment ns declTitle @@ -322,21 +320,29 @@ searchResultHtml fr r = $case srInfo r $of PackageResult _ $of ModuleResult _ - - - P - #{pkgName} + ^{packageBadge} $of DeclarationResult _ moduleName _ _ + ^{packageBadge} - - P - #{pkgName} - - + M #{moduleName} |] where + packageBadge = + [shamlet| + + $maybe route <- resultPackageRoute r + + ^{packageBadgeContent} + $nothing + ^{packageBadgeContent} + |] + packageBadgeContent = + [shamlet| + P + #{pkgName} + |] pkgName = case srSource r of SourceBuiltin ->