summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-09-06 10:35:01 +0200
committerLudovic Courtès <ludo@gnu.org>2017-09-11 22:24:47 +0200
commitce094b4663da6aa52d02f398a19e1d2892641b7d (patch)
treedb426cfb6e1ea59ed0e036db0e8b5bed2f8b1c25 /gnu/system
parent075681d3501082c6e22df8abf29dfe89d85effc1 (diff)
downloadpatches-ce094b4663da6aa52d02f398a19e1d2892641b7d.tar
patches-ce094b4663da6aa52d02f398a19e1d2892641b7d.tar.gz
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.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/uuid.scm22
1 files changed, 14 insertions, 8 deletions
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 60626ebb12..1dd6a11339 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -206,7 +206,7 @@ ISO9660 UUID representation."
('iso9660 => iso9660-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
corresponding bytevector; otherwise return #f."
(match (vhash-assq type %uuid-parsers)
@@ -233,17 +233,23 @@ corresponding bytevector; otherwise return #f."
(define-syntax uuid
(lambda (s)
"Return the UUID object corresponding to the given UUID representation."
- ;; TODO: Extend to types other than DCE.
- (syntax-case s ()
- ((_ str)
- (string? (syntax->datum #'str))
+ (syntax-case s (quote)
+ ((_ str (quote type))
+ (and (string? (syntax->datum #'str))
+ (identifier? #'type))
;; 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
(syntax-violation 'uuid "invalid UUID" s))
- #`(make-uuid 'dce #,(datum->syntax #'str bv))))
+ #`(make-uuid 'type #,(datum->syntax s bv))))
+ ((_ str)
+ (string? (syntax->datum #'str))
+ #'(uuid str 'dce))
((_ str)
- #'(make-uuid 'dce (string->uuid str))))))
+ #'(make-uuid 'dce (string->uuid str 'dce)))
+ ((_ str type)
+ #'(make-uuid type (string->uuid str type))))))
(define uuid->string
;; Convert the given bytevector or UUID object, to the corresponding UUID