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.
This commit is contained in:
Christopher Baines 2019-05-11 16:49:18 +01:00
parent a7053846f1
commit 3611f7b122
3 changed files with 64 additions and 7 deletions

View file

@ -1,8 +1,9 @@
(define-module (guix-data-service model git-branch) (define-module (guix-data-service model git-branch)
#:use-module (squee) #:use-module (squee)
#:use-module (srfi srfi-19)
#:export (insert-git-branch-entry #:export (insert-git-branch-entry
git-branches-for-commit git-branches-for-commit
most-recent-100-commits-for-branch most-recent-commits-for-branch
all-branches-with-most-recent-commit)) all-branches-with-most-recent-commit))
(define (insert-git-branch-entry conn (define (insert-git-branch-entry conn
@ -27,14 +28,30 @@ ORDER BY datetime DESC")
(exec-query conn query (list commit))) (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 (define query
(string-append (string-append
"SELECT git_branches.commit, datetime, " "SELECT git_branches.commit, datetime, "
"(guix_revisions.id IS NOT NULL) as guix_revision_exists " "(guix_revisions.id IS NOT NULL) as guix_revision_exists "
"FROM git_branches " "FROM git_branches "
"LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit " "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 (exec-query
conn conn

View file

@ -348,12 +348,27 @@
(view-branches (view-branches
(all-branches-with-most-recent-commit conn)))) (all-branches-with-most-recent-commit conn))))
((GET "branch" branch-name) ((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 (view-branch
branch-name branch-name
(most-recent-100-commits-for-branch parsed-query-parameters
(most-recent-commits-for-branch
conn 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) ((GET "gnu" "store" filename)
(if (string-suffix? ".drv" filename) (if (string-suffix? ".drv" filename)
(render-derivation conn (string-append "/gnu/store/" filename)) (render-derivation conn (string-append "/gnu/store/" filename))

View file

@ -465,7 +465,8 @@
commit))))))) commit)))))))
branches-with-most-recent-commits))))))))) branches-with-most-recent-commits)))))))))
(define (view-branch branch-name branch-commits) (define (view-branch branch-name query-parameters
branch-commits)
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -479,6 +480,30 @@
(@ (class "col-md-12")) (@ (class "col-md-12"))
(h1 (@ (style "white-space: nowrap;")) (h1 (@ (style "white-space: nowrap;"))
(samp ,branch-name) " branch"))) (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 (div
(@ (class "row")) (@ (class "row"))
(div (div