summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/cargo.scm117
-rw-r--r--guix/build/cargo-build-system.scm54
-rw-r--r--guix/import/cabal.scm7
-rw-r--r--guix/import/crate.scm47
-rw-r--r--guix/import/hackage.scm62
-rw-r--r--guix/import/utils.scm4
6 files changed, 233 insertions, 58 deletions
diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index dc137421e9..fa211d456d 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -29,6 +29,8 @@
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (ice-9 match)
+ #:use-module (ice-9 vlist)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%cargo-build-system-modules
%cargo-utils-modules
@@ -118,18 +120,128 @@ to NAME and VERSION."
#:inputs inputs
#:system system
#:modules imported-modules
- #:outputs (cons "src" outputs)
+ #:outputs outputs
#:guile-for-build guile-for-build))
+(define (package-cargo-inputs p)
+ (apply
+ (lambda* (#:key (cargo-inputs '()) #:allow-other-keys)
+ cargo-inputs)
+ (package-arguments p)))
+
+(define (package-cargo-development-inputs p)
+ (apply
+ (lambda* (#:key (cargo-development-inputs '()) #:allow-other-keys)
+ cargo-development-inputs)
+ (package-arguments p)))
+
+(define (crate-closure inputs)
+ "Return the closure of INPUTS when considering the 'cargo-inputs' and
+'cargod-dev-deps' edges. Omit duplicate inputs, except for those
+already present in INPUTS itself.
+
+This is implemented as a breadth-first traversal such that INPUTS is
+preserved, and only duplicate extracted inputs are removed.
+
+Forked from ((guix packages) transitive-inputs) since this extraction
+uses slightly different rules compared to the rest of Guix (i.e. we
+do not extract the conventional inputs)."
+ (define (seen? seen item)
+ ;; FIXME: We're using pointer identity here, which is extremely sensitive
+ ;; to memoization in package-producing procedures; see
+ ;; <https://bugs.gnu.org/30155>.
+ (vhash-assq item seen))
+
+ (let loop ((inputs inputs)
+ (result '())
+ (propagated '())
+ (first? #t)
+ (seen vlist-null))
+ (match inputs
+ (()
+ (if (null? propagated)
+ (reverse result)
+ (loop (reverse (concatenate propagated)) result '() #f seen)))
+ (((and input (label (? package? package))) rest ...)
+ (if (and (not first?) (seen? seen package))
+ (loop rest result propagated first? seen)
+ (loop rest
+ (cons input result)
+ (cons (package-cargo-inputs package)
+ propagated)
+ first?
+ (vhash-consq package package seen))))
+ ((input rest ...)
+ (loop rest (cons input result) propagated first? seen)))))
+
+(define (expand-crate-sources cargo-inputs cargo-development-inputs)
+ "Extract all transitive sources for CARGO-INPUTS and CARGO-DEVELOPMENT-INPUTS
+along their 'cargo-inputs' edges.
+
+Cargo requires all transitive crate dependencies' sources to be available
+in its index, even if they are optional (this is so it can generate
+deterministic Cargo.lock files regardless of the target platform or enabled
+features). Thus we need all transitive crate dependencies for any cargo
+dev-dependencies, but this is only needed when building/testing a crate directly
+(i.e. we will never need transitive dev-dependencies for any dependency crates).
+
+Another complication arises due potential dependency cycles from Guix's
+perspective: Although cargo does not permit cyclic dependencies between crates,
+however, it permits cycles to occur via dev-dependencies. For example, if crate
+X depends on crate Y, crate Y's tests could pull in crate X to to verify
+everything builds properly (this is a rare scenario, but it it happens for
+example with the `proc-macro2` and `quote` crates). This is allowed by cargo
+because tests are built as a pseudo-crate which happens to depend on the
+X and Y crates, forming an acyclic graph.
+
+We can side step this problem by only considering regular cargo dependencies
+since they are guaranteed to not have cycles. We can further resolve any
+potential dev-dependency cycles by extracting package sources (which never have
+any dependencies and thus no cycles can exist).
+
+There are several implications of this decision:
+* Building a package definition does not require actually building/checking
+any dependent crates. This can be a benefits:
+ - For example, sometimes a crate may have an optional dependency on some OS
+ specific package which cannot be built or run on the current system. This
+ approach means that the build will not fail if cargo ends up internally ignoring
+ the dependency.
+ - It avoids waiting for quadratic builds from source: cargo always builds
+ dependencies within the current workspace. This is largely due to Rust not
+ having a stable ABI and other resolutions that cargo applies. This means that
+ if we have a depencency chain of X -> Y -> Z and we build each definition
+ independently the following will happen:
+ * Cargo will build and test crate Z
+ * Cargo will build crate Z in Y's workspace, then build and test Y
+ * Cargo will build crates Y and Z in X's workspace, then build and test X
+* But there are also some downsides with this approach:
+ - If a dependent crate is subtly broken on the system (i.e. it builds but its
+ tests fail) the consuming crates may build and test successfully but
+ actually fail during normal usage (however, the CI will still build all
+ packages which will give visibility in case packages suddenly break).
+ - Because crates aren't declared as regular inputs, other Guix facilities
+ such as tracking package graphs may not work by default (however, this is
+ something that can always be extended or reworked in the future)."
+ (filter-map
+ (match-lambda
+ ((label (? package? p))
+ (list label (package-source p)))
+ ((label input)
+ (list label input)))
+ (crate-closure (append cargo-inputs cargo-development-inputs))))
+
(define* (lower name
#:key source inputs native-inputs outputs system target
(rust (default-rust))
+ (cargo-inputs '())
+ (cargo-development-inputs '())
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:rust #:inputs #:native-inputs #:outputs))
+ '(#:source #:target #:rust #:inputs #:native-inputs #:outputs
+ #:cargo-inputs #:cargo-development-inputs))
(and (not target) ;; TODO: support cross-compilation
(bag
@@ -145,6 +257,7 @@ to NAME and VERSION."
,@(standard-packages)))
(build-inputs `(("cargo" ,rust "cargo")
("rustc" ,rust)
+ ,@(expand-crate-sources cargo-inputs cargo-development-inputs)
,@native-inputs))
(outputs outputs)
(build cargo-build)
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index 9f44bd6ee9..1f36304b15 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -54,6 +54,22 @@
(bin-dep? (lambda (dep) (find bin? (get-kinds dep)))))
(find bin-dep? (manifest-targets))))
+(define (crate-src? path)
+ "Check if PATH refers to a crate source, namely a gzipped tarball with a
+Cargo.toml file present at its root."
+ (and (gzip-file? path)
+ ;; First we print out all file names within the tarball to see if it
+ ;; looks like the source of a crate. However, the tarball will include
+ ;; an extra path component which we would like to ignore (since we're
+ ;; interested in checking if a Cargo.toml exists at the root of the
+ ;; archive, but not nested anywhere else). We do this by cutting up
+ ;; each output line and only looking at the second component. We then
+ ;; check if it matches Cargo.toml exactly and short circuit if it does.
+ (zero? (apply system* (list "sh" "-c"
+ (string-append "tar -tf " path
+ " | cut -d/ -f2"
+ " | grep -q '^Cargo.toml$'"))))))
+
(define* (configure #:key inputs
(vendor-dir "guix-vendor")
#:allow-other-keys)
@@ -67,14 +83,21 @@
(for-each
(match-lambda
((name . path)
- (let* ((rust-share (string-append path "/share/rust-source"))
- (basepath (basename path))
- (link-dir (string-append vendor-dir "/" basepath)))
- (and (file-exists? rust-share)
+ (let* ((basepath (basename path))
+ (crate-dir (string-append vendor-dir "/" basepath)))
+ (and (crate-src? path)
;; Gracefully handle duplicate inputs
- (not (file-exists? link-dir))
- (symlink rust-share link-dir)))))
+ (not (file-exists? crate-dir))
+ (mkdir-p crate-dir)
+ ;; Cargo crates are simply gzipped tarballs but with a .crate
+ ;; extension. We expand the source to a directory name we control
+ ;; so that we can generate any cargo checksums.
+ ;; The --strip-components argument is needed to prevent creating
+ ;; an extra directory within `crate-dir`.
+ (invoke "tar" "xvf" path "-C" crate-dir "--strip-components" "1")
+ (generate-checksums crate-dir)))))
inputs)
+
;; Configure cargo to actually use this new directory.
(mkdir-p ".cargo")
(let ((port (open-file ".cargo/config" "w" #:encoding "utf-8")))
@@ -117,24 +140,6 @@ directory = '" port)
(define (touch file-name)
(call-with-output-file file-name (const #t)))
-(define* (install-source #:key inputs outputs #:allow-other-keys)
- "Install the source for a given Cargo package."
- (let* ((out (assoc-ref outputs "out"))
- (src (assoc-ref inputs "source"))
- (rsrc (string-append (assoc-ref outputs "src")
- "/share/rust-source")))
- (mkdir-p rsrc)
- ;; Rust doesn't have a stable ABI yet. Because of this
- ;; Cargo doesn't have a search path for binaries yet.
- ;; Until this changes we are working around this by
- ;; vendoring the crates' sources by symlinking them
- ;; to store paths.
- (copy-recursively "." rsrc)
- (touch (string-append rsrc "/.cargo-ok"))
- (generate-checksums rsrc)
- (install-file "Cargo.toml" rsrc)
- #t))
-
(define* (install #:key inputs outputs skip-build? #:allow-other-keys)
"Install a given Cargo package."
(let* ((out (assoc-ref outputs "out")))
@@ -156,7 +161,6 @@ directory = '" port)
(define %standard-phases
(modify-phases gnu:%standard-phases
(delete 'bootstrap)
- (add-before 'configure 'install-source install-source)
(replace 'configure configure)
(replace 'build build)
(replace 'check check)
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index 1a87be0b00..7dfe771e41 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -40,6 +40,7 @@
cabal-package?
cabal-package-name
cabal-package-version
+ cabal-package-revision
cabal-package-license
cabal-package-home-page
cabal-package-source-repository
@@ -638,13 +639,14 @@ If #f use the function 'port-filename' to obtain it."
;; information of the Cabal file, but only the ones we currently are
;; interested in.
(define-record-type <cabal-package>
- (make-cabal-package name version license home-page source-repository
+ (make-cabal-package name version revision license home-page source-repository
synopsis description
executables lib test-suites
flags eval-environment custom-setup)
cabal-package?
(name cabal-package-name)
(version cabal-package-version)
+ (revision cabal-package-revision)
(license cabal-package-license)
(home-page cabal-package-home-page)
(source-repository cabal-package-source-repository)
@@ -838,6 +840,7 @@ See the manual for limitations.")))))))
(define (cabal-evaluated-sexp->package evaluated-sexp)
(let* ((name (lookup-join evaluated-sexp "name"))
(version (lookup-join evaluated-sexp "version"))
+ (revision (lookup-join evaluated-sexp "x-revision"))
(license (lookup-join evaluated-sexp "license"))
(home-page (lookup-join evaluated-sexp "homepage"))
(home-page-or-hackage
@@ -856,7 +859,7 @@ See the manual for limitations.")))))))
(custom-setup (match (make-cabal-section evaluated-sexp 'custom-setup)
((x) x)
(_ #f))))
- (make-cabal-package name version license home-page-or-hackage
+ (make-cabal-package name version revision license home-page-or-hackage
source-repository synopsis description executables lib
test-suites flags eval-environment custom-setup)))
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 @@
(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 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
(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/hackage.scm b/guix/import/hackage.scm
index 366256b40d..6f426af900 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -117,19 +117,34 @@ version is returned."
(#f name)
(m (match:substring m 1)))))))
+(define (read-cabal-and-hash port)
+ "Read a Cabal file from PORT and return it and its hash in nix-base32
+format as two values."
+ (let-values (((port get-hash) (open-sha256-input-port port)))
+ (values (read-cabal (canonical-newline-port port))
+ (bytevector->nix-base32-string (get-hash)))))
+
+(define (hackage-fetch-and-hash name-version)
+ "Fetch the latest Cabal revision for the package NAME-VERSION, and return
+two values: the parsed Cabal file and its hash in nix-base32 format. If the
+version part is omitted from the package name, then fetch the latest
+version. On failure, both return values will be #f."
+ (guard (c ((and (http-get-error? c)
+ (= 404 (http-get-error-code c)))
+ (values #f #f))) ;"expected" if package is unknown
+ (let*-values (((name version) (package-name->name+version name-version))
+ ((url) (hackage-cabal-url name version))
+ ((port _) (http-fetch url))
+ ((cabal hash) (read-cabal-and-hash port)))
+ (close-port port)
+ (values cabal hash))))
+
(define (hackage-fetch name-version)
"Return the Cabal file for the package NAME-VERSION, or #f on failure. If
the version part is omitted from the package name, then return the latest
version."
- (guard (c ((and (http-get-error? c)
- (= 404 (http-get-error-code c)))
- #f)) ;"expected" if package is unknown
- (let-values (((name version) (package-name->name+version name-version)))
- (let* ((url (hackage-cabal-url name version))
- (port (http-fetch url))
- (result (read-cabal (canonical-newline-port port))))
- (close-port port)
- result))))
+ (let-values (((cabal hash) (hackage-fetch-and-hash name-version)))
+ cabal))
(define string->license
;; List of valid values from
@@ -198,15 +213,20 @@ package being processed and is used to filter references to itself."
(cons own-name ghc-standard-libraries))))
dependencies))
-(define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t))
+(define* (hackage-module->sexp cabal cabal-hash
+ #:key (include-test-dependencies? #t))
"Return the `package' S-expression for a Cabal package. CABAL is the
-representation of a Cabal file as produced by 'read-cabal'."
+representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is
+the hash of the Cabal file."
(define name
(cabal-package-name cabal))
(define version
(cabal-package-version cabal))
+
+ (define revision
+ (cabal-package-revision cabal))
(define source-url
(hackage-source-url name version))
@@ -252,9 +272,14 @@ representation of a Cabal file as produced by 'read-cabal'."
(list 'quasiquote inputs))))))
(define (maybe-arguments)
- (if (not include-test-dependencies?)
- '((arguments `(#:tests? #f)))
- '()))
+ (match (append (if (not include-test-dependencies?)
+ '(#:tests? #f)
+ '())
+ (if (not (string-null? revision))
+ `(#:cabal-revision (,revision ,cabal-hash))
+ '()))
+ (() '())
+ (args `((arguments (,'quasiquote ,args))))))
(let ((tarball (with-store store
(download-to-store store source-url))))
@@ -294,10 +319,11 @@ symbol 'true' or 'false'. The value associated with other keys has to conform
to the Cabal file format definition. The default value associated with the
keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\"
respectively."
- (let ((cabal-meta (if port
- (read-cabal (canonical-newline-port port))
- (hackage-fetch package-name))))
- (and=> cabal-meta (compose (cut hackage-module->sexp <>
+ (let-values (((cabal-meta cabal-hash)
+ (if port
+ (read-cabal-and-hash port)
+ (hackage-fetch-and-hash package-name))))
+ (and=> cabal-meta (compose (cut hackage-module->sexp <> cabal-hash
#:include-test-dependencies?
include-test-dependencies?)
(cut eval-cabal <> cabal-environment)))))
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 @@
url-fetch
guix-hash-url
+ package-names->package-inputs
maybe-inputs
maybe-native-inputs
package->definition
@@ -236,6 +237,9 @@ into a proper sentence and by using two spaces between sentences."
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))
generated by cgit v1.2.3 (git 2.45.2) at 2024-08-02 20:49:34 +0000