branch: externals/yaml
commit 2e2e7d199ec94f5db0a12f3e558d4b13aaffb852
Author: Zachary Romero <zacrom...@posteo.net>
Commit: Zachary Romero <zacrom...@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)))
