cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow specifying the fields on the packages page

Browse source 
This is mostly for the JSON output, as it allows much more information to be
included.
This commit is contained in:
Christopher Baines 2019-05-16 22:28:16 +01:00
parent d52f5b530f
commit 83012b101b
3 changed files with 189 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

31
guix-data-service/model/package.scm
View file

@ -35,10 +35,23 @@
(define query (define query
(string-append " (string-append "
WITH data AS ( 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 FROM packages
INNER JOIN package_metadata INNER JOIN package_metadata
ON packages.package_metadata_id = package_metadata.id ON packages.package_metadata_id = package_metadata.id
LEFT OUTER JOIN locations
ON package_metadata.location_id = locations.id
WHERE packages.id IN ( WHERE packages.id IN (
SELECT package_derivations.package_id SELECT package_derivations.package_id
FROM package_derivations FROM package_derivations
@ -78,10 +91,24 @@ WHERE data.name IN (SELECT name FROM package_names);"))
" "
SELECT packages.name, SELECT packages.name,
packages.version, 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 FROM packages
INNER JOIN package_metadata INNER JOIN package_metadata
ON packages.package_metadata_id = package_metadata.id ON packages.package_metadata_id = package_metadata.id
LEFT OUTER JOIN locations
ON package_metadata.location_id = locations.id
WHERE packages.id IN ( WHERE packages.id IN (
SELECT package_derivations.package_id SELECT package_derivations.package_id
FROM package_derivations FROM package_derivations

58
guix-data-service/web/controller.scm
View file

@ -25,7 +25,11 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (web request) #:use-module (web request)
#:use-module (web uri) #:use-module (web uri)
#:use-module (texinfo)
#:use-module (texinfo html)
#:use-module (texinfo plain-text)
#:use-module (squee) #:use-module (squee)
#:use-module (json)
#:use-module (guix-data-service comparison) #:use-module (guix-data-service comparison)
#:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-branch)
#:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model git-repository)
@ -38,6 +42,7 @@
#:use-module (guix-data-service model build) #:use-module (guix-data-service model build)
#:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service jobs load-new-guix-revision)
#:use-module (guix-data-service web render) #: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 query-parameters)
#:use-module (guix-data-service web util) #:use-module (guix-data-service web util)
#:use-module (guix-data-service web view html) #:use-module (guix-data-service web view html)
@ -105,6 +110,14 @@
packages-count packages-count
derivations-counts)))))) 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 (define (render-revision-packages mime-types
conn conn
commit-hash commit-hash
@ -121,10 +134,12 @@
(view-revision-packages commit-hash (view-revision-packages commit-hash
query-parameters query-parameters
'() '()
'()
#f)))) #f))))
(let* ((search-query (assq-ref query-parameters 'search_query)) (let* ((search-query (assq-ref query-parameters 'search_query))
(limit-results (assq-ref query-parameters 'limit_results)) (limit-results (assq-ref query-parameters 'limit_results))
(fields (assq-ref query-parameters 'field))
(packages (packages
(if search-query (if search-query
(search-packages-in-revision (search-packages-in-revision
@ -137,6 +152,9 @@
commit-hash commit-hash
#:limit-results limit-results #:limit-results limit-results
#:after-name (assq-ref query-parameters 'after_name)))) #:after-name (assq-ref query-parameters 'after_name))))
(git-repositories
(git-repositories-containing-commit conn
commit-hash))
(show-next-page? (show-next-page?
(and (not search-query) (and (not search-query)
(>= (length packages) (>= (length packages)
@ -146,18 +164,48 @@
mime-types) mime-types)
((application/json) ((application/json)
(render-json (render-json
`((packages . ,(list->vector `((revision
. ((commit . ,commit-hash)))
(packages
. ,(list->vector
(map (match-lambda (map (match-lambda
((name version synopsis) ((name version synopsis description home-page
location-file location-line
location-column-number licenses)
`((name . ,name) `((name . ,name)
(version . ,version) ,@(if (member "version" fields)
(synopsis . ,synopsis)))) `((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)))))) packages))))))
(else (else
(apply render-html (apply render-html
(view-revision-packages commit-hash (view-revision-packages commit-hash
query-parameters query-parameters
packages packages
git-repositories
show-next-page?))))))) show-next-page?)))))))
(define (render-revision-package mime-types (define (render-revision-package mime-types
@ -486,6 +534,8 @@
(parse-query-parameters (parse-query-parameters
request request
`((after_name ,identity) `((after_name ,identity)
(field ,identity #:multi-value
#:default ("version" "synopsis"))
(search_query ,identity) (search_query ,identity)
(limit_results ,parse-result-limit #:default 100))) (limit_results ,parse-result-limit #:default 100)))
;; You can't specify a search query, but then also limit the ;; You can't specify a search query, but then also limit the

100
guix-data-service/web/view/html.scm
View file

@ -27,6 +27,7 @@
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (texinfo) #:use-module (texinfo)
#:use-module (texinfo html) #:use-module (texinfo html)
#:use-module (json)
#:export (index #:export (index
view-statistics view-statistics
view-revision-package-and-version view-revision-package-and-version
@ -97,6 +98,7 @@
(define* (form-horizontal-control label query-parameters (define* (form-horizontal-control label query-parameters
#:key #:key
name
help-text help-text
required? required?
options) options)
@ -111,8 +113,9 @@
(string-downcase label))) (string-downcase label)))
(help-span-id (string-append (help-span-id (string-append
input-id "-help-text")) input-id "-help-text"))
(input-name (underscore-join-words (input-name (or name
(string-downcase label))) (underscore-join-words
(string-downcase label))))
(has-error? (invalid-query-parameter? (has-error? (invalid-query-parameter?
(assq-ref query-parameters (assq-ref query-parameters
(string->symbol input-name)))) (string->symbol input-name))))
@ -144,12 +147,20 @@
value) value)
(_ '())))) (_ '()))))
(map (lambda (option-value) (map (match-lambda
((option-value)
`(option `(option
(@ ,@(if (member option-value selected-options) (@ ,@(if (member option-value selected-options)
'((selected "")) '((selected ""))
'())) '()))
,(value->text option-value))) ,(value->text option-value)))
((option-label . option-value)
`(option
(@ ,@(if (member option-value selected-options)
'((selected ""))
'())
(value ,option-value))
,(value->text option-label))))
options))) options)))
`(input (@ (class "form-control") `(input (@ (class "form-control")
(style "font-family: monospace;") (style "font-family: monospace;")
@ -445,7 +456,17 @@
(define (view-revision-packages revision-commit-hash (define (view-revision-packages revision-commit-hash
query-parameters query-parameters
packages packages
git-repositories
show-next-page?) show-next-page?)
(define field-options
(map
(lambda (field)
(cons field
(hyphenate-words
(string-downcase field))))
'("Version" "Synopsis" "Description"
"Home page" "Location" "Licenses")))
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -474,6 +495,11 @@
"Search query" query-parameters "Search query" query-parameters
#:help-text #:help-text
"List packages where the name or synopsis match the query.") "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 ,(form-horizontal-control
"After name" query-parameters "After name" query-parameters
#:help-text #:help-text
@ -496,23 +522,77 @@
(thead (thead
(tr (tr
(th (@ (class "col-md-3")) "Name") (th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-3")) "Version") ,@(filter-map
(th (@ (class "col-md-3")) "Synopsis") (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")) ""))) (th (@ (class "col-md-3")) "")))
(tbody (tbody
,@(map ,@(let ((fields (assq-ref query-parameters 'field)))
(map
(match-lambda (match-lambda
((name version synopsis) ((name version synopsis description home-page
location-file location-line
location-column-number licenses)
`(tr `(tr
(td ,name) (td ,name)
(td ,version) ,@(if (member "version" fields)
(td ,(stexi->shtml (texi-fragment->stexi synopsis))) `((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")) (td (@ (class "text-right"))
(a (@ (href ,(string-append (a (@ (href ,(string-append
"/revision/" revision-commit-hash "/revision/" revision-commit-hash
"/package/" name "/" version))) "/package/" name "/" version)))
"More information"))))) "More information")))))
packages))))) packages))))))
,@(if show-next-page? ,@(if show-next-page?
`((div `((div
(@ (class "row")) (@ (class "row"))