Support controlling the fields returned for package derivations

Mostly so that the builds can be avoided when querying for all the
derivations, as that's slow.

3 files changed, 79 insertions, 17 deletions

diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
index e2bd3e6..693e513 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -181,7 +181,9 @@ ORDER BY derivations.system DESC,
                 (filter (lambda (build)
                           (assoc-ref build "status"))
                         (vector->list
-                         (json-string->scm builds-json))))))
+                         (json-string->scm builds-json)))))
+         ((file_name system target)
+          (list file_name system target)))
        (exec-query conn
                    query
                    (list revision-commit-hash name version))))
@@ -194,7 +196,8 @@ ORDER BY derivations.system DESC,
                                                  minimum-builds
                                                  maximum-builds
                                                  limit-results
-                                                 after-name)
+                                                 after-name
+                                                 (include-builds? #t))
   (define criteria
     (string-join
      `(,@(filter-map
@@ -243,7 +246,9 @@ ORDER BY derivations.system DESC,
      "
 SELECT derivations.file_name,
        derivations.system,
-       package_derivations.target,
+       package_derivations.target"
+     (if include-builds?
+         ",
        (
          SELECT JSON_AGG(
                   json_build_object(
@@ -264,7 +269,9 @@ SELECT derivations.file_name,
            ON builds.id = latest_build_status.build_id
          WHERE builds.derivation_output_details_set_id =
                derivations_by_output_details_set.derivation_output_details_set_id
-       ) AS builds
+       ) AS builds"
+         "")
+     "
 FROM derivations
 INNER JOIN derivations_by_output_details_set
   ON derivations.id = derivations_by_output_details_set.derivation_id
@@ -299,7 +306,9 @@ ORDER BY derivations.file_name
                 target
                 (if (string-null? builds)
                     #()
-                    (json-string->scm builds)))))
+                    (json-string->scm builds))))
+         ((file_name system target)
+          (list file_name system target)))
        (exec-query conn
                    query
                    `(,commit-hash
@@ -316,7 +325,8 @@ ORDER BY derivations.file_name
                                                  minimum-builds
                                                  maximum-builds
                                                  limit-results
-                                                 after-name)
+                                                 after-name
+                                                 (include-builds? #t))
   (define criteria
     (string-join
      `(,@(filter-map
@@ -365,7 +375,9 @@ ORDER BY derivations.file_name
      "
 SELECT derivations.file_name,
        derivations.system,
-       package_derivations.target,
+       package_derivations.target"
+     (if include-builds?
+         ",
        (
          SELECT JSON_AGG(
                   json_build_object(
@@ -386,7 +398,9 @@ SELECT derivations.file_name,
            ON builds.id = latest_build_status.build_id
          WHERE builds.derivation_output_details_set_id =
                derivations_by_output_details_set.derivation_output_details_set_id
-       ) AS builds
+       ) AS builds"
+         "")
+     "
 FROM derivations
 INNER JOIN derivations_by_output_details_set
   ON derivations.id = derivations_by_output_details_set.derivation_id
@@ -416,6 +430,10 @@ ORDER BY derivations.file_name
          "")))
 
   (map (match-lambda
+         ((file_name system target)
+          (list file_name
+                system
+                target))
          ((file_name system target builds)
           (list file_name
                 system
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index ddaf70a..25b7604 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -174,6 +174,8 @@
                     (target ,parse-target #:multi-value)
                     (maximum_builds ,parse-number)
                     (minimum_builds ,parse-number)
+                    (field          ,identity #:multi-value
+                                    #:default ("system" "target" "builds"))
                     (after_name ,identity)
                     (limit_results  ,parse-result-limit
                                     #:no-default-when (all_results)
@@ -723,6 +725,8 @@
               (assq-ref query-parameters 'all_results))
              (search-query
               (assq-ref query-parameters 'search_query))
+             (fields
+              (assq-ref query-parameters 'field))
              (derivations
               (if search-query
                   (search-package-derivations-in-revision
@@ -734,7 +738,8 @@
                    #:maximum-builds (assq-ref query-parameters 'maximum_builds)
                    #:minimum-builds (assq-ref query-parameters 'minimum_builds)
                    #:limit-results limit-results
-                   #:after-name (assq-ref query-parameters 'after_name))
+                   #:after-name (assq-ref query-parameters 'after_name)
+                   #:include-builds? (member "builds" fields))
                   (select-package-derivations-in-revision
                    conn
                    commit-hash
@@ -743,7 +748,8 @@
                    #:maximum-builds (assq-ref query-parameters 'maximum_builds)
                    #:minimum-builds (assq-ref query-parameters 'minimum_builds)
                    #:limit-results limit-results
-                   #:after-name (assq-ref query-parameters 'after_name))))
+                   #:after-name (assq-ref query-parameters 'after_name)
+                   #:include-builds? (member "builds" fields))))
              (build-server-urls
               (group-to-alist
                (match-lambda
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index 71a99d5..2d1b706 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -1052,6 +1052,17 @@ figure {
                                             #:key (path-base "/revision/")
                                             header-text
                                             header-link)
+  (define field-options
+    (map
+     (lambda (field)
+       (cons field
+             (hyphenate-words
+              (string-downcase field))))
+     '("(no additional fields)" "System" "Target" "Builds")))
+
+  (define fields
+    (assq-ref query-parameters 'field))
+
   (layout
    #:body
    `(,(header)
@@ -1096,6 +1107,11 @@ figure {
             "Maximum builds" query-parameters
             #:help-text "Only show derivations with a maximum number of known builds.")
           ,(form-horizontal-control
+            "Fields" query-parameters
+            #:name "field"
+            #:options field-options
+            #:help-text "Fields to return in the response.")
+          ,(form-horizontal-control
             "After name" query-parameters
             #:help-text
             "List derivations that are alphabetically after the given name.")
@@ -1122,20 +1138,42 @@ figure {
          (thead
           (tr
            (th "File name")
-           (th "System")
-           (th "Target")
-           (th "Builds")))
+           ,@(if (member "system" fields)
+                 '((th "System"))
+                 '())
+           ,@(if (member "target" fields)
+                 '((th "Target"))
+                 '())
+           ,@(if (member "builds" fields)
+                 '((th "Builds"))
+                 '())))
          (tbody
           ,@(map
              (match-lambda
+               ((file-name system target)
+                `(tr
+                  (td (a (@ (href ,file-name))
+                         ,(display-store-item-short file-name)))
+                  ,@(if (member "system" fields)
+                        `((td (@ (style "font-family: monospace;"))
+                              ,system))
+                        '())
+                  ,@(if (member "target" fields)
+                        `((td (@ (style "font-family: monospace;"))
+                              ,target))
+                        '())))
                ((file-name system target builds)
                 `(tr
                   (td (a (@ (href ,file-name))
                          ,(display-store-item-short file-name)))
-                  (td (@ (style "font-family: monospace;"))
-                      ,system)
-                  (td (@ (style "font-family: monospace;"))
-                      ,target)
+                  ,@(if (member "system" fields)
+                        `((td (@ (style "font-family: monospace;"))
+                              ,system))
+                        '())
+                  ,@(if (member "target" fields)
+                        `((td (@ (style "font-family: monospace;"))
+                              ,target))
+                        '())
                   (td
                    (dl
                     (@ (style "margin-bottom: 0;"))