diff --git a/Application.hs b/Application.hs index 026369c..38c3320 100644 --- a/Application.hs +++ b/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 diff --git a/Handler/PackageCounts.hs b/Handler/PackageCounts.hs new file mode 100644 index 0000000..4e91655 --- /dev/null +++ b/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") diff --git a/config/routes b/config/routes index 41a1980..bcb98a4 100644 --- a/config/routes +++ b/config/routes @@ -55,3 +55,4 @@ /refresh-deprecated RefreshDeprecatedR GET /build-version BuildVersionR GET +/package-counts PackageCountsR GET diff --git a/stackage-server.cabal b/stackage-server.cabal index 269ff8c..ec40dea 100644 --- a/stackage-server.cabal +++ b/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 diff --git a/templates/package-counts.hamlet b/templates/package-counts.hamlet new file mode 100644 index 0000000..2dc47c0 --- /dev/null +++ b/templates/package-counts.hamlet @@ -0,0 +1,20 @@ +
+

Package counts + +

+ This page provides historical information on the number of packages included + in Stackage Nightly and LTS Haskell snapshots, purely for the sake of + curiosity. + + + + + + $forall c <- counts + +
Title + Count + Date +
#{name c} + #{packages c} + #{show $ date c} diff --git a/templates/package-counts.lucius b/templates/package-counts.lucius new file mode 100644 index 0000000..f95547c --- /dev/null +++ b/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; +}