This is an automated email from the git hooks/post-receive script. glondu pushed a commit to branch master in repository atdgen.
commit 7137770108884a8b4488e4d6a0c35a901dccce23 Author: Stephane Glondu <st...@glondu.net> Date: Thu Jan 28 09:51:50 2016 +0100 Imported Upstream version 1.6.1 --- src/Makefile | 2 +- src/ag_mapping.ml | 27 +++++++++++++++++++++++++++ src/ag_ocaml.ml | 2 ++ src/ag_oj_emit.ml | 37 +++++++++++++++++++++++++------------ src/ag_oj_run.ml | 20 ++++++++++---------- test/test.atd | 2 ++ 6 files changed, 67 insertions(+), 23 deletions(-) diff --git a/src/Makefile b/src/Makefile index 34916c7..0b064dd 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,4 +1,4 @@ -VERSION = 1.6.0 +VERSION = 1.6.1 ifeq "$(shell ocamlc -config |grep os_type)" "os_type: Win32" EXE=.exe else diff --git a/src/ag_mapping.ml b/src/ag_mapping.ml index df16bb3..e4ac141 100644 --- a/src/ag_mapping.ml +++ b/src/ag_mapping.ml @@ -181,3 +181,30 @@ let make_deref Env.empty (flatten l) in fun x -> deref_expr defs [] x + +(* + Resolve names and unwrap `wrap` constructs + (discarding annotations along the way) +*) +let rec unwrap (deref: ('a, 'b) mapping -> ('a, 'b) mapping) x = + match deref x with + | `Wrap (loc, x, a, b) -> unwrap deref x + | x -> x + +(* This is for debugging *) +let constructor : ('a, 'b) mapping -> string = function + | `Unit _ -> "Unit" + | `Bool _ -> "Bool" + | `Int _ -> "Int" + | `Float _ -> "Float" + | `String _ -> "String" + | `Sum _ -> "Sum" + | `Record _ -> "Record" + | `Tuple _ -> "Tuple" + | `List _ -> "List" + | `Option _ -> "Option" + | `Nullable _ -> "Nullable" + | `Wrap _ -> "Wrap" + | `Name (loc, name, _, _, _) -> "Name " ^ name + | `External _ -> "External" + | `Tvar _ -> "Tvar" diff --git a/src/ag_ocaml.ml b/src/ag_ocaml.ml index 6caab85..41ba52b 100644 --- a/src/ag_ocaml.ml +++ b/src/ag_ocaml.ml @@ -412,6 +412,8 @@ let rec ocaml_of_expr_mapping (x : (atd_ocaml_repr, _) mapping) : ocaml_expr = `Name ("option", [ocaml_of_expr_mapping x]) | `Nullable (loc, x, `Nullable, _) -> `Name ("option", [ocaml_of_expr_mapping x]) + | `Wrap _ -> + assert false | `Name (loc, s, l, _, _) -> `Name (s, List.map ocaml_of_expr_mapping l) | `Tvar (loc, s) -> diff --git a/src/ag_oj_emit.ml b/src/ag_oj_emit.ml index 5bb30ec..b63a322 100644 --- a/src/ag_oj_emit.ml +++ b/src/ag_oj_emit.ml @@ -113,16 +113,25 @@ val %s_of_string :%s ) (flatten defs) +let is_json_string deref x = + (* + Calling 'unwrap' allows us to ignore 'wrap' constructors + and determine that the JSON representation is a string. + This assumes that no '<json>' annotation imposes + another representation for the JSON string. + *) + match Ag_mapping.unwrap deref x with + | `String _ -> true + | _ -> false (* or maybe we just don't know *) + let get_assoc_type deref loc x = match deref x with - `Tuple (loc2, [| k; v |], `Tuple, `Tuple) -> - (match deref k.cel_value with - `String _ -> () - | _ -> - error loc "Due to <json repr=\"object\"> keys must be strings"); - v.cel_value - | _ -> - error loc "Expected due to <json repr=\"object\">: (string * _) list" + | `Tuple (loc2, [| k; v |], `Tuple, `Tuple) -> + if not (is_json_string deref k.cel_value) then + error loc "Due to <json repr=\"object\"> keys must be strings"; + (k.cel_value, v.cel_value) + | _ -> + error loc "Expected due to <json repr=\"object\">: (string * _) list" let nth name i len = @@ -515,7 +524,7 @@ let rec make_writer p (x : oj_mapping) : Ag_indent.t list = ] | `Object -> - let x = get_assoc_type p.deref loc x in + let k, v = get_assoc_type p.deref loc x in let write = match o with `List -> "Ag_oj_run.write_assoc_list (" @@ -523,7 +532,9 @@ let rec make_writer p (x : oj_mapping) : Ag_indent.t list = in [ `Line write; - `Block (make_writer p x); + `Block (make_writer p k); + `Line ") ("; + `Block (make_writer p v); `Line ")"; ] ) @@ -951,7 +962,7 @@ let rec make_reader p type_annot (x : oj_mapping) : Ag_indent.t list = ] | `Object -> - let x = get_assoc_type p.deref loc x in + let k, v = get_assoc_type p.deref loc x in let read = match o with `List -> "Ag_oj_run.read_assoc_list (" @@ -959,7 +970,9 @@ let rec make_reader p type_annot (x : oj_mapping) : Ag_indent.t list = in [ `Line read; - `Block (make_reader p None x); + `Block (make_reader p None k); + `Line ") ("; + `Block (make_reader p None v); `Line ")"; ] ) diff --git a/src/ag_oj_run.ml b/src/ag_oj_run.ml index a10ff6b..d5aced6 100644 --- a/src/ag_oj_run.ml +++ b/src/ag_oj_run.ml @@ -57,21 +57,21 @@ let write_array write_item ob a = array_iter write_item write_comma ob a; Bi_outbuf.add_char ob ']' -let write_assoc_list write_item ob l = +let write_assoc_list write_key write_item ob l = Bi_outbuf.add_char ob '{'; list_iter ( fun ob (k, v) -> - Yojson.Safe.write_string ob k; + write_key ob k; Bi_outbuf.add_char ob ':'; write_item ob v ) write_comma ob l; Bi_outbuf.add_char ob '}' -let write_assoc_array write_item ob l = +let write_assoc_array write_key write_item ob l = Bi_outbuf.add_char ob '{'; array_iter ( fun ob (k, v) -> - Yojson.Safe.write_string ob k; + write_key ob k; Bi_outbuf.add_char ob ':'; write_item ob v ) write_comma ob l; @@ -160,13 +160,13 @@ let read_array read_item p lb = Yojson.Safe.read_space p lb; Yojson.Safe.read_array read_item p lb -let read_assoc_list_rev read_item p lb = +let read_assoc_list_rev read_key read_item p lb = Yojson.Safe.read_space p lb; let read acc k p lb = (k, read_item p lb) :: acc in - Yojson.Safe.read_fields read [] p lb + Yojson.Safe.read_abstract_fields read_key read [] p lb -let read_assoc_list read_item p lb = - List.rev (read_assoc_list_rev read_item p lb) +let read_assoc_list read_key read_item p lb = + List.rev (read_assoc_list_rev read_key read_item p lb) let array_of_rev_list l = match l with @@ -181,8 +181,8 @@ let array_of_rev_list l = done; a -let read_assoc_array read_item p lb = - array_of_rev_list (read_assoc_list_rev read_item p lb) +let read_assoc_array read_key read_item p lb = + array_of_rev_list (read_assoc_list_rev read_key read_item p lb) let read_until_field_value p lb = Yojson.Safe.read_space p lb; diff --git a/test/test.atd b/test/test.atd index 4546f29..29e7fe0 100644 --- a/test/test.atd +++ b/test/test.atd @@ -183,6 +183,8 @@ type id = string <ocaml validator="fun path x -> assert false"> wrap `Id \"\" -> failwith \"empty\" | _ -> None"> +type json_map = (id * int) list <json repr="object"> + type natural = int wrap <ocaml module="Test_lib.Natural"> type even_natural = natural wrap <ocaml module="Test_lib.Even_natural"> -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/atdgen.git _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits