all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
blob 170a1f70b68b154403a4f3217258fa8afce18a86 16502 bytes (raw)
name: guix/build-system/cargo.scm 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
 
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system cargo)
  #:use-module (guix search-paths)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix gexp)
  #:use-module (guix monads)
  #:use-module (guix packages)
  #: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
            cargo-build-system
            %crate-base-url
            crate-url
            crate-url?
            crate-uri))

(define %crate-base-url
  (make-parameter "https://crates.io"))
(define crate-url
  (string-append (%crate-base-url) "/api/v1/crates/"))
(define crate-url?
  (cut string-prefix? crate-url <>))

(define (crate-uri name version)
  "Return a URI string for the crate package hosted at crates.io corresponding
to NAME and VERSION."
  (string-append crate-url name "/" version "/download"))

(define (default-rust target)
  "Return the default Rust package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((rust (resolve-interface '(gnu packages rust))))
    (module-ref rust 'rust)))

(define (default-rust-sysroot target)
  "Return the default Rust sysroot for <target>."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((module (resolve-interface '(gnu packages rust))))
    (module-ref module 'make-rust-sysroot)))

(define %cargo-utils-modules
  ;; Build-side modules imported by default.
  `((guix build cargo-utils)
    ,@%gnu-build-system-modules))

(define %cargo-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build cargo-build-system)
    (guix build json)
    ,@%cargo-utils-modules))

(define* (cargo-build name inputs
                      #:key
                      source
                      (tests? #t)
                      (test-target #f)
                      (vendor-dir "guix-vendor")
                      (cargo-build-flags ''("--release"))
                      (cargo-test-flags ''("--release"))
                      (cargo-package-flags ''("--no-metadata" "--no-verify"))
                      (features ''())
                      (skip-build? #f)
                      (install-source? #t)
                      (phases '%standard-phases)
                      (outputs '("out"))
                      (search-paths '())
                      (system (%current-system))
                      (guile #f)
                      (imported-modules %cargo-build-system-modules)
                      (modules '((guix build cargo-build-system)
                                 (guix build utils))))
  "Build SOURCE using CARGO, and with INPUTS."

  (define builder
    (with-imported-modules imported-modules
      #~(begin
          (use-modules #$@(sexp->gexp modules))

          (cargo-build #:name #$name
                       #:source #+source
                       #:system #$system
                       #:test-target #$test-target
                       #:vendor-dir #$vendor-dir
                       #:cargo-build-flags #$(sexp->gexp cargo-build-flags)
                       #:cargo-test-flags #$(sexp->gexp cargo-test-flags)
                       #:cargo-package-flags #$(sexp->gexp cargo-package-flags)
                       #:features #$(sexp->gexp features)
                       #:skip-build? #$skip-build?
                       #:install-source? #$install-source?
                       #:tests? #$(and tests? (not skip-build?))
                       #:phases #$(if (pair? phases)
                                      (sexp->gexp phases)
                                      phases)
                       #:outputs #$(outputs->gexp outputs)
                       #:inputs #$(input-tuples->gexp inputs)
                       #:search-paths '#$(sexp->gexp
                                          (map search-path-specification->sexp
                                               search-paths))))))

  (gexp->derivation name builder
                    #:system system
                    #:target #f
                    #:graft? #f
                    #:guile-for-build guile))

(define* (cargo-cross-build name
                            #:key
                            source target
                            build-inputs target-inputs host-inputs
                            (tests? #f)
                            (test-target #f)
                            (vendor-dir "guix-vendor")
                            (cargo-build-flags ''("--release"))
                            (cargo-test-flags ''("--release"))
                            (cargo-package-flags ''("--no-metadata" "--no-verify"))
                            (features ''())
                            (skip-build? #f)
                            (install-source? (not (target-mingw? target)))
                            (phases '%standard-phases)
                            (outputs '("out"))
                            (search-paths '())
                            (native-search-paths '())
                            (system (%current-system))
                            (guile #f)
                            (imported-modules %cargo-build-system-modules)
                            (modules '((guix build cargo-build-system)
                                       (guix build utils))))
  "Cross-build SOURCE using CARGO, and with INPUTS."

  (define builder
    (with-imported-modules imported-modules
      #~(begin
          (use-modules #$@(sexp->gexp modules))

          (cargo-build #:name #$name
                       #:source #+source
                       #:target #+target
                       #:system #$system
                       #:test-target #$test-target
                       #:vendor-dir #$vendor-dir
                       #:cargo-build-flags #$(sexp->gexp cargo-build-flags)
                       #:cargo-test-flags #$(sexp->gexp cargo-test-flags)
                       #:cargo-package-flags #$(sexp->gexp cargo-package-flags)
                       #:features #$(sexp->gexp features)
                       #:skip-build? #$skip-build?
                       #:install-source? #$install-source?
                       #:tests? #$(and tests? (not skip-build?))
                       #:phases #$(if (pair? phases)
                                      (sexp->gexp phases)
                                      phases)
                       #:outputs #$(outputs->gexp outputs)
                       #:inputs (append #$(input-tuples->gexp host-inputs)
                                        #+(input-tuples->gexp target-inputs))
                       #:native-inputs #+(input-tuples->gexp build-inputs)
                       #:make-dynamic-linker-cache? #f ;cross-compiling
                       #:search-paths '#$(sexp->gexp
                                          (map search-path-specification->sexp
                                               search-paths))
                       #:native-search-paths '#$(sexp->gexp
                                          (map search-path-specification->sexp
                                               native-search-paths))))))

  (gexp->derivation name builder
                    #:system system
                    #:target target
                    #:graft? #f
                    #:guile-for-build guile))

(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 (package-cargo-native-inputs p)
  (apply
    (lambda* (#:key (cargo-native-inputs '()) #:allow-other-keys)
      cargo-native-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 dependency 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 target))
                (rust-sysroot (default-rust-sysroot target))
                (cargo-inputs '())
                (cargo-development-inputs '())
                (cargo-native-inputs '())
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."

  (define private-keywords
    `(#:rust #:inputs #:native-inputs #:outputs
      #:cargo-inputs #:cargo-development-inputs #:cargo-native-inputs
      #:rust-sysroot
      ,@(if target '() '(#:target))))

  (bag
    (name name)
    (system system)
    (target target)
    (host-inputs `(,@(if source
                       `(("source" ,source))
                       '())

                    ;,@(if target '() inputs)
                    ,@(if target inputs '())

                    ,@(expand-crate-sources cargo-inputs cargo-development-inputs)))
    (build-inputs `(("cargo" ,rust "cargo")
                    ("rustc" ,rust)

                    ,@native-inputs
                    ;,@(if target inputs '())
                    ,@(if target '() inputs)
                    ;,@inputs

                    ,@(apply append
                             cargo-native-inputs
                             (map (match-lambda
                                    ((tag pkg)
                                     (package-cargo-native-inputs pkg)))
                                  (crate-closure (append cargo-inputs
                                                         cargo-development-inputs))))

                    ,@(if target
                        ;; Use the standard cross inputs of
                        ;; 'gnu-build-system'.
                        (standard-cross-packages target 'host)
                        '())
                    ;; Keep the standard inputs of 'gnu-build-system'
                    ,@(standard-packages)))
    (target-inputs `(,@(if target
                         (standard-cross-packages target 'target)
                         '())

                     ;; This provides a separate sysroot for the regular rustc
                     ,@(if target
                         `(("rust-sysroot" ,(rust-sysroot target)))
                         '())))
    (outputs outputs)
    (build (if target cargo-cross-build cargo-build))
    (arguments (strip-keyword-arguments private-keywords arguments))))

(define cargo-build-system
  (build-system
    (name 'cargo)
    (description
     "Cargo build system, to build Rust crates")
    (lower lower)))

debug log:

solving 170a1f70b6 ...
found 170a1f70b6 in https://yhetil.org/guix/3142134916e56f2b51bf3f496c3b2d9d3a4ac541.1708028701.git.~@wolfsden.cz/
found c029cc1dda in https://git.savannah.gnu.org/cgit/guix.git
preparing index
index prepared:
100644 c029cc1dda880a1389db62d5f663de377cbd2b33	guix/build-system/cargo.scm

applying [1/1] https://yhetil.org/guix/3142134916e56f2b51bf3f496c3b2d9d3a4ac541.1708028701.git.~@wolfsden.cz/
diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index c029cc1dda..170a1f70b6 100644

Checking patch guix/build-system/cargo.scm...
Applied patch guix/build-system/cargo.scm cleanly.

index at:
100644 170a1f70b68b154403a4f3217258fa8afce18a86	guix/build-system/cargo.scm

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.