PackageRank

datafiles/static/browse.js

@@ -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);
   }
 };

datafiles/templates/Html/browse.html.st

@@ -93,6 +93,9 @@
     #arrow-maintainers {
       width: 100px;
     }
+    #arrow-packageRank {
+      width: 150px;
+    }
     .lastUpload, #sliderAndOutput {
       white-space: nowrap;
     }
@@ -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>

datafiles/templates/Html/noscript-search-form.html.st

@@ -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>

hackage-server.cabal

@@ -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

src/Distribution/Server/Features.hs

@@ -291,6 +291,8 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
                          versionsFeature
                          usersFeature
                          uploadFeature
+                         documentationCoreFeature
+                         tarIndexCacheFeature
 
     searchFeature   <- mkSearchFeature
                          coreFeature

src/Distribution/Server/Features/Browse.hs

@@ -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
@@ -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
@@ -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

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

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

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

@@ -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
@@ -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
@@ -51,6 +53,7 @@ columnToTemplateName = \case
   NormalColumn LastUpload -> "lastUpload"
   NormalColumn ReferenceVersion -> "referenceVersion"
   NormalColumn Maintainers -> "maintainers"
+  NormalColumn PackageRank -> "packageRank"
 
 instance FromJSON Direction where
   parseJSON =

src/Distribution/Server/Features/HaskellPlatform.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE RankNTypes, NamedFieldPuns, RecordWildCards #-}
 module Distribution.Server.Features.HaskellPlatform (
-    PlatformFeature,
+    PlatformFeature(..),
     PlatformResource(..),
     initPlatformFeature,
   ) where

src/Distribution/Server/Features/PackageList.hs

@@ -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(..))
@@ -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
@@ -41,7 +46,6 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Time.Clock (UTCTime(..))
 
-
 data ListFeature = ListFeature {
     listFeatureInterface :: HackageFeature,
 
@@ -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
@@ -115,10 +121,10 @@ emptyPackageItem pkg =
       itemNumBenchmarks = 0,
       itemLastUpload = UTCTime (toEnum 0) 0,
       itemHotness = 0,
-      itemReferenceVersion = ""
+      itemReferenceVersion = "",
+      itemPackageRank = 0
   }
 
-
 initListFeature :: ServerEnv
                 -> IO (CoreFeature
                     -> ReverseFeature
@@ -128,6 +134,8 @@ initListFeature :: ServerEnv
                     -> VersionsFeature
                     -> UserFeature
                     -> UploadFeature
+                    -> DocumentationFeature
+                    -> TarIndexCacheFeature
                     -> IO ListFeature)
 initListFeature _env = do
     itemCache  <- newMemStateWHNF Map.empty
@@ -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)
@@ -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") {
@@ -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
@@ -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
@@ -302,6 +319,7 @@ listFeature CoreFeature{..}
           , itemLastUpload = fst (pkgOriginalUploadInfo pkg)
           , itemRevDepsCount = intRevDirectCount
           , itemHotness = votes + fromIntegral (cmFind pkgname downs) + fromIntegral intRevDirectCount * 2
+          , itemPackageRank = packageR
           }
 
     ------------------------------

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

@@ -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)