Refactor the repository pages code

Move it out of the main controller and html modules to better separate the
code, which should allow to make it easier to read in the future.

1 files changed, 3 insertions, 175 deletions

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index b6381a3..769d2dd 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -54,6 +54,7 @@
   #:use-module (guix-data-service web jobs controller)
   #:use-module (guix-data-service web view html)
   #:use-module (guix-data-service web revision controller)
+  #:use-module (guix-data-service web repository controller)
   #:export (controller))
 
 (define cache-control-default-max-age
@@ -617,181 +618,8 @@
                               (count-derivations conn))))
     (('GET "revision" args ...)
      (delegate-to revision-controller))
-    (('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)))))
-       (#f
-        (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
-             request
-             `((after_date     ,parse-datetime)
-               (before_date    ,parse-datetime)
-               (limit_results  ,parse-result-limit #:default 100)))))
-       (render-html
-        #:sxml (if (any-invalid-query-parameters? parsed-query-parameters)
-                   (view-branch repository-id
-                                branch-name parsed-query-parameters '())
-                   (view-branch
-                    repository-id
-                    branch-name
-                    parsed-query-parameters
-                    (most-recent-commits-for-branch
-                     conn
-                     (string->number repository-id)
-                     branch-name
-                     #:limit (assq-ref parsed-query-parameters 'limit_results)
-                     #:after-date (assq-ref parsed-query-parameters
-                                            'after_date)
-                     #:before-date (assq-ref parsed-query-parameters
-                                             'before_date)))))))
-    (('GET "repository" repository-id "branch" branch-name "package" package-name)
-     (let ((package-versions
-            (package-versions-for-branch conn
-                                         (string->number repository-id)
-                                         branch-name
-                                         package-name)))
-       (case (most-appropriate-mime-type
-              '(application/json text/html)
-              mime-types)
-         ((application/json)
-          (render-json
-           `((versions . ,(list->vector
-                           (map (match-lambda
-                                  ((package-version first-guix-revision-commit
-                                                    first-datetime
-                                                    last-guix-revision-commit
-                                                    last-datetime)
-                                   `((version . ,package-version)
-                                     (first_revision
-                                      . ((commit . ,first-guix-revision-commit)
-                                         (datetime . ,first-datetime)))
-                                     (last_revision
-                                      . ((commit . ,last-guix-revision-commit)
-                                         (datetime . ,last-datetime))))))
-                                package-versions))))))
-         (else
-          (render-html
-           #:sxml (view-branch-package
-                   repository-id
-                   branch-name
-                   package-name
-                   package-versions))))))
-    (('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
-     (let ((commit-hash
-            (latest-processed-commit-for-branch conn repository-id branch-name)))
-       (if commit-hash
-           (render-view-revision mime-types
-                                 conn
-                                 commit-hash
-                                 #:path-base path
-                                 #:header-text
-                                 `("Latest processed revision for branch "
-                                   (samp ,branch-name)))
-           (render-unknown-revision mime-types
-                                    conn
-                                    commit-hash))))
-    (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "packages")
-     (let ((commit-hash
-            (latest-processed-commit-for-branch conn repository-id branch-name)))
-       (if commit-hash
-           (let ((parsed-query-parameters
-                  (guard-against-mutually-exclusive-query-parameters
-                   (parse-query-parameters
-                    request
-                    `((after_name     ,identity)
-                      (field          ,identity #:multi-value
-                                      #:default ("version" "synopsis"))
-                      (search_query   ,identity)
-                      (limit_results  ,parse-result-limit
-                                      #:no-default-when (all_results)
-                                      #:default 100)
-                      (all_results    ,parse-checkbox-value)))
-                   ;; You can't specify a search query, but then also limit the
-                   ;; results by filtering for after a particular package name
-                   '((after_name search_query)
-                     (limit_results all_results)))))
-
-             (render-revision-packages mime-types
-                                       conn
-                                       commit-hash
-                                       parsed-query-parameters
-                                       #:path-base path
-                                       #:header-text
-                                       `("Latest processed revision for branch "
-                                         (samp ,branch-name))
-                                       #:header-link
-                                       (string-append
-                                        "/repository/" repository-id
-                                        "/branch/" branch-name
-                                        "/latest-processed-revision")))
-           (render-unknown-revision mime-types
-                                    conn
-                                    commit-hash))))
-    (('GET "repository" repository-id "branch" branch-name "latest-processed-revision"
-           "lint-warnings")
-     (let ((commit-hash
-            (latest-processed-commit-for-branch conn repository-id branch-name)))
-       (if commit-hash
-           (let ((parsed-query-parameters
-                  (parse-query-parameters
-                   request
-                   `((package_query  ,identity)
-                     (linter         ,identity #:multi-value)
-                     (message_query  ,identity)
-                     (field          ,identity #:multi-value
-                                     #:default ("linter"
-                                                "message"
-                                                "location"))))))
-
-             (render-revision-lint-warnings mime-types
-                                            conn
-                                            commit-hash
-                                            parsed-query-parameters
-                                            #:path-base path
-                                            #:header-text
-                                            `("Latest processed revision for branch "
-                                              (samp ,branch-name))
-                                            #:header-link
-                                            (string-append
-                                             "/repository/" repository-id
-                                             "/branch/" branch-name
-                                             "/latest-processed-revision")))
-           (render-unknown-revision mime-types
-                                    conn
-                                    commit-hash))))
-    (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package" name version)
-     (let ((commit-hash
-            (latest-processed-commit-for-branch conn repository-id branch-name)))
-       (if commit-hash
-           (render-revision-package-version mime-types
-                                            conn
-                                            commit-hash
-                                            name
-                                            version
-                                            #:header-text
-                                            `("Latest processed revision for branch "
-                                              (samp ,branch-name))
-                                            #:header-link
-                                            (string-append
-                                             "/repository/" repository-id
-                                             "/branch/" branch-name
-                                             "/latest-processed-revision"))
-           (render-unknown-revision mime-types
-                                    conn
-                                    commit-hash))))
+    (('GET "repository" _ ...)
+     (delegate-to repository-controller))
     (('GET "gnu" "store" filename)
      ;; These routes are a little special, as the extensions aren't used for
      ;; content negotiation, so just use the path from the request