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 76ba7a4..a2332f6 100644 --- a/src/Handler/Search.hs +++ b/src/Handler/Search.hs @@ -208,35 +208,42 @@ 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) + +-- | 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 SearchResult{..} = +routeResult result@SearchResult{..} = case srInfo of PackageResult _ -> - ( case srSource of - SourcePackage pkgName _ -> - PackageR (PathPackageName pkgName) - SourceBuiltin -> - -- this shouldn't happen - HomeR + -- packages are never builtin, so the fallback is unreachable + ( fromMaybe HomeR (resultPackageRoute result) , Nothing ) ModuleResult modName -> - ( moduleRoute modName + ( moduleRoute result modName , Nothing ) 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. @@ -313,18 +320,29 @@ searchResultHtml fr r = $case srInfo r $of PackageResult _ $of ModuleResult _ - - P - #{pkgName} + ^{packageBadge} $of DeclarationResult _ moduleName _ _ + ^{packageBadge} - P - #{pkgName} - - M - #{moduleName} + + M + #{moduleName} |] where + packageBadge = + [shamlet| + + $maybe route <- resultPackageRoute r + + ^{packageBadgeContent} + $nothing + ^{packageBadgeContent} + |] + packageBadgeContent = + [shamlet| + P + #{pkgName} + |] pkgName = case srSource r of SourceBuiltin ->