Commits

Moritz Heidkamp committed 4d17865

Add tag emitters

Comments (0)

Files changed (2)

         (cons (car coll)))
    out))
 
+(define (emit-tag el out)
+  (write-edn/tag (caadr el) (cdadr el) (caddr el) out))
+
 (define edn-emitters
   (make-parameter
    (list (cons keyword?       emit-keyword)
          (cons (car? 'list)   (coll-emitter #\( #\)))
          (cons (car? 'vector) (coll-emitter #\[ #\]))
          (cons (car? 'set)    emit-set)
-         (cons (car? 'map)    emit-map))))
+         (cons (car? 'map)    emit-map)
+         (cons (car? 'tag)    emit-tag))))
 
 (define (emitter-ref obj)
   (or (alist-ref obj (edn-emitters) (lambda (pred? _) (pred? obj)))
 
 (define (write-edn obj #!optional (output (current-output-port)))
   ((emitter-ref obj) obj output))
+
+(define (write-edn/tag ns name obj #!optional (output (current-output-port)))
+  (let ((emit (emitter-ref obj)))
+    (display #\# output)
+    (when ns
+      (display ns output)
+      (display #\/ output))
+    (display name output)
+    (display #\space output)
+    (emit obj output)))
 (test-group "tags"
   (test-write '(tag (#f . inst) "1985-04-12T23:20:50.52Z")
               "#inst \"1985-04-12T23:20:50.52Z\"")
-  (test-write "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\""
-              '(tag (#f . uuid) "f81d4fae-7dec-11d0-a765-00a0c91e6bf6")))
+  (test-write '(tag (#f . uuid) "f81d4fae-7dec-11d0-a765-00a0c91e6bf6")
+              "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"")
+  (test-write '(tag (my . tag) 123)
+              "#my/tag 123"))
 
 (test-end)