Allow specifying the fields on the packages page
This is mostly for the JSON output, as it allows much more information to be included.
This commit is contained in:
Christopher Baines
parent
d52f5b530f
commit
83012b101b
|
|
@ -35,10 +35,23 @@
|
|||
(define query
|
||||
(string-append "
|
||||
WITH data AS (
|
||||
SELECT packages.name, packages.version, package_metadata.synopsis
|
||||
SELECT packages.name, packages.version, package_metadata.synopsis,
|
||||
package_metadata.description, package_metadata.home_page,
|
||||
locations.file, locations.line, locations.column_number,
|
||||
(SELECT JSON_AGG((license_data.*))
|
||||
FROM (
|
||||
SELECT licenses.name, licenses.uri, licenses.comment
|
||||
FROM licenses
|
||||
INNER JOIN license_sets ON licenses.id = ANY(license_sets.license_ids)
|
||||
WHERE license_sets.id = package_metadata.license_set_id
|
||||
ORDER BY licenses.name
|
||||
) AS license_data
|
||||
) AS licenses
|
||||
FROM packages
|
||||
INNER JOIN package_metadata
|
||||
ON packages.package_metadata_id = package_metadata.id
|
||||
LEFT OUTER JOIN locations
|
||||
ON package_metadata.location_id = locations.id
|
||||
WHERE packages.id IN (
|
||||
SELECT package_derivations.package_id
|
||||
FROM package_derivations
|
||||
|
|
@ -78,10 +91,24 @@ WHERE data.name IN (SELECT name FROM package_names);"))
|
|||
"
|
||||
SELECT packages.name,
|
||||
packages.version,
|
||||
package_metadata.synopsis
|
||||
package_metadata.synopsis,
|
||||
package_metadata.description,
|
||||
package_metadata.home_page,
|
||||
locations.file, locations.line, locations.column_number,
|
||||
(SELECT JSON_AGG((license_data.*))
|
||||
FROM (
|
||||
SELECT licenses.name, licenses.uri, licenses.comment
|
||||
FROM licenses
|
||||
INNER JOIN license_sets ON licenses.id = ANY(license_sets.license_ids)
|
||||
WHERE license_sets.id = package_metadata.license_set_id
|
||||
ORDER BY licenses.name
|
||||
) AS license_data
|
||||
) AS licenses
|
||||
FROM packages
|
||||
INNER JOIN package_metadata
|
||||
ON packages.package_metadata_id = package_metadata.id
|
||||
LEFT OUTER JOIN locations
|
||||
ON package_metadata.location_id = locations.id
|
||||
WHERE packages.id IN (
|
||||
SELECT package_derivations.package_id
|
||||
FROM package_derivations
|
||||
|
|
|
|||
|
|
@ -25,7 +25,11 @@
|
|||
#:use-module (srfi srfi-26)
|
||||
#:use-module (web request)
|
||||
#:use-module (web uri)
|
||||
#:use-module (texinfo)
|
||||
#:use-module (texinfo html)
|
||||
#:use-module (texinfo plain-text)
|
||||
#:use-module (squee)
|
||||
#:use-module (json)
|
||||
#:use-module (guix-data-service comparison)
|
||||
#:use-module (guix-data-service model git-branch)
|
||||
#:use-module (guix-data-service model git-repository)
|
||||
|
|
@ -38,6 +42,7 @@
|
|||
#:use-module (guix-data-service model build)
|
||||
#:use-module (guix-data-service jobs load-new-guix-revision)
|
||||
#:use-module (guix-data-service web render)
|
||||
#:use-module (guix-data-service web sxml)
|
||||
#:use-module (guix-data-service web query-parameters)
|
||||
#:use-module (guix-data-service web util)
|
||||
#:use-module (guix-data-service web view html)
|
||||
|
|
@ -105,6 +110,14 @@
|
|||
packages-count
|
||||
derivations-counts))))))
|
||||
|
||||
(define (texinfo->variants-alist s)
|
||||
(let ((stexi (texi-fragment->stexi s)))
|
||||
`((source . ,s)
|
||||
(html . ,(with-output-to-string
|
||||
(lambda ()
|
||||
(sxml->html (stexi->shtml stexi)))))
|
||||
(plain . ,(stexi->plain-text stexi)))))
|
||||
|
||||
(define (render-revision-packages mime-types
|
||||
conn
|
||||
commit-hash
|
||||
|
|
@ -121,10 +134,12 @@
|
|||
(view-revision-packages commit-hash
|
||||
query-parameters
|
||||
'()
|
||||
'()
|
||||
#f))))
|
||||
|
||||
(let* ((search-query (assq-ref query-parameters 'search_query))
|
||||
(limit-results (assq-ref query-parameters 'limit_results))
|
||||
(fields (assq-ref query-parameters 'field))
|
||||
(packages
|
||||
(if search-query
|
||||
(search-packages-in-revision
|
||||
|
|
@ -137,6 +152,9 @@
|
|||
commit-hash
|
||||
#:limit-results limit-results
|
||||
#:after-name (assq-ref query-parameters 'after_name))))
|
||||
(git-repositories
|
||||
(git-repositories-containing-commit conn
|
||||
commit-hash))
|
||||
(show-next-page?
|
||||
(and (not search-query)
|
||||
(>= (length packages)
|
||||
|
|
@ -146,18 +164,48 @@
|
|||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`((packages . ,(list->vector
|
||||
(map (match-lambda
|
||||
((name version synopsis)
|
||||
`((name . ,name)
|
||||
(version . ,version)
|
||||
(synopsis . ,synopsis))))
|
||||
packages))))))
|
||||
`((revision
|
||||
. ((commit . ,commit-hash)))
|
||||
(packages
|
||||
. ,(list->vector
|
||||
(map (match-lambda
|
||||
((name version synopsis description home-page
|
||||
location-file location-line
|
||||
location-column-number licenses)
|
||||
`((name . ,name)
|
||||
,@(if (member "version" fields)
|
||||
`((version . ,version))
|
||||
'())
|
||||
,@(if (member "synopsis" fields)
|
||||
`((synopsis
|
||||
. ,(texinfo->variants-alist synopsis)))
|
||||
'())
|
||||
,@(if (member "description" fields)
|
||||
`((description
|
||||
. ,(texinfo->variants-alist description)))
|
||||
'())
|
||||
,@(if (member "home-page" fields)
|
||||
`((home-page . ,home-page))
|
||||
'())
|
||||
,@(if (member "location" fields)
|
||||
`((location
|
||||
. ((file . ,location-file)
|
||||
(line . ,location-line)
|
||||
(column . ,location-column-number))))
|
||||
'())
|
||||
,@(if (member "licenses" fields)
|
||||
`((licenses
|
||||
. ,(if (string-null? licenses)
|
||||
#()
|
||||
(json-string->scm licenses))))
|
||||
'()))))
|
||||
packages))))))
|
||||
(else
|
||||
(apply render-html
|
||||
(view-revision-packages commit-hash
|
||||
query-parameters
|
||||
packages
|
||||
git-repositories
|
||||
show-next-page?)))))))
|
||||
|
||||
(define (render-revision-package mime-types
|
||||
|
|
@ -486,6 +534,8 @@
|
|||
(parse-query-parameters
|
||||
request
|
||||
`((after_name ,identity)
|
||||
(field ,identity #:multi-value
|
||||
#:default ("version" "synopsis"))
|
||||
(search_query ,identity)
|
||||
(limit_results ,parse-result-limit #:default 100)))
|
||||
;; You can't specify a search query, but then also limit the
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@
|
|||
#:use-module (srfi srfi-19)
|
||||
#:use-module (texinfo)
|
||||
#:use-module (texinfo html)
|
||||
#:use-module (json)
|
||||
#:export (index
|
||||
view-statistics
|
||||
view-revision-package-and-version
|
||||
|
|
@ -97,6 +98,7 @@
|
|||
|
||||
(define* (form-horizontal-control label query-parameters
|
||||
#:key
|
||||
name
|
||||
help-text
|
||||
required?
|
||||
options)
|
||||
|
|
@ -111,8 +113,9 @@
|
|||
(string-downcase label)))
|
||||
(help-span-id (string-append
|
||||
input-id "-help-text"))
|
||||
(input-name (underscore-join-words
|
||||
(string-downcase label)))
|
||||
(input-name (or name
|
||||
(underscore-join-words
|
||||
(string-downcase label))))
|
||||
(has-error? (invalid-query-parameter?
|
||||
(assq-ref query-parameters
|
||||
(string->symbol input-name))))
|
||||
|
|
@ -144,12 +147,20 @@
|
|||
value)
|
||||
(_ '()))))
|
||||
|
||||
(map (lambda (option-value)
|
||||
`(option
|
||||
(@ ,@(if (member option-value selected-options)
|
||||
'((selected ""))
|
||||
'()))
|
||||
,(value->text option-value)))
|
||||
(map (match-lambda
|
||||
((option-value)
|
||||
`(option
|
||||
(@ ,@(if (member option-value selected-options)
|
||||
'((selected ""))
|
||||
'()))
|
||||
,(value->text option-value)))
|
||||
((option-label . option-value)
|
||||
`(option
|
||||
(@ ,@(if (member option-value selected-options)
|
||||
'((selected ""))
|
||||
'())
|
||||
(value ,option-value))
|
||||
,(value->text option-label))))
|
||||
options)))
|
||||
`(input (@ (class "form-control")
|
||||
(style "font-family: monospace;")
|
||||
|
|
@ -445,7 +456,17 @@
|
|||
(define (view-revision-packages revision-commit-hash
|
||||
query-parameters
|
||||
packages
|
||||
git-repositories
|
||||
show-next-page?)
|
||||
(define field-options
|
||||
(map
|
||||
(lambda (field)
|
||||
(cons field
|
||||
(hyphenate-words
|
||||
(string-downcase field))))
|
||||
'("Version" "Synopsis" "Description"
|
||||
"Home page" "Location" "Licenses")))
|
||||
|
||||
(layout
|
||||
#:extra-headers
|
||||
'((cache-control . ((max-age . 60))))
|
||||
|
|
@ -474,6 +495,11 @@
|
|||
"Search query" query-parameters
|
||||
#:help-text
|
||||
"List packages where the name or synopsis match the query.")
|
||||
,(form-horizontal-control
|
||||
"Fields" query-parameters
|
||||
#:name "field"
|
||||
#:options field-options
|
||||
#:help-text "Fields to return in the response.")
|
||||
,(form-horizontal-control
|
||||
"After name" query-parameters
|
||||
#:help-text
|
||||
|
|
@ -496,23 +522,77 @@
|
|||
(thead
|
||||
(tr
|
||||
(th (@ (class "col-md-3")) "Name")
|
||||
(th (@ (class "col-md-3")) "Version")
|
||||
(th (@ (class "col-md-3")) "Synopsis")
|
||||
,@(filter-map
|
||||
(match-lambda
|
||||
((label . value)
|
||||
(if (member value (assq-ref query-parameters 'field))
|
||||
`(th (@ (class "col-md-3")) ,label)
|
||||
#f)))
|
||||
field-options)
|
||||
(th (@ (class "col-md-3")) "")))
|
||||
(tbody
|
||||
,@(map
|
||||
(match-lambda
|
||||
((name version synopsis)
|
||||
`(tr
|
||||
(td ,name)
|
||||
(td ,version)
|
||||
(td ,(stexi->shtml (texi-fragment->stexi synopsis)))
|
||||
(td (@ (class "text-right"))
|
||||
(a (@ (href ,(string-append
|
||||
"/revision/" revision-commit-hash
|
||||
"/package/" name "/" version)))
|
||||
"More information")))))
|
||||
packages)))))
|
||||
,@(let ((fields (assq-ref query-parameters 'field)))
|
||||
(map
|
||||
(match-lambda
|
||||
((name version synopsis description home-page
|
||||
location-file location-line
|
||||
location-column-number licenses)
|
||||
`(tr
|
||||
(td ,name)
|
||||
,@(if (member "version" fields)
|
||||
`((td ,version))
|
||||
'())
|
||||
,(if (member "synopsis" fields)
|
||||
`((td ,(stexi->shtml (texi-fragment->stexi synopsis))))
|
||||
'())
|
||||
,(if (member "description" fields)
|
||||
`((td ,(stexi->shtml (texi-fragment->stexi description))))
|
||||
'())
|
||||
,(if (member "home-page" fields)
|
||||
`((td ,home-page))
|
||||
'())
|
||||
,(if (member "location" fields)
|
||||
`((td
|
||||
,@(if (and location-file
|
||||
(not (string-null? location-file)))
|
||||
`((ul
|
||||
,@(map
|
||||
(match-lambda
|
||||
((id label url cgit-url-base)
|
||||
(if
|
||||
(and cgit-url-base
|
||||
(not (string-null? cgit-url-base)))
|
||||
`(li
|
||||
(a (@ (href
|
||||
,(string-append
|
||||
cgit-url-base "tree/"
|
||||
location-file "?id=" revision-commit-hash
|
||||
"#n" location-line)))
|
||||
,location-file
|
||||
" (line: " ,location-line
|
||||
", column: " ,location-column-number ")"))
|
||||
`(li ,location-file
|
||||
" (line: " ,location-line
|
||||
", column: " ,location-column-number ")"))))
|
||||
git-repositories)))
|
||||
'())))
|
||||
'())
|
||||
,(if (member "licenses" fields)
|
||||
`((td
|
||||
(ul
|
||||
(@ (class "list-inline"))
|
||||
,@(map (lambda (license)
|
||||
`(li (a (@ (href ,(assoc-ref license "uri")))
|
||||
,(assoc-ref license "name"))))
|
||||
(vector->list
|
||||
(json-string->scm licenses))))))
|
||||
'())
|
||||
(td (@ (class "text-right"))
|
||||
(a (@ (href ,(string-append
|
||||
"/revision/" revision-commit-hash
|
||||
"/package/" name "/" version)))
|
||||
"More information")))))
|
||||
packages))))))
|
||||
,@(if show-next-page?
|
||||
`((div
|
||||
(@ (class "row"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue