From 7da69272476c8f1186c5aff8f32f7c76a04f3b9d Mon Sep 17 00:00:00 2001 From: Yvan Sraka Date: Thu, 20 Apr 2023 15:25:00 +0200 Subject: [PATCH 01/12] Fix #18: add support for deprecated-versions Co-authored-by: Andrea Bedini --- app/Foliage/CmdBuild.hs | 57 ++++++++++++++--- app/Foliage/Meta.hs | 25 +++++++- app/Foliage/Meta/Aeson.hs | 2 + app/Foliage/Pages.hs | 15 +++-- app/Foliage/PreparePackageVersion.hs | 91 +++++++++++++++++++++------ templates/allPackageVersions.mustache | 6 +- templates/packageVersion.mustache | 6 +- 7 files changed, 168 insertions(+), 34 deletions(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 067895a..9543a83 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedStrings #-} module Foliage.CmdBuild (cmdBuild) where @@ -8,16 +9,20 @@ import Codec.Archive.Tar.Entry qualified as Tar import Codec.Compression.GZip qualified as GZip import Control.Monad (unless, void, when) import Data.Aeson qualified as Aeson -import Data.ByteString qualified as BS -import Data.ByteString.Lazy qualified as BL +import Data.Bifunctor (second) +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Lazy.Char8 qualified as BL import Data.List (sortOn) +import Data.List.NonEmpty qualified as NE import Data.Maybe (fromMaybe) import Data.Text qualified as T +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Traversable (for) import Development.Shake import Development.Shake.FilePath import Distribution.Package import Distribution.Pretty (prettyShow) +import Distribution.Version import Foliage.HackageSecurity hiding (ToJSON, toJSON) import Foliage.Meta import Foliage.Meta.Aeson () @@ -35,7 +40,7 @@ import System.Directory (createDirectoryIfMissing) cmdBuild :: BuildOptions -> IO () cmdBuild buildOptions = do - outputDirRoot <- liftIO $ makeAbsolute (fromFilePath (buildOptsOutputDir buildOptions)) + outputDirRoot <- makeAbsolute (fromFilePath (buildOptsOutputDir buildOptions)) shake opts $ do addFetchRemoteAssetRule cacheDir @@ -72,7 +77,7 @@ buildAction liftIO $ createKeys keysPath return $ \name -> readKeysAt (keysPath name) SignOptsDon'tSign -> - return $ const $ return [] + return $ const $ pure [] expiryTime <- for mExpireSignaturesOn $ \expireSignaturesOn -> do @@ -101,9 +106,10 @@ buildAction void $ forP packageVersions $ makePackageVersionPage outputDir - void $ forP packageVersions $ \PreparedPackageVersion {pkgId, cabalFilePath} -> do - let PackageIdentifier {pkgName, pkgVersion} = pkgId - copyFileChanged cabalFilePath (outputDir "index" prettyShow pkgName prettyShow pkgVersion prettyShow pkgName <.> "cabal") + void $ + forP packageVersions $ \PreparedPackageVersion {pkgId, cabalFilePath} -> do + let PackageIdentifier {pkgName, pkgVersion} = pkgId + copyFileChanged cabalFilePath (outputDir "index" prettyShow pkgName prettyShow pkgVersion prettyShow pkgName <.> "cabal") cabalEntries <- foldMap @@ -133,7 +139,9 @@ buildAction (IndexPkgMetadata pkgId) (fromMaybe currentTime pkgTimestamp) - let tarContents = Tar.write $ sortOn Tar.entryTime (cabalEntries ++ metadataEntries) + let extraEntries = getExtraEntries packageVersions + + let tarContents = Tar.write $ sortOn Tar.entryTime (cabalEntries ++ metadataEntries ++ extraEntries) traced "Writing index" $ do BL.writeFile (anchorPath outputDirRoot repoLayoutIndexTar) tarContents BL.writeFile (anchorPath outputDirRoot repoLayoutIndexTarGz) $ GZip.compress tarContents @@ -290,6 +298,39 @@ prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = d targetsDelegations = Nothing } +-- Currently `extraEntries` are only used for encoding `prefered-versions`. +getExtraEntries :: [PreparedPackageVersion] -> [Tar.Entry] +getExtraEntries packageVersions = + let groupedPackageVersions = NE.groupWith (pkgName . pkgId) packageVersions + generateEntriesForGroup packageGroup = map createTarEntry effectiveRanges + where + -- Get the package name of the current group. + pn = pkgName $ pkgId $ NE.head packageGroup + -- Collect and sort the deprecation changes for the package group. + deprecationChanges = sortOn fst $ foldMap versionDeprecationChanges packageGroup + -- Calculate (by applying them chronologically) the effective `VersionRange` for the package group. + effectiveRanges = NE.tail $ NE.scanl applyChangeToRange (posixSecondsToUTCTime 0, anyVersion) deprecationChanges + -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp. + createTarEntry (ts, effectiveRange) = mkTarEntry (BL.pack $ show effectiveRange) (IndexPkgPrefs pn) ts + in foldMap generateEntriesForGroup groupedPackageVersions + +-- Extract deprecation changes for a given `PreparedPackageVersion`. +versionDeprecationChanges :: PreparedPackageVersion -> [(UTCTime, VersionRange -> VersionRange)] +versionDeprecationChanges PreparedPackageVersion {pkgId = PackageIdentifier {pkgVersion}, pkgVersionDeprecationChanges} = map (second $ applyDeprecation pkgVersion) pkgVersionDeprecationChanges + +-- Apply a given change (`VersionRange -> VersionRange`) to a `VersionRange` and +-- return the simplified the result with a new timestamp. +applyChangeToRange :: (UTCTime, VersionRange) -> (UTCTime, VersionRange -> VersionRange) -> (UTCTime, VersionRange) +applyChangeToRange (_, range) (ts, change) = (ts, simplifyVersionRange $ change range) + +-- Exclude (or include) to the `VersionRange` of prefered versions, a given +-- `Version`, if the `Version` is (or not) tagged as "deprecated". +applyDeprecation :: Version -> Bool -> VersionRange -> VersionRange +applyDeprecation pkgVersion deprecated = + if deprecated + then intersectVersionRanges (notThisVersion pkgVersion) + else unionVersionRanges (thisVersion pkgVersion) + mkTarEntry :: BL.ByteString -> IndexFile dec -> UTCTime -> Tar.Entry mkTarEntry contents indexFile timestamp = (Tar.fileEntry tarPath contents) diff --git a/app/Foliage/Meta.hs b/app/Foliage/Meta.hs index 7130367..6cd01ad 100644 --- a/app/Foliage/Meta.hs +++ b/app/Foliage/Meta.hs @@ -16,6 +16,7 @@ module Foliage.Meta packageVersionTimestamp, packageVersionSource, packageVersionRevisions, + packageVersionDeprecations, packageVersionForce, PackageVersionSpec (PackageVersionSpec), readPackageVersionSpec, @@ -23,6 +24,9 @@ module Foliage.Meta RevisionSpec (RevisionSpec), revisionTimestamp, revisionNumber, + DeprecationSpec (DeprecationSpec), + deprecationTimestamp, + deprecationIsDeprecated, PackageVersionSource, pattern TarballSource, pattern GitHubSource, @@ -174,6 +178,8 @@ data PackageVersionSpec = PackageVersionSpec packageVersionSource :: PackageVersionSource, -- | revisions packageVersionRevisions :: [RevisionSpec], + -- | deprecations + packageVersionDeprecations :: [DeprecationSpec], -- | force version packageVersionForce :: Bool } @@ -189,6 +195,8 @@ sourceMetaCodec = .= packageVersionSource <*> Toml.list revisionMetaCodec "revisions" .= packageVersionRevisions + <*> Toml.list deprecationMetaCodec "deprecation" + .= packageVersionDeprecations <*> withDefault False (Toml.bool "force-version") .= packageVersionForce @@ -202,7 +210,7 @@ data RevisionSpec = RevisionSpec { revisionTimestamp :: UTCTime, revisionNumber :: Int } - deriving (Show, Eq, Generic) + deriving (Show, Eq, Generic, Ord) deriving anyclass (Binary, Hashable, NFData) revisionMetaCodec :: TomlCodec RevisionSpec @@ -213,6 +221,21 @@ revisionMetaCodec = <*> Toml.int "number" .= revisionNumber +data DeprecationSpec = DeprecationSpec + { deprecationTimestamp :: UTCTime, + deprecationIsDeprecated :: Bool + } + deriving (Show, Eq, Generic, Ord) + deriving anyclass (Binary, Hashable, NFData) + +deprecationMetaCodec :: TomlCodec DeprecationSpec +deprecationMetaCodec = + DeprecationSpec + <$> timeCodec "timestamp" + .= deprecationTimestamp + <*> withDefault True (Toml.bool "deprecated") + .= deprecationIsDeprecated + timeCodec :: Toml.Key -> TomlCodec UTCTime timeCodec key = Toml.dimap (utcToZonedTime utc) zonedTimeToUTC $ Toml.zonedTime key diff --git a/app/Foliage/Meta/Aeson.hs b/app/Foliage/Meta/Aeson.hs index 339b39c..dfe0240 100644 --- a/app/Foliage/Meta/Aeson.hs +++ b/app/Foliage/Meta/Aeson.hs @@ -18,6 +18,8 @@ deriving via MyAesonEncoding PackageMetaEntry instance ToJSON PackageMetaEntry deriving via MyAesonEncoding RevisionSpec instance ToJSON RevisionSpec +deriving via MyAesonEncoding DeprecationSpec instance ToJSON DeprecationSpec + deriving via MyAesonEncoding PackageVersionSpec instance ToJSON PackageVersionSpec deriving via Text instance ToJSON GitHubRepo diff --git a/app/Foliage/Pages.hs b/app/Foliage/Pages.hs index 9df7777..35274df 100644 --- a/app/Foliage/Pages.hs +++ b/app/Foliage/Pages.hs @@ -95,7 +95,8 @@ data AllPackageVersionsPageEntry { allPackageVersionsPageEntryPkgId :: PackageIdentifier, allPackageVersionsPageEntryTimestamp :: UTCTime, allPackageVersionsPageEntryTimestampPosix :: POSIXTime, - allPackageVersionsPageEntrySource :: PackageVersionSource + allPackageVersionsPageEntrySource :: PackageVersionSource, + allPackageVersionsPageEntryDeprecated :: Bool } | AllPackageVersionsPageEntryRevision { allPackageVersionsPageEntryPkgId :: PackageIdentifier, @@ -116,13 +117,16 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = entries = -- collect all cabal file revisions including the original cabal file foldMap - ( \PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, cabalFileRevisions} -> + ( \PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, pkgVersionIsDeprecated, cabalFileRevisions} -> -- original cabal file AllPackageVersionsPageEntryPackage { allPackageVersionsPageEntryPkgId = pkgId, allPackageVersionsPageEntryTimestamp = fromMaybe currentTime pkgTimestamp, allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp), - allPackageVersionsPageEntrySource = pkgVersionSource + allPackageVersionsPageEntrySource = pkgVersionSource, + -- FIXME: this weirdly seems to not work (display a `Deprecated` badge on all package version page) ... + -- don't understand yet why! :/ + allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated } -- list of revisions : [ AllPackageVersionsPageEntryRevision @@ -138,7 +142,7 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = & sortOn (Down . allPackageVersionsPageEntryTimestamp) makePackageVersionPage :: FilePath -> PreparedPackageVersion -> Action () -makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, pkgDesc, cabalFileRevisions} = do +makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, pkgDesc, cabalFileRevisions, pkgVersionIsDeprecated} = do traced ("webpages / package / " ++ prettyShow pkgId) $ do IO.createDirectoryIfMissing True (outputDir "package" prettyShow pkgId) TL.writeFile (outputDir "package" prettyShow pkgId "index.html") $ @@ -147,7 +151,8 @@ makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pk [ "pkgVersionSource" .= pkgVersionSource, "cabalFileRevisions" .= map fst cabalFileRevisions, "pkgDesc" .= jsonGenericPackageDescription pkgDesc, - "pkgTimestamp" .= pkgTimestamp + "pkgTimestamp" .= pkgTimestamp, + "pkgVersionDeprecated" .= pkgVersionIsDeprecated ] indexPageTemplate :: Template diff --git a/app/Foliage/PreparePackageVersion.hs b/app/Foliage/PreparePackageVersion.hs index 854bdda..7fe5b6d 100644 --- a/app/Foliage/PreparePackageVersion.hs +++ b/app/Foliage/PreparePackageVersion.hs @@ -7,6 +7,8 @@ module Foliage.PreparePackageVersion pkgTimestamp, pkgVersionSource, pkgVersionForce, + pkgVersionIsDeprecated, + pkgVersionDeprecationChanges, pkgDesc, sdistPath, cabalFilePath, @@ -20,7 +22,8 @@ where import Control.Monad (unless) import Data.List (sortOn) -import Data.Ord (Down (Down)) +import Data.Maybe (listToMaybe) +import Data.Ord (Down (..)) import Development.Shake (Action) import Development.Shake.FilePath (joinPath, splitDirectories) import Distribution.Client.Compat.Prelude (fromMaybe, prettyShow) @@ -28,17 +31,21 @@ import Distribution.Parsec (simpleParsec) import Distribution.Types.GenericPackageDescription (GenericPackageDescription (packageDescription)) import Distribution.Types.PackageDescription (PackageDescription (package)) import Distribution.Types.PackageId -import Foliage.Meta (PackageVersionSource, PackageVersionSpec (..), RevisionSpec (..), UTCTime, latestRevisionNumber) +import Foliage.Meta (DeprecationSpec (..), PackageVersionSource, PackageVersionSpec (..), RevisionSpec (..), UTCTime, latestRevisionNumber) import Foliage.PrepareSdist (prepareSdist) import Foliage.PrepareSource (prepareSource) import Foliage.Shake (readGenericPackageDescription', readPackageVersionSpec') import System.FilePath (takeBaseName, takeFileName, (<.>), ()) +-- TODO: ensure that `pkgVersionDeprecationChanges` and `cabalFileRevisions` are +-- sorted by timestamp, with https://hackage.haskell.org/package/sorted-list ?! data PreparedPackageVersion = PreparedPackageVersion { pkgId :: PackageId, pkgTimestamp :: Maybe UTCTime, pkgVersionSource :: PackageVersionSource, pkgVersionForce :: Bool, + pkgVersionIsDeprecated :: Bool, + pkgVersionDeprecationChanges :: [(UTCTime, Bool)], pkgDesc :: GenericPackageDescription, sdistPath :: FilePath, cabalFilePath :: FilePath, @@ -46,6 +53,33 @@ data PreparedPackageVersion = PreparedPackageVersion cabalFileRevisions :: [(UTCTime, FilePath)] } +-- @andreabedini comments: +-- +-- The function `preparePackageVersion` has a bit of a special role which I +-- should comment upon. +-- +-- There are at three sources of information about a package: +-- +-- * the path of the meta file: `_sources/pkg-name/pkg-version/meta.toml` +-- * the content of `meta.toml` +-- * the tarball/sdist pointed by `meta.toml` +-- +-- +-- Before #37 I used to refer to these three pieces of data independently, +-- thinking it would be a good idea to keep the data-pipeline granular. +-- +-- While working on #37, I realised this granularity was leading me to have +-- consistency checks scattered around the code so I figured it would make more +-- sense to centralise these checks into a single function and to use a type +-- (`PreparedPackageVersion`) as evidence that everything is consistent (e.g. +-- the package name inferred from the meta.toml path is the same as the one in +-- the cabal file of the source distribution). +-- +-- This function has also the chance to denormalise some data (i.e. repeating it +-- multiple times in different forms) for easy consumption downstream. This +-- could be split out in the future if `PreparedPackageVersion` starts to become +-- a kitchen sink. + preparePackageVersion :: FilePath -> FilePath -> Action PreparedPackageVersion preparePackageVersion inputDir metaFile = do let (name, version) = case splitDirectories metaFile of @@ -60,18 +94,18 @@ preparePackageVersion inputDir metaFile = do readPackageVersionSpec' (inputDir metaFile) >>= \case PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Nothing} | not (null packageVersionRevisions) -> do - error $ - unlines - [ inputDir metaFile <> " has cabal file revisions but the original package has no timestamp.", - "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions" - ] + error $ + unlines + [ inputDir metaFile <> " has cabal file revisions but the original package has no timestamp.", + "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions" + ] PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Just pkgTs} | any ((< pkgTs) . revisionTimestamp) packageVersionRevisions -> do - error $ - unlines - [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself.", - "Adjust the timestamps so that all revisions come after the original package" - ] + error $ + unlines + [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself.", + "Adjust the timestamps so that all revisions come after the original package" + ] meta -> return meta @@ -111,12 +145,31 @@ preparePackageVersion inputDir metaFile = do "version in cabal file: " ++ prettyShow (Distribution.Types.PackageId.pkgVersion $ package $ packageDescription pkgDesc) ] - let cabalFileRevisions = - sortOn - (Down . fst) - [ (revisionTimestamp, cabalFileRevisionPath revisionNumber) - | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec - ] + let cabalFileRevisions = sortOn Down [(revisionTimestamp, cabalFileRevisionPath revisionNumber) | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec] + + let pkgVersionDeprecationChanges = sortOn Down [(deprecationTimestamp, deprecationIsDeprecated) | DeprecationSpec {deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec] + + -- Here is where we check that there are no "double deprecations" (i.e. two + -- consecutive (in time) `deprecated = true` or `deprecated = false`) + let noDoubleDeprecations xs = and $ zipWith (/=) xs' (tail xs') + where + xs' = map snd xs + + -- Ensure the package version is not introduced already deprecated + let notIntroducedDeprecated = all (\(timestamp, _) -> packageVersionTimestamp pkgSpec > Just timestamp) + + -- Ensure the first deprecation is an actual deprecation + let firstDeprecationIsActual = maybe True snd . listToMaybe + + let deprecationChangesValid = + noDoubleDeprecations pkgVersionDeprecationChanges + && notIntroducedDeprecated pkgVersionDeprecationChanges + && firstDeprecationIsActual pkgVersionDeprecationChanges + + unless deprecationChangesValid $ + error $ "The deprecation changes for " ++ prettyShow pkgId ++ " are inconsistent." + + let pkgVersionIsDeprecated = maybe False snd $ listToMaybe pkgVersionDeprecationChanges return PreparedPackageVersion @@ -124,6 +177,8 @@ preparePackageVersion inputDir metaFile = do pkgTimestamp = packageVersionTimestamp pkgSpec, pkgVersionSource = packageVersionSource pkgSpec, pkgVersionForce = packageVersionForce pkgSpec, + pkgVersionDeprecationChanges, + pkgVersionIsDeprecated, pkgDesc, sdistPath, cabalFilePath, diff --git a/templates/allPackageVersions.mustache b/templates/allPackageVersions.mustache index 0a3cb9a..9e1b08a 100644 --- a/templates/allPackageVersions.mustache +++ b/templates/allPackageVersions.mustache @@ -49,7 +49,11 @@ {{#entries}} {{#AllPackageVersionsPageEntryPackage}} - {{allPackageVersionsPageEntryPkgId}} + + {{allPackageVersionsPageEntryPkgId}} + {{#allPackageVersionsPageEntryDeprecated}} + Deprecated + {{/allPackageVersionsPageEntryDeprecated}} Version {{allPackageVersionsPageEntryTimestamp}} diff --git a/templates/packageVersion.mustache b/templates/packageVersion.mustache index 91b95e6..99361f1 100644 --- a/templates/packageVersion.mustache +++ b/templates/packageVersion.mustache @@ -27,7 +27,11 @@
  • All package versions
    • -

    + +

    + {{#pkgVersionDeprecated}} + Deprecated + {{/pkgVersionDeprecated}} {{name}}-{{version}}

    From 33edc7773dc18f8f6e4fee8f730e142c1cd1223c Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 24 Apr 2023 11:52:03 +0800 Subject: [PATCH 02/12] Put a bandage on cmdImportIndex --- app/Foliage/CmdImportIndex.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/app/Foliage/CmdImportIndex.hs b/app/Foliage/CmdImportIndex.hs index 25ec972..1a4522f 100644 --- a/app/Foliage/CmdImportIndex.hs +++ b/app/Foliage/CmdImportIndex.hs @@ -27,7 +27,11 @@ import System.FilePath cmdImportIndex :: ImportIndexOptions -> IO () cmdImportIndex opts = do - putStrLn "EXPERIMENTAL. Import the Hackage index from $HOME/.cabal. Make sure you have done `cabal update` recently." + putStrLn $ + unlines + [ "This command is EXPERIMENTAL and INCOMPLETE!", + "Import the Hackage index from $HOME/.cabal. Make sure you have done `cabal update` recently." + ] home <- getEnv "HOME" entries <- Tar.read <$> BSL.readFile (home ".cabal/packages/hackage.haskell.org/01-index.tar") m <- importIndex indexfilter entries M.empty @@ -60,6 +64,7 @@ importIndex f (Tar.Next e es) m = { packageVersionSource = TarballSource (pkgIdToHackageUrl pkgId) Nothing, packageVersionTimestamp = Just time, packageVersionRevisions = [], + packageVersionDeprecations = [], packageVersionForce = False } -- Existing package, new revision From 16d75ecc1654799dfbda5ee32fb3ff51bcda9079 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 24 Apr 2023 22:08:54 +0800 Subject: [PATCH 03/12] Rework the metadata validation --- app/Foliage/Meta.hs | 2 +- app/Foliage/PreparePackageVersion.hs | 99 ++++++++++++++++++---------- 2 files changed, 64 insertions(+), 37 deletions(-) diff --git a/app/Foliage/Meta.hs b/app/Foliage/Meta.hs index 6cd01ad..cc00973 100644 --- a/app/Foliage/Meta.hs +++ b/app/Foliage/Meta.hs @@ -195,7 +195,7 @@ sourceMetaCodec = .= packageVersionSource <*> Toml.list revisionMetaCodec "revisions" .= packageVersionRevisions - <*> Toml.list deprecationMetaCodec "deprecation" + <*> Toml.list deprecationMetaCodec "deprecations" .= packageVersionDeprecations <*> withDefault False (Toml.bool "force-version") .= packageVersionForce diff --git a/app/Foliage/PreparePackageVersion.hs b/app/Foliage/PreparePackageVersion.hs index 7fe5b6d..d540326 100644 --- a/app/Foliage/PreparePackageVersion.hs +++ b/app/Foliage/PreparePackageVersion.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} module Foliage.PreparePackageVersion ( PreparedPackageVersion @@ -22,7 +23,8 @@ where import Control.Monad (unless) import Data.List (sortOn) -import Data.Maybe (listToMaybe) +import Data.List.NonEmpty qualified as NE +import Data.Maybe (listToMaybe, mapMaybe) import Data.Ord (Down (..)) import Development.Shake (Action) import Development.Shake.FilePath (joinPath, splitDirectories) @@ -37,8 +39,8 @@ import Foliage.PrepareSource (prepareSource) import Foliage.Shake (readGenericPackageDescription', readPackageVersionSpec') import System.FilePath (takeBaseName, takeFileName, (<.>), ()) --- TODO: ensure that `pkgVersionDeprecationChanges` and `cabalFileRevisions` are --- sorted by timestamp, with https://hackage.haskell.org/package/sorted-list ?! +-- TODO: can we ensure that `pkgVersionDeprecationChanges` and `cabalFileRevisions` are +-- sorted by timestamp? e.g https://hackage.haskell.org/package/sorted-list data PreparedPackageVersion = PreparedPackageVersion { pkgId :: PackageId, pkgTimestamp :: Maybe UTCTime, @@ -91,27 +93,66 @@ preparePackageVersion inputDir metaFile = do let pkgId = PackageIdentifier pkgName pkgVersion pkgSpec <- - readPackageVersionSpec' (inputDir metaFile) >>= \case - PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Nothing} - | not (null packageVersionRevisions) -> do + readPackageVersionSpec' (inputDir metaFile) >>= \meta@PackageVersionSpec {..} -> do + case (NE.nonEmpty packageVersionRevisions, packageVersionTimestamp) of + (Just _someRevisions, Nothing) -> error $ unlines - [ inputDir metaFile <> " has cabal file revisions but the original package has no timestamp.", - "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions" + [ inputDir metaFile <> " has cabal file revisions but the package has no timestamp.", + "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions." ] - PackageVersionSpec {packageVersionRevisions, packageVersionTimestamp = Just pkgTs} - | any ((< pkgTs) . revisionTimestamp) packageVersionRevisions -> do + (Just (NE.sort -> someRevisions), Just ts) + | revisionTimestamp (NE.head someRevisions) <= ts -> + error $ + unlines + [ inputDir metaFile <> " has a revision with timestamp earlier (or equal) than the package itself.", + "Adjust the timestamps so that all revisions come after the package publication." + ] + | not (null $ duplicates (revisionTimestamp <$> someRevisions)) -> + error $ + unlines + [ inputDir metaFile <> " has two revisions entries with the same timestamp.", + "Adjust the timestamps so that all the revisions happen at a different time." + ] + _otherwise -> return () + + case (NE.nonEmpty packageVersionDeprecations, packageVersionTimestamp) of + (Just _someDeprecations, Nothing) -> error $ unlines - [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself.", - "Adjust the timestamps so that all revisions come after the original package" + [ inputDir metaFile <> " has deprecations but the package has no timestamp.", + "This combination doesn't make sense. Either add a timestamp on the original package or remove the deprecation." ] - meta -> - return meta + (Just (NE.sort -> someDeprecations), Just ts) + | deprecationTimestamp (NE.head someDeprecations) <= ts -> + error $ + unlines + [ inputDir metaFile <> " has a deprecation entry with timestamp earlier (or equal) than the package itself.", + "Adjust the timestamps so that all the (un-)deprecations come after the package publication." + ] + | not (deprecationIsDeprecated (NE.head someDeprecations)) -> + error $ + "The first deprecation entry in" <> inputDir metaFile <> " cannot be an un-deprecation" + | not (null $ duplicates (deprecationTimestamp <$> someDeprecations)) -> + error $ + unlines + [ inputDir metaFile <> " has two deprecation entries with the same timestamp.", + "Adjust the timestamps so that all the (un-)deprecations happen at a different time." + ] + | not (null $ doubleDeprecations someDeprecations) -> + error $ + unlines + [ inputDir metaFile <> " contains two consecutive deprecations or two consecutive un-deprecations.", + "Make sure deprecations and un-deprecations alternate in time." + ] + _otherwise -> return () + + return meta srcDir <- prepareSource pkgId pkgSpec let originalCabalFilePath = srcDir prettyShow pkgName <.> "cabal" + cabalFileRevisionPath revisionNumber = joinPath [ inputDir, @@ -122,7 +163,7 @@ preparePackageVersion inputDir metaFile = do ] <.> "cabal" - let cabalFilePath = + cabalFilePath = maybe originalCabalFilePath cabalFileRevisionPath @@ -149,26 +190,6 @@ preparePackageVersion inputDir metaFile = do let pkgVersionDeprecationChanges = sortOn Down [(deprecationTimestamp, deprecationIsDeprecated) | DeprecationSpec {deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec] - -- Here is where we check that there are no "double deprecations" (i.e. two - -- consecutive (in time) `deprecated = true` or `deprecated = false`) - let noDoubleDeprecations xs = and $ zipWith (/=) xs' (tail xs') - where - xs' = map snd xs - - -- Ensure the package version is not introduced already deprecated - let notIntroducedDeprecated = all (\(timestamp, _) -> packageVersionTimestamp pkgSpec > Just timestamp) - - -- Ensure the first deprecation is an actual deprecation - let firstDeprecationIsActual = maybe True snd . listToMaybe - - let deprecationChangesValid = - noDoubleDeprecations pkgVersionDeprecationChanges - && notIntroducedDeprecated pkgVersionDeprecationChanges - && firstDeprecationIsActual pkgVersionDeprecationChanges - - unless deprecationChangesValid $ - error $ "The deprecation changes for " ++ prettyShow pkgId ++ " are inconsistent." - let pkgVersionIsDeprecated = maybe False snd $ listToMaybe pkgVersionDeprecationChanges return @@ -185,3 +206,9 @@ preparePackageVersion inputDir metaFile = do originalCabalFilePath, cabalFileRevisions } + +duplicates :: Ord a => NE.NonEmpty a -> [a] +duplicates = mapMaybe (listToMaybe . NE.tail) . NE.group + +doubleDeprecations :: NE.NonEmpty DeprecationSpec -> [NE.NonEmpty DeprecationSpec] +doubleDeprecations = filter ((> 1) . length) . NE.groupWith deprecationIsDeprecated From 62789a17e816fcc91f3ba0c86d1871b87c611ea7 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 24 Apr 2023 22:23:24 +0800 Subject: [PATCH 04/12] Revisions at the same time as publication is allowed (Apparently) --- app/Foliage/PreparePackageVersion.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/app/Foliage/PreparePackageVersion.hs b/app/Foliage/PreparePackageVersion.hs index d540326..ef08b36 100644 --- a/app/Foliage/PreparePackageVersion.hs +++ b/app/Foliage/PreparePackageVersion.hs @@ -102,10 +102,10 @@ preparePackageVersion inputDir metaFile = do "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions." ] (Just (NE.sort -> someRevisions), Just ts) - | revisionTimestamp (NE.head someRevisions) <= ts -> + | revisionTimestamp (NE.head someRevisions) < ts -> error $ unlines - [ inputDir metaFile <> " has a revision with timestamp earlier (or equal) than the package itself.", + [ inputDir metaFile <> " has a revision with timestamp earlier than the package itself.", "Adjust the timestamps so that all revisions come after the package publication." ] | not (null $ duplicates (revisionTimestamp <$> someRevisions)) -> From 9c142e3702b279efbe44b62cd0208b435cf2d381 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 24 Apr 2023 22:26:13 +0800 Subject: [PATCH 05/12] Properly render version ranges --- app/Foliage/CmdBuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 9543a83..6608189 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -311,7 +311,7 @@ getExtraEntries packageVersions = -- Calculate (by applying them chronologically) the effective `VersionRange` for the package group. effectiveRanges = NE.tail $ NE.scanl applyChangeToRange (posixSecondsToUTCTime 0, anyVersion) deprecationChanges -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp. - createTarEntry (ts, effectiveRange) = mkTarEntry (BL.pack $ show effectiveRange) (IndexPkgPrefs pn) ts + createTarEntry (ts, effectiveRange) = mkTarEntry (BL.pack $ prettyShow effectiveRange) (IndexPkgPrefs pn) ts in foldMap generateEntriesForGroup groupedPackageVersions -- Extract deprecation changes for a given `PreparedPackageVersion`. From 9948cc7d56bc44a4fade25fc7f6f5fa54d3ff9f6 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 24 Apr 2023 22:40:56 +0800 Subject: [PATCH 06/12] Add comments about revisions timestamps --- app/Foliage/CmdBuild.hs | 4 ++++ app/Foliage/PreparePackageVersion.hs | 1 + 2 files changed, 5 insertions(+) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 6608189..2468086 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -121,6 +121,9 @@ buildAction -- all revised cabal files, with their timestamp revcf <- for cabalFileRevisions $ uncurry (prepareIndexPkgCabal pkgId) + -- WARN: So far Foliage allows publishing a package and a cabal file revision with the same timestamp + -- This accidentally works because 1) the following inserts the original cabal file before the revisions + -- AND 2) Data.List.sortOn is stable. The revised cabal file will always be after the original one. return $ cf : revcf ) packageVersions @@ -141,6 +144,7 @@ buildAction let extraEntries = getExtraEntries packageVersions + -- WARN: See note above, the sorting here has to be stable let tarContents = Tar.write $ sortOn Tar.entryTime (cabalEntries ++ metadataEntries ++ extraEntries) traced "Writing index" $ do BL.writeFile (anchorPath outputDirRoot repoLayoutIndexTar) tarContents diff --git a/app/Foliage/PreparePackageVersion.hs b/app/Foliage/PreparePackageVersion.hs index ef08b36..8f24c7b 100644 --- a/app/Foliage/PreparePackageVersion.hs +++ b/app/Foliage/PreparePackageVersion.hs @@ -102,6 +102,7 @@ preparePackageVersion inputDir metaFile = do "This combination doesn't make sense. Either add a timestamp on the original package or remove the revisions." ] (Just (NE.sort -> someRevisions), Just ts) + -- WARN: this should really be a <= | revisionTimestamp (NE.head someRevisions) < ts -> error $ unlines From a93eb62daa4d1e505dd8517752a556ab3190c779 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 14:12:22 +0800 Subject: [PATCH 07/12] Add more comments --- app/Foliage/CmdBuild.hs | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/app/Foliage/CmdBuild.hs b/app/Foliage/CmdBuild.hs index 2468086..36540a1 100644 --- a/app/Foliage/CmdBuild.hs +++ b/app/Foliage/CmdBuild.hs @@ -305,22 +305,38 @@ prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = d -- Currently `extraEntries` are only used for encoding `prefered-versions`. getExtraEntries :: [PreparedPackageVersion] -> [Tar.Entry] getExtraEntries packageVersions = - let groupedPackageVersions = NE.groupWith (pkgName . pkgId) packageVersions + let -- Group all (package) versions by package (name) + groupedPackageVersions :: [NE.NonEmpty PreparedPackageVersion] + groupedPackageVersions = NE.groupWith (pkgName . pkgId) packageVersions + + -- All versions of a given package together form a list of entries + -- The list of entries might be empty (in case no version has been deprecated) + generateEntriesForGroup :: NE.NonEmpty PreparedPackageVersion -> [Tar.Entry] generateEntriesForGroup packageGroup = map createTarEntry effectiveRanges where -- Get the package name of the current group. + pn :: PackageName pn = pkgName $ pkgId $ NE.head packageGroup - -- Collect and sort the deprecation changes for the package group. + -- Collect and sort the deprecation changes for the package group, turning them into a action on VersionRange + deprecationChanges :: [(UTCTime, VersionRange -> VersionRange)] deprecationChanges = sortOn fst $ foldMap versionDeprecationChanges packageGroup -- Calculate (by applying them chronologically) the effective `VersionRange` for the package group. + effectiveRanges :: [(UTCTime, VersionRange)] effectiveRanges = NE.tail $ NE.scanl applyChangeToRange (posixSecondsToUTCTime 0, anyVersion) deprecationChanges -- Create a `Tar.Entry` for the package group, its computed `VersionRange` and a timestamp. createTarEntry (ts, effectiveRange) = mkTarEntry (BL.pack $ prettyShow effectiveRange) (IndexPkgPrefs pn) ts in foldMap generateEntriesForGroup groupedPackageVersions +-- TODO: the functions belows should be moved to Foliage.PreparedPackageVersion + -- Extract deprecation changes for a given `PreparedPackageVersion`. versionDeprecationChanges :: PreparedPackageVersion -> [(UTCTime, VersionRange -> VersionRange)] -versionDeprecationChanges PreparedPackageVersion {pkgId = PackageIdentifier {pkgVersion}, pkgVersionDeprecationChanges} = map (second $ applyDeprecation pkgVersion) pkgVersionDeprecationChanges +versionDeprecationChanges + PreparedPackageVersion + { pkgId = PackageIdentifier {pkgVersion}, + pkgVersionDeprecationChanges + } = + map (second $ applyDeprecation pkgVersion) pkgVersionDeprecationChanges -- Apply a given change (`VersionRange -> VersionRange`) to a `VersionRange` and -- return the simplified the result with a new timestamp. From 754a1c1bd7e41a644f42c6022aad6e7e53b295b2 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 14:12:42 +0800 Subject: [PATCH 08/12] Remove dead code --- app/Foliage/Meta.hs | 76 +-------------------------------------- app/Foliage/Meta/Aeson.hs | 4 --- 2 files changed, 1 insertion(+), 79 deletions(-) diff --git a/app/Foliage/Meta.hs b/app/Foliage/Meta.hs index cc00973..e0d7285 100644 --- a/app/Foliage/Meta.hs +++ b/app/Foliage/Meta.hs @@ -6,14 +6,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Foliage.Meta - ( PackageMeta (PackageMeta), - PackageMetaEntry (PackageMetaEntry), - packageMetaEntryDeprecated, - packageMetaEntryPreferred, - packageMetaEntryTimestamp, - readPackageMeta, - writePackageMeta, - packageVersionTimestamp, + ( packageVersionTimestamp, packageVersionSource, packageVersionRevisions, packageVersionDeprecations, @@ -34,7 +27,6 @@ module Foliage.Meta GitHubRev (..), UTCTime, latestRevisionNumber, - consolidateRanges, ) where @@ -48,12 +40,7 @@ import Data.Text qualified as T import Data.Time.LocalTime (utc, utcToZonedTime, zonedTimeToUTC) import Development.Shake.Classes (Binary, Hashable, NFData) import Distribution.Aeson () -import Distribution.Parsec (simpleParsec) -import Distribution.Pretty (prettyShow) import Distribution.Types.Orphans () -import Distribution.Types.Version (Version) -import Distribution.Types.VersionRange (VersionRange, anyVersion, intersectVersionRanges, notThisVersion) -import Distribution.Version (isAnyVersion, isNoVersion, simplifyVersionRange) import Foliage.Time (UTCTime) import GHC.Generics (Generic) import Network.URI (URI, parseURI) @@ -61,58 +48,6 @@ import Network.URI.Orphans () import Toml (TomlCodec, (.=)) import Toml qualified -newtype PackageMeta = PackageMeta - { packageMetaEntries :: [PackageMetaEntry] - } - deriving (Show, Eq, Generic) - deriving anyclass (Binary, Hashable, NFData) - -data PackageMetaEntry = PackageMetaEntry - { packageMetaEntryTimestamp :: UTCTime, - packageMetaEntryPreferred :: [VersionRange], - packageMetaEntryDeprecated :: [Version] - } - deriving (Show, Eq, Generic) - deriving anyclass (Binary, Hashable, NFData) - -readPackageMeta :: FilePath -> IO PackageMeta -readPackageMeta = Toml.decodeFile packageMetaCodec - -writePackageMeta :: FilePath -> PackageMeta -> IO () -writePackageMeta fp a = void $ Toml.encodeToFile packageMetaCodec fp a - -packageMetaCodec :: TomlCodec PackageMeta -packageMetaCodec = - PackageMeta - <$> Toml.list packageMetaEntryCodec "entries" - .= packageMetaEntries - -packageMetaEntryCodec :: TomlCodec PackageMetaEntry -packageMetaEntryCodec = - PackageMetaEntry - <$> timeCodec "timestamp" - .= packageMetaEntryTimestamp - <*> Toml.arrayOf _VersionRange "preferred-versions" - .= packageMetaEntryPreferred - <*> Toml.arrayOf _Version "deprecated-versions" - .= packageMetaEntryDeprecated - -_Version :: Toml.TomlBiMap Version Toml.AnyValue -_Version = Toml._TextBy showVersion parseVersion - where - showVersion = T.pack . prettyShow - parseVersion t = case simpleParsec (T.unpack t) of - Nothing -> Left $ T.pack $ "unable to parse version" ++ T.unpack t - Just v -> Right v - -_VersionRange :: Toml.TomlBiMap VersionRange Toml.AnyValue -_VersionRange = Toml._TextBy showVersion parseVersion - where - showVersion = T.pack . prettyShow - parseVersion t = case simpleParsec (T.unpack t) of - Nothing -> Left $ T.pack $ "unable to parse version" ++ T.unpack t - Just v -> Right v - newtype GitHubRepo = GitHubRepo {unGitHubRepo :: Text} deriving (Show, Eq, Binary, Hashable, NFData) via Text @@ -249,12 +184,3 @@ withDefault :: Eq a => a -> TomlCodec a -> TomlCodec a withDefault d c = (fromMaybe d <$> Toml.dioptional c) .= f where f a = if a == d then Nothing else Just a - --- | copied from hackage-server -consolidateRanges :: PackageMetaEntry -> Maybe VersionRange -consolidateRanges PackageMetaEntry {packageMetaEntryPreferred, packageMetaEntryDeprecated} = - if isAnyVersion range || isNoVersion range then Nothing else Just range - where - range = - simplifyVersionRange $ - foldr intersectVersionRanges anyVersion (map notThisVersion packageMetaEntryDeprecated ++ packageMetaEntryPreferred) diff --git a/app/Foliage/Meta/Aeson.hs b/app/Foliage/Meta/Aeson.hs index dfe0240..47a7462 100644 --- a/app/Foliage/Meta/Aeson.hs +++ b/app/Foliage/Meta/Aeson.hs @@ -12,10 +12,6 @@ import Foliage.Meta import Foliage.Utils.Aeson import Network.URI (URI) -deriving via MyAesonEncoding PackageMeta instance ToJSON PackageMeta - -deriving via MyAesonEncoding PackageMetaEntry instance ToJSON PackageMetaEntry - deriving via MyAesonEncoding RevisionSpec instance ToJSON RevisionSpec deriving via MyAesonEncoding DeprecationSpec instance ToJSON DeprecationSpec From 285c8e31b18f14c9c7e67b5639146b2f9d3d4af6 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 14:29:18 +0800 Subject: [PATCH 09/12] Comments and formatting --- app/Foliage/Meta.hs | 3 +++ app/Foliage/PreparePackageVersion.hs | 14 ++++++++++++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/app/Foliage/Meta.hs b/app/Foliage/Meta.hs index e0d7285..b5642d8 100644 --- a/app/Foliage/Meta.hs +++ b/app/Foliage/Meta.hs @@ -158,6 +158,9 @@ revisionMetaCodec = data DeprecationSpec = DeprecationSpec { deprecationTimestamp :: UTCTime, + -- | 'True' means the package version has been deprecated + -- 'False' means the package version has been undeprecated + -- FIXME: we should consider something better than 'Bool' deprecationIsDeprecated :: Bool } deriving (Show, Eq, Generic, Ord) diff --git a/app/Foliage/PreparePackageVersion.hs b/app/Foliage/PreparePackageVersion.hs index 8f24c7b..2027d1f 100644 --- a/app/Foliage/PreparePackageVersion.hs +++ b/app/Foliage/PreparePackageVersion.hs @@ -187,9 +187,19 @@ preparePackageVersion inputDir metaFile = do "version in cabal file: " ++ prettyShow (Distribution.Types.PackageId.pkgVersion $ package $ packageDescription pkgDesc) ] - let cabalFileRevisions = sortOn Down [(revisionTimestamp, cabalFileRevisionPath revisionNumber) | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec] + let cabalFileRevisions = + sortOn + Down + [ (revisionTimestamp, cabalFileRevisionPath revisionNumber) + | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec + ] - let pkgVersionDeprecationChanges = sortOn Down [(deprecationTimestamp, deprecationIsDeprecated) | DeprecationSpec {deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec] + let pkgVersionDeprecationChanges = + sortOn + Down + [ (deprecationTimestamp, deprecationIsDeprecated) + | DeprecationSpec {deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec + ] let pkgVersionIsDeprecated = maybe False snd $ listToMaybe pkgVersionDeprecationChanges From 64f1578369e4d96cfb8ad864474ce791a8055ce0 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 14:58:44 +0800 Subject: [PATCH 10/12] Restore integrity validation for datatables.js Likely disabled by accident. --- templates/allPackageVersions.mustache | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/templates/allPackageVersions.mustache b/templates/allPackageVersions.mustache index 9e1b08a..2278144 100644 --- a/templates/allPackageVersions.mustache +++ b/templates/allPackageVersions.mustache @@ -10,9 +10,7 @@ - - + All package versions From 4f706f9bd9b06f2b50dd1cd4993cb961bb47c939 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 15:06:46 +0800 Subject: [PATCH 11/12] Fix page formatting issue --- app/Foliage/Pages.hs | 2 -- templates/allPackageVersions.mustache | 3 ++- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/app/Foliage/Pages.hs b/app/Foliage/Pages.hs index 35274df..7ad0e00 100644 --- a/app/Foliage/Pages.hs +++ b/app/Foliage/Pages.hs @@ -124,8 +124,6 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = allPackageVersionsPageEntryTimestamp = fromMaybe currentTime pkgTimestamp, allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds (fromMaybe currentTime pkgTimestamp), allPackageVersionsPageEntrySource = pkgVersionSource, - -- FIXME: this weirdly seems to not work (display a `Deprecated` badge on all package version page) ... - -- don't understand yet why! :/ allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated } -- list of revisions diff --git a/templates/allPackageVersions.mustache b/templates/allPackageVersions.mustache index 2278144..9b60315 100644 --- a/templates/allPackageVersions.mustache +++ b/templates/allPackageVersions.mustache @@ -48,10 +48,11 @@ {{#AllPackageVersionsPageEntryPackage}} - {{allPackageVersionsPageEntryPkgId}} + {{allPackageVersionsPageEntryPkgId}} {{#allPackageVersionsPageEntryDeprecated}} Deprecated {{/allPackageVersionsPageEntryDeprecated}} + Version {{allPackageVersionsPageEntryTimestamp}} From 4cafbe75a1a8bd7f16f362d5ff44f6a78378d5e6 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 15 May 2023 15:23:36 +0800 Subject: [PATCH 12/12] Improve deprecation label on the webpages - Add label also to revisions - Resize the label on package versions page --- app/Foliage/Pages.hs | 7 +++++-- templates/allPackageVersions.mustache | 13 +++++++++---- templates/packageVersion.mustache | 7 ++++--- 3 files changed, 18 insertions(+), 9 deletions(-) diff --git a/app/Foliage/Pages.hs b/app/Foliage/Pages.hs index 7ad0e00..c0c103f 100644 --- a/app/Foliage/Pages.hs +++ b/app/Foliage/Pages.hs @@ -90,6 +90,7 @@ makeAllPackagesPage currentTime outputDir packageVersions = -- sort packages by pkgId & sortOn allPackagesPageEntryPkgId +-- FIXME: refactor this data AllPackageVersionsPageEntry = AllPackageVersionsPageEntryPackage { allPackageVersionsPageEntryPkgId :: PackageIdentifier, @@ -101,7 +102,8 @@ data AllPackageVersionsPageEntry | AllPackageVersionsPageEntryRevision { allPackageVersionsPageEntryPkgId :: PackageIdentifier, allPackageVersionsPageEntryTimestamp :: UTCTime, - allPackageVersionsPageEntryTimestampPosix :: POSIXTime + allPackageVersionsPageEntryTimestampPosix :: POSIXTime, + allPackageVersionsPageEntryDeprecated :: Bool } deriving stock (Generic) deriving (ToJSON) via MyAesonEncoding AllPackageVersionsPageEntry @@ -130,7 +132,8 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = : [ AllPackageVersionsPageEntryRevision { allPackageVersionsPageEntryPkgId = pkgId, allPackageVersionsPageEntryTimestamp = revisionTimestamp, - allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp + allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp, + allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated } | (revisionTimestamp, _) <- cabalFileRevisions ] diff --git a/templates/allPackageVersions.mustache b/templates/allPackageVersions.mustache index 9b60315..22338fc 100644 --- a/templates/allPackageVersions.mustache +++ b/templates/allPackageVersions.mustache @@ -66,10 +66,15 @@ {{/AllPackageVersionsPageEntryPackage}} {{#AllPackageVersionsPageEntryRevision}} - {{allPackageVersionsPageEntryPkgId}} - Revision - {{allPackageVersionsPageEntryTimestamp}} - + + {{allPackageVersionsPageEntryPkgId}} + {{#allPackageVersionsPageEntryDeprecated}} + Deprecated + {{/allPackageVersionsPageEntryDeprecated}} + + Revision + {{allPackageVersionsPageEntryTimestamp}} + {{/AllPackageVersionsPageEntryRevision}} {{/entries}} diff --git a/templates/packageVersion.mustache b/templates/packageVersion.mustache index 99361f1..8784008 100644 --- a/templates/packageVersion.mustache +++ b/templates/packageVersion.mustache @@ -29,12 +29,13 @@

    - {{#pkgVersionDeprecated}} - Deprecated - {{/pkgVersionDeprecated}} {{name}}-{{version}}

    + {{#pkgVersionDeprecated}} +
    Deprecated
    +
    + {{/pkgVersionDeprecated}}
    Synopsis

    {{synopsis}}

    Description