summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-05-11 16:49:18 +0100
committerChristopher Baines <mail@cbaines.net>2019-05-11 16:49:18 +0100
commit3611f7b1225f66d8d1469d715ba5ad63a0e133cd (patch)
treef9be59a3619ce93d27d7c84c5805e0e66d718d28
parenta7053846f144155e4459ebfd843b860167ffb7af (diff)
downloaddata-service-3611f7b1225f66d8d1469d715ba5ad63a0e133cd.tar
data-service-3611f7b1225f66d8d1469d715ba5ad63a0e133cd.tar.gz
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.
-rw-r--r--guix-data-service/model/git-branch.scm23
-rw-r--r--guix-data-service/web/controller.scm21
-rw-r--r--guix-data-service/web/view/html.scm27
3 files changed, 64 insertions, 7 deletions
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))))
@@ -483,6 +484,30 @@
(@ (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
+ (@ (class "col-md-12"))
(table
(@ (class "table table-responsive"))
(thead