From: "Ludovic Courtès" <ludo@gnu.org>
To: guix-devel <guix-devel@gnu.org>
Subject: Guix Data Service client module
Date: Sun, 27 Jun 2021 23:23:43 +0200 [thread overview]
Message-ID: <87czs7ypb4.fsf@inria.fr> (raw)
[-- Attachment #1: Type: text/plain, Size: 3836 bytes --]
Hello Guix!
Here’s a client module for the Guix Data Service, allowing you to access
a subset of the Guix Data Service interfaces from the comfort of your
REPL.
I had it sitting in my source tree for a while and Chris sent me an
impressive shell one-liner that made me want to try from Scheme:
wget "https://data.guix-patches.cbaines.net/revision/47f85c53d954f857b45cebefee27ec512d917484/lint-warnings.json?locale=en_US.UTF-8&linter=input-labels&field=linter&field=message&field=location" -O - | jq -r '.lint_warnings | .[] | .package.name' | sort | uniq | wc -l
Turns out we can do the same in two long lines of Scheme!
--8<---------------cut here---------------start------------->8---
scheme@(guix data-service)> (define s (open-data-service "https://data.guix-patches.cbaines.net"))
scheme@(guix data-service)> (length (delete-duplicates (map lint-warning-package (revision-lint-warnings s "47f85c53d954f857b45cebefee27ec512d917484" "input-labels"))))
$6 = 3560
--8<---------------cut here---------------end--------------->8---
(That counts the number of packages at that revision that have one or
more warnings from the new ‘input-labels’ lint checker.)
We can do other things, such as browsing package versions:
--8<---------------cut here---------------start------------->8---
scheme@(guix data-service)> (define s (open-data-service "https://data.guix.gnu.org"))
scheme@(guix data-service)> (package-version-branches (car (package-versions (lookup-package s "emacs"))))
$9 = (#<<branch> name: "master" repository-id: 1>)
scheme@(guix data-service)> (package-version-history s (car $9) "emacs")
$10 = (#<<package-version-range> version: "27.2" first-revision: #<<revision> commit: "cc33f50d0e2a7835e99913226cb4c4b0e9e961ae" date: #<date nanosecond: 0 second: 54 minute: 30 hour: 20 day: 25 month: 3 year: 2021 zone-offset: 0>> last-revision: #<<revision> commit: "364b56124b88398c199aacbfd4fdfc9a1583e634" date: #<date nanosecond: 0 second: 31 minute: 16 hour: 13 day: 27 month: 6 year: 2021 zone-offset: 0>>> #<<package-version-range> version: "27.1" first-revision: #<<revision> commit: "36a09d185343375a5cba370431870f9c4435d623" date: #<date nanosecond: 0 second: 52 minute: 16 hour: 4 day: 28 month: 8 year: 2020 zone-offset: 0>> last-revision: #<<revision> commit: "ac29d37e2ffd7a85adfcac9be4d5bce018289bec" date: #<date nanosecond: 0 second: 2 minute: 36 hour: 17 day: 25 month: 3 year: 2021 zone-offset: 0>>> #<<package-version-range> version: "26.3" first-revision: #<<revision> commit: "43412ab967ee00789fe933f916d804aed9961c57" date: #<date nanosecond: 0 second: 29 minute: 36 hour: 3 day: 30 month: 8 year: 2019 zone-offset: 0>> last-revision: #<<revision> commit: "bf19d5e4b26a2e38fe93a45f9341e14476ea5f82" date: #<date nanosecond: 0 second: 19 minute: 50 hour: 21 day: 27 month: 8 year: 2020 zone-offset: 0>>> #<<package-version-range> version: "26.2" first-revision: #<<revision> commit: "5069baedb8a902c3b1ea9656c11471658a1de56b" date: #<date nanosecond: 0 second: 8 minute: 46 hour: 22 day: 12 month: 4 year: 2019 zone-offset: 0>> last-revision: #<<revision> commit: "02c61278f1327d403f072f42e6b92a1dc62fc93a" date: #<date nanosecond: 0 second: 35 minute: 44 hour: 0 day: 30 month: 8 year: 2019 zone-offset: 0>>> #<<package-version-range> version: "26.1" first-revision: #<<revision> commit: "897f303d2fa61497a931cf5fcb43349eb5f44c14" date: #<date nanosecond: 0 second: 47 minute: 31 hour: 7 day: 1 month: 1 year: 2019 zone-offset: 0>> last-revision: #<<revision> commit: "ee6c4b62b88640f3828cf73a30377124e16cb95f" date: #<date nanosecond: 0 second: 51 minute: 8 hour: 20 day: 12 month: 4 year: 2019 zone-offset: 0>>>)
--8<---------------cut here---------------end--------------->8---
Now all we need to do is plug it into the right tools and enjoy!
Ludo’.
[-- Attachment #2: the module --]
[-- Type: text/plain, Size: 8244 bytes --]
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix data-service)
#:use-module (json)
#:use-module (web client)
#:use-module (web response)
#:use-module (web uri)
#:use-module ((guix diagnostics) #:select (location))
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-71)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 match))
(define-json-mapping <repository> make-repository repository?
json->repository
(id repository-id)
(label repository-label)
(url repository-url)
(branches repository-branches "branches"
(const 'not-implemented))) ;FIXME: another kind of branch!
(define-json-mapping <branch> make-branch branch?
json->branch
(name branch-name)
(repository-id branch-repository-id "git_repository_id"))
(define-json-mapping <package-version> make-package-version
package-version?
json->package-version
(string package-version-string "version")
(branches package-version-branches "branches"
(lambda (vector)
(map json->branch (vector->list vector)))))
(define-json-mapping <package> make-package package?
json->package
(name package-name)
(versions package-versions "versions"
(lambda (vector)
(map json->package-version (vector->list vector)))))
(define (utc-date date)
"Return DATE with its timezone offset zeroed."
(make-date (date-nanosecond date) (date-second date)
(date-minute date) (date-hour date)
(date-day date) (date-month date) (date-year date)
0))
(define (string->date* str)
(utc-date (string->date str "~Y-~m-~d ~H:~M:~S"))) ;assume dates are UTC
(define-json-mapping <revision> make-revision revision?
json->revision
(commit revision-commit)
(date revision-date "datetime" string->date*))
(define-json-mapping <package-version-range>
make-package-version-range package-version-range?
json->package-version-range
(version package-version-range-version)
(first-revision package-version-range-first-revision
"first_revision" json->revision)
(last-revision package-version-range-last-revision
"last_revision" json->revision))
(define-json-mapping <build>
make-build build?
json->build
(server-id build-server-id "build_server_id")
(id build-id "build_server_build_id")
(time build-time "timestamp"
(lambda (str)
(utc-date
(string->date str "~Y-~m-~dT~H:~M:~S")))))
(define-json-mapping <channel-instance>
make-channel-instance channel-instance?
json->channel-instance
(system channel-instance-system)
(derivation channel-instance-derivation)
(builds channel-instance-builds "builds"
(lambda (vector)
(map json->build (vector->list vector)))))
(define (json->location alist)
(location (assoc-ref alist "file")
(assoc-ref alist "line-number")
(assoc-ref alist "column-number")))
(define-json-mapping <lint-warning> make-lint-warning lint-warning?
json->lint-warning
(package lint-warning-package "package"
(lambda (alist)
(assoc-ref alist "name")))
(package-version lint-warning-package-version "package"
(lambda (alist)
(assoc-ref alist "version")))
(message lint-warning-message)
(location lint-warning-location "location" json->location))
\f
;;;
;;; Calling the Guix Data Service.
;;;
;; Connection to an instance of the Data Service.
(define-record-type <data-service>
(data-service socket uri)
data-service?
(socket data-service-socket)
(uri data-service-uri))
(define (open-data-service url)
"Open a connection to the Guix Data Service instance at URL."
(let ((uri (string->uri url)))
(data-service (open-socket-for-uri uri) uri)))
(define (make-data-service-uri service path)
(build-uri
(uri-scheme (data-service-uri service))
#:host (uri-host (data-service-uri service))
#:port (uri-port (data-service-uri service))
#:path path))
(define (discard port n)
"Read N bytes from PORT and discard them."
(define bv (make-bytevector 4096))
(let loop ((n n))
(unless (zero? n)
(match (get-bytevector-n! port bv 0
(min n (bytevector-length bv)))
((? eof-object?) #t)
(read (loop (- n read)))))))
(define (call service path)
(let* ((uri (make-data-service-uri service path))
(response port
(http-get uri
#:port (data-service-socket service)
#:keep-alive? #t
#:headers '((Accept . "application/json"))
#:streaming? #t)))
(unless (= 200 (response-code response))
(when (response-content-length response)
(discard port (response-content-length response)))
(throw 'data-service-client-error uri response))
port))
(define (lookup-package service name)
"Lookup package NAME and return a package record."
(json->package (call service (string-append "/package/" name))))
(define (lookup-repository service id)
"Lookup the repository with the given ID, an integer, and return it."
(json->repository
(call service (string-append "/repository/" (number->string id)))))
(define (package-version-history service branch package)
"Return a list of package version ranges for PACKAGE, a string, on BRANCH, a
<branch> record."
;; http://data.guix.gnu.org/repository/1/branch/master/package/emacs.json
(map json->package-version-range
(let ((result (json->scm
(call service
(string-append "/repository/"
(number->string
(branch-repository-id branch))
"/branch/"
(branch-name branch)
"/package/" package)))))
(vector->list (assoc-ref result "versions")))))
(define (revision-channel-instances service commit)
"Return the channel instances for COMMIT."
(let ((result (json->scm
(call service
(string-append "/revision/" commit
"/channel-instances")))))
(map json->channel-instance
(vector->list (assoc-ref result "channel_instances")))))
(define* (revision-lint-warnings service commit #:optional linter)
"Return lint warnings for COMMIT. If LINTER is given, only show warnings
for the given linter--e.g., 'description'."
(let ((result (json->scm
(call service
(string-append "/revision/" commit
"/lint-warnings"
(if linter
(string-append "?linter=" linter)
""))))))
(map json->lint-warning
(vector->list (assoc-ref result "lint_warnings")))))
next reply other threads:[~2021-06-27 21:24 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-06-27 21:23 Ludovic Courtès [this message]
2022-02-04 10:14 ` Guix Data Service client module Christopher Baines
2022-02-05 15:04 ` Ludovic Courtès
2022-02-15 18:10 ` Christopher Baines
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87czs7ypb4.fsf@inria.fr \
--to=ludo@gnu.org \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).