import: crate: Define dependencies as arguments.

* guix/import/crate.scm:
(crate-fetch)[input-crates]: Rename to dev-crates.
[native-input-crates]: Rename to dev-dep-crates.
[inputs]: Rename to cargo-inputs.
[native-inputs]: Rename to cargo-development-inputs.
(maybe-cargo-inputs, maybe-cargo-development-inputs, maybe-arguments): Add
them.
(make-crate-sexp)[inputs]: Rename to cargo-inputs.
[native-inputs]: Rename to cargo-development-inputs.
[maybe-native-inputs, maybe-inputs]: Replace with maybe-arguments.
* guix/import/utils.scm: (package-names->package-inputs): Make public.  Add
docstring.
* tests/crate.scm (crate->guix-package): Update the match pattern.

Signed-off-by: Chris Marusich <cmmarusich@gmail.com>
This commit is contained in:
Ivan Petkov 2019-05-17 00:26:07 -07:00 committed by Chris Marusich
parent 8a290772a4
commit 5a9ef8a960
No known key found for this signature in database
GPG Key ID: DD409A15D822469D
3 changed files with 42 additions and 13 deletions

View File

@ -65,29 +65,53 @@
(path (string-append "/" version "/dependencies")) (path (string-append "/" version "/dependencies"))
(deps-json (json-fetch-alist (string-append crate-url name path))) (deps-json (json-fetch-alist (string-append crate-url name path)))
(deps (assoc-ref deps-json "dependencies")) (deps (assoc-ref deps-json "dependencies"))
(input-crates (filter (crate-kind-predicate "normal") deps)) (dep-crates (filter (crate-kind-predicate "normal") deps))
(native-input-crates (dev-dep-crates
(filter (lambda (dep) (filter (lambda (dep)
(not ((crate-kind-predicate "normal") dep))) deps)) (not ((crate-kind-predicate "normal") dep))) deps))
(inputs (crates->inputs input-crates)) (cargo-inputs (crates->inputs dep-crates))
(native-inputs (crates->inputs native-input-crates)) (cargo-development-inputs (crates->inputs dev-dep-crates))
(home-page (match homepage (home-page (match homepage
(() repository) (() repository)
(_ homepage)))) (_ homepage))))
(callback #:name name #:version version (callback #:name name #:version version
#:inputs inputs #:native-inputs native-inputs #:cargo-inputs cargo-inputs
#:cargo-development-inputs cargo-development-inputs
#:home-page home-page #:synopsis synopsis #:home-page home-page #:synopsis synopsis
#:description description #:license license))) #:description description #:license license)))
(define* (make-crate-sexp #:key name version inputs native-inputs (define (maybe-cargo-inputs package-names)
(match (package-names->package-inputs package-names)
(()
'())
((package-inputs ...)
`((#:cargo-inputs ,package-inputs)))))
(define (maybe-cargo-development-inputs package-names)
(match (package-names->package-inputs package-names)
(()
'())
((package-inputs ...)
`((#:cargo-development-inputs ,package-inputs)))))
(define (maybe-arguments arguments)
(match arguments
(()
'())
((args ...)
`((arguments (,'quasiquote ,args))))))
(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
home-page synopsis description license home-page synopsis description license
#:allow-other-keys) #:allow-other-keys)
"Return the `package' s-expression for a rust package with the given NAME, "Return the `package' s-expression for a rust package with the given NAME,
VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
and LICENSE."
(let* ((port (http-fetch (crate-uri name version))) (let* ((port (http-fetch (crate-uri name version)))
(guix-name (crate-name->package-name name)) (guix-name (crate-name->package-name name))
(inputs (map crate-name->package-name inputs)) (cargo-inputs (map crate-name->package-name cargo-inputs))
(native-inputs (map crate-name->package-name native-inputs)) (cargo-development-inputs (map crate-name->package-name
cargo-development-inputs))
(pkg `(package (pkg `(package
(name ,guix-name) (name ,guix-name)
(version ,version) (version ,version)
@ -99,8 +123,9 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(base32 (base32
,(bytevector->nix-base32-string (port-sha256 port)))))) ,(bytevector->nix-base32-string (port-sha256 port))))))
(build-system cargo-build-system) (build-system cargo-build-system)
,@(maybe-native-inputs native-inputs "src") ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs)
,@(maybe-inputs inputs "src") (maybe-cargo-development-inputs
cargo-development-inputs)))
(home-page ,(match home-page (home-page ,(match home-page
(() "") (() "")
(_ home-page))) (_ home-page)))

View File

@ -52,6 +52,7 @@
url-fetch url-fetch
guix-hash-url guix-hash-url
package-names->package-inputs
maybe-inputs maybe-inputs
maybe-native-inputs maybe-native-inputs
package->definition package->definition
@ -236,6 +237,9 @@ into a proper sentence and by using two spaces between sentences."
cleaned 'pre ". " 'post))) cleaned 'pre ". " 'post)))
(define* (package-names->package-inputs names #:optional (output #f)) (define* (package-names->package-inputs names #:optional (output #f))
"Given a list of PACKAGE-NAMES, and an optional OUTPUT, tries to generate a
quoted list of inputs, as suitable to use in an 'inputs' field of a package
definition."
(map (lambda (input) (map (lambda (input)
(cons* input (list 'unquote (string->symbol input)) (cons* input (list 'unquote (string->symbol input))
(or (and output (list output)) (or (and output (list output))

View File

@ -89,9 +89,9 @@
('base32 ('base32
(? string? hash))))) (? string? hash)))))
('build-system 'cargo-build-system) ('build-system 'cargo-build-system)
('inputs ('arguments
('quasiquote ('quasiquote
(("rust-bar" ('unquote 'rust-bar) "src")))) (('#:cargo-inputs (("rust-bar" ('unquote rust-bar)))))))
('home-page "http://example.com") ('home-page "http://example.com")
('synopsis "summary") ('synopsis "summary")
('description "summary") ('description "summary")