From e5208d2e2068f1882098bb36f6410e6de1333514 Mon Sep 17 00:00:00 2001 From: mjambon Date: Thu, 3 Sep 2009 11:46:56 +0000 Subject: [PATCH] Fixed bug introduced in the previous bugfix: "predefined" ignored in the first definition of a group of type definitions. + some package cleanup. --- json-static/META.template | 2 - json-static/Makefile | 4 +- json-static/check.ml | 72 --------------------------- json-static/pa_json_static.ml.310 | 7 ++- json-static/run_json_static.ml | 82 ------------------------------- json-static/run_json_static.mli | 53 -------------------- 6 files changed, 5 insertions(+), 215 deletions(-) delete mode 100644 json-static/run_json_static.ml delete mode 100644 json-static/run_json_static.mli diff --git a/json-static/META.template b/json-static/META.template index 94f46bf..5c96469 100644 --- a/json-static/META.template +++ b/json-static/META.template @@ -3,5 +3,3 @@ description = "statically-typed JSON data" requires = "camlp4 json-wheel" archive(syntax,toploop) = "pa_json_static.cmo" archive(syntax,preprocessor) = "pa_json_static.cmo" -archive(byte) = "run_json_static.cmo" -archive(native) = "run_json_static.cmx" diff --git a/json-static/Makefile b/json-static/Makefile index 807c874..dbf0176 100644 --- a/json-static/Makefile +++ b/json-static/Makefile @@ -1,6 +1,6 @@ include Camlp4Version -VERSION = 0.9.7 +VERSION = 0.9.8 export VERSION @@ -39,7 +39,7 @@ check: > check.mli.auto ocamlfind ocamlopt -o check -package json-wheel -linkpkg \ -pp 'camlp4o -I . $(PARSER) pa_json_static.cmo' \ - run_json_static.cmx check.ml + check.ml ./check install: META ocamlfind install json-static META \ diff --git a/json-static/check.ml b/json-static/check.ml index 370609e..19bac81 100644 --- a/json-static/check.ml +++ b/json-static/check.ml @@ -33,75 +33,3 @@ and b = int type json c = (string * d * d) list and d = [ `A ] - -(******************* Main example with runtime test **********************) -(* -module Custom = -struct - type t = int - let of_json = Json_type.Browse.int - let to_json = Json_type.Build.int - let typedef = Run_json_static.Int -end - - -type json t = < x: int list list; - y: z; - assoc: (string * int) assoc; - ?opt1: string option; - ?opt2: string = "abc" > -and z = [ `A - | `B "b!" of bool - | `C of (Json_type.json_type * (string, number) Hashtbl.t) - | `Custom of (Custom.t * int array * z * z) ] - - -(* Another type that accepts exactly the same data *) -type json t2 = { x: int list list; - y: z2; - assoc: (string * int) assoc; - ?opt1: string option; - ?opt2: string = "abc" } -and z2 = - A - | B "b!" of bool - | C of (Json_type.json_type * (string, number) Hashtbl.t) - | Custom of (Custom.t * int array * z2 * z2) - - -let sample = " -{ \"x\" : [ [1], [2, 3] ], - \"y\" : [ \"Custom\", - [ 123, - [ 4, 5, 6 ], - [ \"b!\", true ], - [ \"C\", [ null, { \"a\" : 100, - \"b\" : 3.14 } ] ] ] ], - \"assoc\": { \"x1\": 1, \"x2\": 2, \"x3\": 3 } -} -" - -let json = Json_io.json_of_string sample -let obj = t_of_json json -let json' = json_of_t obj -let sample' = Json_io.string_of_json json' - -let json2 = Json_io.json_of_string sample -let obj2 = t2_of_json json -let json2' = json_of_t2 obj2 -let sample2' = Json_io.string_of_json json2' - - - -let _ = - print_endline sample'; - assert (sample' = sample2'); - assert (json' = json2'); - - (match obj#y with - `Custom (_, _, _, `C (_, tbl)) -> - (try assert (Hashtbl.find tbl "a" = 100.) - with Not_found -> assert false); - | _ -> assert false); - print_endline "Passed!" -*) diff --git a/json-static/pa_json_static.ml.310 b/json-static/pa_json_static.ml.310 index da70bfb..c26bc47 100644 --- a/json-static/pa_json_static.ml.310 +++ b/json-static/pa_json_static.ml.310 @@ -219,6 +219,7 @@ let make_typedef _loc names l = | Raw -> <:ctyp< Json_type.t >> | Custom s -> <:ctyp< $uid:s$ . t >> in + let l = List.filter (fun (_, x) -> not x.is_predefined) l in match l with [] -> <:str_item< >> | ((_loc, name), x) :: l -> @@ -227,10 +228,8 @@ let make_typedef _loc names l = let dcl = Ast.TyDcl (_loc, name, [], convert x.def, []) in List.fold_right ( fun ((_loc, name), x) acc -> - if x.is_predefined then acc - else - let dcl = Ast.TyDcl (_loc, name, [], convert x.def, []) in - <:ctyp< $dcl$ and $acc$ >> + let dcl = Ast.TyDcl (_loc, name, [], convert x.def, []) in + <:ctyp< $dcl$ and $acc$ >> ) l dcl in <:str_item< type $tdl$ >> diff --git a/json-static/run_json_static.ml b/json-static/run_json_static.ml deleted file mode 100644 index e6789bf..0000000 --- a/json-static/run_json_static.ml +++ /dev/null @@ -1,82 +0,0 @@ -(* - Runtime library for json-static. - - Author: Martin Jambon - -Copyright (c) 2007 Wink Technologies Inc. -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. The name of the author may not be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES -OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. -IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*) - -module Dynlist = -struct - type t = unit -> Json_type.t list - let to_json x = Json_type.Array (x ()) - let of_json x = - let l = Json_type.Browse.array x in - (fun () -> l) -end - -type json field = { field_caml_name : string; - field_json_name : string; - field_type : t; - optional : bool; - json_default : Json_type.t option; - json_subset : json_subset option; - is_mutable : bool } - -and json_subset = - [ `List of Json_type.t list - | `Dynlist of Dynlist.t - | `Abstract_set ] - -and constructor = { cons_caml_name : string; - cons_json_name : string; - cons_args : t list } - -and t = - List of t - | Array of t - | Option of t - | Object of field list - | Record of field list - | Hashtbl of t - | Assoc of t - | Tuple of t list - | Variant of constructor list - | Poly of constructor list - | Name of string - | String - | Bool - | Int - | Float - | Number - | Raw - - -and typedef = { typename : string; - def : t; - is_predefined : bool; - is_private : bool } - diff --git a/json-static/run_json_static.mli b/json-static/run_json_static.mli deleted file mode 100644 index b50570a..0000000 --- a/json-static/run_json_static.mli +++ /dev/null @@ -1,53 +0,0 @@ -type field = { - field_caml_name : string; - field_json_name : string; - field_type : t; - optional : bool; - json_default : Json_type.t option; - json_subset : json_subset option; - is_mutable : bool; -} -and json_subset = - [ `Abstract_set - | `Dynlist of unit -> Json_type.t list - | `List of Json_type.t list ] -and constructor = { - cons_caml_name : string; - cons_json_name : string; - cons_args : t list; -} -and t = - List of t - | Array of t - | Option of t - | Object of field list - | Record of field list - | Hashtbl of t - | Assoc of t - | Tuple of t list - | Variant of constructor list - | Poly of constructor list - | Name of string - | String - | Bool - | Int - | Float - | Number - | Raw -and typedef = { - typename : string; - def : t; - is_predefined : bool; - is_private : bool; -} -val __json_static_error : Json_type.t -> string -> 'a -val field_of_json : Json_type.t -> field -val json_subset_of_json : Json_type.t -> json_subset -val constructor_of_json : Json_type.t -> constructor -val t_of_json : Json_type.t -> t -val typedef_of_json : Json_type.t -> typedef -val json_of_field : field -> Json_type.t -val json_of_json_subset : json_subset -> Json_type.t -val json_of_constructor : constructor -> Json_type.t -val json_of_t : t -> Json_type.t -val json_of_typedef : typedef -> Json_type.t