List maintainers on package page (#1098)

* List maintainers on package page

Author: AliasQli

datafiles/templates/Html/candidate-page.html.st

@@ -130,6 +130,12 @@
     $downloadSection$
 
     <h4>Maintainer's Corner</h4>
+    <p>Package maintainers</p>
+    <ul>
+      <li>
+        $maintainers$
+      </li>
+    </ul>
     <p>For package maintainers and hackage trustees</p>
     <ul>
       <li>

datafiles/templates/Html/package-page.html.st

@@ -94,7 +94,13 @@
 
         <div id="maintainer-corner">
           <h4>Maintainer's Corner</h4>
-          <p>For $package.maintainerURL$ and hackage trustees</p>
+          <p><a href="$package.maintainerURL$">Package maintainers</a></p>
+          <ul>
+            <li>
+              $maintainers$
+            </li>
+          </ul>
+          <p>For package maintainers and hackage trustees</p>
           <ul>
             <li>
               <a href="$baseurl$/package/$package.name$/maintain">

src/Distribution/Server/Features/Html.hs

@@ -76,6 +76,7 @@ import qualified Text.XHtml.Strict as XHtml
 import Text.XHtml.Table (simpleTable)
 import Distribution.PackageDescription (hasLibs)
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
+import Distribution.Server.Pages.Group (listGroupCompact)
 
 
 -- TODO: move more of the below to Distribution.Server.Pages.*, it's getting
@@ -590,6 +591,7 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
             docURL  = packageDocsContentUri docs realpkg
             execs   = rendExecNames render
             pkgdesc = flattenPackageDescription $ pkgDesc pkg
+            maintainers = maintainersGroup pkgname
 
         prefInfo      <- queryGetPreferredInfo pkgname
         distributions <- queryPackageStatus pkgname
@@ -611,6 +613,8 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
         mdocIndex     <- maybe (return Nothing)
           (liftM Just . liftIO . cachedTarIndex) mdoctarblob
         analyticsPixels <- getPackageAnalyticsPixels pkgname
+        userDb          <- queryGetUserDb
+        maintainerlist  <- liftIO $ queryUserGroup maintainers
         let
           idAndReport = fmap (\(rptId, rpt, _) -> (rptId, rpt)) rptStats
           install = getInstall $ fmap (fst &&& BR.installOutcome . snd) idAndReport
@@ -661,6 +665,7 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
           , "candidates"        $= case candidates of
                                     [] -> [ toHtml "No Candidates"]
                                     _  -> [ PagesNew.commaList $ flip map candidates $ \cand -> anchor ! [href $ corePackageIdUri candidatesCore "" $ packageId cand] << display (packageVersion cand) ]
+          , "maintainers"       $= listGroupCompact (map (Users.userIdToName userDb) (Group.toList maintainerlist))
           ] ++
           -- Items not related to IO (mostly pure functions)
           PagesNew.packagePageTemplate render
@@ -1118,7 +1123,7 @@ mkHtmlCandidates utilities@HtmlUtilities{..}
                  DocumentationFeature{documentationResource, queryDocumentation,..}
                  TarIndexCacheFeature{cachedTarIndex}
                  PackageCandidatesFeature{..}
-                 UserFeature{ guardAuthorised, guardAuthorised_ }
+                 UserFeature{ guardAuthorised, guardAuthorised_, queryGetUserDb }
                  templates = HtmlCandidates{..}
   where
     candidates     = candidatesResource
@@ -1277,10 +1282,15 @@ mkHtmlCandidates utilities@HtmlUtilities{..}
               [] -> []
               warn -> [thediv ! [theclass "candidate-warn"] << [paragraph << strong (toHtml "Warnings:"), unordList warn]]
 
+      let maintainers = maintainersGroup pkgname
+      userDb          <- queryGetUserDb
+      maintainerlist  <- liftIO $ queryUserGroup maintainers
+
       return $ toResponse . template $
         [ "versions"          $= (PagesNew.renderVersion (packageId cand) (classifyVersions prefInfo $ insert version otherVersions) Nothing)
         , "maintainHtml"      $= [maintainHtml]
         , "warningBox"        $= warningBox
+        , "maintainers"       $= listGroupCompact (map (Users.userIdToName userDb) (Group.toList maintainerlist))
         ] ++
         PagesNew.packagePageTemplate render
             mdocIndex Nothing mreadme

src/Distribution/Server/Pages/Group.hs

@@ -1,7 +1,8 @@
 -- Body of the HTML page for a package
 module Distribution.Server.Pages.Group (
     groupPage,
-    renderGroupName
+    renderGroupName,
+    listGroupCompact
     -- renderGroupNameWithCands
   ) where
 
@@ -69,7 +70,13 @@ removeUser uname uri =
     ]
 
 listGroup :: [Users.UserName] -> Maybe String -> Html
-listGroup [] _ = p << "No member exist presently"
-listGroup users muri = unordList (map displayName users)
-  where displayName uname = (anchor ! [href $ "/user/" ++ display uname] << display uname) +++
+listGroup [] _ = p << "No current members of group"
+listGroup users muri = unordList (map (displayName muri) users)
+
+listGroupCompact :: [Users.UserName] -> Html
+listGroupCompact [] = toHtml "No current members of group"
+listGroupCompact users = foldr1 (\a b -> a +++ ", " +++ b) (map (displayName Nothing) users)
+
+displayName :: Maybe String -> Users.UserName -> Html
+displayName muri uname = (anchor ! [href $ "/user/" ++ display uname] << display uname) +++
                             maybe [] (removeUser uname) muri

src/Distribution/Server/Pages/PackageFromTemplate.hs

@@ -166,8 +166,7 @@ packagePageTemplate render
       , templateVal "license"       (Old.rendLicense render)
       , templateVal "author"        (toHtml $ author desc)
       , templateVal "maintainer"    (Old.maintainField $ rendMaintainer render)
-      , templateVal "maintainerURL" (toHtml $
-        anchor ! [href $ "/package" </> pkgName </> "maintainers" ] << "package maintainers")
+      , templateVal "maintainerURL" (toHtml $ "/package" </> pkgName </> "maintainers")
       , templateVal "buildDepends"  (snd (Old.renderDependencies render))
       , templateVal "optional"      optionalPackageInfoTemplate
       , templateVal "candidateBanner" candidateBanner