diff --git a/src/core/Flora/Model/Package/Types.hs b/src/core/Flora/Model/Package/Types.hs index a132e906..3d9ecb21 100644 --- a/src/core/Flora/Model/Package/Types.hs +++ b/src/core/Flora/Model/Package/Types.hs @@ -152,6 +152,10 @@ parseNamespace txt = then Just $ Namespace txt else Nothing +extractNamespaceText :: Namespace -> Text +extractNamespaceText (Namespace text) = + fromMaybe text (Text.stripPrefix "@" text) + instance ToSchema Namespace where declareNamedSchema proxy = genericDeclareNamedSchema openApiSchemaOptions proxy diff --git a/src/core/Flora/Model/PackageIndex/Update.hs b/src/core/Flora/Model/PackageIndex/Update.hs index 65244040..bd188c7e 100644 --- a/src/core/Flora/Model/PackageIndex/Update.hs +++ b/src/core/Flora/Model/PackageIndex/Update.hs @@ -16,7 +16,9 @@ import Effectful import Effectful.PostgreSQL.Transact.Effect (DB, dbtToEff) import Flora.Model.PackageIndex.Types - ( PackageIndex, mkPackageIndex ) + ( PackageIndex + , mkPackageIndex + ) updatePackageIndexByName :: DB :> es => Text -> Maybe UTCTime -> Eff es () updatePackageIndexByName repositoryName newTimestamp = do diff --git a/src/web/FloraWeb/Common/Guards.hs b/src/web/FloraWeb/Common/Guards.hs index b24c0f26..5ca15720 100644 --- a/src/web/FloraWeb/Common/Guards.hs +++ b/src/web/FloraWeb/Common/Guards.hs @@ -7,10 +7,10 @@ import Effectful import Effectful.Log (Log) import Effectful.PostgreSQL.Transact.Effect import Effectful.Time (Time) -import Flora.Model.PackageIndex.Query as Query -import Flora.Model.PackageIndex.Types ( PackageIndex ) import Flora.Model.Package import Flora.Model.Package.Query qualified as Query +import Flora.Model.PackageIndex.Query as Query +import Flora.Model.PackageIndex.Types (PackageIndex) import Flora.Model.Release.Query qualified as Query import Flora.Model.Release.Types (Release) @@ -45,12 +45,12 @@ guardThatReleaseExists packageId version action = do guardThatPackageIndexExists :: DB :> es - => PackageName - -> (PackageName -> Eff es PackageIndex) + => Namespace + -> (Namespace -> Eff es PackageIndex) -- ^ Action to run if the package index does not exist -> Eff es PackageIndex -guardThatPackageIndexExists packageName action = do - result <- Query.getPackageIndexByName (extractPackageNameText packageName) +guardThatPackageIndexExists namespace action = do + result <- Query.getPackageIndexByName (extractNamespaceText namespace) case result of Just packageIndex -> pure packageIndex - Nothing -> action packageName + Nothing -> action namespace diff --git a/src/web/FloraWeb/Pages/Server/Packages.hs b/src/web/FloraWeb/Pages/Server/Packages.hs index 1f516484..259d436c 100644 --- a/src/web/FloraWeb/Pages/Server/Packages.hs +++ b/src/web/FloraWeb/Pages/Server/Packages.hs @@ -30,9 +30,9 @@ import Flora.Logging import Flora.Model.BlobIndex.Query qualified as Query import Flora.Model.Package import Flora.Model.Package.Query qualified as Query +import Flora.Model.PackageIndex.Types (PackageIndex (..)) import Flora.Model.Release.Query qualified as Query import Flora.Model.Release.Types -import Flora.Model.PackageIndex.Types (PackageIndex (..)) import Flora.Search qualified as Search import FloraWeb.Common.Auth import FloraWeb.Common.Guards @@ -91,7 +91,7 @@ showPackageVersion namespace packageName mversion = do session <- getSession templateEnv' <- fromSession session defaultTemplateEnv package <- guardThatPackageExists namespace packageName (\_ _ -> web404) - packageIndex <- guardThatPackageIndexExists packageName $ const web404 + packageIndex <- guardThatPackageIndexExists namespace $ const web404 releases <- Query.getReleases package.packageId let latestRelease = releases diff --git a/src/web/FloraWeb/Pages/Templates/Packages.hs b/src/web/FloraWeb/Pages/Templates/Packages.hs index 6028b806..b170f273 100644 --- a/src/web/FloraWeb/Pages/Templates/Packages.hs +++ b/src/web/FloraWeb/Pages/Templates/Packages.hs @@ -1,21 +1,21 @@ module FloraWeb.Pages.Templates.Packages where +import Control.Monad (when) import Control.Monad.Extra (whenJust) import Control.Monad.Reader (ask) -import Control.Monad (when) -import Data.Foldable ( fold, forM_ ) +import Data.Foldable (fold, forM_) import Data.List qualified as List import Data.Map.Strict qualified as Map -import Data.Maybe ( fromJust, fromMaybe, isJust ) +import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Positive -import Data.Text.Display -import Data.Text qualified as Text import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.Display import Data.Time (defaultTimeLocale) import Data.Time qualified as Time -import Data.Vector.Algorithms.Intro qualified as MVector -import Data.Vector qualified as Vector import Data.Vector (Vector) +import Data.Vector qualified as Vector +import Data.Vector.Algorithms.Intro qualified as MVector import Distribution.Orphans () import Distribution.Pretty (pretty) import Distribution.SPDX.License qualified as SPDX @@ -72,7 +72,8 @@ presentationHeaderForSubpage namespace packageName release target numberOfPackag p_ [class_ "synopsis"] $ span_ [class_ "version"] $ toHtml $ - display numberOfPackages <> " results" + display numberOfPackages + <> " results" presentationHeaderForVersions :: Namespace @@ -90,7 +91,8 @@ presentationHeaderForVersions namespace packageName numberOfReleases = div_ [cla p_ [class_ "synopsis"] $ span_ [class_ "version"] $ toHtml $ - display numberOfReleases <> " results" + display numberOfReleases + <> " results" showDependents :: Namespace @@ -147,15 +149,19 @@ versionListItem namespace packageName release = do Just ts -> span_ [class_ "package-list-item__synopsis"] (toHtml $ Time.formatTime defaultTimeLocale "%a, %_d %b %Y" ts) li_ [class_ "package-list-item"] $ - a_ [href, class_ ""] $ do - h4_ [class_ "package-list-item__name"] $ - strong_ [class_ ""] . toHtml $ - "v" <> toHtml release.version - uploadedAt - div_ [class_ "package-list-item__metadata"] $ - span_ [class_ "package-list-item__license"] $ do - licenseIcon - toHtml release.license + a_ [href, class_ ""] $ + do + h4_ [class_ "package-list-item__name"] + $ strong_ [class_ ""] + . toHtml + $ "v" + <> toHtml release.version + uploadedAt + div_ [class_ "package-list-item__metadata"] $ + span_ [class_ "package-list-item__license"] $ + do + licenseIcon + toHtml release.license -- | Render a list of package informations packageListing @@ -167,8 +173,9 @@ packageListing packageListing mExactMatchItems packages = ul_ [class_ "package-list"] $ do whenJust mExactMatchItems $ \exactMatchItems -> - forM_ exactMatchItems $ \em -> div_ [class_ "exact-match"] $ - packageListItem (em.namespace, em.name, em.synopsis, em.version, em.license) + forM_ exactMatchItems $ \em -> + div_ [class_ "exact-match"] $ + packageListItem (em.namespace, em.name, em.synopsis, em.version, em.license) Vector.forM_ packages ( \PackageInfo{..} -> packageListItem (namespace, name, synopsis, version, license) @@ -181,10 +188,11 @@ requirementListing requirements = showChangelog :: Namespace -> PackageName -> Version -> Maybe TextHtml -> FloraHTML showChangelog namespace packageName version mChangelog = div_ [class_ "container"] $ div_ [class_ "divider"] $ do div_ [class_ "page-title"] $ - h1_ [class_ ""] $ do - span_ [class_ "headline"] $ toHtml ("Changelog of " <> display namespace <> "/" <> display packageName) - toHtmlRaw @Text " " - span_ [class_ "version"] $ toHtml $ display version + h1_ [class_ ""] $ + do + span_ [class_ "headline"] $ toHtml ("Changelog of " <> display namespace <> "/" <> display packageName) + toHtmlRaw @Text " " + span_ [class_ "version"] $ toHtml $ display version section_ [class_ "release-changelog"] $ do case mChangelog of Nothing -> toHtml @Text "This release does not have a Changelog" @@ -239,7 +247,7 @@ displayLinks namespace packageName packageIndexURL release = h3_ [class_ "package-body-section links"] "Links" ul_ [class_ "links"] $ do li_ [class_ "package-link"] $ a_ [href_ (getHomepage release)] "Homepage" - li_ [class_ "package-link"] $ a_ [href_ (packageIndexURL <> "/" <> display packageName <> "-" <> display release.version)] "Documentation" + li_ [class_ "package-link"] $ a_ [href_ (packageIndexURL <> "/package/" <> display packageName <> "-" <> display release.version)] "Documentation" li_ [class_ "package-link"] $ displaySourceRepos release.sourceRepos li_ [class_ "package-link"] $ displayChangelog namespace packageName release.version release.changelog @@ -285,12 +293,13 @@ displayVersions namespace packageName versions numberOfReleases = toHtml $ Time.formatTime defaultTimeLocale "%a, %_d %b %Y" ts case release.revisedAt of Nothing -> span_ [] "" - Just revisionDate -> span_ - [ dataText_ - ("Revised on " <> display (Time.formatTime defaultTimeLocale "%a, %_d %b %Y, %R %EZ" revisionDate)) - , class_ "revised-date" - ] - pen + Just revisionDate -> + span_ + [ dataText_ + ("Revised on " <> display (Time.formatTime defaultTimeLocale "%a, %_d %b %Y, %R %EZ" revisionDate)) + , class_ "revised-date" + ] + pen displayDependencies :: (Namespace, PackageName, Version) @@ -348,11 +357,12 @@ displayPackageDeprecation (PackageAlternatives inFavourOf) = else do label_ [for_ "install-string", class_ "font-light"] "This package has been deprecated in favour of" ul_ [class_ "package-alternatives"] $ - Vector.forM_ inFavourOf $ \PackageAlternative{namespace, package} -> - li_ [] $ - a_ - [href_ ("/packages/" <> display namespace <> "/" <> display package)] - (text $ display namespace <> "/" <> display package) + Vector.forM_ inFavourOf $ + \PackageAlternative{namespace, package} -> + li_ [] $ + a_ + [href_ ("/packages/" <> display namespace <> "/" <> display package)] + (text $ display namespace <> "/" <> display package) displayReleaseDeprecation :: Maybe (Namespace, PackageName, Version) -> FloraHTML displayReleaseDeprecation mLatestViableRelease = @@ -477,8 +487,9 @@ intercalateVec sep vector = formatInstallString :: PackageName -> Release -> Text formatInstallString packageName Release{version} = - Text.pack . render $ - hcat [pretty packageName, PP.space, rangedVersion, ","] + Text.pack + . render + $ hcat [pretty packageName, PP.space, rangedVersion, ","] where rangedVersion :: Doc rangedVersion = "^>=" <> majMin