03/03: Add a JSON page for repository branches

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 033858410bed1dfa1efbb5c48a900eb59fcfc813
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Sep 27 16:32:56 2020 +0100

    Add a JSON page for repository branches
---
 guix-data-service/web/repository/controller.scm | 50 +++++++++++++++++++------
 scripts/guix-data-service-process-job.in        | 14 +++++--
 2 files changed, 49 insertions(+), 15 deletions(-)

diff --git a/guix-data-service/web/repository/controller.scm 
b/guix-data-service/web/repository/controller.scm
index e8e1b52..d3c6ab5 100644
--- a/guix-data-service/web/repository/controller.scm
+++ b/guix-data-service/web/repository/controller.scm
@@ -64,19 +64,45 @@
     (('GET "repository" id)
      (match (select-git-repository conn id)
        ((label url cgit-url-base)
-        (render-html
-         #:sxml
-         (view-git-repository
-          (string->number id)
-          label url cgit-url-base
-          (all-branches-with-most-recent-commit conn
-                                                (string->number id)))))
+        (let ((branches
+               (all-branches-with-most-recent-commit conn
+                                                     (string->number id))))
+          (case (most-appropriate-mime-type
+                 '(application/json text/html)
+                 mime-types)
+            ((application/json)
+             (render-json
+              `((id . ,id)
+                (label . ,label)
+                (url . ,url)
+                (branches
+                 . ,(list->vector
+                     (map (match-lambda
+                            ((name commit date revision-exists? job-events)
+                             `((name . ,name)
+                               (commit . ,commit))))
+                          branches))))))
+            (else
+             (render-html
+              #:sxml
+              (view-git-repository
+               (string->number id)
+               label url cgit-url-base
+               branches))))))
        (#f
-        (render-html
-         #:sxml (general-not-found
-                 "Repository not found"
-                 "")
-         #:code 404))))
+        (case (most-appropriate-mime-type
+               '(application/json text/html)
+               mime-types)
+          ((application/json)
+           (render-json
+            '((error . "Repository not found"))
+            #:code 404))
+          (else
+           (render-html
+            #:sxml (general-not-found
+                    "Repository not found"
+                    "")
+            #:code 404))))))
     (('GET "repository" repository-id "branch" branch-name)
      (let ((parsed-query-parameters
             (parse-query-parameters
diff --git a/scripts/guix-data-service-process-job.in 
b/scripts/guix-data-service-process-job.in
index 3572cdb..04b9881 100644
--- a/scripts/guix-data-service-process-job.in
+++ b/scripts/guix-data-service-process-job.in
@@ -26,6 +26,8 @@
              (srfi srfi-37)
              (ice-9 match)
              (guix-data-service database)
+             (guix-data-service data-deletion)
+             (guix-data-service model 
package-derivation-by-guix-revision-range)
              (guix-data-service jobs load-new-guix-revision))
 
 (setvbuf (current-output-port) 'line)
@@ -36,6 +38,12 @@
 ;; Make stack traces more useful
 (setenv "COLUMNS" "256")
 
-(match (command-line)
-  ((name job)
-   (process-load-new-guix-revision-job job)))
+;; (with-postgresql-connection
+;;  "foo"
+;;  rebuild-package-derivations-table)
+;;(delete-revisions-for-all-branches-except-most-recent-n 100)
+(delete-unreferenced-derivations)
+
+;; (match (command-line)
+;;   ((name job)
+;;    (process-load-new-guix-revision-job job)))