file-systems: Remove deprecated 'title' field helper procedures.
* gnu/system/file-systems.scm (<file-system>): Change constructor name to 'file-system'. (report-deprecation, device-expression, process-file-system-declaration, file-system): Remove macros. (file-system-title): Remove procedure. Signed-off-by: Ludovic Courtès <ludo@gnu.org>master
parent
559732e42b
commit
2397f47680
|
@ -42,7 +42,6 @@
|
||||||
file-system?
|
file-system?
|
||||||
file-system-device
|
file-system-device
|
||||||
file-system-device->string
|
file-system-device->string
|
||||||
file-system-title ;deprecated
|
|
||||||
file-system-mount-point
|
file-system-mount-point
|
||||||
file-system-type
|
file-system-type
|
||||||
file-system-needed-for-boot?
|
file-system-needed-for-boot?
|
||||||
|
@ -158,7 +157,7 @@ flags are found."
|
||||||
#'%validate-file-system-flags))))
|
#'%validate-file-system-flags))))
|
||||||
|
|
||||||
;; File system declaration.
|
;; File system declaration.
|
||||||
(define-record-type* <file-system> %file-system
|
(define-record-type* <file-system> file-system
|
||||||
make-file-system
|
make-file-system
|
||||||
file-system?
|
file-system?
|
||||||
(device file-system-device) ; string | <uuid> | <file-system-label>
|
(device file-system-device) ; string | <uuid> | <file-system-label>
|
||||||
|
@ -200,72 +199,6 @@ flags are found."
|
||||||
(format port "#<file-system-label ~s>"
|
(format port "#<file-system-label ~s>"
|
||||||
(file-system-label->string obj))))
|
(file-system-label->string obj))))
|
||||||
|
|
||||||
(define-syntax report-deprecation
|
|
||||||
(lambda (s)
|
|
||||||
"Report the use of the now-deprecated 'title' field."
|
|
||||||
(syntax-case s ()
|
|
||||||
((_ field)
|
|
||||||
(let* ((source (syntax-source #'field))
|
|
||||||
(file (and source (assq-ref source 'filename)))
|
|
||||||
(line (and source
|
|
||||||
(and=> (assq-ref source 'line) 1+)))
|
|
||||||
(column (and source (assq-ref source 'column))))
|
|
||||||
(format (current-error-port)
|
|
||||||
"~a:~a:~a: warning: 'title' field is deprecated~%"
|
|
||||||
file line column)
|
|
||||||
#t)))))
|
|
||||||
|
|
||||||
;; Helper for 'process-file-system-declaration'.
|
|
||||||
(define-syntax device-expression
|
|
||||||
(syntax-rules (quote label uuid device)
|
|
||||||
((_ (quote label) dev)
|
|
||||||
(file-system-label dev))
|
|
||||||
((_ (quote uuid) dev)
|
|
||||||
(if (uuid? dev) dev (uuid dev)))
|
|
||||||
((_ (quote device) dev)
|
|
||||||
dev)
|
|
||||||
((_ title dev)
|
|
||||||
(case title
|
|
||||||
((label) (file-system-label dev))
|
|
||||||
((uuid) (uuid dev))
|
|
||||||
(else dev)))))
|
|
||||||
|
|
||||||
;; Helper to interpret the now-deprecated 'title' field. Detect forms like
|
|
||||||
;; (title 'label), remove them, and adjust the 'device' field accordingly.
|
|
||||||
;; TODO: Remove this once 'title' has been deprecated long enough.
|
|
||||||
(define-syntax process-file-system-declaration
|
|
||||||
(syntax-rules (device title)
|
|
||||||
((_ () (rest ...) #f #f) ;no 'title' and no 'device' field
|
|
||||||
(%file-system rest ...))
|
|
||||||
((_ () (rest ...) dev #f) ;no 'title' field
|
|
||||||
(%file-system rest ... (device dev)))
|
|
||||||
((_ () (rest ...) dev titl) ;got a 'title' field
|
|
||||||
(%file-system rest ...
|
|
||||||
(device (device-expression titl dev))))
|
|
||||||
((_ ((title titl) rest ...) (previous ...) dev _)
|
|
||||||
(begin
|
|
||||||
(report-deprecation (title titl))
|
|
||||||
(process-file-system-declaration (rest ...)
|
|
||||||
(previous ...)
|
|
||||||
dev titl)))
|
|
||||||
((_ ((device dev) rest ...) (previous ...) _ titl)
|
|
||||||
(process-file-system-declaration (rest ...)
|
|
||||||
(previous ...)
|
|
||||||
dev titl))
|
|
||||||
((_ (field rest ...) (previous ...) dev titl)
|
|
||||||
(process-file-system-declaration (rest ...)
|
|
||||||
(previous ... field)
|
|
||||||
dev titl))))
|
|
||||||
|
|
||||||
(define-syntax-rule (file-system fields ...)
|
|
||||||
(process-file-system-declaration (fields ...) () #f #f))
|
|
||||||
|
|
||||||
(define (file-system-title fs) ;deprecated
|
|
||||||
(match (file-system-device fs)
|
|
||||||
((? file-system-label?) 'label)
|
|
||||||
((? uuid?) 'uuid)
|
|
||||||
((? string?) 'device)))
|
|
||||||
|
|
||||||
;; Note: This module is used both on the build side and on the host side.
|
;; Note: This module is used both on the build side and on the host side.
|
||||||
;; Arrange not to pull (guix store) and (guix config) because the latter
|
;; Arrange not to pull (guix store) and (guix config) because the latter
|
||||||
;; differs from user to user.
|
;; differs from user to user.
|
||||||
|
|
Reference in New Issue