Skip to content

Commit 7bad6f8

Browse files
blackheavenblackheaven
committed
fix: replace list lastVersion by referenceVersion (#1264)
1 parent 1cba044 commit 7bad6f8

File tree

8 files changed

+62
-19
lines changed

8 files changed

+62
-19
lines changed

‎datafiles/static/browse.js

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,7 @@ const replaceRows = (response) => {
133133
tr.appendChild(createSimpleText(row.description));
134134
tr.appendChild(createTags(row.tags));
135135
tr.appendChild(createLastUpload(row.lastUpload));
136-
tr.appendChild(createSimpleText(row.lastVersion));
136+
tr.appendChild(createSimpleText(row.referenceVersion));
137137
tr.appendChild(createMaintainers(row.maintainers));
138138
l.appendChild(tr);
139139
}

‎datafiles/templates/Html/browse.html.st

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -212,7 +212,7 @@
212212
<th id=arrow-description><a href="javascript: sort('description')">Description</a></th>
213213
<th id=arrow-tags><a href="javascript: sort('tags')">Tags</a></th>
214214
<th id=arrow-lastUpload><a href="javascript: sort('lastUpload')">Last U/L</a></th>
215-
<th id=arrow-lastVersion><a href="javascript: sort('lastVersion')">Last Version</a></th>
215+
<th id=arrow-referenceVersion><a href="javascript: sort('referenceVersion')">Reference Version</a></th>
216216
<th id=arrow-maintainers><a href="javascript: sort('maintainers')">Maintainers</a></th>
217217
</tr>
218218
</thead>

‎src/Distribution/Server/Features/Browse.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -139,15 +139,15 @@ packageIndexInfoToValue :: CoreResource -> TagsResource -> UserResource -> Packa
139139
packageIndexInfoToValue
140140
coreResource tagsResource userResource
141141
PackageItem{itemName, itemDownloads, itemVotes,
142-
itemDesc, itemTags, itemLastUpload, itemLastVersion, itemMaintainer} =
142+
itemDesc, itemTags, itemLastUpload, itemReferenceVersion, itemMaintainer} =
143143
object
144144
[ Key.fromString "name" .= renderPackage itemName
145145
, Key.fromString "downloads" .= itemDownloads
146146
, Key.fromString "votes" .= itemVotes
147147
, Key.fromString "description" .= itemDesc
148148
, Key.fromString "tags" .= map renderTag (S.toAscList itemTags)
149149
, Key.fromString "lastUpload" .= iso8601Show itemLastUpload
150-
, Key.fromString "lastVersion" .= itemLastVersion
150+
, Key.fromString "referenceVersion" .= itemReferenceVersion
151151
, Key.fromString "maintainers" .= map renderUser itemMaintainer
152152
]
153153
where

‎src/Distribution/Server/Features/Browse/ApplyFilter.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ sort isSearch sortColumn sortDirection =
6363
Description -> comparing itemDesc
6464
Tags -> comparing (S.toAscList . itemTags)
6565
LastUpload -> comparing itemLastUpload
66-
LastVersion -> comparing itemLastVersion
66+
ReferenceVersion -> comparing itemReferenceVersion
6767
Maintainers -> comparing itemMaintainer
6868
in sortBy (maybeReverse comparer)
6969
where

‎src/Distribution/Server/Features/Browse/Options.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import Distribution.Server.Features.Browse.Parsers (Filter, conditions, condsToF
99

1010
data IsSearch = IsSearch | IsNotSearch
1111

12-
data NormalColumn = Name | Downloads | Rating | Description | Tags | LastUpload | LastVersion | Maintainers
12+
data NormalColumn = Name | Downloads | Rating | Description | Tags | LastUpload | ReferenceVersion | Maintainers
1313
deriving (Show, Eq)
1414

1515
data Column = DefaultColumn | NormalColumn NormalColumn
@@ -36,7 +36,7 @@ instance FromJSON Column where
3636
"description" -> pure $ NormalColumn Description
3737
"tags" -> pure $ NormalColumn Tags
3838
"lastUpload" -> pure $ NormalColumn LastUpload
39-
"lastVersion" -> pure $ NormalColumn LastVersion
39+
"referenceVersion" -> pure $ NormalColumn ReferenceVersion
4040
"maintainers" -> pure $ NormalColumn Maintainers
4141
t -> fail $ "Column invalid: " ++ T.unpack t
4242

@@ -49,7 +49,7 @@ columnToTemplateName = \case
4949
NormalColumn Description -> "description"
5050
NormalColumn Tags -> "tags"
5151
NormalColumn LastUpload -> "lastUpload"
52-
NormalColumn LastVersion -> "lastVersion"
52+
NormalColumn ReferenceVersion -> "referenceVersion"
5353
NormalColumn Maintainers -> "maintainers"
5454

5555
instance FromJSON Direction where

‎src/Distribution/Server/Features/Html/HtmlUtilities.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ htmlUtilities CoreFeature{coreResource}
5252
, td $ toHtml $ itemDesc item
5353
, td $ " (" +++ renderTags (itemTags item) +++ ")"
5454
, td $ toHtml $ formatTime defaultTimeLocale "%F" (itemLastUpload item)
55-
, td $ toHtml $ itemLastVersion item
55+
, td $ toHtml $ itemReferenceVersion item
5656
, td $ "" +++ intersperse (toHtml ", ") (map renderUser (itemMaintainer item))
5757
]
5858
where

‎src/Distribution/Server/Features/PackageList.hs

Lines changed: 47 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import Distribution.Package
2929
import Distribution.PackageDescription
3030
import Distribution.PackageDescription.Configuration
3131
import Distribution.Pretty (prettyShow)
32+
import Distribution.Types.Version (Version)
3233
import Distribution.Utils.ShortText (fromShortText)
3334

3435
import Control.Concurrent
@@ -89,17 +90,33 @@ data PackageItem = PackageItem {
8990
itemLastUpload :: !UTCTime,
9091
-- Hotness = recent downloads + stars + 2 * no rev deps
9192
itemHotness :: !Float,
92-
-- Last version
93-
itemLastVersion :: !String
93+
-- Reference version (non-deprecated highest numbered version)
94+
itemReferenceVersion :: !String
9495
}
9596

9697
instance MemSize PackageItem where
9798
memSize (PackageItem a b c d e f g h i j k l _m n o) = memSize11 a b c d e f g h i j (k, l, n, o)
9899

99100

100101
emptyPackageItem :: PackageName -> PackageItem
101-
emptyPackageItem pkg = PackageItem pkg Set.empty Nothing "" []
102-
0 0 0 False 0 0 0 (UTCTime (toEnum 0) 0) 0 ""
102+
emptyPackageItem pkg =
103+
PackageItem {
104+
itemName = pkg,
105+
itemTags = Set.empty,
106+
itemDeprecated = Nothing,
107+
itemDesc = "",
108+
itemMaintainer = [],
109+
itemVotes = 0,
110+
itemDownloads = 0,
111+
itemRevDepsCount = 0,
112+
itemHasLibrary = False,
113+
itemNumExecutables = 0,
114+
itemNumTests = 0,
115+
itemNumBenchmarks = 0,
116+
itemLastUpload = UTCTime (toEnum 0) 0,
117+
itemHotness = 0,
118+
itemReferenceVersion = ""
119+
}
103120

104121

105122
initListFeature :: ServerEnv
@@ -134,10 +151,14 @@ initListFeature _env = do
134151

135152
registerHookJust packageChangeHook isPackageAdd $ \pkg -> do
136153
let pkgname = packageName . packageId $ pkg
137-
modifyItem pkgname $ \x -> x
138-
{itemLastUpload = fst (pkgOriginalUploadInfo pkg)
139-
,itemLastVersion = prettyShow $ pkgVersion $ pkgInfoId pkg
140-
}
154+
prefsinfo <- queryGetPreferredInfo pkgname
155+
index <- queryGetPackageIndex
156+
let allVersions = packageVersion <$> PackageIndex.lookupPackageName index pkgname
157+
modifyItem pkgname $ \x ->
158+
updateReferenceVersion prefsinfo allVersions $
159+
x
160+
{ itemLastUpload = fst (pkgOriginalUploadInfo pkg)
161+
}
141162
runHook_ itemUpdate (Set.singleton pkgname)
142163

143164
registerHook groupChangedHook $ \(gd,_,_,_,_) ->
@@ -174,6 +195,11 @@ initListFeature _env = do
174195
modifyItem pkgname (updateDeprecation mpkgs)
175196
runHook_ itemUpdate (Set.singleton pkgname)
176197

198+
registerHook updatePreferredHook $ \(pkgname, prefsinfo) -> do
199+
index <- queryGetPackageIndex
200+
let allVersions = packageVersion <$> PackageIndex.lookupPackageName index pkgname
201+
modifyItem pkgname $ updateReferenceVersion prefsinfo allVersions
202+
177203
return feature
178204

179205

@@ -265,8 +291,9 @@ listFeature CoreFeature{..}
265291
votes <- pkgNumScore pkgname
266292
deprs <- queryGetDeprecatedFor pkgname
267293
maintainers <- queryUserGroup (maintainersGroup pkgname)
294+
prefsinfo <- queryGetPreferredInfo pkgname
268295

269-
return $ (,) pkgname $ (updateDescriptionItem desc $ emptyPackageItem pkgname) {
296+
return $ (,) pkgname . updateReferenceVersion prefsinfo [pkgVersion (pkgInfoId pkg)] $ (updateDescriptionItem desc $ emptyPackageItem pkgname) {
270297
itemTags = tags
271298
, itemMaintainer = map (userIdToName users) (UserIdSet.toList maintainers)
272299
, itemDeprecated = deprs
@@ -275,7 +302,6 @@ listFeature CoreFeature{..}
275302
, itemLastUpload = fst (pkgOriginalUploadInfo pkg)
276303
, itemRevDepsCount = intRevDirectCount
277304
, itemHotness = votes + fromIntegral (cmFind pkgname downs) + fromIntegral intRevDirectCount * 2
278-
, itemLastVersion = prettyShow $ pkgVersion $ pkgInfoId pkg
279305
}
280306

281307
------------------------------
@@ -329,6 +355,17 @@ updateDeprecation pkgs item =
329355
itemDeprecated = pkgs
330356
}
331357

358+
updateReferenceVersion :: PreferredInfo -> [Version] -> PackageItem -> PackageItem
359+
updateReferenceVersion prefsinfo allVersions item =
360+
item {
361+
itemReferenceVersion =
362+
case nonDeprecatedVersion of
363+
[] -> ""
364+
xs -> prettyShow $ maximum xs
365+
}
366+
where
367+
nonDeprecatedVersion = filter (`notElem` deprecatedVersions prefsinfo) allVersions
368+
332369
updateReverseItem :: Int -> PackageItem -> PackageItem
333370
updateReverseItem revDirectCount item =
334371
item {

‎src/Distribution/Server/Features/PreferredVersions.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ data VersionsFeature = VersionsFeature {
5555
versionsResource :: VersionsResource,
5656
deprecatedHook :: Hook (PackageName, Maybe [PackageName]) (),
5757
putDeprecated :: PackageName -> ServerPartE Bool,
58+
updatePreferredHook :: Hook (PackageName, PreferredInfo) (),
5859
putPreferred :: PackageName -> ServerPartE (),
5960
updateDeprecatedTags :: IO (),
6061

@@ -101,12 +102,14 @@ initVersionsFeature :: ServerEnv
101102
initVersionsFeature env@ServerEnv{serverStateDir} = do
102103
preferredState <- preferredStateComponent False serverStateDir
103104
deprecatedHook <- newHook
105+
updatePreferredHook <- newHook
104106

105107
return $ \core upload tags user -> do
106108

107109
let feature = versionsFeature env
108110
core upload tags user
109111
preferredState deprecatedHook
112+
updatePreferredHook
110113
return feature
111114

112115
preferredStateComponent :: Bool -> FilePath -> IO (StateComponent AcidState PreferredVersions)
@@ -130,6 +133,7 @@ versionsFeature :: ServerEnv
130133
-> UserFeature
131134
-> StateComponent AcidState PreferredVersions
132135
-> Hook (PackageName, Maybe [PackageName]) ()
136+
-> Hook (PackageName, PreferredInfo) ()
133137
-> VersionsFeature
134138
versionsFeature ServerEnv{ serverVerbosity = verbosity }
135139
CoreFeature{..}
@@ -138,6 +142,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
138142
UserFeature{ guardAuthorised_ }
139143
preferredState
140144
deprecatedHook
145+
updatePreferredHook
141146
= VersionsFeature{..}
142147
where
143148
versionsFeatureInterface = (emptyHackageFeature "versions") {
@@ -315,6 +320,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
315320
(prefs, deprs) <- lookPrefRangeDeprecatedVersions pkgs
316321

317322
prefinfo <- updateState preferredState (SetPreferredInfo pkgname prefs deprs)
323+
runHook_ updatePreferredHook (pkgname, prefinfo { deprecatedVersions = deprs }) -- It seems they are not set
318324
updateIndexPackagePreferredVersions pkgname prefinfo
319325
where
320326
lookPrefRangeDeprecatedVersions pkgs = do

0 commit comments

Comments
 (0)