~ruther/guix-local

12e0b9e9e4eb47f635d09f6bf3bee674c7b80234 — Hilton Chain 1 year, 10 days ago f27fb84
import: crate: Add ‘--lockfile’ option.

* guix/import/crate.scm (cargo-inputs-from-lockfile)
find-cargo-inputs-location, extract-cargo-inputs): New procedures.
* guix/scripts/import/crate.scm (%options): Add ‘--lockfile’ option.
(show-help): Add it.
(guix-import-crate): Use it.
* doc/guix.texi (Invoking guix import): Document it.

Change-Id: I291478e04adf9f2df0bf216425a5e8aeba0bedd9
3 files changed, 102 insertions(+), 10 deletions(-)

M doc/guix.texi
M guix/import/crate.scm
M guix/scripts/import/crate.scm
M doc/guix.texi => doc/guix.texi +5 -0
@@ 14957,6 14957,11 @@ version instead instead of aborting.
If a crate dependency is not (yet) packaged, make the corresponding
input in @code{#:cargo-inputs} or @code{#:cargo-development-inputs} into
a comment.
@item --lockfile=@var{file}
@itemx -f @var{file}
When @option{--lockfile} is specified, the importer will ignore other options
and won't output package expressions, instead importing source expressions
from @var{file}, a @file{Cargo.lock} file.
@end table

@item elm

M guix/import/crate.scm => guix/import/crate.scm +46 -0
@@ 60,6 60,9 @@
            string->license
            crate-recursive-import
            cargo-lock->expressions
            cargo-inputs-from-lockfile
            find-cargo-inputs-location
            extract-cargo-inputs
            %crate-updater))




@@ 559,6 562,49 @@ referencing all imported sources."
            (list ,@(map second source-expressions)))))
    (values source-expressions cargo-inputs-entry)))

(define* (cargo-inputs-from-lockfile #:optional (lockfile "Cargo.lock"))
  "Given LOCKFILE (default to \"Cargo.lock\" in current directory), return a
source list imported from it, to be used as package inputs.  This procedure
can be used for adding a manifest file within the source tree of a Rust
application."
  (let ((source-expressions
         cargo-inputs-entry
         (cargo-lock->expressions lockfile "cargo-inputs-temporary")))
    (eval-string
     (call-with-output-string
       (lambda (port)
         (for-each
          (cut pretty-print-with-comments port <>)
          `((use-modules (guix build-system cargo))
            ,@source-expressions
            (define-cargo-inputs lookup-cargo-inputs ,cargo-inputs-entry)
            (lookup-cargo-inputs 'cargo-inputs-temporary))))))))

(define (find-cargo-inputs-location file)
  "Search in FILE for a top-level definition of Cargo inputs.  Return the
location if found, or #f otherwise."
  (find-definition-location file 'lookup-cargo-inputs
                            #:define-prefix 'define-cargo-inputs))

(define* (extract-cargo-inputs file #:key exclude)
  "Search in FILE for a top-level definition of Cargo inputs.  If found,
return its entries excluding EXCLUDE, or an empty list otherwise."
  (call-with-input-file file
    (lambda (port)
      (do ((syntax (read-syntax port)
                   (read-syntax port)))
          ((match (syntax->datum syntax)
             (('define-cargo-inputs 'lookup-cargo-inputs _ ...) #t)
             ((? eof-object?) #t)
             (_ #f))
           (or (and (not (eof-object? syntax))
                    (match (syntax->datum syntax)
                      (('define-cargo-inputs 'lookup-cargo-inputs inputs ...)
                       (remove (lambda (cargo-input-entry)
                                 (eq? exclude (first cargo-input-entry)))
                               inputs))))
               '()))))))


;;;
;;; Updater

M guix/scripts/import/crate.scm => guix/scripts/import/crate.scm +51 -10
@@ 25,12 25,15 @@
(define-module (guix scripts import crate)
  #:use-module (guix ui)
  #:use-module (guix utils)
  #:use-module (guix read-print)
  #:use-module (guix scripts)
  #:use-module (guix import crate)
  #:use-module (guix scripts import)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-37)
  #:use-module (srfi srfi-71)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:export (guix-import-crate))


@@ 60,6 63,9 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
                         sufficient package exists for it"))
  (newline)
  (display (G_ "
  -f, --lockfile=FILE    import dependencies from FILE, a 'Cargo.lock' file"))
  (newline)
  (display (G_ "
  -h, --help             display this help and exit"))
  (display (G_ "
  -V, --version          display version information and exit"))


@@ 87,6 93,11 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
         (option '("mark-missing") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'mark-missing #t result)))
         (option '(#\f "lockfile") #f #t
                 (lambda (opt name arg result)
                   (if (file-exists? arg)
                       (alist-cons 'lockfile arg result)
                       (leave (G_ "file '~a' does not exist~%") arg))))
         %standard-import-options))




@@ 101,6 112,8 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
                        #:build-options? #f))

  (let* ((opts (parse-options))
         (lockfile (assoc-ref opts 'lockfile))
         (file-to-insert (assoc-ref opts 'file-to-insert))
         (args (filter-map (match-lambda
                             (('argument . value)
                              value)


@@ 111,16 124,44 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
       (define-values (name version)
         (package-name->name+version spec))

       (match (if (assoc-ref opts 'recursive)
                  (crate-recursive-import
                   name #:version version
                   #:recursive-dev-dependencies?
                   (assoc-ref opts 'recursive-dev-dependencies)
                   #:allow-yanked? (assoc-ref opts 'allow-yanked))
                  (crate->guix-package
                   name #:version version #:include-dev-deps? #t
                   #:allow-yanked? (assoc-ref opts 'allow-yanked)
                   #:mark-missing? (assoc-ref opts 'mark-missing)))
       (match (cond
               (lockfile
                (let ((source-expressions
                       _
                       (cargo-lock->expressions lockfile name)))
                  (when file-to-insert
                    (let* ((source-expressions
                            cargo-inputs-entry
                            (cargo-lock->expressions lockfile name))
                           (term (first cargo-inputs-entry))
                           (cargo-inputs
                            `(define-cargo-inputs lookup-cargo-inputs
                               ,@(sort
                                  (cons cargo-inputs-entry
                                        (extract-cargo-inputs
                                         file-to-insert #:exclude term))
                                  (lambda (a b)
                                    (string< (symbol->string (first a))
                                             (symbol->string (first b)))))))
                           (_
                            (and=> (find-cargo-inputs-location file-to-insert)
                                   delete-expression))
                           (port (open-file file-to-insert "a")))
                      (pretty-print-with-comments port cargo-inputs)
                      (newline port)
                      (close-port port)))
                  source-expressions))
               ((assoc-ref opts 'recursive)
                (crate-recursive-import
                 name #:version version
                 #:recursive-dev-dependencies?
                 (assoc-ref opts 'recursive-dev-dependencies)
                 #:allow-yanked? (assoc-ref opts 'allow-yanked)))
               (else
                (crate->guix-package
                 name #:version version #:include-dev-deps? #t
                 #:allow-yanked? (assoc-ref opts 'allow-yanked)
                 #:mark-missing? (assoc-ref opts 'mark-missing))))
         ((or #f '())
          (leave (G_ "failed to download meta-data for package '~a'~%")
                 (if version