Merge pull request #49 from yvan-sraka/deprecated-versions

Fix #18: add support for deprecated-versions

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
@@ -115,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
@@ -133,7 +142,10 @@ buildAction
             (IndexPkgMetadata pkgId)
             (fromMaybe currentTime pkgTimestamp)
 
-    let tarContents = Tar.write $ sortOn Tar.entryTime (cabalEntries ++ metadataEntries)
+    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
       BL.writeFile (anchorPath outputDirRoot repoLayoutIndexTarGz) $ GZip.compress tarContents
@@ -290,6 +302,55 @@ prepareIndexPkgMetadata expiryTime PreparedPackageVersion {pkgId, sdistPath} = d
         targetsDelegations = Nothing
       }
 
+-- Currently `extraEntries` are only used for encoding `prefered-versions`.
+getExtraEntries :: [PreparedPackageVersion] -> [Tar.Entry]
+getExtraEntries 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, 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
+
+-- 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)

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

app/Foliage/Meta.hs

@@ -6,16 +6,10 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Foliage.Meta
-  ( PackageMeta (PackageMeta),
-    PackageMetaEntry (PackageMetaEntry),
-    packageMetaEntryDeprecated,
-    packageMetaEntryPreferred,
-    packageMetaEntryTimestamp,
-    readPackageMeta,
-    writePackageMeta,
-    packageVersionTimestamp,
+  ( packageVersionTimestamp,
     packageVersionSource,
     packageVersionRevisions,
+    packageVersionDeprecations,
     packageVersionForce,
     PackageVersionSpec (PackageVersionSpec),
     readPackageVersionSpec,
@@ -23,6 +17,9 @@ module Foliage.Meta
     RevisionSpec (RevisionSpec),
     revisionTimestamp,
     revisionNumber,
+    DeprecationSpec (DeprecationSpec),
+    deprecationTimestamp,
+    deprecationIsDeprecated,
     PackageVersionSource,
     pattern TarballSource,
     pattern GitHubSource,
@@ -30,7 +27,6 @@ module Foliage.Meta
     GitHubRev (..),
     UTCTime,
     latestRevisionNumber,
-    consolidateRanges,
   )
 where
 
@@ -44,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)
@@ -57,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
 
@@ -174,6 +113,8 @@ data PackageVersionSpec = PackageVersionSpec
     packageVersionSource :: PackageVersionSource,
     -- | revisions
     packageVersionRevisions :: [RevisionSpec],
+    -- | deprecations
+    packageVersionDeprecations :: [DeprecationSpec],
     -- | force version
     packageVersionForce :: Bool
   }
@@ -189,6 +130,8 @@ sourceMetaCodec =
     .= packageVersionSource
     <*> Toml.list revisionMetaCodec "revisions"
     .= packageVersionRevisions
+    <*> Toml.list deprecationMetaCodec "deprecations"
+    .= packageVersionDeprecations
     <*> withDefault False (Toml.bool "force-version")
     .= packageVersionForce
 
@@ -202,7 +145,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 +156,24 @@ revisionMetaCodec =
     <*> Toml.int "number"
     .= revisionNumber
 
+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)
+  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
 
@@ -226,12 +187,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)

app/Foliage/Meta/Aeson.hs

@@ -12,12 +12,10 @@ 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
+
 deriving via MyAesonEncoding PackageVersionSpec instance ToJSON PackageVersionSpec
 
 deriving via Text instance ToJSON GitHubRepo

app/Foliage/Pages.hs

@@ -90,17 +90,20 @@ makeAllPackagesPage currentTime outputDir packageVersions =
         -- sort packages by pkgId
         & sortOn allPackagesPageEntryPkgId
 
+-- FIXME: refactor this
 data AllPackageVersionsPageEntry
   = AllPackageVersionsPageEntryPackage
       { allPackageVersionsPageEntryPkgId :: PackageIdentifier,
         allPackageVersionsPageEntryTimestamp :: UTCTime,
         allPackageVersionsPageEntryTimestampPosix :: POSIXTime,
-        allPackageVersionsPageEntrySource :: PackageVersionSource
+        allPackageVersionsPageEntrySource :: PackageVersionSource,
+        allPackageVersionsPageEntryDeprecated :: Bool
       }
   | AllPackageVersionsPageEntryRevision
       { allPackageVersionsPageEntryPkgId :: PackageIdentifier,
         allPackageVersionsPageEntryTimestamp :: UTCTime,
-        allPackageVersionsPageEntryTimestampPosix :: POSIXTime
+        allPackageVersionsPageEntryTimestampPosix :: POSIXTime,
+        allPackageVersionsPageEntryDeprecated :: Bool
       }
   deriving stock (Generic)
   deriving (ToJSON) via MyAesonEncoding AllPackageVersionsPageEntry
@@ -116,19 +119,21 @@ 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,
+                allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated
               }
               -- list of revisions
               : [ AllPackageVersionsPageEntryRevision
                     { allPackageVersionsPageEntryPkgId = pkgId,
                       allPackageVersionsPageEntryTimestamp = revisionTimestamp,
-                      allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp
+                      allPackageVersionsPageEntryTimestampPosix = utcTimeToPOSIXSeconds revisionTimestamp,
+                      allPackageVersionsPageEntryDeprecated = pkgVersionIsDeprecated
                     }
                   | (revisionTimestamp, _) <- cabalFileRevisions
                 ]
@@ -138,7 +143,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 +152,8 @@ makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pk
           [ "pkgVersionSource" .= pkgVersionSource,
             "cabalFileRevisions" .= map fst cabalFileRevisions,
             "pkgDesc" .= jsonGenericPackageDescription pkgDesc,
-            "pkgTimestamp" .= pkgTimestamp
+            "pkgTimestamp" .= pkgTimestamp,
+            "pkgVersionDeprecated" .= pkgVersionIsDeprecated
           ]
 
 indexPageTemplate :: Template

app/Foliage/PreparePackageVersion.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Foliage.PreparePackageVersion
   ( PreparedPackageVersion
@@ -7,6 +8,8 @@ module Foliage.PreparePackageVersion
         pkgTimestamp,
         pkgVersionSource,
         pkgVersionForce,
+        pkgVersionIsDeprecated,
+        pkgVersionDeprecationChanges,
         pkgDesc,
         sdistPath,
         cabalFilePath,
@@ -20,7 +23,9 @@ where
 
 import Control.Monad (unless)
 import Data.List (sortOn)
-import Data.Ord (Down (Down))
+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)
 import Distribution.Client.Compat.Prelude (fromMaybe, prettyShow)
@@ -28,17 +33,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: 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,
     pkgVersionSource :: PackageVersionSource,
     pkgVersionForce :: Bool,
+    pkgVersionIsDeprecated :: Bool,
+    pkgVersionDeprecationChanges :: [(UTCTime, Bool)],
     pkgDesc :: GenericPackageDescription,
     sdistPath :: FilePath,
     cabalFilePath :: FilePath,
@@ -46,6 +55,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
@@ -57,27 +93,67 @@ preparePackageVersion inputDir metaFile = do
   let pkgId = PackageIdentifier pkgName pkgVersion
 
   pkgSpec <-
-    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"
-                ]
-      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"
-                ]
-      meta ->
-        return meta
+    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 package has no timestamp.",
+                "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
+                  [ 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)) ->
+              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 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."
+              ]
+        (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,
@@ -88,7 +164,7 @@ preparePackageVersion inputDir metaFile = do
           ]
           <.> "cabal"
 
-  let cabalFilePath =
+      cabalFilePath =
         maybe
           originalCabalFilePath
           cabalFileRevisionPath
@@ -113,20 +189,37 @@ preparePackageVersion inputDir metaFile = do
 
   let cabalFileRevisions =
         sortOn
-          (Down . fst)
+          Down
           [ (revisionTimestamp, cabalFileRevisionPath revisionNumber)
             | RevisionSpec {revisionTimestamp, revisionNumber} <- packageVersionRevisions pkgSpec
           ]
 
+  let pkgVersionDeprecationChanges =
+        sortOn
+          Down
+          [ (deprecationTimestamp, deprecationIsDeprecated)
+            | DeprecationSpec {deprecationTimestamp, deprecationIsDeprecated} <- packageVersionDeprecations pkgSpec
+          ]
+
+  let pkgVersionIsDeprecated = maybe False snd $ listToMaybe pkgVersionDeprecationChanges
+
   return
     PreparedPackageVersion
       { pkgId,
         pkgTimestamp = packageVersionTimestamp pkgSpec,
         pkgVersionSource = packageVersionSource pkgSpec,
         pkgVersionForce = packageVersionForce pkgSpec,
+        pkgVersionDeprecationChanges,
+        pkgVersionIsDeprecated,
         pkgDesc,
         sdistPath,
         cabalFilePath,
         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

templates/allPackageVersions.mustache

@@ -10,9 +10,7 @@
     <script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/5.1.3/js/bootstrap.bundle.min.js" integrity="sha384-ka7Sk0Gln4gmtz2MlQnikT1wXgYsOg+OMhuP+IlRH9sENBO0LRn5q+8nbTov4+1p" crossorigin="anonymous"></script>
     <!-- DataTables -->
     <link rel="stylesheet" href="https://cdn.datatables.net/v/bs5/dt-1.12.1/datatables.min.css" integrity="sha384-4+3RMUungd+Oh0juS2Jl3yQ7mPlVfsgr10NLSsqltLXIECi9ExY4d1cTtmf9aN8E" crossorigin="anonymous">
-    <!-- <script src="https://cdn.datatables.net/v/bs5/jq-3.6.0/dt-1.12.1/datatables.min.js" integrity="sha384-eU1uLDC5C4YCIouMauJZjbrnSmIiICWWAPdnZjRkNnuDxG+eJFN/EhW5GlKPAIVl" crossorigin="anonymous"></script>
-    -->
-    <script src="https://cdn.datatables.net/v/bs5/jq-3.6.0/dt-1.12.1/datatables.js"></script>
+    <script src="https://cdn.datatables.net/v/bs5/jq-3.6.0/dt-1.12.1/datatables.min.js" integrity="sha384-eU1uLDC5C4YCIouMauJZjbrnSmIiICWWAPdnZjRkNnuDxG+eJFN/EhW5GlKPAIVl" crossorigin="anonymous"></script>
     <title>
       All package versions
     </title>
@@ -49,7 +47,12 @@
         {{#entries}}
           {{#AllPackageVersionsPageEntryPackage}}
           <tr>
-            <td class="col-sm-2"><a href="../package/{{allPackageVersionsPageEntryPkgId}}">{{allPackageVersionsPageEntryPkgId}}</a></td>
+            <td class="col-sm-2">
+              <a href="../package/{{allPackageVersionsPageEntryPkgId}}">{{allPackageVersionsPageEntryPkgId}}</a>
+              {{#allPackageVersionsPageEntryDeprecated}}
+              <span class="badge bg-danger">Deprecated</span>
+              {{/allPackageVersionsPageEntryDeprecated}}
+            </td>
             <td class="col-sm-1">Version</td>
             <td class="col-sm-3" data-order="{{allPackageVersionsPageEntryTimestampPosix}}">{{allPackageVersionsPageEntryTimestamp}}</td>
             <td class="col-sm-6">
@@ -63,10 +66,15 @@
           {{/AllPackageVersionsPageEntryPackage}}
           {{#AllPackageVersionsPageEntryRevision}}
           <tr>
-            <td>{{allPackageVersionsPageEntryPkgId}}</td>
-            <td>Revision</td>
-            <td data-order="{{allPackageVersionsPageEntryTimestampPosix}}">{{allPackageVersionsPageEntryTimestamp}}</td>
-            <td></td>
+            <td class="col-sm-2">
+              <a href="../package/{{allPackageVersionsPageEntryPkgId}}">{{allPackageVersionsPageEntryPkgId}}</a>
+              {{#allPackageVersionsPageEntryDeprecated}}
+              <span class="badge bg-danger">Deprecated</span>
+              {{/allPackageVersionsPageEntryDeprecated}}
+            </td>
+            <td class="col-sm-1">Revision</td>
+            <td class="col-sm-3" data-order="{{allPackageVersionsPageEntryTimestampPosix}}">{{allPackageVersionsPageEntryTimestamp}}</td>
+            <td class="col-sm-6"></td>
           </tr>
           {{/AllPackageVersionsPageEntryRevision}}
         {{/entries}}

templates/packageVersion.mustache

@@ -27,10 +27,15 @@
         <li class="nav-item">
           <a class="nav-link" href="../../all-package-versions/index.html">All package versions</a>
         </li>
-      </ul>      <h1 class="py-5">
+      </ul>
+      <h1 class="py-5">
         {{name}}-{{version}}
       </h1>
       <dl class="row class="px-4 py-5">
+        {{#pkgVersionDeprecated}}
+        <dt class="col-sm-3"><span class="badge bg-danger" style="font-size: 1em">Deprecated</span></dt>
+        <dd></dd>
+        {{/pkgVersionDeprecated}}
         <dt class="col-sm-3">Synopsis</dt>
         <dd class="col-sm-9"><p>{{synopsis}}</p></dd>
         <dt class="col-sm-3">Description</dt>