[elpa] externals/yaml 2e2e7d199e 023/124: Implement anchor alias resolution

[ELPA Syncer]

branch: externals/yaml
commit 2e2e7d199ec94f5db0a12f3e558d4b13aaffb852
Author: Zachary Romero <zacromero@posteo.net>
Commit: Zachary Romero <zacromero@posteo.net>

    Implement anchor alias resolution
---
 yaml-tests.el | 132 +++++++++++++++++++++++++++++++++++++++++++++++++---------
 yaml.el       |  39 ++++++++++++++---
 2 files changed, 145 insertions(+), 26 deletions(-)

diff --git a/yaml-tests.el b/yaml-tests.el
index 99a835e1a0..e7be6f6966 100644
--- a/yaml-tests.el
+++ b/yaml-tests.el
@@ -332,33 +332,114 @@
                  '("abc" "def" "ghi")))
   (should (equal (yaml-parse-string "- [abc, def, ghi]\n- [jkl, mno, pqr]\n- 
[stu, vwx, yz]")
                  '(("abc" "def" "ghi") ("jkl" "mno" "pqr") ("stu" "vwx" 
"yz"))))
+  (should (equal (yaml-parse-string "a")
+                 "a"))
+  (should (equal (yaml-parse-string "\"a\"")
+                 "a"))
+  (should (equal (yaml-parse-string "'a'")
+                 "a"))
+  (should (equal (yaml-parse-string "- !!str \"a\"
+- 'b'
+- &anchor \"c\"
+- *anchor
+- !!str")
+                 ["a" "b" "c" "c" ""])))
+
+(ert-deftest yaml-parsing-completes ()
+  "Tests that the yaml parses."
+  (should (yaml-parse-string "one: two"))
+  (should (yaml-parse-string "!!map { ? !!str one : !!str one}"))
+  (should (yaml-parse-string "\"one\" : [
+  \"key\" : value,
+ ]"))
+  (should (yaml-parse-string "{ ? !!str : \"two\"}"))
+  (should (yaml-parse-string "{ ? !!str : !!str }"))
+  (should (yaml-parse-string "{ ? : }"))
+  (should (yaml-parse-string "{ ? !!str \"one\" : \"two\"}"))
+  (should (yaml-parse-string
+           "apiVersion: apps/v1
+kind: Deployment
+metadata:
+  name: nginx-deployment
+spec:
+  selector:
+    matchLabels:
+      app: nginx
+  replicas: 2 # tells deployment to run 2 pods matching the template
+  template:
+    metadata:
+      labels:
+        app: nginx
+    spec:
+      containers:
+      - name: nginx
+        image: nginx:1.14.2
+        ports:
+        - containerPort: 80"))
+
+  ;; example 7.17
+  ;; TODO: The empty strings of "http://foo.com"; and "omitted value" should be 
tagged as !!null.
+  (should (yaml-parse-string
+           "{
+unquoted : \"separate\",
+http://foo.com,
+omitted value:,
+: omitted key,
+}"))
+
+  ;; example 7.18
+  (should (yaml-parse-string
+           "{
+\"adjacent\":value,
+\"readable\":·value,
+\"empty\":
+}"))
+
+  ;; example 7.19
+  (should (yaml-parse-string
+           "[
+foo: bar
+]"))
+
+  ;; example 7.20
+  (should (yaml-parse-string
+           "[
+? foo
+ bar : baz
+]"))
+
+  ;; example 7.21
+  (should (yaml-parse-string
+           "- [ YAML : separate ]
+- [ : empty key entry ]
+- [ {JSON: like}:adjacent ]"))
+
+  ;; example 7.22
+  (should (not (condition-case n
+                   (yaml-parse-string "[ foo
+ bar: invalid,
+ \"foo...>1K characters...bar\": invalid ]")
+                 (error nil))))
+
+  ;; example 7.23
+  (should (yaml-parse-string "- [ a, b ]
+- { a: b }
+- \"a\"
+- 'b'
+- c"))
+
+  ;; example 7.24
   )
 
+(condition-case nil
+    1
+  (error 'error))
 
 ;; (yaml-parse-string
 ;;  "one: two
 ;; three: four")
 
-;; (yaml-parse-string
-;;  "apiVersion: apps/v1
-;; kind: Deployment
-;; metadata:
-;;   name: nginx-deployment
-;; spec:
-;;   selector:
-;;     matchLabels:
-;;       app: nginx
-;;   replicas: 2 # tells deployment to run 2 pods matching the template
-;;   template:
-;;     metadata:
-;;       labels:
-;;         app: nginx
-;;     spec:
-;;       containers:
-;;       - name: nginx
-;;         image: nginx:1.14.2
-;;         ports:
-;;         - containerPort: 80")
+
 
 ;; (yaml-parse-string
 ;;  "schema: 'packages/api/src/schema.graphql'
@@ -377,6 +458,17 @@ extensions:
           - typescript
           - typescript-resolvers")
 
+(yaml-parse-string "
+recipe:
+  ingredients:
+  - milk
+  - eggs
+  - öil
+  - flour
+  duration: 10
+  steps: null"
+                   :object-type 'alist)
+
 ;; (yaml-parse-string "apiVersion: v1
 ;; description: A Helm chart for bidder canary
 ;; home: https://github.com/travelaudience/bidder-bidder
diff --git a/yaml.el b/yaml.el
index 1dedea6d8d..5a575b5c61 100644
--- a/yaml.el
+++ b/yaml.el
@@ -185,6 +185,9 @@ This flag is intended for development purposes.")
   "The state that the YAML parser is with regards to incoming events.")
 (defvar yaml--root nil)
 
+(defvar yaml--anchor-mappings nil)
+(defvar yaml--resolve-aliases nil)
+
 (defun yaml--parse-block-header (header)
   "Parse the HEADER string returning chomping style and indent count."
   (let* ((pos 0)
@@ -352,15 +355,29 @@ This flag is intended for development purposes.")
     (yaml--scalar-event nil obj))
   '(:sequence-end))
 
+(defun yaml--anchor-event (name)
+  (push :anchor yaml--state-stack)
+  (push `(:anchor ,name) yaml--object-stack)
+  (message "DEBUG ANCHOR: %s -> %s" name yaml--last-added-item))
+
 (defun yaml--scalar-event (style value)
+  (message "DEBUG SCALAR: %s" value)
+  (setq yaml--last-added-item value)
   (let ((top-state (car yaml--state-stack))
         (value (cond
                 ((stringp value) (yaml--resolve-scalar-tag value))
                 ((listp value) (yaml--format-list value))
-                ((hash-table-p value) (yaml--format-object value)))))
+                ((hash-table-p value) (yaml--format-object value))
+                ((vectorp value) value))))
     (cond
      ((not top-state)
       (setq yaml--root value))
+     ((equal top-state :anchor)
+      (let* ((anchor (pop yaml--object-stack))
+             (name (nth 1 anchor)))
+        (puthash name value yaml--anchor-mappings)
+        (pop yaml--state-stack)
+        (yaml--scalar-event nil value)))
      ((equal top-state :sequence)
       (let ((l (car yaml--object-stack)))
         (setcar yaml--object-stack (append l (list value)))))
@@ -378,6 +395,11 @@ This flag is intended for development purposes.")
   '(:scalar))
 
 (defun yaml--alias-event (name)
+  (if yaml--resolve-aliases
+      (let ((resolved (gethash name yaml--anchor-mappings)))
+        (unless resolved (error "Undefined alias '%s'" name))
+        (yaml--scalar-event nil resolved))
+    (yaml--scalar-event nil (vector :alias name)))
   '(:alias))
 
 (defun yaml--check-document-start () t)
@@ -476,7 +498,7 @@ This flag is intended for development purposes.")
                                                    (substring x 1)
                                                  "'"))
                                             replaced)))
-                             (yaml--add-event (yaml--scalar-event "single" 
replaced)))))
+                             (yaml--add-event (yaml--scalar-event "single" 
(substring replaced 1 (1- (length replaced))))))))
     ("c-double-quoted" . (lambda (text)
                            (let* ((replaced (replace-regexp-in-string
                                              "\\(?:[ \t]*\r?\n[ \t]*\\)"
@@ -536,12 +558,13 @@ This flag is intended for development purposes.")
     ("e-scalar" . (lambda (text)
                     (yaml--add-event (yaml--scalar-event "plain" ""))))
     ("c-ns-anchor-property" . (lambda (text)
-                                (setq yaml--anchor (substring text 1))))
+                                (yaml--anchor-event (substring text 1))))
     ("c-ns-tag-property" . (lambda (text)
                              ;; (error "not implemented: %s" text)
                              ))
     ("c-ns-alias-node" . (lambda (text)
-                           (yaml--add-event (yaml--alias-event (substring text 
1)))))))
+                           (yaml--add-event (yaml--alias-event (substring text 
1)))))
+    ))
 
 (defun yaml--walk-events (tree)
   "Event walker iterates over the parse TREE and signals events based off of 
the parsed rules."
@@ -561,7 +584,6 @@ This flag is intended for development purposes.")
       (yaml--walk-events (car tree))
       (yaml--walk-events (cdr tree)))))
 
-
 (defmacro yaml--frame (name rule)
   "Add a new state frame of NAME for RULE."
   (declare (indent defun))
@@ -877,6 +899,8 @@ value.  It defaults to the symbol :false."
   (setq yaml--object-stack nil)
   (setq yaml--state-stack nil)
   (setq yaml--root nil)
+  (setq yaml--anchor-mappings (make-hash-table :test 'equal))
+  (setq yaml--resolve-aliases nil)
   (let ((object-type (plist-get args :object-type))
         (sequence-type (plist-get args :sequence-type))
         (null-object (plist-get args :null-object))
@@ -906,7 +930,10 @@ value.  It defaults to the symbol :false."
         (error (format "parser finished before end of input %s/%s"
                        yaml--parsing-position
                        (length yaml--parsing-input))))
-      (message "Parsed data: %s" (pp-to-string res))
+      (when yaml--parse-debug (message "Parsed data: %s" (pp-to-string res)))
+      (yaml--walk-events res)
+      (setq yaml--root nil)
+      (setq yaml--resolve-aliases t)
       (yaml--walk-events res)
       yaml--root)))