amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

scripts: import: Support expressions defined by 'define.

Browse source 
* guix/utils.scm (find-definition-location): New procedure.
(find-definition-insertion-location): Define with it.
* guix/scripts/import.scm (import-as-definitions, guix-import): Support
expressions defined by 'define.

Change-Id: I03118e1a3372028b4f0530964aba871b4a1a4d25
This commit is contained in:
Hilton Chain 2025-02-27 15:23:50 +08:00
parent 115accdb26
commit 6094090db2
No known key found for this signature in database
GPG key ID: ACC66D09CA528292
2 changed files with 36 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

19
guix/scripts/import.scm
View file

@ -30,6 +30,7 @@
#:use-module (guix read-print) #:use-module (guix read-print)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (%standard-import-options #:export (%standard-import-options
@ -84,7 +85,8 @@ PROC callback."
((and expr (or ('package _ ...) ((and expr (or ('package _ ...)
('let _ ...))) ('let _ ...)))
(proc (package->definition expr))) (proc (package->definition expr)))
((and expr ('define-public _ ...)) ((and expr (or ('define-public _ ...)
('define _ ...)))
(proc expr)) (proc expr))
((expressions ...) ((expressions ...)
(for-each (lambda (expr) (for-each (lambda (expr)
@ -92,7 +94,8 @@ PROC callback."
((and expr (or ('package _ ...) ((and expr (or ('package _ ...)
('let _ ...))) ('let _ ...)))
(proc (package->definition expr))) (proc (package->definition expr)))
((and expr ('define-public _ ...)) ((and expr (or ('define-public _ ...)
('define _ ...)))
(proc expr)))) (proc expr))))
expressions)) expressions))
(x (x
@ -129,13 +132,19 @@ PROC callback."
(show-version-and-exit "guix import")) (show-version-and-exit "guix import"))
((or ("-i" file importer args ...) ((or ("-i" file importer args ...)
("--insert" 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) (lambda (expr)
(match expr (match expr
(('define-public term _ ...) (((? define-prefix? define-prefix) term _ ...)
(let ((source-properties (let ((source-properties
(find-definition-insertion-location (find-definition-insertion-location
file term))) file term #:define-prefix define-prefix)))
(if source-properties (if source-properties
(insert-expression source-properties expr) (insert-expression source-properties expr)
(let ((port (open-file file "a"))) (let ((port (open-file file "a")))

27
guix/utils.scm
View file

@ -154,6 +154,7 @@
edit-expression edit-expression
delete-expression delete-expression
insert-expression insert-expression
find-definition-location
find-definition-insertion-location find-definition-insertion-location
filtered-port filtered-port
@ -520,24 +521,36 @@ SOURCE-PROPERTIES."
(string-append expr "\n\n" str)))) (string-append expr "\n\n" str))))
(edit-expression source-properties insert))) (edit-expression source-properties insert)))
(define (find-definition-insertion-location file term) (define* (find-definition-location file term
"Search in FILE for a top-level public definition whose defined term #:key (define-prefix 'define-public)
alphabetically succeeds TERM. Return the location if found, or #f (pred string=))
otherwise." "Search in FILE for a top-level definition created using DEFINE-PREFIX, with
(let ((search-term (symbol->string term))) the defined term compared to TERM through PRED. Return the location if PRED
returns #t, or #f otherwise."
(let ((search-term (symbol->string term))
(define-prefix? (cut eq? define-prefix <>)))
(call-with-input-file file (call-with-input-file file
(lambda (port) (lambda (port)
(do ((syntax (read-syntax port) (do ((syntax (read-syntax port)
(read-syntax port))) (read-syntax port)))
((match (syntax->datum syntax) ((match (syntax->datum syntax)
(('define-public current-term _ ...) (((? define-prefix?) current-term _ ...)
(string> (symbol->string current-term) (pred (symbol->string current-term)
search-term)) search-term))
((? eof-object?) #t) ((? eof-object?) #t)
(_ #f)) (_ #f))
(and (not (eof-object? syntax)) (and (not (eof-object? syntax))
(syntax-source syntax)))))))) (syntax-source syntax))))))))
(define* (find-definition-insertion-location file term
#:key
(define-prefix 'define-public))
"Search in FILE for a top-level definition created using DEFINE-PREFIX, with
the defined term alphabetically succeeds TERM. Return the location if found,
or #f otherwise."
(find-definition-location
file term #:define-prefix define-prefix #:pred string>))
;;; ;;;
;;; Keyword arguments. ;;; Keyword arguments.