diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/import.scm | 71 | ||||
| -rw-r--r-- | guix/scripts/import/crate.scm | 64 |
2 files changed, 93 insertions, 42 deletions
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 9db4919156..5de5fc9e00 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -25,11 +25,15 @@ (define-module (guix scripts import) #:use-module (guix import utils) + #:use-module (guix diagnostics) + #:use-module (guix i18n) #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix read-print) #:use-module (guix utils) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (%standard-import-options @@ -40,7 +44,14 @@ ;;; Command line options. ;;; -(define %standard-import-options '()) +(define %standard-import-options + (list + ;; Hidden option for importer-specific file preprocessing. + (option '("file-to-insert") #f #t + (lambda (opt name arg result) + (if (file-exists? arg) + (alist-cons 'file-to-insert arg result) + (leave (G_ "file '~a' does not exist~%") arg)))))) ;;; @@ -70,7 +81,7 @@ Run IMPORTER with ARGS.\n")) (display (G_ " -h, --help display this help and exit")) (display (G_ " - -i, --insert insert packages into file alphabetically")) + -i, --insert=FILE insert packages into FILE alphabetically")) (display (G_ " -V, --version display version information and exit")) (newline) @@ -84,7 +95,8 @@ PROC callback." ((and expr (or ('package _ ...) ('let _ ...))) (proc (package->definition expr))) - ((and expr ('define-public _ ...)) + ((and expr (or ('define-public _ ...) + ('define _ ...))) (proc expr)) ((expressions ...) (for-each (lambda (expr) @@ -92,7 +104,8 @@ PROC callback." ((and expr (or ('package _ ...) ('let _ ...))) (proc (package->definition expr))) - ((and expr ('define-public _ ...)) + ((and expr (or ('define-public _ ...) + ('define _ ...))) (proc expr)))) expressions)) (x @@ -107,7 +120,18 @@ PROC callback." (category packaging) (synopsis "import a package definition from an external repository") - (match args + (define (process-args args) + (match args + ;; Workaround to accpet ‘--insert=FILE’, for the consistency of + ;; command-line interface. + ((arg . rest) + (if (string-prefix? "--insert=" arg) + (append (string-split arg #\=) + rest) + args)) + (_ args))) + + (match (process-args args) (() (format (current-error-port) (G_ "guix import: missing importer name~%"))) @@ -118,20 +142,33 @@ PROC callback." (show-version-and-exit "guix import")) ((or ("-i" file importer args ...) ("--insert" file importer args ...)) - (let ((find-and-insert + (let* ((define-prefixes + `(,@(if (member importer '("crate")) + '(define) + '()) + define-public)) + (define-prefix? (cut member <> define-prefixes)) + (find-and-insert (lambda (expr) (match expr - (('define-public term _ ...) - (let ((source-properties - (find-definition-insertion-location - file term))) - (if source-properties - (insert-expression source-properties expr) - (let ((port (open-file file "a"))) - (pretty-print-with-comments port expr) - (newline port) - (close-port port))))))))) - (import-as-definitions importer args find-and-insert))) + (((? define-prefix? define-prefix) term _ ...) + ;; Skip existing definition. + (unless (find-definition-location + file term #:define-prefix define-prefix) + (let ((source-properties + (find-definition-insertion-location + file term #:define-prefix define-prefix))) + (if source-properties + (insert-expression source-properties expr) + (let ((port (open-file file "a"))) + (pretty-print-with-comments port expr) + (newline port) + (newline port) + (close-port port)))))))))) + (import-as-definitions importer + (cons (string-append "--file-to-insert=" file) + args) + find-and-insert))) ((importer args ...) (let ((print (lambda (expr) (leave-on-EPIPE diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 723cbb3665..0218cced74 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -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)) @@ -47,17 +50,11 @@ (display (G_ "Usage: guix import crate PACKAGE-NAME Import and convert the crates.io package for PACKAGE-NAME.\n")) (display (G_ " - -r, --recursive import packages recursively")) - (display (G_ " - --recursive-dev-dependencies - include dev-dependencies recursively")) - (newline) - (display (G_ " --allow-yanked allow importing yanked crates if no alternative satisfying the version requirement is found")) + (newline) (display (G_ " - --mark-missing comment out the desired dependency if no - sufficient package exists for it")) + -f, --lockfile=FILE import dependencies from FILE, a 'Cargo.lock' file")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -75,18 +72,14 @@ Import and convert the crates.io package for PACKAGE-NAME.\n")) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix import crate"))) - (option '(#\r "recursive") #f #f - (lambda (opt name arg result) - (alist-cons 'recursive #t result))) - (option '("recursive-dev-dependencies") #f #f - (lambda (opt name arg result) - (alist-cons 'recursive-dev-dependencies #t result))) (option '("allow-yanked") #f #f (lambda (opt name arg result) (alist-cons 'allow-yanked #t result))) - (option '("mark-missing") #f #f + (option '(#\f "lockfile") #f #t (lambda (opt name arg result) - (alist-cons 'mark-missing #t result))) + (if (file-exists? arg) + (alist-cons 'lockfile arg result) + (leave (G_ "file '~a' does not exist~%") arg)))) %standard-import-options)) @@ -101,6 +94,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 +106,35 @@ 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)) + (match (if 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) (crate->guix-package - name #:version version #:include-dev-deps? #t - #:allow-yanked? (assoc-ref opts 'allow-yanked) - #:mark-missing? (assoc-ref opts 'mark-missing))) + name #:version version + #:allow-yanked? (assoc-ref opts 'allow-yanked))) ((or #f '()) (leave (G_ "failed to download meta-data for package '~a'~%") (if version |