diff --git a/hackage-server.cabal b/hackage-server.cabal index c9d20eeca..16afe763b 100644 --- a/hackage-server.cabal +++ b/hackage-server.cabal @@ -393,6 +393,7 @@ library Distribution.Server.Features.RecentPackages Distribution.Server.Features.PreferredVersions Distribution.Server.Features.PreferredVersions.State + Distribution.Server.Features.PreferredVersions.Types Distribution.Server.Features.PreferredVersions.Backup Distribution.Server.Features.ReverseDependencies Distribution.Server.Features.ReverseDependencies.State diff --git a/src/Distribution/Server/Features/PackageInfoJSON.hs b/src/Distribution/Server/Features/PackageInfoJSON.hs index 58607529d..ad593e368 100644 --- a/src/Distribution/Server/Features/PackageInfoJSON.hs +++ b/src/Distribution/Server/Features/PackageInfoJSON.hs @@ -109,7 +109,6 @@ instance Aeson.ToJSON PackageVersions where encodeStatus = \case Preferred.NormalVersion -> "normal" Preferred.DeprecatedVersion -> "deprecated" - Preferred.UnpreferredVersion -> "unpreferred" diff --git a/src/Distribution/Server/Features/PreferredVersions.hs b/src/Distribution/Server/Features/PreferredVersions.hs index 440484ed6..a66def777 100644 --- a/src/Distribution/Server/Features/PreferredVersions.hs +++ b/src/Distribution/Server/Features/PreferredVersions.hs @@ -4,6 +4,7 @@ module Distribution.Server.Features.PreferredVersions ( VersionsFeature(..), VersionsResource(..), initVersionsFeature, + sumRange, PreferredInfo(..), VersionStatus(..), @@ -20,6 +21,7 @@ import Distribution.Server.Framework import Distribution.Server.Features.PreferredVersions.State import Distribution.Server.Features.PreferredVersions.Backup +import Distribution.Server.Features.PreferredVersions.Types import Distribution.Server.Features.Core import Distribution.Server.Features.Upload @@ -217,7 +219,6 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity } $ map packageVersion pkgs versionType NormalVersion = "normal-version" versionType DeprecatedVersion = "deprecated-version" - versionType UnpreferredVersion = "unpreferred-version" return . toResponse . object $ map (\(i, vs) -> (versionType i, array $ map (string . display) vs)) $ Map.toList classifiedVersions @@ -384,7 +385,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity } renderPrefInfo :: PreferredInfo -> PreferredRender renderPrefInfo pref = PreferredRender { rendSumRange = maybe "-any" display $ sumRange pref, - rendRanges = map display $ preferredRanges pref, + rendRanges = [], rendVersions = deprecatedVersions pref } @@ -462,8 +463,7 @@ string = String . Text.pack getVersionStatus :: PreferredInfo -> Version -> VersionStatus getVersionStatus info version | version `elem` deprecatedVersions info = DeprecatedVersion - | maybe True (withinRange version) (sumRange info) = NormalVersion - | otherwise = UnpreferredVersion + | otherwise = NormalVersion classifyVersions :: PreferredInfo -> [Version] -> [(Version, VersionStatus)] classifyVersions (PreferredInfo [] [] _) = map (flip (,) NormalVersion) @@ -477,9 +477,8 @@ findBestVersion attempts to find the best version to display out of a set of versions. The quality of a given version is encoded in a pair (VersionStatus, Bool). If the version is a NormalVersion, then the boolean indicates whether if it the most recently uploaded preferred version (and all higher versions are -either deprecated or unpreferred). Otherwise, if it is a DeprecatedVersion or -UnpreferredVersion, the boolean indicates that it is the maximum of all uploaded -versions. +either deprecated or unpreferred). Otherwise, if it is a DeprecatedVersion, +the boolean indicates that it is the maximum of all uploaded versions. The list of available versions is scanned from the back (most recent) to the front (first one uploaded). If a 'better' version is found than the current @@ -490,20 +489,12 @@ finishes up. The exact ordering is defined as: available. This option may appear anywhere, although it is always seen before (NormalVersion, False). In this case, the algorithm finishes up. -2. (UnpreferredVersion, True) means the latest available version of the package -is not preferred, but the latest preferred version is not available. If this -option appears anywhere, it will be the most recent version in the set, -excluding deprecated versions. - -3. (NormalVersion, False) means neither the actual latest version nor the +2. (NormalVersion, False) means neither the actual latest version nor the preferred latest version are available, but there is some preferred version -that's available. It can only be scanned after (NormalVersion, True) and -(UnpreferredVersion, True), so the algorithm finishes up in this case. -4. (UnpreferredVersion, False) means no preferred versions are available, and -only an older version is available. It is still possible to see a NormalVersion -after this option, so the algorithm continues. +that's available. It can only be scanned after (NormalVersion, True) so the +algorithm finishes up in this case. -5. (DeprecatedVersion, True) and (DeprecatedVersion, False) mean only a +3. (DeprecatedVersion, True) and (DeprecatedVersion, False) mean only a deprecated version is available. This is not so great. This is a bit complex but I think it has the most intuitive result, and is @@ -533,7 +524,6 @@ findBestVersion info allVersions versions = NormalVersion | v == maxAllVersion -> (v, (NormalVersion, True)) NormalVersion -> oldSearch vs (v, (NormalVersion, False)) DeprecatedVersion -> newSearch vs (v, (DeprecatedVersion, True)) - UnpreferredVersion -> oldSearch vs (v, (UnpreferredVersion, True)) newSearch [] opt = opt oldSearch (v:vs) opt = case infoMap Map.! v of @@ -546,13 +536,10 @@ findBestVersion info allVersions versions = optionPrefs :: (VersionStatus, Bool) -> Int optionPrefs opt = case opt of (NormalVersion, True) -> 4 - (UnpreferredVersion, True) -> 3 (NormalVersion, False) -> 2 - (UnpreferredVersion, False) -> 1 _ -> 0 classifyOpt opt = case opt of (NormalVersion, True) -> Just NormalVersion - (UnpreferredVersion, True) -> Just UnpreferredVersion (DeprecatedVersion, _) -> Just DeprecatedVersion _ -> Nothing diff --git a/src/Distribution/Server/Features/PreferredVersions/Backup.hs b/src/Distribution/Server/Features/PreferredVersions/Backup.hs index 6f6690095..5477e4420 100644 --- a/src/Distribution/Server/Features/PreferredVersions/Backup.hs +++ b/src/Distribution/Server/Features/PreferredVersions/Backup.hs @@ -48,11 +48,11 @@ importPreferredCSV :: PreferredVersions importPreferredCSV st pkg ( _version : (match "preferredRanges" -> Just ranges) : (match "deprecatedVersions" -> Just deprecated) - : (optionalSumRange -> Just sumRange) + : (optionalSumRange -> _) ) = do - let info = PreferredInfo { preferredRanges = ranges + let info = PreferredInfo { unused_preferredRanges = ranges , deprecatedVersions = deprecated - , sumRange = sumRange + , unused_sumRange = Nothing } return st { preferredMap = Map.insert pkg info (preferredMap st) } importPreferredCSV _ _ _ = fail "Failed to read preferred.csv" @@ -92,12 +92,12 @@ backupPreferredVersions (PreferredVersions preferredMap deprecatedMap _) = ++ map backupDeprecated (Map.toList deprecatedMap) backupPreferredInfo :: (PackageName, PreferredInfo) -> BackupEntry -backupPreferredInfo (name, PreferredInfo {..}) = +backupPreferredInfo (name, prefinfo@PreferredInfo {..}) = csvToBackup (pkgPath name "preferred.csv") $ [ [showVersion versionCSV] - , "preferredRanges" : map display preferredRanges + , "preferredRanges" : map display unused_preferredRanges , "deprecatedVersions" : map display deprecatedVersions - ] ++ case sumRange of + ] ++ case sumRange prefinfo of Nothing -> [] Just versionRange -> [["sumRange", display versionRange]] where diff --git a/src/Distribution/Server/Features/PreferredVersions/State.hs b/src/Distribution/Server/Features/PreferredVersions/State.hs index 92c059dde..ee2c95eb6 100644 --- a/src/Distribution/Server/Features/PreferredVersions/State.hs +++ b/src/Distribution/Server/Features/PreferredVersions/State.hs @@ -22,24 +22,37 @@ data PreferredVersions = PreferredVersions { migratedEphemeralPrefs :: Bool } deriving (Show, Eq) + +-- NOTE: preferred versions no longer exist; this structure is actually only +-- used to keep around 'deprecatedVersions'. +-- +-- The unused fields are kept around so as to not change the +-- automatically-derived serialization format. data PreferredInfo = PreferredInfo { - preferredRanges :: [VersionRange], + unused_preferredRanges :: [VersionRange], deprecatedVersions :: [Version], - sumRange :: Maybe VersionRange -- cached form of 'consolidateRanges' below + -- | Use 'sumRange' instead. + unused_sumRange :: Maybe VersionRange } deriving (Show, Eq) +{-# DEPRECATED + unused_preferredRanges + "This field is completely unused, but is kept around to not change the automatically derived serialization format." #-} +{-# DEPRECATED + unused_sumRange + "This field is completely unused, but is kept around to not change the automatically derived serialization format." #-} + emptyPreferredInfo :: PreferredInfo emptyPreferredInfo = PreferredInfo [] [] Nothing -consolidateRanges :: [VersionRange] -> [Version] -> Maybe VersionRange -consolidateRanges ranges depr = + +sumRange :: PreferredInfo -> Maybe VersionRange +sumRange (PreferredInfo ranges depr _) = let range = simplifyVersionRange $ foldr intersectVersionRanges anyVersion (map notThisVersion depr ++ ranges) in if isAnyVersion range || isNoVersion range then Nothing else Just range -data VersionStatus = NormalVersion | DeprecatedVersion | UnpreferredVersion deriving (Show, Eq, Ord, Enum) - data PreferredVersions_v0 = PreferredVersions_v0 (Map PackageName PreferredInfo) @@ -87,9 +100,9 @@ setPreferredInfo :: PackageName -> [VersionRange] -> [Version] -> Update PreferredVersions PreferredInfo setPreferredInfo name ranges versions = do let prefinfo = PreferredInfo { - preferredRanges = ranges, + unused_preferredRanges = ranges, deprecatedVersions = versions, - sumRange = consolidateRanges ranges versions + unused_sumRange = Nothing } if null ranges && null versions then modify $ \p -> p { @@ -127,7 +140,7 @@ setMigratedEphemeralPrefs = modify $ \p -> p { migratedEphemeralPrefs = True } setPreferredRanges :: PackageName -> [VersionRange] -> Update PreferredVersions () setPreferredRanges name ranges = - alterPreferredInfo name $ \p -> p { preferredRanges = ranges } + alterPreferredInfo name $ \p -> p { unused_preferredRanges = ranges } setDeprecatedVersions :: PackageName -> [Version] -> Update PreferredVersions () setDeprecatedVersions name versions = @@ -142,7 +155,7 @@ alterPreferredInfo name func = } where res (PreferredInfo [] [] _) = Nothing -- ie delete res (PreferredInfo ranges depr _) = - Just (PreferredInfo ranges depr (consolidateRanges ranges depr)) + Just (PreferredInfo ranges depr Nothing) makeAcidic ''PreferredVersions ['setPreferredInfo diff --git a/src/Distribution/Server/Features/PreferredVersions/Types.hs b/src/Distribution/Server/Features/PreferredVersions/Types.hs index c53f1a125..c04af8efd 100644 --- a/src/Distribution/Server/Features/PreferredVersions/Types.hs +++ b/src/Distribution/Server/Features/PreferredVersions/Types.hs @@ -2,8 +2,4 @@ module Distribution.Server.Features.PreferredVersions.Types where -import Data.SafeCopy (base, deriveSafeCopy) - -data VersionStatus = NormalVersion | DeprecatedVersion | UnpreferredVersion deriving (Show, Eq, Ord, Enum) - -$(deriveSafeCopy 0 'base ''VersionStatus) +data VersionStatus = NormalVersion | DeprecatedVersion deriving (Show, Eq, Ord, Enum) diff --git a/src/Distribution/Server/Features/ReverseDependencies/State.hs b/src/Distribution/Server/Features/ReverseDependencies/State.hs index 3bbaeeeb8..a8345fe3f 100644 --- a/src/Distribution/Server/Features/ReverseDependencies/State.hs +++ b/src/Distribution/Server/Features/ReverseDependencies/State.hs @@ -49,6 +49,7 @@ import Distribution.Server.Packages.Types import Distribution.Server.Framework.MemSize import Distribution.Server.Features.PreferredVersions (maybeBestVersion) import Distribution.Server.Features.PreferredVersions.State +import Distribution.Server.Features.PreferredVersions.Types import Distribution.Server.Packages.PackageIndex (PackageIndex) import qualified Distribution.Server.Packages.PackageIndex as PackageIndex import Distribution.Version diff --git a/src/Distribution/Server/Pages/Package.hs b/src/Distribution/Server/Pages/Package.hs index b58991edc..c6373ae4f 100644 --- a/src/Distribution/Server/Pages/Package.hs +++ b/src/Distribution/Server/Pages/Package.hs @@ -327,7 +327,6 @@ renderVersion (PackageIdentifier pname pversion) allVersions info = status st = case st of NormalVersion -> [theclass "normal"] DeprecatedVersion -> [theclass "deprecated"] - UnpreferredVersion -> [theclass "unpreferred"] infoHtml = case info of Nothing -> noHtml; Just str -> " (" +++ (anchor ! [href str] << "info") +++ ")" categoryField :: String -> Html diff --git a/src/Distribution/Server/Pages/PackageFromTemplate.hs b/src/Distribution/Server/Pages/PackageFromTemplate.hs index 82a7f877b..1d3ca249f 100644 --- a/src/Distribution/Server/Pages/PackageFromTemplate.hs +++ b/src/Distribution/Server/Pages/PackageFromTemplate.hs @@ -374,7 +374,6 @@ renderVersion (PackageIdentifier pname pversion) allVersions info = status st = case st of NormalVersion -> [] DeprecatedVersion -> [theclass "deprecated"] - UnpreferredVersion -> [theclass "unpreferred"] infoHtml = case info of Nothing -> noHtml diff --git a/src/Distribution/Server/Pages/Reverse.hs b/src/Distribution/Server/Pages/Reverse.hs index aa8a288aa..21f845479 100644 --- a/src/Distribution/Server/Pages/Reverse.hs +++ b/src/Distribution/Server/Pages/Reverse.hs @@ -62,7 +62,6 @@ reverseHtmlUtil ReverseFeature{reverseResource} = ReverseHtmlUtil{..} | (ReverseRender pkg status count'', n) <- zip renders [(1::Int)..] ] renderStatus (Just DeprecatedVersion) = [theclass "deprecated"] - renderStatus (Just UnpreferredVersion) = [theclass "unpreferred"] renderStatus _ = [] renderCount ReverseCount{totalCount, directCount} = diff --git a/tests/ReverseDependenciesTest.hs b/tests/ReverseDependenciesTest.hs index c1d150239..b536633eb 100644 --- a/tests/ReverseDependenciesTest.hs +++ b/tests/ReverseDependenciesTest.hs @@ -23,7 +23,8 @@ import Network.URI (parseURI) import System.Random (mkStdGen) import Distribution.Package (PackageIdentifier(..), mkPackageName, packageId, packageName) -import Distribution.Server.Features.PreferredVersions.State (PreferredVersions(..), VersionStatus(NormalVersion), PreferredInfo(..)) +import Distribution.Server.Features.PreferredVersions.State (PreferredVersions(..), PreferredInfo(..)) +import Distribution.Server.Features.PreferredVersions.Types (VersionStatus(NormalVersion)) import Distribution.Server.Features.ReverseDependencies (ReverseFeature(..), ReverseCount(..), reverseFeature) import Distribution.Server.Features.ReverseDependencies.State (ReverseIndex(..), addPackage, constructReverseIndex, emptyReverseIndex, getDependenciesFlat, getDependencies, getDependenciesFlatRaw, getDependenciesRaw) import Distribution.Server.Features.Tags (Tag(..))