@@ -16,7 +16,8 @@

                  (:file "scalar")

                  (:file "parser")

                  (:file "emitter")

-		 (:file "round-trip")

+                 (:file "emitter2")

+                 (:file "round-trip")

                  (:file "spec")

                  (:file "bench")

                  (:file "cl-yaml")))))

@@ -8,7 +8,6 @@

 		:allocate-emitter

 		:emitter-initialize

 		:emitter-delete

-		:emit

 		:set-output

 		:stream-start-event-initialize

 		:stream-end-event-initialize

@@ -25,7 +24,12 @@

   (:import-from :libyaml.write-handler

 		:*write-handler-callback*

 		:*write-handler-stream*)

-  (:export :stream-start-event

+  (:export ;; Original interface

+	   :emit

+	   :emit-to-string

+	   :encode

+	   ;; libyaml based interface

+	   :stream-start-event

 	   :stream-end-event

 	   :document-start-event

 	   :document-end-event

@@ -46,6 +50,68 @@

   (:documentation "The YAML emitter."))

 (in-package :yaml.emitter)

+;;; Encoder functions

+

+(defgeneric encode (value stream)

+  (:documentation "Write the YAML corresponding to value to a stream."))

+

+(defmethod encode ((true (eql 't)) stream)

+  "Encode true."

+  (write-string "true" stream))

+

+(defmethod encode ((true (eql 'nil)) stream)

+  "Encode false."

+  (write-string "false" stream))

+

+(defmethod encode ((integer integer) stream)

+  "Encode an integer."

+  (princ integer stream))

+

+(defmethod encode ((float float) stream)

+  "Encode a float."

+  (princ float stream))

+

+(defmethod encode ((string string) stream)

+  "Encode a string."

+  ;; (write-string string stream)

+  (format stream "~s" string))

+

+(defmethod encode ((list list) stream)

+  "Encode a list."

+  (write-string "[" stream)

+  (loop for sublist on list do

+    (encode (first sublist) stream)

+    (when (rest sublist)

+      (write-string ", " stream)))

+  (write-string "]" stream))

+

+(defmethod encode ((vector vector) stream)

+  "Encode a vector."

+  (encode (loop for elem across vector collecting elem) stream))

+

+(defmethod encode ((table hash-table) stream)

+  "Encode a hash table."

+  (write-string "{ " stream)

+  (loop for sublist on (alexandria:hash-table-keys table) do

+    (let ((key (first sublist)))

+      (encode key stream)

+      (write-string ": " stream)

+      (encode (gethash key table) stream)

+      (when (rest sublist)

+        (write-string ", " stream))))

+  (write-string " }" stream))

+

+;;; Interface

+

+(defun emit (value stream)

+  "Emit a value to a stream."

+  (encode value stream))

+

+(defun emit-to-string (value)

+  "Emit a value to string."

+  (with-output-to-string (stream)

+(emit value stream)))

+

 ;;; Wrappers around cl-libyaml event interface with defaults and keyword args

 (defun stream-start-event (event &key (encoding :utf8-encoding))

@@ -141,7 +207,7 @@

 				  &key version-directive

 				  tag-directive-start 

 				  tag-directive-end

-				  (implicit 0)) &body body)

+				  (implicit nil)) &body body)

   (declare (ignorable version-directive tag-directive-start

 		      tag-directive-end implicit))

   (let ((emitter-value (gensym "EMITTER"))

@@ -194,7 +260,7 @@

   (let ((printed-value (print-scalar value)))

     (apply #'scalar-event (foreign-event emitter)

 	   printed-value (length printed-value) rest)

-    (emit (foreign-emitter emitter) (foreign-event emitter))))

+    (libyaml.emitter:emit (foreign-emitter emitter) (foreign-event emitter))))

 (defgeneric print-scalar (scalar)

   (:documentation "Convert a scalar object into its printed representation"))

@@ -222,7 +288,18 @@

   (let ((*read-default-float-format* 'double-float))

     (princ-to-string scalar)))

-;;; Interface

-

 (defgeneric emit-object (emitter obj)

   (:documentation "Emit YAML representation of obj"))

+

+(defmethod emit-object (emitter (obj symbol))

+  (emit-scalar emitter obj))

+

+(defmethod emit-object (emitter (obj string))

+  (emit-scalar emitter obj))

+

+(defmethod emit-object (emitter (obj integer))

+  (emit-scalar emitter obj))

+

+(defmethod emit-object (emitter (obj float))

+  (emit-scalar emitter obj))

+

@@ -2,10 +2,21 @@

 (defpackage cl-yaml

   (:use :cl)

   (:nicknames :yaml)

+  (:import-from :yaml.parser

+                :register-scalar-converter

+                :register-sequence-converter

+                :register-mapping-converter)

+  (:import-from :yaml.emitter

+                :emit-object

+                :print-scalar)

   (:export :parse

-           ;:emit

-           ;:emit-to-string

-	   )

+           :emit

+           :emit-to-string

+           :register-scalar-converter

+           :register-sequence-converter

+           :register-mapping-converter

+           :emit-object

+           :print-scalar)

   (:documentation "The main YAML interface."))

 (in-package :yaml)

@@ -23,8 +34,8 @@

   (parse (uiop:read-file-string input)

          :multi-document-p multi-document-p))

-;; (defun emit (value stream)

-;;   (yaml.emitter:emit value stream))

+(defun emit (value stream)

+  (yaml.emitter:emit value stream))

-;; (defun emit-to-string (value)

-;;   (yaml.emitter:emit-to-string value))

+(defun emit-to-string (value)

+  (yaml.emitter:emit-to-string value))

@@ -10,6 +10,7 @@

   (run! 'cl-yaml-test.scalar:scalar)

   (run! 'cl-yaml-test.parser:parser)

   (run! 'cl-yaml-test.emitter:emitter)

+  (run! 'cl-yaml-test.emitter2:emitter2)

   (run! 'cl-yaml-test.round-trip:round-trip)

   (run! 'cl-yaml-test.spec:spec)

   (run! 'cl-yaml-test.bench:bench))

@@ -1,80 +1,67 @@

 (in-package :cl-user)

 (defpackage cl-yaml-test.emitter

   (:use :cl :fiveam)

+  (:import-from :alexandria

+                :alist-hash-table)

   (:export :emitter)

   (:documentation "Emitter tests."))

 (in-package :cl-yaml-test.emitter)

+;;; Macros

+

 (defmacro define-test-cases ((name) &rest pairs)

   `(test ,name

      ,@(loop for (form string) in pairs collecting

-	    `(is (equal (yaml.emitter:with-emitter-to-string (emitter)

-			  (yaml.emitter:emit-stream (emitter)

-			    (yaml.emitter:emit-document (emitter :implicit t)

-			      (yaml.emitter:emit-scalar emitter ,form))))

-			,(format nil "~a~%...~%" string)))))) ;; Document end marker

-                                                              ;; is libyaml behavior

-

-(defun test-emit-sequence (sequence style)

-  (yaml.emitter:with-emitter-to-string (emitter)

-    (yaml.emitter:emit-stream (emitter)

-      (yaml.emitter:emit-document (emitter :implicit t)

-	(yaml.emitter:emit-sequence (emitter :style style)

-	  (mapcar (lambda (element) (yaml.emitter:emit-scalar emitter element))

-		  sequence))))))

+         `(is (equal (yaml.emitter:emit-to-string ,form)

+                     ,string)))))

-(defun test-emit-mapping (mapping style)

-  (yaml.emitter:with-emitter-to-string (emitter)

-    (yaml.emitter:emit-stream (emitter)

-      (yaml.emitter:emit-document (emitter :implicit t)

-	(yaml.emitter:emit-mapping (emitter :style style)

-	  (mapcar (lambda (pair)

-		    (yaml.emitter:emit-scalar emitter (car pair))

-		    (yaml.emitter:emit-scalar emitter (cdr pair)))

-		  mapping))))))

+;;; Tests

 (def-suite emitter

-    :description "YAML emitter tests.")

+  :description "YAML emitter tests.")

 (in-suite emitter)

 (define-test-cases (boolean)

-  (t "true")

-  (nil "false"))

+  (t

+   "true")

+  (nil

+   "false"))

 (define-test-cases (integers)

-  (1 "1")

-  (123 "123")

-  (+123 "123")

-  (-123 "-123"))

+  (1

+   "1")

+  (123

+   "123")

+  (+123

+   "123")

+  (-123

+   "-123"))

 (define-test-cases (floats)

-  (1.23 "1.23")

-  (6.62607e-34 "6.62607e-34"))

-

-(test flow-sequence

-  (is (equal (test-emit-sequence '(1 "a" 3.14f0 3.14d0) :flow-sequence-style)

-	     "[1, a, 3.14, 3.14]

-")))

-

-(test block-sequence

-  (is (equal (test-emit-sequence '(1 "a" 3.14f0 3.14d0) :block-sequence-style)

-	     "- 1

-- a

-- 3.14

-- 3.14

-")))

+  (1.23

+   "1.23")

+  (6.62607e-34

+   "6.62607e-34"))

-(test flow-mapping

-  (is (equal (test-emit-mapping '(("integer" . 1) ("string" . "test") ("bool" . nil))

-				:flow-mapping-style)

-	     "{integer: 1, string: test, bool: false}

-")))

+(define-test-cases (lists)

+  ((list 1 2 3)

+   "[1, 2, 3]")

+  ((vector 1 2 3)

+   "[1, 2, 3]"))

-(test block-mapping

-  (is (equal (test-emit-mapping '(("integer" . 1) ("string" . "test") ("bool" . nil))

-				:block-mapping-style)

-	     "integer: 1

-string: test

-bool: false

-")))

+(test hash-tables

+  (let ((table (alexandria:alist-hash-table

+                (list (cons "a" 1)

+                      (cons "b" 2)))))

+    (is

+     (equal (yaml:emit-to-string table)

+            "{ \"b\": 2, \"a\": 1 }"))))

+(test toplevel-function

+  (is

+    (equal (yaml:emit-to-string 1)

+           "1"))

+  (is

+    (equal (with-output-to-string (stream)

+             (yaml:emit 1 stream))

+           "1")))

new file mode 100644

@@ -0,0 +1,79 @@

+(in-package :cl-user)

+(defpackage cl-yaml-test.emitter2

+  (:use :cl :fiveam)

+  (:export :emitter2)

+  (:documentation "Emitter tests - libyaml-based emitter."))

+(in-package :cl-yaml-test.emitter2)

+

+(defmacro define-test-cases ((name) &rest pairs)

+  `(test ,name

+     ,@(loop for (form string) in pairs collecting

+            `(is (equal (yaml.emitter:with-emitter-to-string (emitter)

+                          (yaml.emitter:emit-stream (emitter)

+                            (yaml.emitter:emit-document (emitter :implicit t)

+                              (yaml.emitter:emit-scalar emitter ,form))))

+                        ,(format nil "~a~%...~%" string)))))) ;; Document end marker

+                                                              ;; is libyaml behavior

+

+(defun test-emit-sequence (sequence style)

+  (yaml.emitter:with-emitter-to-string (emitter)

+    (yaml.emitter:emit-stream (emitter)

+      (yaml.emitter:emit-document (emitter :implicit t)

+        (yaml.emitter:emit-sequence (emitter :style style)

+          (mapcar (lambda (element) (yaml.emitter:emit-scalar emitter element))

+                  sequence))))))

+

+(defun test-emit-mapping (mapping style)

+  (yaml.emitter:with-emitter-to-string (emitter)

+    (yaml.emitter:emit-stream (emitter)

+      (yaml.emitter:emit-document (emitter :implicit t)

+        (yaml.emitter:emit-mapping (emitter :style style)

+          (mapcar (lambda (pair)

+                    (yaml.emitter:emit-scalar emitter (car pair))

+                    (yaml.emitter:emit-scalar emitter (cdr pair)))

+                  mapping))))))

+

+(def-suite emitter2

+    :description "YAML libyaml-based emitter tests.")

+(in-suite emitter2)

+

+(define-test-cases (boolean)

+  (t "true")

+  (nil "false"))

+

+(define-test-cases (integers)

+  (1 "1")

+  (123 "123")

+  (+123 "123")

+  (-123 "-123"))

+

+(define-test-cases (floats)

+  (1.23 "1.23")

+  (6.62607e-34 "6.62607e-34"))

+

+(test flow-sequence

+  (is (equal (test-emit-sequence '(1 "a" 3.14f0 3.14d0) :flow-sequence-style)

+             "[1, a, 3.14, 3.14]

+")))

+

+(test block-sequence

+  (is (equal (test-emit-sequence '(1 "a" 3.14f0 3.14d0) :block-sequence-style)

+             "- 1

+- a

+- 3.14

+- 3.14

+")))

+

+(test flow-mapping

+  (is (equal (test-emit-mapping '(("integer" . 1) ("string" . "test") ("bool" . nil))

+                                :flow-mapping-style)

+             "{integer: 1, string: test, bool: false}

+")))

+

+(test block-mapping

+  (is (equal (test-emit-mapping '(("integer" . 1) ("string" . "test") ("bool" . nil))

+                                :block-mapping-style)

+             "integer: 1

+string: test

+bool: false

+")))