Skip to content

Commit 7c36cf7

Browse files
kubanekokubaneko
committed
some comments and refactoring
1 parent 834a12f commit 7c36cf7

File tree

2 files changed

+78
-73
lines changed

2 files changed

+78
-73
lines changed

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

Lines changed: 17 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -9,24 +9,32 @@ module Distribution.Server.Features.PackageList.MStats
99
, MStats(..)
1010
) where
1111

12-
1312
import Commonmark
1413
import Commonmark.Extensions
1514
import Control.Monad.Identity
1615
import qualified Data.ByteString.Lazy as BS
1716
( ByteString
18-
, toStrict
19-
)
17+
, toStrict )
2018
import qualified Data.Text as T
2119
import qualified Data.Text.Encoding as T
2220
import qualified Data.Text.Encoding.Error as T
2321
( lenientDecode )
2422

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

29+
data MarkdownStats = NotImportant MStats |
30+
HCode MStats |
31+
Code MStats |
32+
Section MStats |
33+
Table Int MStats | -- Int of rows
34+
PText MStats |
35+
List Int MStats -- Int of elements
36+
deriving (Show)
37+
3038
data MStats = MStats Int Int --number of pictures, number of chars
3139
deriving Show
3240

@@ -42,14 +50,7 @@ instance HasAttributes MStats where
4250
instance Semigroup MStats where
4351
(MStats a b) <> (MStats c d) = MStats (a + c) (b + d)
4452

45-
data MarkdownStats = NotImportant MStats |
46-
HCode MStats |
47-
Code MStats |
48-
Section MStats |
49-
Table Int MStats | -- Int of rows
50-
PText MStats |
51-
List Int MStats -- Int of elements
52-
deriving (Show)
53+
-- Getter functions
5354

5455
getCode :: [MarkdownStats] -> (Int, Int) -- number of code blocks, size of code
5556
getCode [] = (0, 0)
@@ -67,10 +68,6 @@ getSections [] = 0
6768
getSections (Section _ : xs) = 1 + getSections xs
6869
getSections (_ : xs) = getSections xs
6970

70-
(><) :: (Int, Int) -> (Int, Int) -> (Int, Int)
71-
(><) (a, b) (c, d) = (a + c, b + d)
72-
73-
7471
sumMStat :: [MarkdownStats] -> MStats
7572
sumMStat [] = mempty
7673
sumMStat (x : xs) = case x of
@@ -88,6 +85,11 @@ getListsTables ((List a _) : ys) = a + getListsTables ys
8885
getListsTables ((Table a _) : ys) = a + getListsTables ys
8986
getListsTables (_ : ys) = getListsTables ys
9087

88+
-- helper
89+
(><) :: (Int, Int) -> (Int, Int) -> (Int, Int)
90+
(><) (a, b) (c, d) = (a + c, b + d)
91+
92+
-- INSTANCES
9193
instance Rangeable [MarkdownStats] where
9294
ranged = const id
9395

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

Lines changed: 61 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -21,29 +21,29 @@ import Distribution.Server.Util.Markdown
2121
import Distribution.Server.Util.ServeTarball
2222
( loadTarEntry )
2323
import Distribution.Simple.Utils ( safeHead
24-
, safeLast
25-
)
24+
, safeLast )
2625
import Distribution.Types.Version
2726
import qualified Distribution.Utils.ShortText as S
2827

2928
import qualified Codec.Archive.Tar as Tar
3029
import Control.Exception ( SomeException(..)
31-
, handle
32-
)
30+
, handle )
3331
import qualified Data.ByteString.Lazy as BSL
3432
import Data.List ( maximumBy
35-
, sortBy
36-
)
33+
, sortBy )
3734
import Data.Maybe ( isNothing )
3835
import Data.Ord ( comparing )
3936
import qualified Data.Time.Clock as CL
4037
import Distribution.Server.Packages.Readme
4138
import GHC.Float ( int2Float )
4239
import System.FilePath ( isExtensionOf )
4340

41+
-- HELPER FUNCTIONS
42+
4443
handleConst :: a -> IO a -> IO a
4544
handleConst c = handle (\(_ :: SomeException) -> return c)
4645

46+
-- Scorer stores rank information
4747
data Scorer = Scorer
4848
{ maximumS :: !Float
4949
, score :: !Float
@@ -70,6 +70,7 @@ total (Scorer a b) = b / a
7070
scale :: Float -> Scorer -> Scorer
7171
scale mx sc = fracScor mx (total sc)
7272

73+
-- calculates number of versions from version list
7374
major :: Num a => [a] -> a
7475
major (x : _) = x
7576
major _ = 0
@@ -86,6 +87,8 @@ numDays (Just first) (Just end) =
8687
(toRational CL.nominalDay)
8788
numDays _ _ = 0
8889

90+
-- Score Calculations
91+
8992
freshness :: [Version] -> CL.UTCTime -> Bool -> IO Float
9093
freshness [] _ _ = return 0
9194
freshness (x : xs) lastUpd app =
@@ -148,6 +151,58 @@ readmeScore tarCache pkgI app = do
148151
rows = getListsTables stats
149152
sections = getSections stats
150153

154+
authorScore :: Int -> PackageDescription -> Scorer
155+
authorScore maintainers desc =
156+
boolScor 1 (not $ S.null $ author desc) <> maintScore
157+
where
158+
maintScore = boolScor 3 (maintainers > 1) <> scorer 5 (int2Float maintainers)
159+
160+
codeScore :: Float -> Float -> Scorer
161+
codeScore documentS haskellL =
162+
boolScor 1 (haskellL > 700)
163+
<> boolScor 1 (haskellL < 80000)
164+
<> fracScor 2 (min 1 (haskellL / 5000))
165+
<> fracScor 2 (min 1 (documentS / ((3000 + haskellL) * 1600)))
166+
167+
versionScore
168+
:: [Version]
169+
-> VersionsFeature
170+
-> [CL.UTCTime]
171+
-> PackageDescription
172+
-> IO Scorer
173+
versionScore versionList versions lastUploads desc = do
174+
use <- intUsable
175+
depre <- deprec
176+
return $ calculateScore depre lastUploads use
177+
where
178+
pkgNm = pkgName $ package desc
179+
partVers =
180+
flip partitionVersions versionList <$> queryGetPreferredInfo versions pkgNm
181+
intUsable = do
182+
(norm, _, unpref) <- partVers
183+
return $ versionNumbers <$> norm ++ unpref
184+
deprec = do
185+
(_, deprecN, _) <- partVers
186+
return deprecN
187+
calculateScore :: [Version] -> [CL.UTCTime] -> [[Int]] -> Scorer
188+
calculateScore depre lUps intUse =
189+
boolScor 20 (length intUse > 1)
190+
<> scorer 40 (numDays (safeHead lUps) (safeLast lUps) / 11)
191+
<> scorer
192+
15
193+
(int2Float $ length $ filter (\x -> major x > 0 || minor x > 0)
194+
intUse
195+
)
196+
<> scorer
197+
20
198+
(int2Float $ 4 * length
199+
(filter (\x -> major x > 0 && patches x > 0) intUse)
200+
)
201+
<> scorer 10 (int2Float $ patches $ maximumBy (comparing patches) intUse)
202+
<> boolScor 8 (any (\x -> major x == 0 && patches x > 0) intUse)
203+
<> boolScor 10 (any (\x -> major x > 0 && major x < 20) intUse)
204+
<> boolScor 5 (not $ null depre)
205+
151206
baseScore
152207
:: VersionsFeature
153208
-> Int
@@ -213,58 +268,6 @@ baseScore vers maintainers docs env tarCache versionList lastUploads pkgI = do
213268
return $ BlobStorage.filepath (serverBlobStore env) <$> blob
214269
documHas = queryHasDocumentation docs pkgId
215270

216-
authorScore :: Int -> PackageDescription -> Scorer
217-
authorScore maintainers desc =
218-
boolScor 1 (not $ S.null $ author desc) <> maintScore
219-
where
220-
maintScore = boolScor 3 (maintainers > 1) <> scorer 5 (int2Float maintainers)
221-
222-
codeScore :: Float -> Float -> Scorer
223-
codeScore documentS haskellL =
224-
boolScor 1 (haskellL > 700)
225-
<> boolScor 1 (haskellL < 80000)
226-
<> fracScor 2 (min 1 (haskellL / 5000))
227-
<> fracScor 2 (min 1 (documentS / ((3000 + haskellL) * 1600)))
228-
229-
versionScore
230-
:: [Version]
231-
-> VersionsFeature
232-
-> [CL.UTCTime]
233-
-> PackageDescription
234-
-> IO Scorer
235-
versionScore versionList versions lastUploads desc = do
236-
use <- intUsable
237-
depre <- deprec
238-
return $ calculateScore depre lastUploads use
239-
where
240-
pkgNm = pkgName $ package desc
241-
partVers =
242-
flip partitionVersions versionList <$> queryGetPreferredInfo versions pkgNm
243-
intUsable = do
244-
(norm, _, unpref) <- partVers
245-
return $ versionNumbers <$> norm ++ unpref
246-
deprec = do
247-
(_, deprecN, _) <- partVers
248-
return deprecN
249-
calculateScore :: [Version] -> [CL.UTCTime] -> [[Int]] -> Scorer
250-
calculateScore depre lUps intUse =
251-
boolScor 20 (length intUse > 1)
252-
<> scorer 40 (numDays (safeHead lUps) (safeLast lUps) / 11)
253-
<> scorer
254-
15
255-
(int2Float $ length $ filter (\x -> major x > 0 || minor x > 0)
256-
intUse
257-
)
258-
<> scorer
259-
20
260-
(int2Float $ 4 * length
261-
(filter (\x -> major x > 0 && patches x > 0) intUse)
262-
)
263-
<> scorer 10 (int2Float $ patches $ maximumBy (comparing patches) intUse)
264-
<> boolScor 8 (any (\x -> major x == 0 && patches x > 0) intUse)
265-
<> boolScor 10 (any (\x -> major x > 0 && major x < 20) intUse)
266-
<> boolScor 5 (not $ null depre)
267-
268271
temporalScore
269272
:: PackageDescription -> [CL.UTCTime] -> [Version] -> Int -> IO Scorer
270273
temporalScore p lastUploads versionList recentDownloads = do

0 commit comments

Comments
 (0)