camlspotter avatar camlspotter committed 3ccb715 Draft

meta_conv

Comments (0)

Files changed (4)

 name = "json-wheel"
 version = "1.0.6"
 description = "JSON data format"
-requires = "ulib,unix"
+requires = "ulib"
 archive(byte)    = "jsonwheel.cma"
 archive(native)  = "jsonwheel.cmxa"
   json_parser.mli json_parser.mly \
   json_lexer.mll \
   json_io.mli json_io.ml \
-  json_compat.ml
+  json_compat.ml \
+  json_wrap.ml
 
 PACKS = ulib,unix
 
   json_io.mli
   json_io.ml
   json_compat.ml
+  json_wrap.ml
 
 $(Installed json-wheel): $(Installed ulib) $(SOURCES)
   ocamlfind remove json-wheel
+module Json = struct
+  type t = Json_type.json_type =
+      | Object of (string * t) list
+      | Array of t list
+      | String of string
+      | Int of int
+      | Float of float
+      | Bool of bool
+      | Null
+end
+
+open Json
+
+module Json_conv = struct
+  module Encode = struct
+    let int n       = Float (float n)
+    let int32 n     = Float (Int32.to_float n)
+    let int64 n     = Float (Int64.to_float n)
+    let nativeint n = Float (Nativeint.to_float n)
+    let char c      = String (String.make 1 c)
+    let string s    = String s
+    let float n     = Float (float n)
+    let list f xs   = Array (List.map f xs)
+    let array f xs  = Array (List.map f (Array.to_list xs))
+    let bool b      = Bool b
+    let lazy_t f v  = f (Lazy.force v)
+    let option f    = function
+      | None -> Null
+      | Some v -> f v
+  
+    let tuple ts       = Array ts
+    let variant tag = function
+      | [] -> String tag
+      | ts -> Object [tag, Array ts]
+    let record tag_ts  = Object tag_ts
+  end
+  
+  let json_of_int       = Encode.int
+  let json_of_int32     = Encode.int32
+  let json_of_int64     = Encode.int64
+  let json_of_nativeint = Encode.nativeint
+  let json_of_char      = Encode.char
+  let json_of_string    = Encode.string
+  let json_of_float     = Encode.float
+  let json_of_list      = Encode.list
+  let json_of_array     = Encode.array
+  let json_of_bool      = Encode.bool
+  let json_of_lazy_t    = Encode.lazy_t
+  let json_of_option    = Encode.option
+  
+  module Decode = struct
+    exception Error of string
+  
+    let errorf fmt = Printf.ksprintf (fun s -> raise (Error s)) fmt
+  
+    let string = function
+      | String s -> s
+      | _ -> errorf "String expected"
+  
+    let char = function
+      | String s when String.length s = 1 -> s.[0]
+      | _ -> errorf "Char expected"
+  
+    let int_check name min max conv v =
+      if floor v <> v then errorf "overflow: %f is not an integer" v
+      else if min <= v && v <= max then conv v
+      else errorf "overflow: %f is outside of legal range of type %s" v name
+  
+    let int n = match n with
+      | Float n -> int_check "int" (float min_int) (float max_int) int_of_float n
+      | _ -> errorf "Int expected"
+          
+    let int64 n = 
+      let open Int64 in
+      match n with
+      | Float n ->
+          int_check "int64" (to_float min_int) (to_float max_int) of_float n
+      | _ -> errorf "Int64 expected"
+          
+    let int32 n = 
+      let open Int32 in
+      match n with
+      | Float n ->
+          int_check "int32" (to_float min_int) (to_float max_int) of_float n
+      | _ -> errorf "Int32 expected"
+          
+    let nativeint n = 
+      let open Nativeint in
+      match n with
+      | Float n ->
+          int_check "nativeint" (to_float min_int) (to_float max_int) of_float n
+      | _ -> errorf "Nativeint expected"
+          
+    let float = function
+      | Float n -> n
+      | _ -> errorf "Float expected"
+  
+    let list d = function
+      | Array xs -> List.map d xs
+      | _ -> errorf "Array expected for list"
+  
+    let array d = function
+      | Array xs -> Array.of_list (List.map d xs)
+      | _ -> errorf "Array expected for array"
+  
+    let bool = function
+      | Bool b -> b
+      | _ -> errorf "Bool expected"
+  
+    let option f = function
+      | Null -> None
+      | v -> Some (f v)
+  
+    let lazy_t f v = Lazy.from_val (f v)
+  
+    let tuple arity = function 
+      | Array ts when List.length ts = arity -> ts
+      | Array _ -> errorf "Tuple arity mismatch"
+      | _ -> errorf "Array expected for array"
+  
+    let variant = function 
+      | String tag -> tag, [] 
+      | Object [tag, Array ts] when ts <> [] -> tag, ts
+      | Object [tag, Array []] -> errorf "Variant has Object [_, Array []]"
+      | Object _ -> errorf "Variant arity mismatch"
+      | _ -> errorf "Object expected for variant"
+  
+    let record = function
+      | Object alist -> alist
+      | _ -> errorf "Object expected for record"
+  
+  end
+  
+  let int_of_json       = Decode.int
+  let int32_of_json     = Decode.int32
+  let int64_of_json     = Decode.int64
+  let nativeint_of_json = Decode.nativeint
+  let char_of_json      = Decode.char
+  let string_of_json    = Decode.string
+  let float_of_json     = Decode.float
+  let list_of_json      = Decode.list
+  let array_of_json     = Decode.array
+  let bool_of_json      = Decode.bool
+  let lazy_of_json_t    = Decode.lazy_t
+  let option_of_json    = Decode.option
+end
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.