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:
parent
8a290772a4
commit
5a9ef8a960
|
@ -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)))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Reference in New Issue