From 5a9ef8a960706a55764f5bbc67ac83dd48516016 Mon Sep 17 00:00:00 2001 From: Ivan Petkov Date: Fri, 17 May 2019 00:26:07 -0700 Subject: [PATCH] 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 --- guix/import/crate.scm | 47 +++++++++++++++++++++++++++++++++---------- guix/import/utils.scm | 4 ++++ tests/crate.scm | 4 ++-- 3 files changed, 42 insertions(+), 13 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index e0b400d054..9a73d9fe16 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -65,29 +65,53 @@ (define (crate-kind-predicate kind) (path (string-append "/" version "/dependencies")) (deps-json (json-fetch-alist (string-append crate-url name path))) (deps (assoc-ref deps-json "dependencies")) - (input-crates (filter (crate-kind-predicate "normal") deps)) - (native-input-crates + (dep-crates (filter (crate-kind-predicate "normal") deps)) + (dev-dep-crates (filter (lambda (dep) (not ((crate-kind-predicate "normal") dep))) deps)) - (inputs (crates->inputs input-crates)) - (native-inputs (crates->inputs native-input-crates)) + (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 - #:inputs inputs #:native-inputs native-inputs + #:cargo-inputs cargo-inputs + #:cargo-development-inputs cargo-development-inputs #:home-page home-page #:synopsis synopsis #: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 #:allow-other-keys) "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))) (guix-name (crate-name->package-name name)) - (inputs (map crate-name->package-name inputs)) - (native-inputs (map crate-name->package-name native-inputs)) + (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) @@ -99,8 +123,9 @@ (define* (make-crate-sexp #:key name version inputs native-inputs (base32 ,(bytevector->nix-base32-string (port-sha256 port)))))) (build-system cargo-build-system) - ,@(maybe-native-inputs native-inputs "src") - ,@(maybe-inputs inputs "src") + ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs) + (maybe-cargo-development-inputs + cargo-development-inputs))) (home-page ,(match home-page (() "") (_ home-page))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 63fc9bbb27..84503ab907 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -52,6 +52,7 @@ (define-module (guix import utils) url-fetch guix-hash-url + package-names->package-inputs maybe-inputs maybe-native-inputs package->definition @@ -236,6 +237,9 @@ (define (beautify-description description) cleaned 'pre ". " 'post))) (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) (cons* input (list 'unquote (string->symbol input)) (or (and output (list output)) diff --git a/tests/crate.scm b/tests/crate.scm index a1dcfd5e52..a4a328d507 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -89,9 +89,9 @@ (define test-source-hash ('base32 (? string? hash))))) ('build-system 'cargo-build-system) - ('inputs + ('arguments ('quasiquote - (("rust-bar" ('unquote 'rust-bar) "src")))) + (('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))) ('home-page "http://example.com") ('synopsis "summary") ('description "summary")