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:
parent
a7053846f1
commit
3611f7b122
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue