[Emacs-diffs] dynamic-modules 18920eb 19/22: new yaml parsing module using libyaml

[Teodor Zlatanov]

branch: dynamic-modules
commit 18920eb64c4cbb990150c871fd204c745df8f7ee
Author: Aurélien Aptel <address@hidden>
Date:   Sun Nov 23 21:34:11 2014 +0100

    new yaml parsing module using libyaml
---
 modules/yaml/Makefile         |   15 +++
 modules/yaml/tests/alias.yaml |   14 +++
 modules/yaml/tests/map.yaml   |    4 +
 modules/yaml/tests/multi.yaml |   16 +++
 modules/yaml/tests/nest.yaml  |   12 +++
 modules/yaml/tests/scal.yaml  |    2 +
 modules/yaml/tests/seq.yaml   |    5 +
 modules/yaml/yaml-test.el     |   24 +++++
 modules/yaml/yaml.c           |  212 +++++++++++++++++++++++++++++++++++++++++
 9 files changed, 304 insertions(+), 0 deletions(-)

diff --git a/modules/yaml/Makefile b/modules/yaml/Makefile
new file mode 100644
index 0000000..32f61e9
--- /dev/null
+++ b/modules/yaml/Makefile
@@ -0,0 +1,15 @@
+ROOT = ../..
+
+CFLAGS  = `pkg-config yaml-0.1 --cflags`
+LDFLAGS = `pkg-config yaml-0.1 --libs`
+
+all: yaml.so yaml.doc
+
+%.so: %.o
+       gcc -shared $(LDFLAGS) -o $@ $<
+
+%.o: %.c
+       gcc -ggdb3 -Wall -I$(ROOT)/src -I$(ROOT)/lib $(CFLAGS) -fPIC -c $<
+
+%.doc: %.c
+       $(ROOT)/lib-src/make-docfile $< > $@
diff --git a/modules/yaml/tests/alias.yaml b/modules/yaml/tests/alias.yaml
new file mode 100644
index 0000000..c3dade3
--- /dev/null
+++ b/modules/yaml/tests/alias.yaml
@@ -0,0 +1,14 @@
+---
+invoice: 34843
+date   : 2001-01-23
+bill-to: &id001
+    given  : Chris
+    family : Dumars
+    address:
+        lines: |
+            458 Walkman Dr.
+            Suite #292
+        city    : Royal Oak
+        state   : MI
+        postal  : 48046
+ship-to: *id001
diff --git a/modules/yaml/tests/map.yaml b/modules/yaml/tests/map.yaml
new file mode 100644
index 0000000..4021d74
--- /dev/null
+++ b/modules/yaml/tests/map.yaml
@@ -0,0 +1,4 @@
+---
+a: 1
+b: 2
+c: 3
diff --git a/modules/yaml/tests/multi.yaml b/modules/yaml/tests/multi.yaml
new file mode 100644
index 0000000..1eb61f7
--- /dev/null
+++ b/modules/yaml/tests/multi.yaml
@@ -0,0 +1,16 @@
+---
+a: 1
+b:
+    - 1
+    - 2
+    - 3
+---
+foo:
+    bar: 1
+    baz: 2
+    bad: 3
+zob:
+    - 42
+    - 43
+---
+abc
diff --git a/modules/yaml/tests/nest.yaml b/modules/yaml/tests/nest.yaml
new file mode 100644
index 0000000..8a453df
--- /dev/null
+++ b/modules/yaml/tests/nest.yaml
@@ -0,0 +1,12 @@
+---
+product:
+    - sku         : BL394D
+      quantity    : 4
+      description : Basketball
+      price       : 450.00
+    - sku         : BL4438H
+      quantity    : 1
+      description : Super Hoop
+      price       : 2392.00
+tax  : 251.42
+total: 4443.52
diff --git a/modules/yaml/tests/scal.yaml b/modules/yaml/tests/scal.yaml
new file mode 100644
index 0000000..aecd198
--- /dev/null
+++ b/modules/yaml/tests/scal.yaml
@@ -0,0 +1,2 @@
+---
+abc
diff --git a/modules/yaml/tests/seq.yaml b/modules/yaml/tests/seq.yaml
new file mode 100644
index 0000000..15b6a9e
--- /dev/null
+++ b/modules/yaml/tests/seq.yaml
@@ -0,0 +1,5 @@
+---
+- abc
+- def
+- ghi
+- jkl
diff --git a/modules/yaml/yaml-test.el b/modules/yaml/yaml-test.el
new file mode 100644
index 0000000..5f9b5c0
--- /dev/null
+++ b/modules/yaml/yaml-test.el
@@ -0,0 +1,24 @@
+
+(defun yaml-expand-file (file)
+  (if (not (string-match-p "/" file))
+      (expand-file-name
+       (concat "~/prog/c/emacs/dyn/modules/yaml/tests/" file))
+    file))
+
+(defun yaml-test-file (file)
+  (require 'yaml)
+  (require 'json)
+  (with-current-buffer (get-buffer-create "out")
+    (erase-buffer)
+    (insert (json-encode (yaml-parse-file (yaml-expand-file file))))
+    (json-pretty-print (point-min) (point-max))))
+
+(defun yaml-test-buffer (file)
+  (require 'yaml)
+  (require 'json)
+  (with-current-buffer (get-buffer-create "out")
+    (erase-buffer)
+    (insert (json-encode (with-temp-buffer
+                           (insert-file-contents (yaml-expand-file file))
+                           (yaml-parse))))
+    (json-pretty-print (point-min) (point-max))))
diff --git a/modules/yaml/yaml.c b/modules/yaml/yaml.c
new file mode 100644
index 0000000..4096205
--- /dev/null
+++ b/modules/yaml/yaml.c
@@ -0,0 +1,212 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <yaml.h>
+
+
+#include <config.h>
+#include <lisp.h>
+
+#include <character.h> /* buffer.h needs it */
+#include <buffer.h>
+
+int plugin_is_GPL_compatible;
+static Lisp_Object Qyaml;
+
+typedef unsigned char uchar;
+
+struct context
+{
+  yaml_parser_t p;
+  int error;
+  Lisp_Object anchors; /* hashtable mapping alias to values */
+};
+
+static Lisp_Object parse_scalar (struct context *ctx, yaml_event_t *e);
+static Lisp_Object parse_sequence (struct context *ctx, yaml_event_t *e);
+static Lisp_Object parse_mapping (struct context *ctx, yaml_event_t *e);
+
+static Lisp_Object
+parse_element (struct context *ctx)
+{
+  Lisp_Object res = Qnil;
+  yaml_event_t e;
+
+ redo:
+  yaml_parser_parse (&ctx->p, &e);
+  const char *s = (char*)e.data.alias.anchor;
+
+  switch (e.type)
+    {
+    case YAML_STREAM_START_EVENT:
+      /* a stream is a sequence of documents */
+      res = parse_sequence (ctx, &e);
+      break;
+
+    case YAML_DOCUMENT_START_EVENT:
+    case YAML_DOCUMENT_END_EVENT:
+      /* keep reading */
+      yaml_event_delete (&e);
+      goto redo;
+
+    case YAML_ALIAS_EVENT:
+      res = Fgethash (make_string (s, strlen (s)), ctx->anchors, Qnil);
+      break;
+
+    case YAML_SCALAR_EVENT:
+      res = parse_scalar (ctx, &e);
+      if (s)
+          Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
+      break;
+
+    case YAML_SEQUENCE_START_EVENT:
+      res = parse_sequence (ctx, &e);
+      if (s)
+        Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
+      break;
+
+    case YAML_MAPPING_START_EVENT:
+      res = parse_mapping (ctx, &e);
+      if (s)
+        Fputhash (make_string (s, strlen (s)), res, ctx->anchors);
+      break;
+
+    case YAML_NO_EVENT:
+    case YAML_MAPPING_END_EVENT:
+    case YAML_SEQUENCE_END_EVENT:
+    case YAML_STREAM_END_EVENT:
+      res = Qnil;
+      break;
+    }
+
+  yaml_event_delete (&e);
+  return res;
+}
+
+static Lisp_Object
+parse_scalar (struct context *ctx, yaml_event_t *e)
+{
+  return make_string ((char*)e->data.scalar.value, e->data.scalar.length);
+}
+
+static Lisp_Object
+parse_sequence (struct context *ctx, yaml_event_t *e)
+{
+  /* always >= 1 elements in sequence */
+  Lisp_Object cons = Fcons (parse_element (ctx), Qnil);
+  Lisp_Object res = cons;
+
+  while (1)
+    {
+      Lisp_Object e = parse_element (ctx);
+
+      if (NILP (e))
+        break;
+
+      XSETCDR (cons, Fcons(e, Qnil));
+      cons = XCDR (cons);
+    }
+
+  return res;
+}
+
+static Lisp_Object
+parse_mapping (struct context *ctx, yaml_event_t *e)
+{
+  Lisp_Object args[2];
+  args[0] = QCtest;
+  args[1] = Qequal;
+  Lisp_Object res = Fmake_hash_table (2, args);
+
+  while (1)
+    {
+      Lisp_Object key = parse_element (ctx);
+
+      if (NILP (key))
+        break;
+
+      Lisp_Object val = parse_element (ctx);
+
+      Fputhash (key, val, res);
+    }
+
+  return res;
+}
+
+static void
+context_init (struct context *ctx)
+{
+  memset (ctx, 0, sizeof (*ctx));
+  Lisp_Object args[2];
+  args[0] = QCtest;
+  args[1] = Qequal;
+  ctx->anchors = Fmake_hash_table (2, args);
+}
+
+EXFUN (Fyaml_parse, 0);
+DEFUN ("yaml-parse", Fyaml_parse, Syaml_parse, 0, 0, 0,
+       doc: "Parse current buffer as yaml.")
+  (void)
+{
+  struct context ctx;
+  Lisp_Object res = Qnil;
+
+  context_init (&ctx);
+
+  yaml_parser_initialize (&ctx.p);
+  yaml_parser_set_input_string (&ctx.p, BYTE_POS_ADDR (BEGV_BYTE), ZV_BYTE - 
BEGV_BYTE);
+  res = parse_element (&ctx);
+  yaml_parser_delete (&ctx.p);
+
+  return res;
+}
+
+
+EXFUN (Fyaml_parse_file, 1);
+DEFUN ("yaml-parse-file", Fyaml_parse_file, Syaml_parse_file, 1, 1, 0,
+       doc: "Parse FILE as yaml.")
+  (Lisp_Object file)
+{
+  struct gcpro gcpro1;
+  struct context ctx;
+
+  context_init (&ctx);
+
+  int r;
+  FILE *fh;
+  Lisp_Object res = Qnil;
+
+  fh = fopen((char*)SDATA (file), "r");
+
+  if (!fh)
+    goto out;
+
+  r = yaml_parser_initialize (&ctx.p);
+
+  if (!r)
+    goto out_close;
+
+  yaml_parser_set_input_file (&ctx.p, fh);
+
+  GCPRO1 (ctx.anchors);
+  res = parse_element (&ctx);
+  UNGCPRO;
+
+  yaml_parser_delete (&ctx.p);
+
+ out_close:
+  fclose (fh);
+
+ out:
+  return res;
+}
+
+void init ()
+{
+  DEFSYM (Qyaml, "yaml");
+
+  defsubr (&Syaml_parse_file);
+  defsubr (&Syaml_parse);
+
+  Fprovide (Qyaml, Qnil);
+}