Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
62 commits
Select commit Hold shift + click to select a range
40dfc83
started new PageRank branch
kubaneko Jul 1, 2022
cbbaeb6
correct the error
kubaneko Jul 1, 2022
164128b
Created PackageRank module and added it to build
kubaneko Jul 3, 2022
54de869
write out ranking criteria
kubaneko Jul 3, 2022
1e2c6c8
started with maintainer number
kubaneko Jul 4, 2022
e777bf2
added Upload Feature and got number of maintainers for package
kubaneko Jul 5, 2022
6a45d62
divided rankPackage to pure and IO version
kubaneko Jul 5, 2022
0a6dc00
added benchmark and test info
kubaneko Jul 5, 2022
722103b
added Download Feature
kubaneko Jul 7, 2022
056c833
formatted a bit
kubaneko Jul 8, 2022
c0abd3d
used brittany
kubaneko Jul 8, 2022
4c7dba1
added further info about the package
kubaneko Jul 11, 2022
36ef484
added isApp function
kubaneko Jul 12, 2022
53f5104
added Scorer type and started to extract versions
kubaneko Jul 13, 2022
1a157b8
more work on versions
kubaneko Jul 14, 2022
7ab35a9
got versions and partitioned based on status
kubaneko Jul 15, 2022
8d5e68a
separated versions into versionList and verPart
kubaneko Jul 15, 2022
3859803
added last upload times
kubaneko Jul 15, 2022
95e02d3
added freshnessScore
kubaneko Jul 15, 2022
c145124
added Download Scorer
kubaneko Jul 15, 2022
faa42c2
finished simple temporalScore (rankPackageIO)
kubaneko Jul 16, 2022
64453e8
separated rankIO from temporalScore
kubaneko Jul 17, 2022
3c93212
added pageRank
kubaneko Jul 17, 2022
73a65c9
added versionScore
kubaneko Jul 18, 2022
bf38c80
added authorScore
kubaneko Jul 19, 2022
bf77ee3
instance Semigroup Scorer
kubaneko Jul 22, 2022
a27a0c7
got tarballs and fixed warnings
kubaneko Jul 23, 2022
8931732
extracted documentation length
kubaneko Jul 25, 2022
b5ca917
got tarEntries for package and fixed it for documentation
kubaneko Jul 27, 2022
37ce2fb
added codeScore
kubaneko Jul 29, 2022
817559d
replaced some Features by ListFeature
kubaneko Aug 2, 2022
0cd6c96
added some Features to BrowseFeatures - prototype
kubaneko Aug 3, 2022
983606f
Revert "added some Features to BrowseFeatures - prototype"
kubaneko Aug 4, 2022
5147554
Revert "replaced some Features by ListFeature"
kubaneko Aug 5, 2022
22bdc45
changed ListFeature to fit PackageRank
kubaneko Aug 5, 2022
8acc750
changed PackageRank to fit in constructItem
kubaneko Aug 5, 2022
6be2930
integrated PackageRank into ListFeature
kubaneko Aug 7, 2022
8745c69
--no-edit
kubaneko Aug 7, 2022
a3bb571
tried to add an column and failed
kubaneko Aug 7, 2022
e53968c
switch Doubles for Floats
kubaneko Aug 7, 2022
16d6e67
added the column and redid some packageRank issues
kubaneko Aug 9, 2022
f90c797
fixed some basic bugs
kubaneko Aug 9, 2022
d878f42
removed Browse/parser changes
kubaneko Aug 16, 2022
a7bcef6
Fixed missing titile and changed fixed description
kubaneko Aug 16, 2022
6a887b5
Strict Scorer
kubaneko Aug 16, 2022
e881d70
fixed some partial functions
kubaneko Aug 17, 2022
b2a80ce
fixed some bugs
kubaneko Aug 17, 2022
3089b6d
fixed a bug
kubaneko Aug 17, 2022
b888ccb
retrieves src correctly
kubaneko Aug 18, 2022
4748abd
fixed documentation retrieval
kubaneko Aug 19, 2022
7609a8a
changed the algorithm to match cargo
kubaneko Aug 23, 2022
f26effe
prototype for readme parser (collects some info about markdown)
kubaneko Aug 25, 2022
5f38c6b
forgot to add the parser
kubaneko Aug 25, 2022
2ba5071
finished readmeScore
kubaneko Aug 26, 2022
a3c81fa
changed documentation parameter to get reasonable output
kubaneko Aug 27, 2022
ead8f6b
changed some parameters to reflect hackage
kubaneko Aug 27, 2022
9d4d811
moved PackageRank into PackageList Feature and changed UI so packageR…
kubaneko Aug 28, 2022
2cd996b
added some Exception handling
kubaneko Aug 30, 2022
32995c8
some comments and refactoring
kubaneko Sep 4, 2022
39b28de
test commit
kubaneko Oct 2, 2022
5d354da
fixed dumb errors after rebase, changed memsize of packageitem to 12
kubaneko Sep 21, 2025
fc4c527
added reverse Dependencies to PackageRank and tried to scale it for H…
kubaneko Sep 22, 2025
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions datafiles/static/browse.js
Original file line number Diff line number Diff line change
Expand Up @@ -135,6 +135,7 @@ const replaceRows = (response) => {
tr.appendChild(createLastUpload(row.lastUpload));
tr.appendChild(createSimpleText(row.referenceVersion));
tr.appendChild(createMaintainers(row.maintainers));
tr.appendChild(createSimpleText(row.packageRank));
l.appendChild(tr);
}
};
Expand Down
4 changes: 4 additions & 0 deletions datafiles/templates/Html/browse.html.st
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,9 @@
#arrow-maintainers {
width: 100px;
}
#arrow-packageRank {
width: 150px;
}
.lastUpload, #sliderAndOutput {
white-space: nowrap;
}
Expand Down Expand Up @@ -214,6 +217,7 @@
<th id=arrow-lastUpload><a href="javascript: sort('lastUpload')">Last U/L</a></th>
<th id=arrow-referenceVersion><a href="javascript: sort('referenceVersion')">Reference Version</a></th>
<th id=arrow-maintainers><a href="javascript: sort('maintainers')">Maintainers</a></th>
<th id=arrow-packageRank><a href="javascript: sort('packageRank')">Package Rank</a></th>
</tr>
</thead>
<tbody id="listing"></tbody>
Expand Down
1 change: 1 addition & 0 deletions datafiles/templates/Html/noscript-search-form.html.st
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,7 @@
<option $if(tags)$ selected $endif$ value=tags>tags</option>
<option $if(lastUpload)$ selected $endif$ value=lastUpload>date of last upload</option>
<option $if(maintainers)$ selected $endif$ value=maintainers>maintainers</option>
<option $if(packageRank)$ selected $endif$ value=packageRank>rank of the package</option>
</select>
</label>
</div>
Expand Down
2 changes: 2 additions & 0 deletions hackage-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -348,6 +348,8 @@ library
Distribution.Server.Features.PackageCandidates.Backup
Distribution.Server.Features.PackageFeed
Distribution.Server.Features.PackageList
Distribution.Server.Features.PackageList.PackageRank
Distribution.Server.Features.PackageList.MStats
Distribution.Server.Features.Distro
Distribution.Server.Features.Distro.Distributions
Distribution.Server.Features.Distro.Backup
Expand Down
2 changes: 2 additions & 0 deletions src/Distribution/Server/Features.hs
Original file line number Diff line number Diff line change
Expand Up @@ -291,6 +291,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
versionsFeature
usersFeature
uploadFeature
documentationCoreFeature
tarIndexCacheFeature

searchFeature <- mkSearchFeature
coreFeature
Expand Down
5 changes: 4 additions & 1 deletion src/Distribution/Server/Features/Browse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ import qualified Data.Set as S
import Data.Time (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import System.FilePath ((</>))
import GHC.Float.RealFracMethods (roundFloatInteger)

import Data.Aeson (Value(Array), object, toJSON, (.=))
import qualified Data.Aeson.Key as Key
Expand Down Expand Up @@ -139,7 +140,8 @@ packageIndexInfoToValue :: CoreResource -> TagsResource -> UserResource -> Packa
packageIndexInfoToValue
coreResource tagsResource userResource
PackageItem{itemName, itemDownloads, itemVotes,
itemDesc, itemTags, itemLastUpload, itemReferenceVersion, itemMaintainer} =
itemDesc, itemTags, itemLastUpload,
itemReferenceVersion, itemMaintainer, itemPackageRank} =
object
[ Key.fromString "name" .= renderPackage itemName
, Key.fromString "downloads" .= itemDownloads
Expand All @@ -149,6 +151,7 @@ packageIndexInfoToValue
, Key.fromString "lastUpload" .= iso8601Show itemLastUpload
, Key.fromString "referenceVersion" .= itemReferenceVersion
, Key.fromString "maintainers" .= map renderUser itemMaintainer
, Key.fromString "packageRank" .= (roundFloatInteger (1000 * itemPackageRank))
]
where
renderTag :: Tag -> Value
Expand Down
1 change: 1 addition & 0 deletions src/Distribution/Server/Features/Browse/ApplyFilter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,7 @@ sort isSearch sortColumn sortDirection =
LastUpload -> comparing itemLastUpload
ReferenceVersion -> comparing itemReferenceVersion
Maintainers -> comparing itemMaintainer
PackageRank -> comparing itemPackageRank
in sortBy (maybeReverse comparer)
where
maybeReverse =
Expand Down
5 changes: 4 additions & 1 deletion src/Distribution/Server/Features/Browse/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@ import Distribution.Server.Features.Browse.Parsers (Filter, conditions, condsToF

data IsSearch = IsSearch | IsNotSearch

data NormalColumn = Name | Downloads | Rating | Description | Tags | LastUpload | ReferenceVersion | Maintainers
data NormalColumn = Name | Downloads | Rating | Description | Tags |
LastUpload | ReferenceVersion | Maintainers | PackageRank
deriving (Show, Eq)

data Column = DefaultColumn | NormalColumn NormalColumn
Expand Down Expand Up @@ -38,6 +39,7 @@ instance FromJSON Column where
"lastUpload" -> pure $ NormalColumn LastUpload
"referenceVersion" -> pure $ NormalColumn ReferenceVersion
"maintainers" -> pure $ NormalColumn Maintainers
"packageRank" -> pure $ NormalColumn PackageRank
t -> fail $ "Column invalid: " ++ T.unpack t

columnToTemplateName :: Column -> String
Expand All @@ -51,6 +53,7 @@ columnToTemplateName = \case
NormalColumn LastUpload -> "lastUpload"
NormalColumn ReferenceVersion -> "referenceVersion"
NormalColumn Maintainers -> "maintainers"
NormalColumn PackageRank -> "packageRank"

instance FromJSON Direction where
parseJSON =
Expand Down
2 changes: 1 addition & 1 deletion src/Distribution/Server/Features/HaskellPlatform.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{-# LANGUAGE RankNTypes, NamedFieldPuns, RecordWildCards #-}
module Distribution.Server.Features.HaskellPlatform (
PlatformFeature,
PlatformFeature(..),
PlatformResource(..),
initPlatformFeature,
) where
Expand Down
46 changes: 32 additions & 14 deletions src/Distribution/Server/Features/PackageList.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,10 @@ import Distribution.Server.Features.DownloadCount
import Distribution.Server.Features.Tags
import Distribution.Server.Features.Users
import Distribution.Server.Features.Upload(UploadFeature(..))
import Distribution.Server.Features.Documentation (DocumentationFeature(..))
import Distribution.Server.Features.TarIndexCache (TarIndexCacheFeature(..))
import Distribution.Server.Features.PackageList.PackageRank

import Distribution.Server.Users.Users (userIdToName)
import qualified Distribution.Server.Users.UserIdSet as UserIdSet
import Distribution.Server.Users.Group(UserGroup(..), GroupDescription(..))
Expand All @@ -31,6 +35,7 @@ import Distribution.PackageDescription.Configuration
import Distribution.Pretty (prettyShow)
import Distribution.Types.Version (Version)
import Distribution.Utils.ShortText (fromShortText)
import Distribution.Simple.Utils (safeLast)

import Control.Concurrent
import qualified Data.List.NonEmpty as NE
Expand All @@ -41,7 +46,6 @@ import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time.Clock (UTCTime(..))


data ListFeature = ListFeature {
listFeatureInterface :: HackageFeature,

Expand Down Expand Up @@ -91,11 +95,13 @@ data PackageItem = PackageItem {
-- Hotness = recent downloads + stars + 2 * no rev deps
itemHotness :: !Float,
-- Reference version (non-deprecated highest numbered version)
itemReferenceVersion :: !String
itemReferenceVersion :: !String,
-- heuristic way to sort packages
itemPackageRank :: !Float
}

instance MemSize PackageItem where
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)
memSize (PackageItem a b c d e f g h i j k l _m n o r) = memSize12 a b c d e f g h i j (k, l, n, o) r


emptyPackageItem :: PackageName -> PackageItem
Expand All @@ -115,10 +121,10 @@ emptyPackageItem pkg =
itemNumBenchmarks = 0,
itemLastUpload = UTCTime (toEnum 0) 0,
itemHotness = 0,
itemReferenceVersion = ""
itemReferenceVersion = "",
itemPackageRank = 0
}


initListFeature :: ServerEnv
-> IO (CoreFeature
-> ReverseFeature
Expand All @@ -128,6 +134,8 @@ initListFeature :: ServerEnv
-> VersionsFeature
-> UserFeature
-> UploadFeature
-> DocumentationFeature
-> TarIndexCacheFeature
-> IO ListFeature)
initListFeature _env = do
itemCache <- newMemStateWHNF Map.empty
Expand All @@ -140,11 +148,12 @@ initListFeature _env = do
tagsf@TagsFeature{..}
versions@VersionsFeature{..}
users@UserFeature{..}
uploads@UploadFeature{..} -> do
uploads@UploadFeature{..}
documentation tar -> do

let (feature, modifyItem, updateDesc) =
listFeature core revs download votesf tagsf versions users uploads
itemCache itemUpdate
itemCache itemUpdate documentation tar _env

registerHookJust packageChangeHook isPackageChangeAny $ \(pkgid, _) ->
updateDesc (packageName pkgid)
Expand Down Expand Up @@ -213,19 +222,23 @@ listFeature :: CoreFeature
-> UploadFeature
-> MemState (Map PackageName PackageItem)
-> Hook (Set PackageName) ()
-> DocumentationFeature
-> TarIndexCacheFeature
-> ServerEnv
-> (ListFeature,
PackageName -> (PackageItem -> PackageItem) -> IO (),
PackageName -> IO ())

listFeature CoreFeature{..}
ReverseFeature{revDirectCount}
ReverseFeature{revDirectCount, revPackageStats}
DownloadFeature{..}
VotesFeature{..}
TagsFeature{..}
VersionsFeature{..}
versions@VersionsFeature{..}
UserFeature{..}
UploadFeature{..}
itemCache itemUpdate
documentation tar env
= (ListFeature{..}, modifyItem, updateDesc)
where
listFeatureInterface = (emptyHackageFeature "list") {
Expand Down Expand Up @@ -256,7 +269,7 @@ listFeature CoreFeature{..}
let pkgs = PackageIndex.lookupPackageName index pkgname
case pkgs of
[] -> return () --this shouldn't happen
_ -> modifyMemState itemCache . uncurry Map.insert =<< constructItem (last pkgs)
_ -> modifyMemState itemCache . uncurry Map.insert =<< constructItem pkgs

updateDesc pkgname = do
index <- queryGetPackageIndex
Expand All @@ -277,21 +290,25 @@ listFeature CoreFeature{..}
constructItemIndex :: IO (Map PackageName PackageItem)
constructItemIndex = do
index <- queryGetPackageIndex
items <- mapM (constructItem . last) $ PackageIndex.allPackagesByName index
items <- mapM constructItem $ PackageIndex.allPackagesByName index
return $ Map.fromList items

constructItem :: PkgInfo -> IO (PackageName, PackageItem)
constructItem pkg = do
constructItem :: [PkgInfo] -> IO (PackageName, PackageItem)
constructItem pkgs = do
let pkgname = packageName pkg
desc = pkgDesc pkg
intRevDirectCount <- revDirectCount pkgname
pkg = last pkgs
-- [reverse index disabled] revCount <- query . GetReverseCount $ pkgname
revCount@(ReverseCount intRevDirectCount _) <- revPackageStats pkgname
users <- queryGetUserDb
tags <- queryTagsForPackage pkgname
downs <- recentPackageDownloads
votes <- pkgNumScore pkgname
deprs <- queryGetDeprecatedFor pkgname
maintainers <- queryUserGroup (maintainersGroup pkgname)
prefsinfo <- queryGetPreferredInfo pkgname
packageR <- rankPackage versions (cmFind pkgname downs) (UserIdSet.size maintainers)
documentation tar env pkgs (safeLast pkgs) revCount

return $ (,) pkgname . updateReferenceVersion prefsinfo [pkgVersion (pkgInfoId pkg)] $ (updateDescriptionItem desc $ emptyPackageItem pkgname) {
itemTags = tags
Expand All @@ -302,6 +319,7 @@ listFeature CoreFeature{..}
, itemLastUpload = fst (pkgOriginalUploadInfo pkg)
, itemRevDepsCount = intRevDirectCount
, itemHotness = votes + fromIntegral (cmFind pkgname downs) + fromIntegral intRevDirectCount * 2
, itemPackageRank = packageR
}

------------------------------
Expand Down
126 changes: 126 additions & 0 deletions src/Distribution/Server/Features/PackageList/MStats.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,126 @@
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, ConstraintKinds #-}
module Distribution.Server.Features.PackageList.MStats
( parseM
, sumMStat
, getListsTables
, getCode
, getHCode
, getSections
, MStats(..)
) where

import Commonmark
import Commonmark.Extensions
import Control.Monad.Identity
import qualified Data.ByteString.Lazy as BS
( ByteString
, toStrict )
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
( lenientDecode )

-- parses markdown into statistics needed for readmeScore
parseM :: BS.ByteString -> FilePath -> Either ParseError [MarkdownStats]
parseM md name = runIdentity
(commonmarkWith (pipeTableSpec <> defaultSyntaxSpec) name txt)
where txt = T.decodeUtf8With T.lenientDecode . BS.toStrict $ md

data MarkdownStats = NotImportant MStats |
HCode MStats |
Code MStats |
Section MStats |
Table Int MStats | -- Int of rows
PText MStats |
List Int MStats -- Int of elements
deriving (Show)

data MStats = MStats Int Int --number of pictures, number of chars
deriving Show

instance Monoid MStats where
mempty = MStats 0 0

instance Rangeable MStats where
ranged = const id

instance HasAttributes MStats where
addAttributes = const id

instance Semigroup MStats where
(MStats a b) <> (MStats c d) = MStats (a + c) (b + d)

-- Getter functions

getCode :: [MarkdownStats] -> (Int, Int) -- number of code blocks, size of code
getCode [] = (0, 0)
getCode (Code (MStats codeT _) : xs) = (1, codeT) >< getCode xs
getCode (HCode (MStats codeT _) : xs) = (1, codeT) >< getCode xs
getCode (_ : xs) = getCode xs

getHCode :: [MarkdownStats] -> (Int, Int) -- number of code blocks, size of code
getHCode [] = (0, 0)
getHCode (HCode (MStats codeT _) : xs) = (1, codeT) >< getHCode xs
getHCode (_ : xs) = getHCode xs

getSections :: [MarkdownStats] -> Int -- number of code blocks, size of code
getSections [] = 0
getSections (Section _ : xs) = 1 + getSections xs
getSections (_ : xs) = getSections xs

sumMStat :: [MarkdownStats] -> MStats
sumMStat [] = mempty
sumMStat (x : xs) = case x of
(NotImportant a) -> a <> sumMStat xs
(Section a) -> a <> sumMStat xs
(List _ a ) -> a <> sumMStat xs
(Table _ a ) -> a <> sumMStat xs
(HCode a ) -> a <> sumMStat xs
(Code a ) -> a <> sumMStat xs
(PText a ) -> a <> sumMStat xs

getListsTables :: [MarkdownStats] -> Int
getListsTables [] = 0
getListsTables ((List a _) : ys) = a + getListsTables ys
getListsTables ((Table a _) : ys) = a + getListsTables ys
getListsTables (_ : ys) = getListsTables ys

-- helper
(><) :: (Int, Int) -> (Int, Int) -> (Int, Int)
(><) (a, b) (c, d) = (a + c, b + d)

-- INSTANCES
instance Rangeable [MarkdownStats] where
ranged = const id

instance HasAttributes [MarkdownStats] where
addAttributes = const id

instance HasPipeTable MStats [MarkdownStats] where
pipeTable _ _ rows = [Table (length rows) (mconcat $ mconcat <$> rows)]

instance IsInline MStats where
lineBreak = MStats 0 1
softBreak = MStats 0 1
str t = MStats 0 (T.length t)
entity t = MStats 0 (T.length t)
escapedChar _ = MStats 0 1
emph = id
strong = id
link _ _ a = a
image _ _ (MStats a b) = MStats (a + 1) b
code t = MStats 0 (T.length t)
rawInline _ t = MStats 0 (T.length t)

instance IsBlock MStats [MarkdownStats] where
paragraph a = [PText a]
plain a = [PText a]
thematicBreak = [NotImportant mempty]
blockQuote = id
codeBlock language codeT | language == T.pack "haskell" = [HCode (code codeT)]
| otherwise = [Code (code codeT)]
heading _ a = [Section a]
rawBlock _ _ = [NotImportant mempty]
referenceLinkDefinition _ _ = [NotImportant mempty]
list _ _ l = [List (length l + sumLT l) (mconcat $ sumMStat <$> l)]
where sumLT a = sum (getListsTables <$> a)
Loading
Loading