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’.
;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Ludovic Courtès <l...@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)) ;;; ;;; 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")))))
