From 3a7944997409f823a3026e65ab526bfd7b5e381b Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 31 Aug 2019 12:42:54 +0100
Subject: Display counts of lint warnings on the revision page

---
 guix-data-service/web/controller.scm | 14 ++++++++++++--
 guix-data-service/web/view/html.scm  | 23 ++++++++++++++++++++++-
 2 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 2d1fc72..1ecdd19 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -41,6 +41,7 @@
   #:use-module (guix-data-service model derivation)
   #:use-module (guix-data-service model build-status)
   #:use-module (guix-data-service model build)
+  #:use-module (guix-data-service model lint-checker)
   #:use-module (guix-data-service jobs load-new-guix-revision)
   #:use-module (guix-data-service web render)
   #:use-module (guix-data-service web sxml)
@@ -105,7 +106,9 @@
         (derivations-counts
          (count-packages-derivations-in-revision conn commit-hash))
         (jobs-and-events
-         (select-jobs-and-events-for-commit conn commit-hash)))
+         (select-jobs-and-events-for-commit conn commit-hash))
+        (lint-warning-counts
+         (lint-warning-count-by-lint-checker-for-revision conn commit-hash)))
     (case (most-appropriate-mime-type
            '(application/json text/html)
            mime-types)
@@ -118,7 +121,13 @@
                                           `((system . ,system)
                                             (target . ,target)
                                             (derivation_count . ,derivation_count))))
-                                       derivations-counts))))
+                                       derivations-counts)))
+          (lint_warning_counts . ,(map (match-lambda
+                                         ((name description network-dependent count)
+                                          `(,name . ((description       . ,description)
+                                                     (network_dependent . ,(string=? network-dependent "t"))
+                                                     (count             . ,(string->number count))))))
+                                       lint-warning-counts)))
         #:extra-headers http-headers-for-unchanging-content))
       (else
        (render-html
@@ -128,6 +137,7 @@
                 git-repositories-and-branches
                 derivations-counts
                 jobs-and-events
+                lint-warning-counts
                 #:path-base path-base
                 #:header-text header-text)
         #:extra-headers http-headers-for-unchanging-content)))))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 6203a3b..b8cad39 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -450,9 +450,29 @@
                          '())))))
              jobs-and-events)))))
 
+(define (view-revision/lint-warning-counts lint-warning-counts)
+  `((h3 "Lint warnings")
+    (table
+     (@ (class "table"))
+     (thead
+      (tr
+       (th "Linter")
+       (th "Count")))
+     (tbody
+      ,@(map (match-lambda
+               ((name description network-dependent count)
+                `(tr
+                  (td (span (@ (style "font-family: monospace; display: block;"))
+                            ,name)
+                      (p (@ (style "margin: 6px 0 0px;"))
+                         ,description))
+                  (td ,count))))
+             lint-warning-counts)))))
+
 (define* (view-revision commit-hash packages-count
                         git-repositories-and-branches derivations-count
                         jobs-and-events
+                        lint-warning-counts
                         #:key (path-base "/revision/")
                         header-text)
   (layout
@@ -481,7 +501,8 @@
               '()
               (view-revision/git-repositories git-repositories-and-branches
                                               commit-hash))
-        ,@(view-revision/jobs-and-events jobs-and-events))
+        ,@(view-revision/jobs-and-events jobs-and-events)
+        ,@(view-revision/lint-warning-counts lint-warning-counts))
        (div
         (@ (class "col-md-6"))
         (h3 "Derivations")
-- 
cgit v1.2.3