[PATCH 0/4] Refactor (guix ci) and (guix import crate)

DoneSubmitted by Ludovic Courtès.
Details
2 participants
  • Efraim Flashner
  • Ludovic Courtès
Owner
unassigned
Severity
normal
L
L
Ludovic Courtès wrote on 1 Sep 2019 16:46
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20190901144647.15185-1-ludo@gnu.org
Hello Guix!

Initially I just wanted to fix “guix import crate blake2-rfc”, which
didn’t work as Efraim reported on IRC, but that led me to refactor
(guix ci) and (guix import crate) to use ‘define-json-mapping’ to
automatically map JSON dictionaries to records.

Feedback welcome!

Thanks,
Ludo’.

Ludovic Courtès (4):
Add (guix json).
ci: Use (guix json) and adjust for Guile-JSON 3.x.
import: create: Separate crates.io API from actual conversion.
import: crate: Correct interpretation of dual-licensing strings.

Makefile.am | 1 +
guix/build-system/cargo.scm | 11 ++-
guix/ci.scm | 68 ++++++---------
guix/import/crate.scm | 161 ++++++++++++++++++++++++++----------
guix/json.scm | 62 ++++++++++++++
guix/swh.scm | 35 +-------
tests/crate.scm | 13 ++-
7 files changed, 229 insertions(+), 122 deletions(-)
create mode 100644 guix/json.scm

--
2.23.0
L
L
Ludovic Courtès wrote on 1 Sep 2019 16:56
[PATCH 1/4] Add (guix json).
(address . 37254@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20190901145603.15515-1-ludo@gnu.org
* guix/swh.scm (define-json-reader, define-json-mapping): Move to...
* guix/json.scm: ... here. New file.
* Makefile.am (MODULES): Add it.
---
Makefile.am | 1 +
guix/json.scm | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++
guix/swh.scm | 35 +----------------------------
3 files changed, 64 insertions(+), 34 deletions(-)
create mode 100644 guix/json.scm

Toggle diff (135 lines)
diff --git a/Makefile.am b/Makefile.am
index fa6bf8fe80..7b96c9473c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -68,6 +68,7 @@ MODULES =					\
   guix/cpio.scm					\
   guix/deprecation.scm				\
   guix/docker.scm	   			\
+  guix/json.scm					\
   guix/records.scm				\
   guix/pki.scm					\
   guix/progress.scm				\
diff --git a/guix/json.scm b/guix/json.scm
new file mode 100644
index 0000000000..20f0bd8f13
--- /dev/null
+++ b/guix/json.scm
@@ -0,0 +1,62 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018, 2019 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 json)
+  #:use-module (json)
+  #:use-module (srfi srfi-9)
+  #:export (define-json-mapping))
+
+;;; Commentary:
+;;;
+;;; Helpers to map JSON objects to SRFI-9 records.  Taken from (guix swh).
+;;;
+;;; Code:
+
+(define-syntax-rule (define-json-reader json->record ctor spec ...)
+  "Define JSON->RECORD as a procedure that converts a JSON representation,
+read from a port, string, or hash table, into a record created by CTOR and
+following SPEC, a series of field specifications."
+  (define (json->record input)
+    (let ((table (cond ((port? input)
+                        (json->scm input))
+                       ((string? input)
+                        (json-string->scm input))
+                       ((or (null? input) (pair? input))
+                        input))))
+      (let-syntax ((extract-field (syntax-rules ()
+                                    ((_ table (field key json->value))
+                                     (json->value (assoc-ref table key)))
+                                    ((_ table (field key))
+                                     (assoc-ref table key))
+                                    ((_ table (field))
+                                     (assoc-ref table
+                                                (symbol->string 'field))))))
+        (ctor (extract-field table spec) ...)))))
+
+(define-syntax-rule (define-json-mapping rtd ctor pred json->record
+                      (field getter spec ...) ...)
+  "Define RTD as a record type with the given FIELDs and GETTERs, à la SRFI-9,
+and define JSON->RECORD as a conversion from JSON to a record of this type."
+  (begin
+    (define-record-type rtd
+      (ctor field ...)
+      pred
+      (field getter) ...)
+
+    (define-json-reader json->record ctor
+      (field spec ...) ...)))
diff --git a/guix/swh.scm b/guix/swh.scm
index c253e217da..1e8927128c 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -20,6 +20,7 @@
   #:use-module (guix base16)
   #:use-module (guix build utils)
   #:use-module ((guix build syscalls) #:select (mkdtemp!))
+  #:use-module (guix json)
   #:use-module (web client)
   #:use-module (web response)
   #:use-module (json)
@@ -129,40 +130,6 @@
       url
       (string-append url "/")))
 
-(define-syntax-rule (define-json-reader json->record ctor spec ...)
-  "Define JSON->RECORD as a procedure that converts a JSON representation,
-read from a port, string, or hash table, into a record created by CTOR and
-following SPEC, a series of field specifications."
-  (define (json->record input)
-    (let ((table (cond ((port? input)
-                        (json->scm input))
-                       ((string? input)
-                        (json-string->scm input))
-                       ((or (null? input) (pair? input))
-                        input))))
-      (let-syntax ((extract-field (syntax-rules ()
-                                    ((_ table (field key json->value))
-                                     (json->value (assoc-ref table key)))
-                                    ((_ table (field key))
-                                     (assoc-ref table key))
-                                    ((_ table (field))
-                                     (assoc-ref table
-                                                (symbol->string 'field))))))
-        (ctor (extract-field table spec) ...)))))
-
-(define-syntax-rule (define-json-mapping rtd ctor pred json->record
-                      (field getter spec ...) ...)
-  "Define RTD as a record type with the given FIELDs and GETTERs, à la SRFI-9,
-and define JSON->RECORD as a conversion from JSON to a record of this type."
-  (begin
-    (define-record-type rtd
-      (ctor field ...)
-      pred
-      (field getter) ...)
-
-    (define-json-reader json->record ctor
-      (field spec ...) ...)))
-
 (define %date-regexp
   ;; Match strings like "2014-11-17T22:09:38+01:00" or
   ;; "2018-09-30T23:20:07.815449+00:00"".
-- 
2.23.0
L
L
Ludovic Courtès wrote on 1 Sep 2019 16:56
[PATCH 2/4] ci: Use (guix json) and adjust for Guile-JSON 3.x.
(address . 37254@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20190901145603.15515-2-ludo@gnu.org
This is in part a followup to 81c3dc32244a17241d74eea9fa265edfcb326f6d.

* guix/ci.scm (<build>, <checkout>, <evaluation>): Define using
'define-json-mapping'.
(json->build, json->checkout, json->evaluation): Remove.
(queued-builds, latest-builds, latest-evaluations): Pass JSON arrays
through 'vector->list' to adjust for Guile-JSON 3.x.
(evaluations-for-commit): Fix typo to really export.
---
guix/ci.scm | 68 +++++++++++++++++++++--------------------------------
1 file changed, 27 insertions(+), 41 deletions(-)

Toggle diff (132 lines)
diff --git a/guix/ci.scm b/guix/ci.scm
index 1727297dd7..9e21996023 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,9 +18,10 @@
 
 (define-module (guix ci)
   #:use-module (guix http-client)
-  #:autoload   (json parser) (json->scm)
+  #:use-module (guix json)
+  #:use-module (json)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
   #:export (build?
             build-id
             build-derivation
@@ -42,7 +43,7 @@
             queued-builds
             latest-builds
             latest-evaluations
-            evaluation-for-commit))
+            evaluations-for-commit))
 
 ;;; Commentary:
 ;;;
@@ -51,28 +52,31 @@
 ;;;
 ;;; Code:
 
-(define-record-type <build>
-  (make-build id derivation system status timestamp)
-  build?
-  (id          build-id)                          ;integer
+(define-json-mapping <build> make-build build?
+  json->build
+  (id          build-id "id")                     ;integer
   (derivation  build-derivation)                  ;string | #f
   (system      build-system)                      ;string
-  (status      build-status)                      ;integer
+  (status      build-status "buildstatus" )       ;integer
   (timestamp   build-timestamp))                  ;integer
 
-(define-record-type <checkout>
-  (make-checkout commit input)
-  checkout?
+(define-json-mapping <checkout> make-checkout checkout?
+  json->checkout
   (commit      checkout-commit)                   ;string (SHA1)
   (input       checkout-input))                   ;string (name)
 
-(define-record-type <evaluation>
-  (make-evaluation id spec complete? checkouts)
-  evaluation?
+(define-json-mapping <evaluation> make-evaluation evaluation?
+  json->evaluation
   (id          evaluation-id)                     ;integer
   (spec        evaluation-spec)                   ;string
-  (complete?   evaluation-complete?)              ;Boolean
-  (checkouts   evaluation-checkouts))             ;<checkout>*
+  (complete?   evaluation-complete? "in-progress"
+               (match-lambda
+                 (0 #t)
+                 (_ #f)))                         ;Boolean
+  (checkouts   evaluation-checkouts "checkouts"   ;<checkout>*
+               (lambda (checkouts)
+                 (map json->checkout
+                      (vector->list checkouts)))))
 
 (define %query-limit
   ;; Max number of builds requested in queries.
@@ -84,18 +88,11 @@
     (close-port port)
     json))
 
-(define (json->build json)
-  (make-build (hash-ref json "id")
-              (hash-ref json "derivation")
-              (hash-ref json "system")
-              (hash-ref json "buildstatus")
-              (hash-ref json "timestamp")))
-
 (define* (queued-builds url #:optional (limit %query-limit))
   "Return the list of queued derivations on URL."
   (let ((queue (json-fetch (string-append url "/api/queue?nr="
                                           (number->string limit)))))
-    (map json->build queue)))
+    (map json->build (vector->list queue))))
 
 (define* (latest-builds url #:optional (limit %query-limit)
                         #:key evaluation system)
@@ -114,26 +111,15 @@ string such as \"x86_64-linux\"), restrict to builds for SYSTEM."
                                            (option "system" system)))))
     ;; Note: Hydra does not provide a "derivation" field for entries in
     ;; 'latestbuilds', but Cuirass does.
-    (map json->build latest)))
-
-(define (json->checkout json)
-  (make-checkout (hash-ref json "commit")
-                 (hash-ref json "input")))
-
-(define (json->evaluation json)
-  (make-evaluation (hash-ref json "id")
-                   (hash-ref json "specification")
-                   (case (hash-ref json "in-progress")
-                     ((0) #t)
-                     (else #f))
-                   (map json->checkout (hash-ref json "checkouts"))))
+    (map json->build (vector->list latest))))
 
 (define* (latest-evaluations url #:optional (limit %query-limit))
   "Return the latest evaluations performed by the CI server at URL."
   (map json->evaluation
-       (json->scm
-        (http-fetch (string-append url "/api/evaluations?nr="
-                                   (number->string limit))))))
+       (vector->list
+        (json->scm
+         (http-fetch (string-append url "/api/evaluations?nr="
+                                    (number->string limit)))))))
 
 
 (define* (evaluations-for-commit url commit #:optional (limit %query-limit))
-- 
2.23.0
L
L
Ludovic Courtès wrote on 1 Sep 2019 16:56
[PATCH 3/4] import: create: Separate crates.io API from actual conversion.
(address . 37254@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20190901145603.15515-3-ludo@gnu.org
This provides a clean separation between bindings to the
https://crates.io/api/v1API and actual conversion to Guix package
sexps.

As a side-effect, it fixes things like "guix import blake2-rfc", "guix
refresh -t crates", etc.

* guix/import/crate.scm (<crate>, <crate-version>, <crate-dependency>):
New record types.
(lookup-crate, crate-version-dependencies): New procedures.
(crate-fetch): Remove.
(crate->guix-package): Rewrite to use the new API.
(latest-release): Likewise.
* guix/build-system/cargo.scm (%crate-base-url): New variable.
* tests/crate.scm (test-crate): Update accordingly.
---
guix/build-system/cargo.scm | 11 ++-
guix/import/crate.scm | 150 ++++++++++++++++++++++++++----------
tests/crate.scm | 13 +++-
3 files changed, 128 insertions(+), 46 deletions(-)

Toggle diff (272 lines)
diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index 10a1bac844..1e8b3a578e 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
@@ -35,12 +35,17 @@
   #:export (%cargo-build-system-modules
             %cargo-utils-modules
             cargo-build-system
+            %crate-base-url
             crate-url
             crate-url?
             crate-uri))
 
-(define crate-url "https://crates.io/api/v1/crates/")
-(define crate-url? (cut string-prefix? crate-url <>))
+(define %crate-base-url
+  (make-parameter "https://crates.io"))
+(define crate-url
+  (string-append (%crate-base-url) "/api/v1/crates/"))
+(define crate-url?
+  (cut string-prefix? crate-url <>))
 
 (define (crate-uri name version)
   "Return a URI string for the crate package hosted at crates.io corresponding
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 52c5cb1c30..bcd5068e6c 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@
   #:use-module ((guix download) #:prefix download:)
   #:use-module (gcrypt hash)
   #:use-module (guix http-client)
+  #:use-module (guix json)
   #:use-module (guix import json)
   #:use-module (guix import utils)
   #:use-module ((guix licenses) #:prefix license:)
@@ -30,7 +32,6 @@
   #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print) ; recursive
   #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
@@ -39,46 +40,82 @@
             guix-package->crate-name
             %crate-updater))
 
-(define (crate-fetch crate-name callback)
-  "Fetch the metadata for CRATE-NAME from crates.io and call the callback."
+
+;;;
+;;; Interface to https://crates.io/api/v1.
+;;;
 
-  (define (crates->inputs crates)
-    (sort (map (cut assoc-ref <> "crate_id") crates) string-ci<?))
+;; Crates.  A crate is essentially a "package".  It can have several
+;; "versions", each of which has its own set of dependencies, license,
+;; etc.--see <crate-version> below.
+(define-json-mapping <crate> make-crate crate?
+  json->crate
+  (name          crate-name)                      ;string
+  (latest-version crate-latest-version "max_version") ;string
+  (home-page     crate-home-page "homepage")      ;string | #nil
+  (repository    crate-repository)                ;string
+  (description   crate-description)               ;string
+  (keywords      crate-keywords                   ;list of strings
+                 "keywords" vector->list)
+  (categories    crate-categories                 ;list of strings
+                 "categories" vector->list)
+  (versions      crate-versions "actual_versions" ;list of <crate-version>
+                 (lambda (vector)
+                   (map json->crate-version
+                        (vector->list vector))))
+  (links         crate-links))                    ;alist
 
-  (define (string->license string)
-    (map spdx-string->license (string-split string #\/)))
+;; Crate version.
+(define-json-mapping <crate-version> make-crate-version crate-version?
+  json->crate-version
+  (id            crate-version-id)                ;integer
+  (number        crate-version-number "num")      ;string
+  (download-path crate-version-download-path "dl_path") ;string
+  (readme-path   crate-version-readme-path "readme_path") ;string
+  (license       crate-version-license "license") ;string
+  (links         crate-version-links))            ;alist
 
-  (define (crate-kind-predicate kind)
-    (lambda (dep) (string=? (assoc-ref dep "kind") kind)))
-
-  (and-let* ((crate-json (json-fetch (string-append crate-url crate-name)))
-             (crate (assoc-ref crate-json "crate"))
-             (name (assoc-ref crate "name"))
-             (version (assoc-ref crate "max_version"))
-             (homepage (assoc-ref crate "homepage"))
-             (repository (assoc-ref crate "repository"))
-             (synopsis (assoc-ref crate "description"))
-             (description (assoc-ref crate "description"))
-             (license (or (and=> (assoc-ref crate "license")
-                                 string->license)
-                          '()))                   ;missing license info
-             (path (string-append "/" version "/dependencies"))
-             (deps-json (json-fetch (string-append crate-url name path)))
-             (deps (vector->list (assoc-ref deps-json "dependencies")))
-             (dep-crates (filter (crate-kind-predicate "normal") deps))
-             (dev-dep-crates
-              (filter (lambda (dep)
-                        (not ((crate-kind-predicate "normal") dep))) deps))
-             (cargo-inputs (crates->inputs dep-crates))
-             (cargo-development-inputs (crates->inputs dev-dep-crates))
-             (home-page (match homepage
-                          (() repository)
-                          (_ homepage))))
-    (callback #:name name #:version version
-              #:cargo-inputs cargo-inputs
-              #:cargo-development-inputs cargo-development-inputs
-              #:home-page home-page #:synopsis synopsis
-              #:description description #:license license)))
+;; Crate dependency.  Each dependency (each edge in the graph) is annotated as
+;; being a "normal" dependency or a development dependency.  There also
+;; information about the minimum required version, such as "^0.0.41".
+(define-json-mapping <crate-dependency> make-crate-dependency
+  crate-dependency?
+  json->crate-dependency
+  (id            crate-dependency-id "crate_id")  ;string
+  (kind          crate-dependency-kind "kind"     ;'normal | 'dev
+                 string->symbol)
+  (requirement   crate-dependency-requirement "req")) ;string
+
+(define (lookup-crate name)
+  "Look up NAME on https://crates.io and return the corresopnding <crate>
+record or #f if it was not found."
+  (let ((json (json-fetch (string-append (%crate-base-url) "/api/v1/crates/"
+                                         name))))
+    (and=> (and json (assoc-ref json "crate"))
+           (lambda (alist)
+             ;; The "versions" field of ALIST is simply a list of version IDs
+             ;; (integers).  Here, we squeeze in the actual version
+             ;; dictionaries that are not part of ALIST but are just more
+             ;; convenient handled this way.
+             (let ((versions (or (assoc-ref json "versions") '#())))
+               (json->crate `(,@alist
+                              ("actual_versions" . ,versions))))))))
+
+(define (crate-version-dependencies version)
+  "Return the list of <crate-dependency> records of VERSION, a
+<crate-version>."
+  (let* ((path (assoc-ref (crate-version-links version) "dependencies"))
+         (url  (string-append (%crate-base-url) path)))
+    (match (assoc-ref (or (json-fetch url) '()) "dependencies")
+      ((? vector? vector)
+       (map json->crate-dependency (vector->list vector)))
+      (_
+       '()))))
+
+
+;;;
+;;; Converting crates to Guix packages.
+;;;
 
 (define (maybe-cargo-inputs package-names)
   (match (package-names->package-inputs package-names)
@@ -141,7 +178,35 @@ and LICENSE."
 (define (crate->guix-package crate-name)
   "Fetch the metadata for CRATE-NAME from crates.io, and return the
 `package' s-expression corresponding to that package, or #f on failure."
-  (crate-fetch crate-name make-crate-sexp))
+  (define (string->license string)
+    (map spdx-string->license (string-split string #\/)))
+
+  (define (normal-dependency? dependency)
+    (eq? (crate-dependency-kind dependency) 'normal))
+
+  (let* ((crate          (lookup-crate crate-name))
+         (version        (find (lambda (version)
+                                 (string=? (crate-version-number version)
+                                           (crate-latest-version crate)))
+                               (crate-versions crate)))
+         (dependencies   (crate-version-dependencies version))
+         (dep-crates     (filter normal-dependency? dependencies))
+         (dev-dep-crates (remove normal-dependency? dependencies))
+         (cargo-inputs   (sort (map crate-dependency-id dep-crates)
+                               string-ci<?))
+         (cargo-development-inputs
+          (sort (map crate-dependency-id dev-dep-crates)
+                string-ci<?)))
+    (make-crate-sexp #:name crate-name
+                     #:version (crate-version-number version)
+                     #:cargo-inputs cargo-inputs
+                     #:cargo-development-inputs cargo-development-inputs
+                     #:home-page (or (crate-home-page crate)
+                                     (crate-repository crate))
+                     #:synopsis (crate-description crate)
+                     #:description (crate-description crate)
+                     #:license (and=> (crate-version-license version)
+                                      string->license))))
 
 (define (guix-package->crate-name package)
   "Return the crate name of PACKAGE."
@@ -157,6 +222,7 @@ and LICENSE."
 (define (crate-name->package-name name)
   (string-append "rust-" (string-join (string-split name #\_) "-")))
 
+
 ;;;
 ;;; Updater
 ;;;
@@ -175,9 +241,9 @@ and LICENSE."
 (define (latest-release package)
   "Return an <upstream-source> for the latest release of PACKAGE."
   (let* ((crate-name (guix-package->crate-name package))
-         (callback (lambda* (#:key version #:allow-other-keys) version))
-         (version (crate-fetch crate-name callback))
-         (url (crate-uri crate-name version)))
+         (crate      (lookup-crate crate-name))
+         (version    (crate-latest-version crate))
+         (url        (crate-uri crate-name version)))
     (upstream-source
      (package (package-name package))
      (version version)
diff --git a/tests/crate.scm b/tests/crate.scm
index 72c3a13350..8a232ba06c 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,10 +33,20 @@
   \"crate\": {
     \"max_version\": \"1.0.0\",
     \"name\": \"foo\",
-    \"license\": \"MIT/Apache-2.0\",
     \"description\": \"summary\",
     \"homepage\": \"http://example.com\",
     \"repository\": \"http://example.com\",
+    \"keywords\": [\"dummy\" \"test\"],
+    \"categories\": [\"test\"]
+    \"actual_versions\": [
+      { \"id\": \"foo\",
+        \"num\": \"1.0.0\",
+        \"license\": \"MIT/Apache-2.0\",
+        \"links\": {
+          \"dependencies\": \"/api/v1/crates/foo/1.0.0/dependencies\"
+        }
+      }
+    ]
   }
 }")
 
-- 
2.23.0
L
L
Ludovic Courtès wrote on 1 Sep 2019 16:56
[PATCH 4/4] import: crate: Correct interpretation of dual-licensing strings.
(address . 37254@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
20190901145603.15515-4-ludo@gnu.org
* guix/import/crate.scm (%dual-license-rx): New variable.
(crate->guix-package)[string->license]: Rewrite to match it.
* tests/crate.scm (test-crate): Adjust "license" field to current
practice.
---
guix/import/crate.scm | 11 ++++++++++-
tests/crate.scm | 2 +-
2 files changed, 11 insertions(+), 2 deletions(-)

Toggle diff (48 lines)
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index bcd5068e6c..a1cbf33361 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -32,6 +32,7 @@
   #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
@@ -175,11 +176,19 @@ and LICENSE."
          (close-port port)
          pkg))
 
+(define %dual-license-rx
+  ;; Dual licensing is represented by a string such as "MIT OR Apache-2.0".
+  ;; This regexp matches that.
+  (make-regexp "^(.*) OR (.*)$"))
+
 (define (crate->guix-package crate-name)
   "Fetch the metadata for CRATE-NAME from crates.io, and return the
 `package' s-expression corresponding to that package, or #f on failure."
   (define (string->license string)
-    (map spdx-string->license (string-split string #\/)))
+    (match (regexp-exec %dual-license-rx string)
+      (#f (spdx-string->license string))
+      (m  (list (spdx-string->license (match:substring m 1))
+                (spdx-string->license (match:substring m 2))))))
 
   (define (normal-dependency? dependency)
     (eq? (crate-dependency-kind dependency) 'normal))
diff --git a/tests/crate.scm b/tests/crate.scm
index 8a232ba06c..c14862ad9f 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -41,7 +41,7 @@
     \"actual_versions\": [
       { \"id\": \"foo\",
         \"num\": \"1.0.0\",
-        \"license\": \"MIT/Apache-2.0\",
+        \"license\": \"MIT OR Apache-2.0\",
         \"links\": {
           \"dependencies\": \"/api/v1/crates/foo/1.0.0/dependencies\"
         }
-- 
2.23.0
E
E
Efraim Flashner wrote on 1 Sep 2019 18:05
Re: [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate)
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 37254@debbugs.gnu.org)
20190901160513.GI13917@E5400
After my several (panicked :/) messages on IRC it turns out it's working
pretty well. I'm able to run 'guix lint -c refresh' and 'guix refresh -t
crate'.

some errors I've come across, sometimes I get (license (list . #f)),
like for rust-ppv-lite86, and sometimes I get (license (list .
license:expat))), like with rust-schannel.

On Sun, Sep 01, 2019 at 04:46:47PM +0200, Ludovic Courtès wrote:
Toggle quote (35 lines)
> Hello Guix!
>
> Initially I just wanted to fix “guix import crate blake2-rfc”, which
> didn’t work as Efraim reported on IRC, but that led me to refactor
> (guix ci) and (guix import crate) to use ‘define-json-mapping’ to
> automatically map JSON dictionaries to records.
>
> Feedback welcome!
>
> Thanks,
> Ludo’.
>
> Ludovic Courtès (4):
> Add (guix json).
> ci: Use (guix json) and adjust for Guile-JSON 3.x.
> import: create: Separate crates.io API from actual conversion.
> import: crate: Correct interpretation of dual-licensing strings.
>
> Makefile.am | 1 +
> guix/build-system/cargo.scm | 11 ++-
> guix/ci.scm | 68 ++++++---------
> guix/import/crate.scm | 161 ++++++++++++++++++++++++++----------
> guix/json.scm | 62 ++++++++++++++
> guix/swh.scm | 35 +-------
> tests/crate.scm | 13 ++-
> 7 files changed, 229 insertions(+), 122 deletions(-)
> create mode 100644 guix/json.scm
>
> --
> 2.23.0
>
>
>
>

--
Efraim Flashner <efraim@flashner.co.il> אפרים פלשנר
GPG key = A28B F40C 3E55 1372 662D 14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted
-----BEGIN PGP SIGNATURE-----

iQIzBAABCgAdFiEEoov0DD5VE3JmLRT3Qarn3Mo9g1EFAl1r7DUACgkQQarn3Mo9
g1FbChAAkFkXSgkTylmxoWlsBl89Qx19SiHoCMQmdt8+DYLbea81tEzGVhbuzIbB
8g9aDPj4A5bbnN7e9DVH/Bg2Nh9OplEgA7AzrswcP9zUTjY1F/BKUNVdFx7qm3hk
bzpDlpFGXY5P1KfLYYxrIojHJ6VCjoj3Zko9POrdTRu7GgW2ObClgnDc9kWmRYQW
9m+dheFa8Z0c27Jh0c8QrsxL+ITbzZfgETC2vTAuC/p6a7kVlDcT689b+cba2jFD
Wh6bKTI9A3VDUOKD8PjvJG38b5aFh6qJv1xvBjQX/cCHsuHkArOy9SqiKla8l4f+
MhXzh9RhR7Am/tuel40McJcSyaOMtNvZu9M56ch1kaytjDRkrIR7K3qWoJZ9P7TB
TBVYTQvLt0helF9Q7I5QnOw+C0IoYRh35dJTelufcAJphbELsI/MVMe04yOnucSS
wOEW+5m5SoIdEb82vlFwGTHCUf10AGiqY4P4KtSCqLNFXHmpP1xg+MuhyBOzsiXe
+SoLqaKjhlS2yZT8n+06r7AaI/6JyR8//pO3hbJZynns6FHKZg9MkZF+Qqre8ZUX
NCJNrxDt16D8BeBl8az3UGqL0BIjARt8mbr3qrpz8TvBOqeDk3Ux1pj4J5j814M1
K5arnbPYlcJRTcox8f3ixO138H8uEmjVAMFILYIm2YU7qiR1TNE=
=Lpqm
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 4 Sep 2019 13:04
(name . Efraim Flashner)(address . efraim@flashner.co.il)(address . 37254-done@debbugs.gnu.org)
87ftlc726c.fsf@inria.fr
Hello,

Efraim Flashner <efraim@flashner.co.il> skribis:

Toggle quote (4 lines)
> After my several (panicked :/) messages on IRC it turns out it's working
> pretty well. I'm able to run 'guix lint -c refresh' and 'guix refresh -t
> crate'.

There was room for improvement though: :-)

Toggle snippet (34 lines)
$ guix refresh -t crates
Backtrace:
10 (primitive-load "/home/ludo/.config/guix/current/bin/gu…")
In guix/ui.scm:
1692:12 9 (run-guix-command _ . _)
In ice-9/boot-9.scm:
829:9 8 (catch _ _ #<procedure 7f0dd4fb6e98 at guix/ui.scm:623…> …)
829:9 7 (catch _ _ #<procedure 7f0dd4fb6eb0 at guix/ui.scm:746…> …)
In guix/store.scm:
623:10 6 (call-with-store _)
1803:24 5 (run-with-store #<store-connection 256.99 1e05b40> _ # _ …)
In guix/scripts/refresh.scm:
533:14 4 (_ _)
In srfi/srfi-1.scm:
640:9 3 (for-each #<procedure 21e33a0 at guix/scripts/refresh.…> …)
In guix/scripts/refresh.scm:
344:2 2 (check-for-package-update #<package rust-autocfg@0.1.5…> …)
In guix/import/crate.scm:
180:14 1 (latest-release #<package rust-autocfg@0.1.5 gnu/packag…>)
In unknown file:
0 (string-append "https://crates.io/api/v1/crates/" "aut…" …)

ERROR: In procedure string-append:
In procedure string-append: Wrong type (expecting string): #f
$ guix import crate blake2-rfc
guix import: error: failed to download meta-data for package 'blake2-rfc'
$ guix describe
Generacio 101 Aug 26 2019 09:31:24 (nuna)
guix a707484
repository URL: https://git.savannah.gnu.org/git/guix.git
branch: master
commit: a707484d64e7e46f8cb8401c660fbb6eb77ab9c6

This change fixes that.

Toggle quote (4 lines)
> some errors I've come across, sometimes I get (license (list . #f)),
> like for rust-ppv-lite86, and sometimes I get (license (list .
> license:expat))), like with rust-schannel.

Oh there was still an issue with this, so I’ve fixed it. But note that
“guix import crate schannel” doesn’t work on master.

I’ve pushed the whole series now.

Thanks for your feedback!

Ludo’.
Closed
?
Your comment

This issue is archived.

To comment on this conversation send email to 37254@debbugs.gnu.org