[elpa] externals/yaml 96d3e51aeb 048/124: Add yaml-encode feature

[ELPA Syncer]

branch: externals/yaml
commit 96d3e51aeb48ef61440f99a7f4161ad12cf3e749
Author: Zachary Romero <zacromero@posteo.net>
Commit: Zachary Romero <zacromero@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