Remove PreferredVersions functionality

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

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"
 
 
 

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

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

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

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)

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

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

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

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} =

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(..))