Browse Source

Add /package-counts

osd
Michael Snoyman 7 years ago
parent
commit
af28229971
  1. 1
      Application.hs
  2. 39
      Handler/PackageCounts.hs
  3. 1
      config/routes
  4. 1
      stackage-server.cabal
  5. 20
      templates/package-counts.hamlet
  6. 12
      templates/package-counts.lucius

1
Application.hs

@ -71,6 +71,7 @@ import Handler.BannedTags
import Handler.RefreshDeprecated
import Handler.Hoogle
import Handler.BuildVersion
import Handler.PackageCounts
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

39
Handler/PackageCounts.hs

@ -0,0 +1,39 @@
module Handler.PackageCounts
( getPackageCountsR
) where
import Import hiding (Value (..), groupBy, (==.))
import Data.Slug (mkSlug)
import Database.Esqueleto
data Count = Count
{ name :: Text
, date :: Day
, packages :: Int
}
toCount :: (Value Text, Value UTCTime, Value Int) -> Count
toCount (Value x, Value y, Value z) =
Count x (utctDay y) z
getPackageCountsR :: Handler Html
getPackageCountsR = do
admins <- adminUsers <$> getExtra
counts <- runDB $ do
let slugs = mapMaybe mkSlug $ setToList admins
adminUids <- selectKeysList [UserHandle <-. slugs] []
fmap (map toCount) $ select $ from $ \(s, p) -> do
where_ $
(not_ $ s ^. StackageTitle `like` val "%inclusive") &&.
(s ^. StackageId ==. p ^. PackageStackage) &&.
(s ^. StackageUser `in_` valList adminUids)
groupBy (s ^. StackageTitle, s ^. StackageUploaded)
orderBy [desc $ s ^. StackageUploaded]
return
( s ^. StackageTitle
, s ^. StackageUploaded
, countRows
)
defaultLayout $ do
setTitle "Package counts"
$(widgetFile "package-counts")

1
config/routes

@ -55,3 +55,4 @@
/refresh-deprecated RefreshDeprecatedR GET
/build-version BuildVersionR GET
/package-counts PackageCountsR GET

1
stackage-server.cabal

@ -54,6 +54,7 @@ library
Handler.BannedTags
Handler.RefreshDeprecated
Handler.BuildVersion
Handler.PackageCounts
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT

20
templates/package-counts.hamlet

@ -0,0 +1,20 @@
<div .container>
<h1>Package counts
<p>
This page provides historical information on the number of packages included
in Stackage Nightly and LTS Haskell snapshots, purely for the sake of
curiosity.
<table>
<thead>
<tr>
<th .name>Title
<th .count>Count
<th .date>Date
<tbody>
$forall c <- counts
<tr>
<td .name>#{name c}
<td .count>#{packages c}
<td .date>#{show $ date c}

12
templates/package-counts.lucius

@ -0,0 +1,12 @@
th {
font-size: 1.2em;
}
td, th {
padding: 0.5em;
}
.name {
text-align: right;
font-weight: bold;
}
Loading…
Cancel
Save