branch: externals/yaml
commit 96d3e51aeb48ef61440f99a7f4161ad12cf3e749
Author: Zachary Romero <zacrom...@posteo.net>
Commit: Zachary Romero <zacrom...@posteo.net>
Add yaml-encode feature
---
README.md | 24 +++++++++--
yaml-tests.el | 51 +++++++++++++++++++++++
yaml.el | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 201 insertions(+), 4 deletions(-)
diff --git a/README.md b/README.md
index a896f9881c..91c635d32b 100644
--- a/README.md
+++ b/README.md
@@ -2,7 +2,7 @@
yaml.el is a YAML parser written in Emacs List without any external
dependencies. It provides an interface similar to the Emacs JSON
-parsing utility. The function provided is as follows:
+parsing utility. The functions provided are as follows:
``` emacs-lisp
(yaml-parse-string string &rest args)
@@ -14,7 +14,7 @@ The following keyword args are accepted:
objects data in. It takes the following symbols:
- `hash-table` (default)
- `alist`
- - `plist`
+n - `plist`
- `:sequence-type` specifies the Lisp data structure to store the
parsed sequences in. It takes the following symbols:
- `array` (default)
@@ -24,6 +24,13 @@ The following keyword args are accepted:
- `:false-object` specifies the lisp object to use for false.
Defaults to the symbol `:false`.
+```emacs-lisp
+(yaml-encode object)
+```
+
+The function `yaml-encode` will encode a Lisp object to a YAML string.
+
+
## Installation
Until this is published to MELPA you will need to use the code from this repo
directly.
@@ -56,9 +63,20 @@ translations:
three: үш")
;; => #s(hash-table ... data ("translations" #s(hash-table ...)))
-```
+(yaml-encode '("omitted" ((count . 3) (value . 10) (items ("ruby" "diamond")))
"omitted"))
+
+;; => "
+- omitted
+- count: 3
+ value: 10
+ items:
+ ruby: [diamond]
+- omitted"
+
+
+```
## Caveats
diff --git a/yaml-tests.el b/yaml-tests.el
index 1bc0196bf9..3b0c3fd8dd 100644
--- a/yaml-tests.el
+++ b/yaml-tests.el
@@ -456,6 +456,57 @@ keep: |+
# beep" :object-type 'alist)))
+(defun yaml-test-round-trip (o)
+ "Test (equal (decode (encode o)) o)"
+ (let* ((encoded (yaml-encode o))
+ (parsed (yaml-parse-string encoded
+ :object-type 'alist
+ :sequence-type 'list))
+ (encoded-2 (yaml-encode o)))
+ (equal encoded encoded-2)))
+
+(ert-deftest yaml-encode-tests ()
+ (should (yaml-test-round-trip 1))
+ (should (yaml-test-round-trip "one"))
+ (should (yaml-test-round-trip nil))
+ (should (yaml-test-round-trip '(1 2 3)))
+ (should (yaml-test-round-trip '((1 . 2) (3 . 4) (5 . 6))))
+ (should (yaml-test-round-trip
+ '(("key" . "value")
+ ("nested-map" . ((1 . 2) (3 . 4) (5 . 6))))))
+ (should (yaml-test-round-trip
+ '("one"
+ (("key" . "value")
+ ("nested-map" . ((1 . 2) (3 . 4) (5 . 6))))
+ "three")))
+ (should (yaml-test-round-trip
+ '("one"
+ (("key" . "value")
+ ("nested-map" . ((1 . 2) (3 . 4) (5 . 6))))
+ "three")))
+ (should (yaml-test-round-trip
+ '("one"
+ (("key" . "value")
+ ("nested-map" . ((1 . 2) (3 . 4) (5 . 6))))
+ ("nested" "list" 1 2 3))))
+ (should (yaml-test-round-trip
+ '("one"
+ (("key" . "value")
+ ("nested-map" . ((1 . 2) (3 . 4) (5 . 6)))
+ ("nested-list" . (1 2 3 4 5)))
+ ("nested" "list" 1 2 3))))
+ (should (yaml-test-round-trip
+ '("one"
+ (("key" . "value")
+ ("nested-map" . ((1 . 2) (3 . 4) (5 . 6)))
+ ("nested-list" . (1 2 3 4 5)))
+ ("nested" "list" 1 2 3))))
+ (should (yaml-test-round-trip
+ '(t nil)))
+ (should (yaml-encode
+ '((("aaaa" "bbbb" "cccc") ("dddd" "eeee" "ffff") ("gggg" "hhhh"
"iiii"))
+ ("jjjj" "kkkk" "llll") ("mmmm" "nnnn" "oooo") ("pppp" "qqqq"
"rrrr")))))
+
(provide 'yaml-tests)
;; yaml-tests.el ends here
diff --git a/yaml.el b/yaml.el
index 19a78fd27e..1184cadf67 100644
--- a/yaml.el
+++ b/yaml.el
@@ -30,11 +30,14 @@
;; yaml.el contains the code for parsing YAML natively in Elisp with
;; no dependencies. The main function to parse YAML provided is
-;; `yaml-parse-string'. The following are some examples of its usage:
+;; `yaml-parse-string'. `yaml-encode' is also provided to encode a
+;; Lisp object to YAML. The following are some examples of its usage:
;;
;; (yaml-parse-string "key1: value1\nkey2: value2")
;; (yaml-parse-string "key1: value1\nkey2: value2" :object-type 'alist)
;; (yaml-parse-string "numbers: [1, 2, 3]" :sequence-type 'list)
+;;
+;; (yaml-encode '((count . 3) (value . 10) (items ("ruby" "diamond"))))
;;; Code:
@@ -2338,6 +2341,131 @@ Rules for this function are defined by the yaml-spec
JSON file."
(yaml--parse-from-grammar 'ns-plain n c))))
(_ (error "Unknown parsing grammar state: %s %s" state args))))
+;;; Encoding
+
+(defun yaml-encode (object)
+ "Encode OBJECT to a YAML string."
+ (with-temp-buffer
+ (yaml--encode-object object 0)
+ (buffer-string)))
+
+(defun yaml--encode-object (object indent &optional auto-indent)
+ "Encode a Lisp OBJECT to YAML.
+
+INDENT indicates how deeply nested the object will be displayed
+in the YAML. If AUTO-INDENT is non-nil, then emit the object
+without first inserting a newline."
+ (cond
+ ((yaml--scalarp object) (yaml--encode-scalar object))
+ ((hash-table-p object) (yaml--encode-hash-table object indent auto-indent))
+ ((listp object) (yaml--encode-list object indent auto-indent))
+ (t (error "Unknown object %s" object))))
+
+(defun yaml--scalarp (object)
+ "Return non-nil if OBJECT correlates to a YAML scalar."
+ (or (numberp object)
+ (symbolp object)
+ (stringp object)
+ (not object)))
+
+(defun yaml--encode-escape-string (s)
+ "Escape yaml special characters in string S."
+ (let* ((s (replace-regexp-in-string "\\\\" "\\\\" s))
+ (s (replace-regexp-in-string "\n" "\\\\n" s))
+ (s (replace-regexp-in-string "\t" "\\\\t" s))
+ (s (replace-regexp-in-string "\r" "\\\\r" s))
+ (s (replace-regexp-in-string "\"" "\\\\\"" s)))
+ s))
+
+
+
+(defun yaml--encode-scalar (s)
+ "Encode scalar S to buffer."
+ (cond
+ ((not s) (insert "nil"))
+ ((eql t s) (insert "true"))
+ ((symbolp s) (insert (symbol-name s)))
+ ((numberp s) (insert (number-to-string s)))
+ ((stringp s)
+ (if (string-match "\\`[-_a-zA-Z0-9]+\\'" s)
+ (insert s)
+ (insert "\"" (yaml--encode-escape-string s) "\"")))))
+
+(defun yaml--alist-to-hash-table (l)
+ "Return hash representation of L if it is an alist, nil otherwise."
+ (when (and (listp l) (seq-every-p (lambda (x) (and (consp x) (atom (car
x)))) l))
+ (let ((h (make-hash-table)))
+ (seq-map (lambda (cpair)
+ (let ((k (car cpair))
+ (v (cdr cpair)))
+ (puthash k v h)))
+ l)
+ h)))
+
+(defun yaml--encode-list (l indent &optional auto-indent)
+ "Encode list L to a string in the context of being INDENT deep.
+
+If AUTO-INDENT is non-nil, start the list on the current line,
+auto-detecting the indentation"
+ (let ((ht (yaml--alist-to-hash-table l)))
+ (cond (ht
+ (yaml--encode-hash-table ht indent auto-indent))
+ ((zerop (length l))
+ (insert "[]"))
+ ((seq-every-p #'yaml--scalarp l)
+ (insert "[")
+ (yaml--encode-object (car l) 0)
+ (seq-do (lambda (object)
+ (insert ", ")
+ (yaml--encode-object object 0))
+ (cdr l))
+ (insert "]"))
+ (t
+ (let ((first t)
+ (indent-string (make-string (* 2 indent) ?\s)))
+ (seq-do (lambda (object)
+ (if (not first)
+ (insert "\n" indent-string "- ")
+ (if auto-indent
+ (let ((curr-indent
(yaml--encode-auto-detect-indent)))
+ (insert (make-string (- indent curr-indent)
?\s) "- "))
+ (insert "\n" indent-string "- "))
+ (setq first nil))
+ (yaml--encode-object object (+ indent 2)
+ (or
+ (hash-table-p object)
+ (yaml--alist-to-hash-table
object))))
+ l))))))
+
+(defun yaml--encode-auto-detect-indent ()
+ "Return the amount of indentation at current place in encoding."
+ (length (thing-at-point 'line)))
+
+(defun yaml--encode-hash-table (m indent &optional auto-indent)
+ "Encode hash table M to a string in the context of being INDENT deep.
+
+If AUTO-INDENT is non-nil, auto-detect the indent on the current
+line and insert accordingly."
+ (cond ((zerop (hash-table-size m))
+ (insert "{}"))
+ (t
+ (let ((first t)
+ (indent-string (make-string indent ?\s)))
+ (maphash (lambda (k v)
+ (if (not first)
+ (insert "\n" indent-string)
+ (if auto-indent
+ (let ((curr-indent
(yaml--encode-auto-detect-indent)))
+ (when (> curr-indent indent)
+ (setq indent (+ curr-indent 1)))
+ (insert (make-string (- indent curr-indent)
?\s)))
+ (insert "\n" indent-string))
+ (setq first nil))
+ (yaml--encode-object k indent nil)
+ (insert ": ")
+ (yaml--encode-object v (+ indent 2)))
+ m)))))
+
(provide 'yaml)
;;; yaml.el ends here
