mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-09-11 20:27:09 +03:00
Merge branch 'main' into show-public-keys
This commit is contained in:
commit
01a693789f
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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}}
|
||||
|
@ -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>
|
||||
|
Loading…
Reference in New Issue
Block a user