Pull more get-issue-branch-base-and-target-refs calls out

4 files changed, 89 insertions, 73 deletions

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 427fd2f..92ec1a2 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -70,16 +70,13 @@
                       (alist-delete "derivation_changes"
                                     json-body)))))))
 
-(define* (patch-series-compare-url issue-number #:key (json? #t))
-  (and=>
-   (get-issue-branch-base-and-target-refs issue-number)
-   (lambda (base-and-target)
-     (string-append
-      "https://data.qa.guix.gnu.org/compare"
-      (if json? ".json" "")
-      "?"
-      "base_commit=" (assq-ref base-and-target 'base)
-      "&target_commit=" (assq-ref base-and-target 'target)))))
+(define* (patch-series-compare-url base-and-target-refs #:key (json? #t))
+  (string-append
+   "https://data.qa.guix.gnu.org/compare"
+   (if json? ".json" "")
+   "?"
+   "base_commit=" (assq-ref base-and-target-refs 'base)
+   "&target_commit=" (assq-ref base-and-target-refs 'target)))
 
 (define (patch-series-comparison url)
   (retry-on-error
diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm
index 2a0c289..f1d26b1 100644
--- a/guix-qa-frontpage/manage-patch-branches.scm
+++ b/guix-qa-frontpage/manage-patch-branches.scm
@@ -54,10 +54,10 @@
 
 (define (get-issue-branch-base-and-target-refs issue)
   (define base-tag
-    (simple-format #f "base-for-issue-~A" issue))
+    (string-append "base-for-issue-" (number->string issue)))
 
   (define target-branch
-    (simple-format #f "patches/issue-~A" issue))
+    (string-append "patches/issue-" (number->string issue)))
 
   (let ((base (get-commit base-tag))
         (target (get-commit target-branch)))
@@ -241,7 +241,10 @@
                                         (string->number issue-number)))
                              (comparison-url
                               (and series
-                                   (patch-series-compare-url issue-number))))
+                                   (and=>
+                                    (get-issue-branch-base-and-target-refs
+                                     issue-number)
+                                    patch-series-compare-url))))
                         (with-exception-handler
                             (lambda (exn)
                               (if (and
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 89d7941..fe3d344 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -314,62 +314,74 @@
                                 #:ttl 1200)
                                (string->number number))))
          (if series
-             (let ((derivation-changes
-                    change-details
-                    (call-with-values
-                        (lambda ()
-                          (and=>
-                           (get-issue-branch-base-and-target-refs number)
-                           (lambda (base-and-target-refs)
-                             (with-exception-handler
-                                 (lambda (exn)
-                                   (simple-format
-                                    (current-error-port)
-                                    "exception fetching derivation changes: ~A\n"
-                                    exn)
-
-                                   (values #f #f))
-                               (lambda ()
-                                 (with-sqlite-cache
-                                  database
-                                  'derivation-changes
-                                  patch-series-derivation-changes
-                                  #:args
-                                  (list
-                                   (patch-series-derivation-changes-url
-                                    base-and-target-refs
-                                    #:systems %systems-to-submit-builds-for))
-                                  #:ttl 6000))
-                               #:unwind? #t))))
-                      (lambda res
-                        (match res
-                          ((#f)
-                           (values #f #f))
-                          (_ (apply values res))))))
-                   (comparison-details
-                    (and=>
-                     (patch-series-compare-url number)
-                     (lambda (url)
-                       (with-exception-handler
-                           (lambda (exn)
-                             (if (guix-data-service-error? exn)
-                                 exn
-                                 (raise-exception exn)))
+             (let* ((derivation-changes
+                     change-details
+                     (call-with-values
                          (lambda ()
-                           (with-sqlite-cache
-                            database
-                            'lint-warnings
-                            patch-series-comparison
-                            #:args
-                            (list url)
-                            #:ttl 6000))
-                         #:unwind? #t)))))
+                           (and=>
+                            (with-sqlite-cache
+                             database
+                             'issue-branch-base-and-target-refs
+                             get-issue-branch-base-and-target-refs
+                             #:args (list (string->number number))
+                             #:ttl 1200)
+                            (lambda (base-and-target-refs)
+                              (with-exception-handler
+                                  (lambda (exn)
+                                    (simple-format
+                                     (current-error-port)
+                                     "exception fetching derivation changes: ~A\n"
+                                     exn)
+
+                                    (values #f #f))
+                                (lambda ()
+                                  (with-sqlite-cache
+                                   database
+                                   'derivation-changes
+                                   patch-series-derivation-changes
+                                   #:args
+                                   (list
+                                    (patch-series-derivation-changes-url
+                                     base-and-target-refs
+                                     #:systems %systems-to-submit-builds-for))
+                                   #:ttl 6000))
+                                #:unwind? #t))))
+                       (lambda res
+                         (match res
+                           ((#f)
+                            (values #f #f))
+                           (_ (apply values res))))))
+                    (base-and-target-refs
+                     (get-issue-branch-base-and-target-refs
+                      (string->number number)))
+                    (comparison-details
+                     (and=>
+                      base-and-target-refs
+                      (lambda (base-and-target-refs)
+                        (with-exception-handler
+                            (lambda (exn)
+                              (if (guix-data-service-error? exn)
+                                  exn
+                                  (raise-exception exn)))
+                          (lambda ()
+                            (with-sqlite-cache
+                             database
+                             'lint-warnings
+                             patch-series-comparison
+                             #:args
+                             (list (patch-series-compare-url
+                                    base-and-target-refs))
+                             #:ttl 6000))
+                          #:unwind? #t)))))
                (render-html
                 #:sxml (issue-view number
                                    series
                                    (assq-ref (assq-ref series 'mumi)
                                              'tags)
-                                   (patch-series-compare-url number #:json? #f)
+                                   (and base-and-target-refs
+                                        (patch-series-compare-url
+                                         base-and-target-refs
+                                         #:json? #f))
                                    derivation-changes
                                    change-details
                                    comparison-details)))
@@ -478,7 +490,12 @@ port. Also, the port used can be changed by passing the --port option.\n"
                       #f)
                   (lambda ()
                     (and=>
-                     (get-issue-branch-base-and-target-refs (car series))
+                     (with-sqlite-cache
+                      database
+                      'issue-branch-base-and-target-refs
+                      get-issue-branch-base-and-target-refs
+                      #:args (list (car series))
+                      #:ttl 1200)
                      (lambda (base-and-target-refs)
                        (with-sqlite-cache
                         database
diff --git a/scripts/guix-qa-frontpage.in b/scripts/guix-qa-frontpage.in
index 7c4e42e..9debaf7 100644
--- a/scripts/guix-qa-frontpage.in
+++ b/scripts/guix-qa-frontpage.in
@@ -112,15 +112,14 @@
                  (assq-ref opts 'host)
                  (assq-ref opts 'port))
 
-  (let* ((metrics-registry (make-metrics-registry
-                           #:namespace
-                           "guixqafrontpage"))
-         (database
-          (setup-database (assq-ref opts 'database)
-                          metrics-registry)))
-
-    (parameterize
-        ((%git-repository-location (string-append (getcwd) "/guix.git")))
+  (parameterize
+      ((%git-repository-location (string-append (getcwd) "/guix.git")))
+    (let* ((metrics-registry (make-metrics-registry
+                              #:namespace
+                              "guixqafrontpage"))
+           (database
+            (setup-database (assq-ref opts 'database)
+                            metrics-registry)))
 
       (start-refresh-data-thread database)