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

21
guix/scripts/import.scm
View file

@ -30,6 +30,7 @@
#:use-module (guix read-print)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (%standard-import-options
@ -84,7 +85,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 +94,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
@ -129,13 +132,19 @@ 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 _ ...)
(((? define-prefix? define-prefix) term _ ...)
(let ((source-properties
(find-definition-insertion-location
file term)))
(find-definition-insertion-location
file term #:define-prefix define-prefix)))
(if source-properties
(insert-expression source-properties expr)
(let ((port (open-file file "a")))

29
guix/utils.scm
View file

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