summaryrefslogtreecommitdiff
path: root/guix/import/crate.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/import/crate.scm')
-rw-r--r--guix/import/crate.scm140
1 files changed, 87 insertions, 53 deletions
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 57823c3639..6847a7046b 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,6 +28,7 @@
#:use-module (guix import json)
#:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:)
+ #:use-module (guix memoization)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix upstream)
@@ -35,9 +36,12 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (json)
+ #:use-module (semver)
+ #:use-module (semver ranges)
#: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
string->license
@@ -86,7 +90,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
@@ -105,6 +109,8 @@ record or #f if it was not found."
(json->crate `(,@alist
("actual_versions" . ,versions))))))))
+(define mem-lookup-crate (memoize lookup-crate))
+
(define (crate-version-dependencies version)
"Return the list of <crate-dependency> records of VERSION, a
<crate-version>."
@@ -150,34 +156,40 @@ VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTIO
and LICENSE."
(let* ((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))
+ (cargo-inputs
+ (map
+ (lambda (name-version)
+ (apply crate-name->package-name name-version)) cargo-inputs))
+ (cargo-development-inputs
+ (map
+ (lambda (name-version)
+ (apply crate-name->package-name name-version)) 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
+ (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 `(#:skip-build? #t)
+ (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))
+ (home-page ,(match home-page
+ (() "")
+ (_ home-page)))
+ (synopsis ,synopsis)
+ (description ,(beautify-description description))
+ (license ,(match license
+ (() #f)
+ ((license) license)
+ (_ `(list ,@license)))))))
+ (close-port port)
+ (package->definition pkg #t)))
(define (string->license string)
(filter-map (lambda (license)
@@ -188,37 +200,60 @@ and LICENSE."
'unknown-license!)))
(string-split string (string->char-set " /"))))
-(define* (crate->guix-package crate-name #:optional version)
+(define* (crate->guix-package crate-name #:key version #:allow-other-keys)
"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 (semver-range-contains-string? range version)
+ (semver-range-contains? (string->semver-range range)
+ (string->semver version)))
+
(define (normal-dependency? dependency)
- (eq? (crate-dependency-kind dependency) 'normal))
+ (or (eq? (crate-dependency-kind dependency) 'build)
+ (eq? (crate-dependency-kind dependency) 'normal)))
(define crate
- (lookup-crate crate-name))
+ (mem-lookup-crate crate-name))
(define version-number
(or version
(crate-latest-version crate)))
- (define version*
+ (define (find-version crate range)
+ "finds the a vesion of a crate that fulfils the semver <range>"
(find (lambda (version)
- (string=? (crate-version-number version)
- version-number))
+ (semver-range-contains-string?
+ range
+ (crate-version-number version)))
(crate-versions crate)))
+ (define version*
+ (find-version crate version-number))
+
+ (define (sort-map-deps deps)
+ "sorts the dependencies and maps the dependencies to a list
+ containing pairs of (name version)"
+ (sort (map (lambda (dep)
+ (let* ((name (crate-dependency-id dep))
+ (crate (mem-lookup-crate name))
+ (req (crate-dependency-requirement dep))
+ (ver (find-version crate req)))
+ (list name
+ (crate-version-number ver))))
+ deps)
+ (match-lambda* (((_ name) ...)
+ (apply string-ci<? name)))))
+
(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<?)))
+ (let* ((dependencies (crate-version-dependencies version*))
+ (dep-crates dev-dep-crates (partition normal-dependency? dependencies))
+ (cargo-inputs (sort-map-deps dep-crates))
+ ;; for now we are skipping the resolution of the development inputs
+ ;; since most crates are libaries and we only want to test at the
+ ;; app level. This probably should be parameterized though.
+ (cargo-development-inputs '()))
(values
(make-crate-sexp #:name crate-name
#:version (crate-version-number version*)
@@ -230,15 +265,12 @@ latest version of CRATE-NAME."
#:description (crate-description crate)
#:license (and=> (crate-version-license version*)
string->license))
- (append cargo-inputs cargo-development-inputs)))))
+ cargo-inputs))))
-(define* (crate-recursive-import crate-name #:optional version)
- (recursive-import crate-name #f
- #:repo->guix-package
- (lambda (name repo)
- (let ((version (and (string=? name crate-name)
- version)))
- (crate->guix-package name version)))
+(define* (crate-recursive-import crate-name #:key version)
+ (recursive-import crate-name
+ #:repo->guix-package crate->guix-package
+ #:version version
#:guix-name crate-name->package-name))
(define (guix-package->crate-name package)
@@ -252,8 +284,11 @@ latest version of CRATE-NAME."
(match parts
((name _ ...) name))))
-(define (crate-name->package-name name)
- (string-append "rust-" (string-join (string-split name #\_) "-")))
+(define* (crate-name->package-name name #:optional version)
+ (let ((name (guix-name "rust-" name)))
+ (if version
+ (string-append name "-" version)
+ name)))
;;;
@@ -288,4 +323,3 @@ latest version of CRATE-NAME."
(description "Updater for crates.io packages")
(pred crate-package?)
(latest latest-release)))
-
generated by cgit v1.2.3 (git 2.25.4) at 2024-05-04 22:26:07 +0000