aboutsummaryrefslogtreecommitdiff
path: root/json.c
diff options
context:
space:
mode:
Diffstat (limited to 'json.c')
-rw-r--r--json.c112
1 files changed, 112 insertions, 0 deletions
diff --git a/json.c b/json.c
new file mode 100644
index 0000000..9504e35
--- /dev/null
+++ b/json.c
@@ -0,0 +1,112 @@
+#include <cjson/cJSON.h>
+#include <libguile.h>
+
+#include <sys/mman.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+static SCM json_type;
+
+static inline void assert_json (SCM item)
+ { scm_assert_foreign_object_type (json_type, item); }
+static inline cJSON* to_json (SCM item)
+ { return scm_foreign_object_ref (item, 0); }
+static inline SCM from_json (cJSON* item)
+ { return scm_make_foreign_object_1 (json_type, item); }
+
+SCM_DEFINE (parse_json, "parse-json", 1, 0, 0,
+ (SCM filename),
+ "")
+{
+ char* fname = scm_to_utf8_stringn (filename, NULL);
+
+ int fd = open(fname, O_RDONLY);
+ struct stat sb;
+ fstat(fd, &sb);
+ const char* buf = mmap(NULL, sb.st_size, PROT_READ, MAP_SHARED, fd, 0);
+
+ return from_json (cJSON_Parse(buf));
+}
+
+SCM json_to_scheme (cJSON* j) {
+ cJSON* node;
+ switch (j->type) {
+ case cJSON_Invalid:
+ return scm_from_utf8_symbol("invalid");
+
+ case cJSON_False:
+ return SCM_BOOL_F;
+
+ case cJSON_True:
+ return SCM_BOOL_T;
+
+ case cJSON_NULL:
+ return SCM_EOL;
+
+ case cJSON_Number:
+ return scm_values(scm_list_2(
+ scm_from_int(j->valueint),
+ scm_from_double(j->valuedouble)));
+
+ case cJSON_String:
+ return scm_from_utf8_string(j->valuestring);
+
+ case cJSON_Array:
+ node = j->child;
+
+ SCM list = SCM_EOL;
+ while (node != NULL) {
+ list = scm_cons(json_to_scheme(node), list);
+ node = node->next;
+ }
+ return scm_vector(scm_reverse_x (list, SCM_EOL));
+
+ case cJSON_Object:
+ node = j->child;
+ SCM table = scm_c_eval_string ("(make-hash-table)");
+ while (node->next != NULL) {
+ scm_hashq_set_x (table,
+ scm_from_utf8_symbol(node->string),
+ json_to_scheme(node));
+ node = node->next;
+ }
+ return table;
+
+
+ case cJSON_Raw:
+ return scm_from_utf8_symbol("raw");
+ }
+
+ return scm_from_utf8_symbol("nocase");
+}
+
+SCM_DEFINE(json_to_scheme_, "json->scm", 1, 0, 0,
+ (SCM json),
+ "")
+{
+ assert_json(json);
+ cJSON* j = to_json(json);
+
+ return json_to_scheme (j);
+}
+
+static void finilize_json (SCM json) {
+ cJSON* j = to_json(json);
+ cJSON_Delete (j);
+}
+
+static void init_json_type (void) {
+ SCM name = scm_from_utf8_symbol("json");
+ SCM slot = scm_list_1(scm_from_utf8_symbol("data"));
+ scm_t_struct_finalize finilizer = finilize_json;;
+ json_type = scm_make_foreign_object_type (name, slot, finilizer);
+}
+
+void init_json (void) {
+ init_json_type ();
+
+#ifndef SCM_MAGIC_SNARFER
+#include "json.x"
+#endif
+}