Subject: Re: [PATCH 3/3] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test.

From: Efraim Flashner <[email-masked]>
Date: Sun, 1 Dec 2019 11:00:58 +0200

On Sat, Nov 30, 2019 at 08:36:20AM -0800, Martin Becze wrote:
> On 2019-11-28 00:16, Martin Becze wrote:
> > * guix/import/crate.scm (make-crate-sexp): Use <crate> <crate-version> as args
> > * guix/import/crate.scm (crate->crate-version): New Procedure
> > * guix/import/crate.scm (crate->versions): New Procedure
> > * guix/import/crate.scm (crate-recursive-import): Updated to user
> > recursive-import-semver
> > * guix/scripts/import/crate.scm (guix-import-crate): Remove
> > `define-public` generation from UI
> > * guix/tests/crate.scm: Updated tests
> > ---
> >  guix/import/crate.scm         | 165 ++++++++++++++++++----------------
> >  guix/scripts/import/crate.scm |   9 +-
> >  tests/crate.scm               |   2 +-
> >  3 files changed, 91 insertions(+), 85 deletions(-)
> > 
> > diff --git a/guix/import/crate.scm b/guix/import/crate.scm
> > index 8dc014d232..da92c43b8c 100644
> > --- a/guix/import/crate.scm
> > +++ b/guix/import/crate.scm
> > @@ -38,6 +38,7 @@
> >    #:use-module (srfi srfi-1)
> >    #:use-module (srfi srfi-2)
> >    #:use-module (srfi srfi-26)
> > +  #:use-module (srfi srfi-71)
> >    #:export (crate->guix-package
> >              guix-package->crate-name
> >              crate-recursive-import
> > @@ -85,7 +86,7 @@
> >    crate-dependency?
> >    json->crate-dependency
> >    (id            crate-dependency-id "crate_id")  ;string
> > -  (kind          crate-dependency-kind "kind"     ;'normal | 'dev
> > +  (kind          crate-dependency-kind "kind"     ;'normal | 'dev | 'build
> >                   string->symbol)
> >    (requirement   crate-dependency-requirement "req")) ;string
> >  
> > @@ -111,7 +112,9 @@ record or #f if it was not found."
> >           (url  (string-append (%crate-base-url) path)))
> >      (match (assoc-ref (or (json-fetch url) '()) "dependencies")
> >        ((? vector? vector)
> > -       (map json->crate-dependency (vector->list vector)))
> > +       (filter (lambda (dep)
> > +                 (not (eq? (crate-dependency-kind dep) 'dev)))
> > +               (map json->crate-dependency (vector->list vector))))
> >        (_
> >         '()))))
> >  
> > @@ -141,62 +144,84 @@ record or #f if it was not found."
> >      ((args ...)
> >       `((arguments (,'quasiquote ,args))))))
> >  
> > -(define* (make-crate-sexp #:key name version cargo-inputs
> > cargo-development-inputs
> > -                          home-page synopsis description license
> > -                          #:allow-other-keys)
> > -  "Return the `package' s-expression for a rust package with the given NAME,
> > -VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS,
> > DESCRIPTION,
> > -and LICENSE."
> > -  (let* ((port (http-fetch (crate-uri name version)))
> > +(define (make-crate-sexp crate version* dependencies)
> > +  "Return the `package' s-expression for a rust package given <crate>,
> > + <crate-version> and a list of <crate-dependency>"
> > +  (define normal-dependency?
> > +    (match-lambda ((_ dep) (not (eq? (crate-dependency-kind dep) 'dev)))))
> > +
> > +  (define (string->license string)
> > +    (match (regexp-exec %dual-license-rx string)
> > +      (#f (list (spdx-string->license string)))
> > +      (m  (list (spdx-string->license (match:substring m 1))
> > +                (spdx-string->license (match:substring m 2))))))
> > +
> > +  (let* ((dep-crates dev-dep-crates (partition normal-dependency?
> > dependencies))
> > +         (cargo-inputs (sort (unzip1 dep-crates)
> > +                             string-ci<?))
> > +         (cargo-development-inputs
> > +          (sort (unzip1 dev-dep-crates)
> > +                string-ci<?))
> > +         (name (crate-name crate))
> > +         (version (crate-version-number version*))
> > +         (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))
> > +         (port (http-fetch (crate-uri name version)) )
> >           (guix-name (crate-name->package-name name))
> > -         (cargo-inputs (map crate-name->package-name cargo-inputs))
> > -         (cargo-development-inputs (map crate-name->package-name
> > -                                        cargo-development-inputs))
> >           (pkg `(package
> > -                   (name ,guix-name)
> > -                   (version ,version)
> > -                   (source (origin
> > -                             (method url-fetch)
> > -                             (uri (crate-uri ,name version))
> > -                             (file-name (string-append name "-"
> > version ".tar.gz"))
> > -                             (sha256
> > -                              (base32
> > -                               ,(bytevector->nix-base32-string
> > (port-sha256 port))))))
> > -                   (build-system cargo-build-system)
> > -                   ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
> > -                                              (maybe-cargo-development-inputs
> > -                                                cargo-development-inputs)))
> > -                   (home-page ,(match home-page
> > -                                 (() "")
> > -                                 (_ home-page)))
> > -                   (synopsis ,synopsis)
> > -                   (description ,(beautify-description description))
> > -                   (license ,(match license
> > -                               (() #f)
> > -                               ((license) license)
> > -                               (_ `(list ,@license)))))))
> > -         (close-port port)
> > -         pkg))
> > +                 (name ,guix-name)
> > +                 (version ,version)
> > +                 (source (origin
> > +                           (method url-fetch)
> > +                           (uri (crate-uri ,name version))
> > +                           (file-name (string-append name "-" version
> > ".crate"))
> > +                           (sha256
> > +                            (base32
> > +                             ,(bytevector->nix-base32-string
> > (port-sha256 port))))))
> > +                 (build-system cargo-build-system)
> > +                 ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
> > +                                            (maybe-cargo-development-inputs
> > +                                             cargo-development-inputs)))
> > +                 (home-page ,(match home-page
> > +                               (() "")
> > +                               (_ home-page)))
> > +                 (synopsis ,synopsis)
> > +                 (description ,(beautify-description description))
> > +                 (license ,(match license
> > +                             (() #f)
> > +                             ((license) license)
> > +                             (_ `(list ,@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->crate-version crate version-number)
> > +  "returns the <crate-version> for a given CRATE and VERSION-NUMBER"
> > +  (find (lambda (version)
> > +            (string=? (crate-version-number version)
> > +                      version-number))
> > +          (crate-versions crate)))
> > +
> > +(define (crate->versions crate)
> > +  "Returns a list of versions for a given CRATE"
> > +  (map (lambda (version)
> > +         (crate-version-number version))
> > +       (crate-versions crate)))
> > +
> >  (define* (crate->guix-package crate-name #:optional version)
> >    "Fetch the metadata for CRATE-NAME from crates.io, and return the
> >  `package' s-expression corresponding to that package, or #f on failure.
> >  When VERSION is specified, attempt to fetch that version; otherwise fetch the
> >  latest version of CRATE-NAME."
> > -  (define (string->license string)
> > -    (match (regexp-exec %dual-license-rx string)
> > -      (#f (list (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))
> > -
> >    (define crate
> >      (lookup-crate crate-name))
> >  
> > @@ -205,38 +230,27 @@ latest version of CRATE-NAME."
> >          (crate-latest-version crate)))
> >  
> >    (define version*
> > -    (find (lambda (version)
> > -            (string=? (crate-version-number version)
> > -                      version-number))
> > -          (crate-versions crate)))
> > +    (crate->crate-version crate version-number))
> >  
> > -  (and crate version*
> > -       (let* ((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<?)))
> > -         (values
> > -          (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))
> > -          (append cargo-inputs cargo-development-inputs)))))
> > +  (define dependencies (map
> > +                        (lambda (dep)
> > +                          (list (crate-name->package-name
> > +                           (crate-dependency-id dep)) dep))
> > +                        (crate-version-dependencies version*)))
> > +  (make-crate-sexp crate version* dependencies))
> >  
> > -(define (crate-recursive-import crate-name)
> > -  (recursive-import crate-name #f
> > -                    #:repo->guix-package (lambda (name repo)
> > -                                           (crate->guix-package name))
> > -                    #:guix-name crate-name->package-name))
> > +(define* (crate-recursive-import name #:optional version)
> > +  (recursive-import-semver
> > +   #:name name
> > +   #:version version
> > +   #:name->metadata lookup-crate
> > +   #:metadata->package crate->crate-version
> > +   #:metadata-versions crate->versions
> > +   #:package-dependencies crate-version-dependencies
> > +   #:dependency-name crate-dependency-id
> > +   #:dependency-range crate-dependency-requirement
> > +   #:guix-name crate-name->package-name
> > +   #:make-sexp make-crate-sexp))
> >  
> >  (define (guix-package->crate-name package)
> >    "Return the crate name of PACKAGE."
> > @@ -285,4 +299,3 @@ latest version of CRATE-NAME."
> >     (description "Updater for crates.io packages")
> >     (pred crate-package?)
> >     (latest latest-release)))
> > -
> > diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
> > index 4690cceb4d..85ae6fbe59 100644
> > --- a/guix/scripts/import/crate.scm
> > +++ b/guix/scripts/import/crate.scm
> > @@ -96,14 +96,7 @@ Import and convert the crate.io package for
> > PACKAGE-NAME.\n"))
> >           (package-name->name+version spec))
> >  
> >         (if (assoc-ref opts 'recursive)
> > -           (map (match-lambda
> > -                  ((and ('package ('name name) . rest) pkg)
> > -                   `(define-public ,(string->symbol name)
> > -                      ,pkg))
> > -                  (_ #f))
> > -                (reverse
> > -                 (stream->list
> > -                  (crate-recursive-import name))))
> > +           (stream->list (crate-recursive-import name version))
> >             (let ((sexp (crate->guix-package name version)))
> >               (unless sexp
> >                 (leave (G_ "failed to download meta-data for package '~a'~%")
> > diff --git a/tests/crate.scm b/tests/crate.scm
> > index c14862ad9f..b77cbb08c6 100644
> > --- a/tests/crate.scm
> > +++ b/tests/crate.scm
> > @@ -95,7 +95,7 @@
> >           ('source ('origin
> >                      ('method 'url-fetch)
> >                      ('uri ('crate-uri "foo" 'version))
> > -                    ('file-name ('string-append 'name "-" 'version ".tar.gz"))
> > +                    ('file-name ('string-append 'name "-" 'version ".crate"))
> >                      ('sha256
> >                       ('base32
> >                        (? string? hash)))))
> 
> I'm added a patch that will skips the building of libraries which I
> would assume most of the packages being imported are. This could be
> parametrized in the future.

I like this idea. Then we can also unhide all the rust crates. It helps
when people search for them and when guix searches for them to see if
they can be updated or need to be imported.

> From 3f2ff3b4dc4cdf8b0282316b9c2426291da8a6c7 Mon Sep 17 00:00:00 2001
> From: Martin Becze <[email-masked]>
> Date: Sat, 30 Nov 2019 11:27:05 -0500
> Subject: [PATCH] added "#:skip-build? #t" to the output of (make-crate-sexp).
>  Most the the packages imported will be libaries and won't need to build. The
>  top level package will build them though.
> 
> * guix/import/crate.scm (make-crate-sexp): added "#:skip-build? #t" to the output
> ---
>  guix/import/crate.scm | 3 ++-
>  tests/crate.scm       | 3 ++-
>  2 files changed, 4 insertions(+), 2 deletions(-)
> 
> diff --git a/guix/import/crate.scm b/guix/import/crate.scm
> index da92c43b8c..5683369b7a 100644
> --- a/guix/import/crate.scm
> +++ b/guix/import/crate.scm
> @@ -183,7 +183,8 @@ record or #f if it was not found."
>                              (base32
>                               ,(bytevector->nix-base32-string (port-sha256 port))))))
>                   (build-system cargo-build-system)
> -                 ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
> +                 ,@(maybe-arguments (append `(#:skip-build? #t)
> +                                            (maybe-cargo-inputs cargo-inputs)
>                                              (maybe-cargo-development-inputs
>                                               cargo-development-inputs)))
>                   (home-page ,(match home-page
> diff --git a/tests/crate.scm b/tests/crate.scm
> index b77cbb08c6..64e5b6932e 100644
> --- a/tests/crate.scm
> +++ b/tests/crate.scm
> @@ -102,7 +102,8 @@
>           ('build-system 'cargo-build-system)
>           ('arguments
>            ('quasiquote
> -           ('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
> +           ('#:skip-build? #t
> +            #:cargo-inputs (("rust-bar" ('unquote rust-bar))))))
>           ('home-page "http://example.com")
>           ('synopsis "summary")
>           ('description "summary")
> -- 
> 2.24.0
> 

-- 
Efraim Flashner   <[email-masked]>   אפרים פלשנר
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted