unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate)
@ 2019-09-01 14:46 Ludovic Courtès
  2019-09-01 14:56 ` [bug#37254] [PATCH 1/4] Add (guix json) Ludovic Courtès
  2019-09-01 16:05 ` [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Efraim Flashner
  0 siblings, 2 replies; 7+ messages in thread
From: Ludovic Courtès @ 2019-09-01 14:46 UTC (permalink / raw)
  To: 37254

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

^ permalink raw reply	[flat|nested] 7+ messages in thread

* [bug#37254] [PATCH 1/4] Add (guix json).
  2019-09-01 14:46 [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Ludovic Courtès
@ 2019-09-01 14:56 ` Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 2/4] ci: Use (guix json) and adjust for Guile-JSON 3.x Ludovic Courtès
                     ` (2 more replies)
  2019-09-01 16:05 ` [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Efraim Flashner
  1 sibling, 3 replies; 7+ messages in thread
From: Ludovic Courtès @ 2019-09-01 14:56 UTC (permalink / raw)
  To: 37254

* 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

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

^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#37254] [PATCH 2/4] ci: Use (guix json) and adjust for Guile-JSON 3.x.
  2019-09-01 14:56 ` [bug#37254] [PATCH 1/4] Add (guix json) Ludovic Courtès
@ 2019-09-01 14:56   ` Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 3/4] import: create: Separate crates.io API from actual conversion Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 4/4] import: crate: Correct interpretation of dual-licensing strings Ludovic Courtès
  2 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2019-09-01 14:56 UTC (permalink / raw)
  To: 37254

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(-)

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

^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#37254] [PATCH 3/4] import: create: Separate crates.io API from actual conversion.
  2019-09-01 14:56 ` [bug#37254] [PATCH 1/4] Add (guix json) Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 2/4] ci: Use (guix json) and adjust for Guile-JSON 3.x Ludovic Courtès
@ 2019-09-01 14:56   ` Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 4/4] import: crate: Correct interpretation of dual-licensing strings Ludovic Courtès
  2 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2019-09-01 14:56 UTC (permalink / raw)
  To: 37254

This provides a clean separation between bindings to the
https://crates.io/api/v1 API 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(-)

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."
+\f
+;;;
+;;; 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)))
+      (_
+       '()))))
+
+\f
+;;;
+;;; 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 #\_) "-")))
 
+\f
 ;;;
 ;;; 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

^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#37254] [PATCH 4/4] import: crate: Correct interpretation of dual-licensing strings.
  2019-09-01 14:56 ` [bug#37254] [PATCH 1/4] Add (guix json) Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 2/4] ci: Use (guix json) and adjust for Guile-JSON 3.x Ludovic Courtès
  2019-09-01 14:56   ` [bug#37254] [PATCH 3/4] import: create: Separate crates.io API from actual conversion Ludovic Courtès
@ 2019-09-01 14:56   ` Ludovic Courtès
  2 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2019-09-01 14:56 UTC (permalink / raw)
  To: 37254

* 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(-)

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

^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate)
  2019-09-01 14:46 [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Ludovic Courtès
  2019-09-01 14:56 ` [bug#37254] [PATCH 1/4] Add (guix json) Ludovic Courtès
@ 2019-09-01 16:05 ` Efraim Flashner
  2019-09-04 11:04   ` bug#37254: " Ludovic Courtès
  1 sibling, 1 reply; 7+ messages in thread
From: Efraim Flashner @ 2019-09-01 16:05 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 37254

[-- Attachment #1: Type: text/plain, Size: 1695 bytes --]

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:
> 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

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* bug#37254: [PATCH 0/4] Refactor (guix ci) and (guix import crate)
  2019-09-01 16:05 ` [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Efraim Flashner
@ 2019-09-04 11:04   ` Ludovic Courtès
  0 siblings, 0 replies; 7+ messages in thread
From: Ludovic Courtès @ 2019-09-04 11:04 UTC (permalink / raw)
  To: Efraim Flashner; +Cc: 37254-done

Hello,

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

> 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:  :-)

--8<---------------cut here---------------start------------->8---
$ 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
--8<---------------cut here---------------end--------------->8---

This change fixes that.

> 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’.

^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2019-09-04 11:05 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-09-01 14:46 [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Ludovic Courtès
2019-09-01 14:56 ` [bug#37254] [PATCH 1/4] Add (guix json) Ludovic Courtès
2019-09-01 14:56   ` [bug#37254] [PATCH 2/4] ci: Use (guix json) and adjust for Guile-JSON 3.x Ludovic Courtès
2019-09-01 14:56   ` [bug#37254] [PATCH 3/4] import: create: Separate crates.io API from actual conversion Ludovic Courtès
2019-09-01 14:56   ` [bug#37254] [PATCH 4/4] import: crate: Correct interpretation of dual-licensing strings Ludovic Courtès
2019-09-01 16:05 ` [bug#37254] [PATCH 0/4] Refactor (guix ci) and (guix import crate) Efraim Flashner
2019-09-04 11:04   ` bug#37254: " Ludovic Courtès

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).