From 3611f7b1225f66d8d1469d715ba5ad63a0e133cd Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 11 May 2019 16:49:18 +0100
Subject: Add some options to the branch page

Add handling for some query parameters to the branch page. This takes
advantage of the improvements for building forms and query parameter
validation.
---
 guix-data-service/model/git-branch.scm | 23 ++++++++++++++++++++---
 guix-data-service/web/controller.scm   | 21 ++++++++++++++++++---
 guix-data-service/web/view/html.scm    | 27 ++++++++++++++++++++++++++-
 3 files changed, 64 insertions(+), 7 deletions(-)

(limited to 'guix-data-service')

diff --git a/guix-data-service/model/git-branch.scm b/guix-data-service/model/git-branch.scm
index 896e551..8dec755 100644
--- a/guix-data-service/model/git-branch.scm
+++ b/guix-data-service/model/git-branch.scm
@@ -1,8 +1,9 @@
 (define-module (guix-data-service model git-branch)
   #:use-module (squee)
+  #:use-module (srfi srfi-19)
   #:export (insert-git-branch-entry
             git-branches-for-commit
-            most-recent-100-commits-for-branch
+            most-recent-commits-for-branch
             all-branches-with-most-recent-commit))
 
 (define (insert-git-branch-entry conn
@@ -27,14 +28,30 @@ ORDER BY datetime DESC")
 
   (exec-query conn query (list commit)))
 
-(define (most-recent-100-commits-for-branch conn branch-name)
+(define* (most-recent-commits-for-branch conn branch-name
+                                         #:key
+                                         (limit 100)
+                                         after-date
+                                         before-date)
   (define query
     (string-append
      "SELECT git_branches.commit, datetime, "
      "(guix_revisions.id IS NOT NULL) as guix_revision_exists "
      "FROM git_branches "
      "LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit "
-     "WHERE name = $1 ORDER BY datetime DESC LIMIT 100;"))
+     "WHERE name = $1 "
+     (if after-date
+         (simple-format #f " AND datetime > '~A'"
+                        (date->string after-date "~1 ~3"))
+         "")
+     (if before-date
+         (simple-format #f " AND datetime < '~A'"
+                        (date->string before-date "~1 ~3"))
+         "")
+     "ORDER BY datetime DESC"
+     (if limit
+         (simple-format #f " LIMIT ~A;" limit)
+         "")))
 
   (exec-query
    conn
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 658a317..94b8b5e 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -348,12 +348,27 @@
             (view-branches
              (all-branches-with-most-recent-commit conn))))
     ((GET "branch" branch-name)
-     (apply render-html
+     (let ((parsed-query-parameters
+            (parse-query-parameters
+             request
+             `((after_date     ,parse-datetime)
+               (before_date    ,parse-datetime)
+               (limit_results  ,parse-result-limit #:default 100)))))
+       (apply
+        render-html
+        (if (any-invalid-query-parameters? parsed-query-parameters)
+            (view-branch branch-name parsed-query-parameters '())
             (view-branch
              branch-name
-             (most-recent-100-commits-for-branch
+             parsed-query-parameters
+             (most-recent-commits-for-branch
               conn
-              branch-name))))
+              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 "gnu" "store" filename)
      (if (string-suffix? ".drv" filename)
          (render-derivation conn (string-append "/gnu/store/" filename))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 17416e1..93e3bf1 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -465,7 +465,8 @@
                                        commit)))))))
              branches-with-most-recent-commits)))))))))
 
-(define (view-branch branch-name branch-commits)
+(define (view-branch branch-name query-parameters
+                     branch-commits)
   (layout
    #:extra-headers
    '((cache-control . ((max-age . 60))))
@@ -479,6 +480,30 @@
         (@ (class "col-md-12"))
         (h1 (@ (style "white-space: nowrap;"))
             (samp ,branch-name) " branch")))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-12"))
+        (div
+         (@ (class "well"))
+         (form
+          (@ (method "get")
+             (action "")
+             (class "form-horizontal"))
+          ,(form-horizontal-control
+            "After date" query-parameters
+            #:help-text "Only show the branch history after this date.")
+          ,(form-horizontal-control
+            "Before date" query-parameters
+            #:help-text "Only show the branch history before this date.")
+          ,(form-horizontal-control
+            "Limit results" query-parameters
+            #:help-text "The maximum number of results to return.")
+          (div (@ (class "form-group form-group-lg"))
+               (div (@ (class "col-sm-offset-2 col-sm-10"))
+                    (button (@ (type "submit")
+                               (class "btn btn-lg btn-primary"))
+                            "Update results")))))))
       (div
        (@ (class "row"))
        (div
-- 
cgit v1.2.3