me
/
guix
Archived
1
0
Fork 0
Code

uuid: 'uuid' macro supports more UUID types. 

* gnu/system/uuid.scm (string->uuid): Turn 'type' into an optional
argument.
(uuid): Add clauses to allow for an optional 'type' parameter.
master
Ludovic Courtès 2017-09-06 10:35:01 +02:00
parent 075681d350
commit ce094b4663
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 14 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gnu/system/uuid.scm
View File

@ -206,7 +206,7 @@ ISO9660 UUID representation."
('iso9660 => iso9660-uuid->string) ('iso9660 => iso9660-uuid->string)
('fat32 'fat => fat32-uuid->string))) ('fat32 'fat => fat32-uuid->string)))
(define* (string->uuid str #:key (type 'dce)) (define* (string->uuid str #:optional (type 'dce))
"Parse STR as a UUID of the given TYPE. On success, return the "Parse STR as a UUID of the given TYPE. On success, return the
corresponding bytevector; otherwise return #f." corresponding bytevector; otherwise return #f."
(match (vhash-assq type %uuid-parsers) (match (vhash-assq type %uuid-parsers)
@ -233,17 +233,23 @@ corresponding bytevector; otherwise return #f."
(define-syntax uuid (define-syntax uuid
(lambda (s) (lambda (s)
"Return the UUID object corresponding to the given UUID representation." "Return the UUID object corresponding to the given UUID representation."
;; TODO: Extend to types other than DCE. (syntax-case s (quote)
(syntax-case s () ((_ str (quote type))
((_ str) (and (string? (syntax->datum #'str))
(string? (syntax->datum #'str)) (identifier? #'type))
;; A literal string: do the conversion at expansion time. ;; A literal string: do the conversion at expansion time.
(let ((bv (string->uuid (syntax->datum #'str)))) (let ((bv (string->uuid (syntax->datum #'str)
(syntax->datum #'type))))
(unless bv (unless bv
(syntax-violation 'uuid "invalid UUID" s)) (syntax-violation 'uuid "invalid UUID" s))
#`(make-uuid 'dce #,(datum->syntax #'str bv)))) #`(make-uuid 'type #,(datum->syntax s bv))))
((_ str) ((_ str)
#'(make-uuid 'dce (string->uuid str)))))) (string? (syntax->datum #'str))
#'(uuid str 'dce))
((_ str)
#'(make-uuid 'dce (string->uuid str 'dce)))
((_ str type)
#'(make-uuid type (string->uuid str type))))))
(define uuid->string (define uuid->string
;; Convert the given bytevector or UUID object, to the corresponding UUID ;; Convert the given bytevector or UUID object, to the corresponding UUID