Ludovic Courtès <l...@gnu.org> writes: > Luis Felipe <luis.felipe...@protonmail.com> skribis: > >> But I wonder if it is possible now to make the packages part use any of the >> Postgres databases that already exist and allow traditional search without >> JavaScript... > > Former Outreachy intern Danjela Lura, together with Chris Baines, had > started developing a JS-free package browsing interface: > > https://lists.gnu.org/archive/html/guix-devel/2020-07/msg00050.html > > Chris, could you tell us what the status is and what’s missing before we > can use it on the web site?
I think it's unchanged for a while now, I've attached what's probably the latest source code (there's not much to it). I think the remaining work is to settle on a direction in terms of the design and how to integrate it in to the website, and then deploy something for real. Personally, I'm in favour of a packages.guix.gnu.org domain which hosts the search page plus the package pages, and stopping generating package pages with haunt. I don't really have the time to try and move this forward myself, but I can try and support others.
#!/usr/local/bin/guile -s
!#
(use-modules (web server)
(web request)
(web response)
(web uri)
(sxml simple)
(web client)
(rnrs bytevectors)
(srfi srfi-11)
(srfi srfi-1)
(ice-9 match)
(json)
(texinfo)
(texinfo plain-text)
(apps aux strings)
(apps base templates theme)
(apps base utils)
(apps base types)
(apps base templates components))
(define (templatize title body)
`(html (head (title ,title))
(body ,@body)))
(define* (respond #:optional body #:key
(status 200)
(title "Packages")
(doctype "<!DOCTYPE html>\n")
(content-type-params '((charset . "utf-8")))
(content-type 'text/html)
(extra-headers '())
(sxml (and body (templatize title body))))
(values (build-response
#:code status
#:headers `((content-type
. (,content-type ,@content-type-params))
,@extra-headers))
(lambda (port)
(if sxml
(begin
(if doctype (display doctype port))
(sxml->xml sxml port))))))
(define (search-packages-page request body)
(define uri-value
(let ((uri (request-uri request)))
(if (eqv? #f (uri-query uri))
""
(second
(string-split
(uri-query
uri)
#\=)))))
(define response
(let-values
(((response-object body)
(http-request
(string-append
"http://data.guix.gnu.org/repository/1/branch/master/latest-processed-revision/packages.json?locale=en_US.utf8&search_query=";
uri-value
"&field=version&field=synopsis&field=description&after_name=&limit_results=30")
#:method 'GET)))
(json-string->scm
(utf8->string body))))
(respond
`((link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/package.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/item-preview.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/page.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/elements.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/common.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/messages.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/navbar.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/breadcrumbs.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/buttons.css";)))
(link (@ (rel "stylesheet") (href
"http://guix-website-test.cbaines.net/static/base/css/footer.css";)))
(link (@ (rel "stylesheet") (href
"https://stackpath.bootstrapcdn.com/bootstrap/3.4.1/css/bootstrap.min.css";)
(integrity
"sha384-HSMxcRTRxnN+Bdg0JdbxYKrThecOKuH5zCYotlSAcp1+c8xmyTe9GYg1l9a69psu")
(crossorigin "anonymous")))
,(navbar #:active-item "packages/search")
(div (@ (class "package-info"))
(div (@ (class "search-container")
(style "display: block; text-align: center;"))
(h1 "Packages")
(form (@ (style "display: inline-block; margin-right auto;
text-align: left"))
(input (@ (type "text")
(placeholder "Search packages")
(name "search")))
(button (@ (class "btn btn-primary pull-right")
(type "submit"))
'((span (@ (class "glyphicon glyphicon-search")
(aria-hidden "true")))))))
,@(match response
((packages _)
(map
(match-lambda
((description synopsis version name)
(let ((package-name (cdr name))
(package-version (cdr version))
(package-synopsis (match synopsis
((synopsis locale plain html
source)
(cdr source))))
(package-description (match description
((description locale plain
html source)
(cdr source)))))
`(a
(@ (class "item-preview")
(href ,(string-append
"http://guix-website-test.cbaines.net/packages/";
(string-append package-name
"-" package-version))))
(h3 ,package-name " " ,package-version)
(p
(@ (class "item-summary"))
,(string-summarize
(stexi->plain-text (texi-fragment->stexi
package-description))
30)
"…")))))
(vector->list
(cdr packages))))))
(footer
"Made with " (span (@ (class "metta")) "♥")
" by humans and powered by "
(a (@ (class "link-yellow") (href ,(gnu-url "software/guile/")))
"GNU Guile") ". "
(a
(@ (class "link-yellow")
(href
"//git.savannah.gnu.org/cgit/guix/guix-artwork.git/tree/website"))
"Source code")
" under the "
(a
(@ (class "link-yellow")
(href ,(gnu-url "licenses/agpl-3.0.html")))
"GNU AGPL") "."))))
(run-server search-packages-page 'http '(#:port 8765))
signature.asc
Description: PGP signature
