Commits

camlspotter committed 1a5c9d8 Draft

my changes

  • Participants
  • Parent commits 744a334

Comments (0)

Files changed (5)

+^.*\.(cm.*|a|o|annot|omc)$
+^lib/META$
+.*~$
+SOURCES[]=
+  lib/META.template
+  lib/Makefile
+  lib/pa_json_tc.ml
+
+$(Installed json-tc-custom): $(Installed type-conv) $(SOURCES)
+  (cd lib/; make uninstall all install; spotinstall json-tc-custom)
+  CreateInstalled(json-tc-custom, $(find $(OCAMLFIND_DESTDIR)$(DIRSEP)json-tc-custom -f {}))
+
+clean:
+  (cd lib; make clean)

README.custom.rst

+==========================================
+JSON type-conv custom
+==========================================
+
+caml field and CAML constructor names
+==========================================
+
+To work with Json names which are OCaml registered keywords like "type",
+uppercase field names, and lowercase tag names, a special handling
+is introduced for OCaml record fields and constructors which start 
+with "caml_" and "CAML_" respectively::
+
+  type t = CAML_text with json (* in Json, not "CAML_text" but "text" *)
+
+  type r = { caml_type : t } with json (* in Json, not "caml_type" but "type" *)
+
+optional type
+==========================================
+
+Data type name "optional" in OCaml record field type is specially handled. 
+It works as the option type, but the field can be really optional. The field
+need not to exist in Json fields at Json => OCaml translation.
+
+  type 'a optional = 'a option (* You need to declare this alias *)
+
+  type r = { id : Id.t;  (* mandatory field *)
+             source_url : string optional; (* if not exists in Json, None in OCaml *)
+           } with json
+
+  CR jfuruse: No OCaml => Json handling of optional is considered yet.
 	ocamlfind ocamlc -package type-conv -c -pp "$(CAMLP4ORF)" -annot -g -I +camlp4 pa_json_tc.ml
 
 install: META
-	ocamlfind install json-tc META pa_json_tc.cmi pa_json_tc.cmo
+	ocamlfind install json-tc-custom META pa_json_tc.cmi pa_json_tc.cmo
 
 META: META.template Makefile
 	echo 'version = "$(VERSION)"' > META
 	cat META.template >> META
 
 uninstall:
-	ocamlfind remove json-tc
+	ocamlfind remove json-tc-custom
 
 clean:
-	rm -f *.ppo *.ppr *.cmo *.cmi *.o *.cmx *.ast *~ *.auto *.annot META
+	rm -f *.ppo *.ppr *.cmo *.cmi *.cm* *.o *.cmx *.ast *~ *.auto *.annot META

lib/pa_json_tc.ml

     | <:ctyp< $lid:id$ : $t$ >> ->  fnt ~mut:false ~id ~t
     | other -> type_fail other "process_fields: unexpected AST"
   and fnt ~mut ~id ~t =
-    [ { field_caml_name = id; field_json_name = id;
+    let field_json_name = if try String.sub id 0 5 = "caml_" with _ -> false then String.sub id 5 (String.length id - 5) else id in
+    let optional, t = match t with
+      | <:ctyp< optional $t$ >> -> true, <:ctyp< option $t$ >>
+      | _ -> false, t
+    in
+    [ { field_caml_name = id; field_json_name;
         field_type = (_loc, process_td _loc t);
         field_caml_loc = _loc; field_json_loc = _loc;
-        optional = false; default=None; is_mutable = mut } ]
+        optional; default=None; is_mutable = mut } ]
   in fn cs
 
 and process_constructor _loc rf =
   List.map (function
     | <:ctyp< `$uid:id$ of $t$ >> 
     | <:ctyp< $uid:id$ of $t$ >> ->
+       
        let cons_args = List.map (fun x -> _loc, process_td _loc x) (Ast.list_of_ctyp t []) in
-       { cons_caml_name=id; cons_json_name=id; cons_caml_loc=_loc;
+       let cons_json_name = if try String.sub id 0 5 = "CAML_" with _ -> false then String.sub id 5 (String.length id - 5) else id in
+       { cons_caml_name=id; cons_json_name; cons_caml_loc=_loc;
          cons_json_loc=_loc; cons_args=cons_args }
     | <:ctyp< `$uid:id$ >> 
     | <:ctyp< $uid:id$ >> ->
-       { cons_caml_name=id; cons_json_name=id; cons_caml_loc=_loc;
+       let cons_json_name = if try String.sub id 0 5 = "CAML_" with _ -> false then String.sub id 5 (String.length id - 5) else id in
+       { cons_caml_name=id; cons_json_name; cons_caml_loc=_loc;
          cons_json_loc=_loc; cons_args=[] }
     | other -> type_fail other "process_constructor: unexpected AST"
   ) (Ast.list_of_ctyp rf [])