json-wheel-1.0.6/0000755000375200037520000000000011133644521013147 5ustar martinmartinjson-wheel-1.0.6/META0000644000375200037520000000024511133644521013621 0ustar martinmartinname = "json-wheel" version = "1.0.6" description = "JSON data format" requires = "netstring" archive(byte) = "jsonwheel.cma" archive(native) = "jsonwheel.cmxa" json-wheel-1.0.6/json_parser.mly0000644000375200037520000000644411133644521016227 0ustar martinmartin%{ (* Notes about error messages and error locations in ocamlyacc: 1) There is a predefined "error" symbol which can be used as a catch-all, in order to get the location of the token that shouldn't be there. 2) Additional rules that match common errors are added, so that when they are matched, a nice, handcrafted error message is produced. 3) Token locations are retrieved using functions from the Parsing module, which relies on a global state. If you want your error locations to be reliable, don't run two ocamlyacc parsers simultaneously. In the end, the error messages are nicer than the ones that a camlp4 parser (extensible grammar) would produce because we write them manually. However camlp4's messages are all automatic, i.e. they tell you which tokens were expected at a given location. For the file/line/char locations to be correct, the lexbuf must be adjusted by the lexer when the file name changes or a new line is encountered. This is not performed automatically by ocamllex, see file json_lexer.mll. *) open Printf open Json_type let rhs_loc n = (Parsing.rhs_start_pos n, Parsing.rhs_end_pos n) let unclosed opening_name opening_num closing_name closing_num = let msg = sprintf "%s:\nSyntax error: '%s' expected.\n\ %s:\nThis '%s' might be unmatched." (string_of_loc (rhs_loc closing_num)) closing_name (string_of_loc (rhs_loc opening_num)) opening_name in json_error msg let syntax_error s num = let msg = sprintf "%s:\n%s" (string_of_loc (rhs_loc num)) s in json_error msg %} %token STRING %token INT %token FLOAT %token BOOL %token OBJSTART OBJEND ARSTART AREND NULL COMMA COLON %token EOF %start main %type main %% main: | value EOF { $1 } | value error { syntax_error "Junk after end of data" 2 } | EOF { syntax_error "Empty data" 1 } | error { syntax_error "Syntax error" 1 } ; value: | OBJSTART pair_list OBJEND { Object $2 } | OBJSTART OBJEND { Object [] } | OBJSTART pair_list EOF { unclosed "{" 1 "}" 3 } | OBJSTART pair_list error { unclosed "{" 1 "}" 3 } | OBJSTART error { syntax_error "Expecting a comma-separated sequence \ of string:value pairs" 2 } | ARSTART value_list AREND { Array $2 } | ARSTART AREND { Array [] } | ARSTART value_list EOF { unclosed "[" 1 "]" 3 } | ARSTART value_list error { unclosed "[" 1 "]" 3 } | ARSTART error { syntax_error "Expecting a comma-separated sequence \ of values" 2 } | STRING { String $1 } | BOOL { Bool $1 } | NULL { Null } | INT { Int $1 } | FLOAT { Float $1 } ; pair_list: | STRING COLON value COMMA pair_list { ($1, $3) :: $5 } | STRING COLON value COMMA OBJEND { syntax_error "End-of-object commas are illegal" 4 } | STRING COLON value STRING { syntax_error "Missing ','" 4 } | STRING COLON value { [ ($1, $3) ] } ; value_list: | value COMMA value_list { $1 :: $3 } | value COMMA AREND { syntax_error "End-of-array commas are illegal" 2 } | value value { syntax_error "Missing ',' before this value" 2 } | value { [ $1 ] } ; json-wheel-1.0.6/html/0000755000375200037520000000000011133644521014113 5ustar martinmartinjson-wheel-1.0.6/html/type_Json_type.html0000644000375200037520000002630111133644521020016 0ustar martinmartin Json_type sig
  type json_type =
      Object of (string * Json_type.json_type) list
    | Array of Json_type.json_type list
    | String of string
    | Int of int
    | Float of float
    | Bool of bool
    | Null
  type t = Json_type.json_type
  exception Json_error of string
  module Browse :
    sig
      val make_table :
        (string * Json_type.t) list -> (string, Json_type.t) Hashtbl.t
      val field : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t
      val fieldx : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t
      val optfield :
        (string, Json_type.t) Hashtbl.t -> string -> Json_type.t option
      val optfieldx :
        (string, Json_type.t) Hashtbl.t -> string -> Json_type.t option
      val describe : Json_type.t -> string
      val type_mismatch : string -> Json_type.t -> 'a
      val is_null : Json_type.t -> bool
      val is_defined : Json_type.t -> bool
      val null : Json_type.t -> unit
      val string : Json_type.t -> string
      val bool : Json_type.t -> bool
      val number : Json_type.t -> float
      val int : Json_type.t -> int
      val float : Json_type.t -> float
      val array : Json_type.t -> Json_type.t list
      val objekt : Json_type.t -> (string * Json_type.t) list
      val list : (Json_type.t -> 'a) -> Json_type.t -> 'a list
      val option : Json_type.t -> Json_type.t option
      val optional : (Json_type.t -> 'a) -> Json_type.t -> 'a option
      val assert_object_or_array : Json_type.t -> unit
    end
  module Build :
    sig
      val null : Json_type.t
      val bool : bool -> Json_type.t
      val int : int -> Json_type.t
      val float : float -> Json_type.t
      val string : string -> Json_type.t
      val objekt : (string * Json_type.t) list -> Json_type.t
      val array : Json_type.t list -> Json_type.t
      val list : ('a -> Json_type.t) -> 'a list -> Json_type.t
      val option : Json_type.t option -> Json_type.t
      val optional : ('a -> Json_type.t) -> 'a option -> Json_type.t
    end
  val string_of_loc : Lexing.position * Lexing.position -> string
  val json_error : string -> 'a
endjson-wheel-1.0.6/html/type_Json_io.Fast.html0000644000375200037520000000227511133644521020344 0ustar martinmartin Json_io.Fast sig
  val print :
    ?allow_nan:bool -> ?recursive:bool -> Buffer.t -> Json_type.t -> unit
endjson-wheel-1.0.6/html/type_Json_compat.html0000644000375200037520000000144411133644521020321 0ustar martinmartin Json_compat sig  endjson-wheel-1.0.6/html/code_VALJson_compat.serialize.html0000644000375200037520000000154311133644521022603 0ustar martinmartin Json_compat.serialize let serialize x = Json_io.string_of_json xjson-wheel-1.0.6/html/type_Json_io.Compact.html0000644000375200037520000000233711133644521021034 0ustar martinmartin Json_io.Compact sig
  val print :
    ?allow_nan:bool ->
    ?recursive:bool -> Format.formatter -> Json_type.t -> unit
endjson-wheel-1.0.6/html/style.css0000644000375200037520000000433111133644521015766 0ustar martinmartina:visited {color : #416DFF; text-decoration : none; } a:link {color : #416DFF; text-decoration : none;} a:hover {color : Red; text-decoration : none; background-color: #5FFF88} a:active {color : Red; text-decoration : underline; } .keyword { font-weight : bold ; color : Red } .keywordsign { color : #C04600 } .superscript { font-size : 4 } .subscript { font-size : 4 } .comment { color : Green } .constructor { color : Blue } .type { color : #5C6585 } .string { color : Maroon } .warning { color : Red ; font-weight : bold } .info { margin-left : 3em; margin-right : 3em } .param_info { margin-top: 4px; margin-left : 3em; margin-right : 3em } .code { color : #465F91 ; } h1 { font-size : 20pt ; text-align: center; } h2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; } h3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; } h4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; } h5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; } h6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #C0FFFF ; padding: 2px; } div.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; } div.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; } div.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; } .typetable { border-style : hidden } .indextable { border-style : hidden } .paramstable { border-style : hidden ; padding: 5pt 5pt} body { background-color : White } tr { background-color : White } td.typefieldcomment { background-color : #FFFFFF ; font-size: smaller ;} pre { margin-bottom: 4px } div.sig_block {margin-left: 2em}json-wheel-1.0.6/html/Json_io.Fast.html0000644000375200037520000000347211133644521017303 0ustar martinmartin Json_io.Fast
Previous  Up  Next

Module Json_io.Fast


module Fast: sig .. end
Conversion of JSON data to compact text, optimized for speed.
val print : ?allow_nan:bool -> ?recursive:bool -> Buffer.t -> Json_type.t -> unit
This function is faster than the one provided by the Json_io.Compact submodule but it is less generic and is subject to the 16MB size limit of strings on 32-bit architectures.
json-wheel-1.0.6/html/Json_parser.html0000644000375200037520000001027611133644521017274 0ustar martinmartin Json_parser
 Up  

Module Json_parser


module Json_parser: sig .. end

type token =
| STRING of (Json_type.loc * string)
| INT of (Json_type.loc * int)
| FLOAT of (Json_type.loc * float)
| BOOL of (Json_type.loc * bool)
| OBJSTART of Json_type.loc
| OBJEND of Json_type.loc
| ARSTART of Json_type.loc
| AREND of Json_type.loc
| NULL of Json_type.loc
| COMMA of Json_type.loc
| COLON of Json_type.loc
| EOF 
val main : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> Json_type.t
json-wheel-1.0.6/html/Json_io.html0000644000375200037520000001322711133644521016406 0ustar martinmartin Json_io
Previous  Up  Next

Module Json_io


module Json_io: sig .. end
Input and output functions for the JSON format as defined by http://www.json.org/
val json_of_string : ?allow_comments:bool ->
       ?allow_nan:bool ->
       ?big_int_mode:bool -> ?recursive:bool -> string -> Json_type.t
json_of_string s reads the given JSON string.

If allow_comments is true, then C++ style comments are allowed, i.e. /* blabla possibly on several lines */ or // blabla until the end of the line. Comments are not part of the JSON specification and are disabled by default.

If allow_nan is true, then OCaml nan, infinity and neg_infinity float values are represented using their Javascript counterparts NaN, Infinity and -Infinity.

If big_int_mode is true, then JSON ints that cannot be represented using OCaml's int type are represented by strings. This would happen only for ints that are out of the range defined by min_int and max_int, i.e. [-1G, +1G[ on a 32-bit platform. The default is false and a Json_type.Json_error exception is raised if an int is too big.

If recursive is true, then all JSON values are accepted rather than just arrays and objects as specified by the standard. The default is false.

val load_json : ?allow_comments:bool ->
       ?allow_nan:bool ->
       ?big_int_mode:bool -> ?recursive:bool -> string -> Json_type.t
Same as Json_io.json_of_string but the argument is a file to read from.
module Compact: sig .. end
Conversion of JSON data to compact text. 
module Fast: sig .. end
Conversion of JSON data to compact text, optimized for speed. 
module Pretty: sig .. end
Conversion of JSON data to indented text. 
val string_of_json : ?allow_nan:bool -> ?compact:bool -> ?recursive:bool -> Json_type.t -> string
string_of_json converts JSON data to a string.

By default, the output is indented. If the compact flag is set to true, the output will not contain superfluous whitespace and will be produced faster.

If allow_nan is true, then OCaml nan, infinity and neg_infinity float values are represented using their Javascript counterparts NaN, Infinity and -Infinity.

val save_json : ?allow_nan:bool ->
       ?compact:bool -> ?recursive:bool -> string -> Json_type.t -> unit
save_json works like Json_io.string_of_json but saves the results directly into the file specified by the argument of type string.
json-wheel-1.0.6/html/type_Json_parser.html0000644000375200037520000000653111133644521020334 0ustar martinmartin Json_parser sig
  type token =
      STRING of (Json_type.loc * string)
    | INT of (Json_type.loc * int)
    | FLOAT of (Json_type.loc * float)
    | BOOL of (Json_type.loc * bool)
    | OBJSTART of Json_type.loc
    | OBJEND of Json_type.loc
    | ARSTART of Json_type.loc
    | AREND of Json_type.loc
    | NULL of Json_type.loc
    | COMMA of Json_type.loc
    | COLON of Json_type.loc
    | EOF
  val main :
    (Lexing.lexbuf -> Json_parser.token) -> Lexing.lexbuf -> Json_type.t
endjson-wheel-1.0.6/html/index_values.html0000644000375200037520000002752511133644521017502 0ustar martinmartin Index of values

Index of values


A
array [Json_type.Build]
builds a JSON Array.
array [Json_type.Browse]
reads a JSON element as a JSON Array and returns an OCaml list, or raises a Json_error exception.

B
bool [Json_type.Build]
builds a JSON Bool
bool [Json_type.Browse]
reads a JSON element as a bool or raises a Json_error exception.

D
describe [Json_type.Browse]
describe x returns a short description of the given JSON data.
deserialize [Json_compat]

F
field [Json_type.Browse]
field tbl key looks for a unique field key in hash table tbl.
fieldx [Json_type.Browse]
fieldx tbl key works like field tbl key, but returns Null if key is not found in the table.
float [Json_type.Build]
builds a JSON Float
float [Json_type.Browse]
reads a JSON element as a float or raises a Json_error exception.

I
int [Json_type.Build]
builds a JSON Int
int [Json_type.Browse]
reads a JSON element as an int or raises a Json_error exception.
is_defined [Json_type.Browse]
tells whether the given JSON element is not null
is_null [Json_type.Browse]
tells whether the given JSON element is null

J
json_of_string [Json_io]
json_of_string s reads the given JSON string.

L
list [Json_type.Build]
list f l maps OCaml list l to a JSON list using function f to convert the elements into JSON values.
list [Json_type.Browse]
list f x maps a JSON Array x to an OCaml list, converting each element of list x using f.
load_json [Json_io]
Same as Json_io.json_of_string but the argument is a file to read from.

M
make_table [Json_type.Browse]
make_table creates a hash table from the contents of a JSON Object.

N
null [Json_type.Build]
The Null value
null [Json_type.Browse]
raises a Json_error exception if the given JSON value is not Null.
number [Json_type.Browse]
reads a JSON element as an int or a float and returns a float or raises a Json_error exception.

O
objekt [Json_type.Build]
builds a JSON Object.
objekt [Json_type.Browse]
reads a JSON element as a JSON Object and returns an OCaml list, or raises a Json_error exception.
optfield [Json_type.Browse]
optfield tbl key queries hash table tbl for zero or one field key.
optfieldx [Json_type.Browse]
optfieldx is the same as optfield except that it will never return Some Null but None instead.
option [Json_type.Build]
option x returns Null is x is None, or y if x is Some y.
option [Json_type.Browse]
option x returns None is x is Null and Some x otherwise.
optional [Json_type.Build]
optional f x returns Null if x is None, or f x otherwise.
optional [Json_type.Browse]
optional f x maps x using the given function f and returns Some result, unless x is Null in which case it returns None.

P
print [Json_io.Pretty]
Generic pretty-printing function.
print [Json_io.Fast]
This function is faster than the one provided by the Json_io.Compact submodule but it is less generic and is subject to the 16MB size limit of strings on 32-bit architectures.
print [Json_io.Compact]
Generic printing function without superfluous space.

S
save_json [Json_io]
save_json works like Json_io.string_of_json but saves the results directly into the file specified by the argument of type string.
serialize [Json_compat]
string [Json_type.Build]
builds a JSON String
string [Json_type.Browse]
reads a JSON element as a string or raises a Json_error exception.
string_of_json [Json_io]
string_of_json converts JSON data to a string.

T
type_mismatch [Json_type.Browse]
type_mismatch expected x raises the Json_error msg exception, where msg is a message that describes the error as a type mismatch between the element x and what is expected.

json-wheel-1.0.6/html/code_VALJson_compat.deserialize.html0000644000375200037520000000163611133644521023117 0ustar martinmartin Json_compat.deserialize let deserialize s = Json_io.json_of_string ~allow_comments:true sjson-wheel-1.0.6/html/index.html0000644000375200037520000000277111133644521016117 0ustar martinmartin

Index of types
Index of exceptions
Index of values
Index of modules


Json_type
OCaml representation of JSON data
Json_io
Input and output functions for the JSON format as defined by http://www.json.org/
Json_compat
Pseudo-compatibility with other JSON implementation.
json-wheel-1.0.6/html/index_exceptions.html0000644000375200037520000000211211133644521020345 0ustar martinmartin Index of exceptions

Index of exceptions


J
Json_error [Json_type]
Errors that are produced by the json-wheel library are represented using the Json_error exception.

json-wheel-1.0.6/html/Json_type.Build.html0000644000375200037520000001156211133644521020016 0ustar martinmartin Json_type.Build
Previous  Up  

Module Json_type.Build


module Build: sig .. end
This submodule provides some simple functions for building JSON data from other OCaml types.

Use open Json_type.Build when you want to convert JSON data into another OCaml type.

val null : Json_type.t
The Null value
val bool : bool -> Json_type.t
builds a JSON Bool
val int : int -> Json_type.t
builds a JSON Int
val float : float -> Json_type.t
builds a JSON Float
val string : string -> Json_type.t
builds a JSON String
val objekt : (string * Json_type.t) list -> Json_type.t
builds a JSON Object.

See Json_type.Browse.objekt for an explanation about the unusual spelling.

val array : Json_type.t list -> Json_type.t
builds a JSON Array.
val list : ('a -> Json_type.t) -> 'a list -> Json_type.t
list f l maps OCaml list l to a JSON list using function f to convert the elements into JSON values.

For example, list int [1; 2; 3] is a shortcut for Array [ Int 1; Int 2; Int 3 ].

val option : Json_type.t option -> Json_type.t
option x returns Null is x is None, or y if x is Some y.
val optional : ('a -> Json_type.t) -> 'a option -> Json_type.t
optional f x returns Null if x is None, or f x otherwise.

For example, list (optional int) [Some 1; Some 2; None] returns Array [ Int 1; Int 2; Null ].

json-wheel-1.0.6/html/index_methods.html0000644000375200037520000000142111133644521017631 0ustar martinmartin Index of class methods

Index of class methods


json-wheel-1.0.6/html/Json_io.Compact.html0000644000375200037520000000355011133644521017771 0ustar martinmartin Json_io.Compact
 Up  Next

Module Json_io.Compact


module Compact: sig .. end
Conversion of JSON data to compact text.
val print : ?allow_nan:bool -> ?recursive:bool -> Format.formatter -> Json_type.t -> unit
Generic printing function without superfluous space. See the standard Format module for how to create and use formatters.

In general, Json_io.string_of_json and Json_io.save_json are more convenient.

json-wheel-1.0.6/html/index_modules.html0000644000375200037520000000463011133644521017643 0ustar martinmartin Index of modules

Index of modules


B
Browse [Json_type]
This submodule provides some simple functions for checking and reading the structure of JSON data.
Build [Json_type]
This submodule provides some simple functions for building JSON data from other OCaml types.

C
Compact [Json_io]
Conversion of JSON data to compact text.

F
Fast [Json_io]
Conversion of JSON data to compact text, optimized for speed.

J
Json_compat
Pseudo-compatibility with other JSON implementation.
Json_io
Input and output functions for the JSON format as defined by http://www.json.org/
Json_type
OCaml representation of JSON data

P
Pretty [Json_io]
Conversion of JSON data to indented text.

json-wheel-1.0.6/html/index_classes.html0000644000375200037520000000140511133644521017625 0ustar martinmartin Index of classes

Index of classes


json-wheel-1.0.6/html/type_Json_type.Browse.html0000644000375200037520000001360111133644521021255 0ustar martinmartin Json_type.Browse sig
  val make_table :
    (string * Json_type.t) list -> (string, Json_type.t) Hashtbl.t
  val field : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t
  val fieldx : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t
  val optfield :
    (string, Json_type.t) Hashtbl.t -> string -> Json_type.t option
  val optfieldx :
    (string, Json_type.t) Hashtbl.t -> string -> Json_type.t option
  val describe : Json_type.t -> string
  val type_mismatch : string -> Json_type.t -> 'a
  val is_null : Json_type.t -> bool
  val is_defined : Json_type.t -> bool
  val null : Json_type.t -> unit
  val string : Json_type.t -> string
  val bool : Json_type.t -> bool
  val number : Json_type.t -> float
  val int : Json_type.t -> int
  val float : Json_type.t -> float
  val array : Json_type.t -> Json_type.t list
  val objekt : Json_type.t -> (string * Json_type.t) list
  val list : (Json_type.t -> 'a) -> Json_type.t -> 'a list
  val option : Json_type.t -> Json_type.t option
  val optional : (Json_type.t -> 'a) -> Json_type.t -> 'a option
  val assert_object_or_array : Json_type.t -> unit
endjson-wheel-1.0.6/html/type_Json_io.html0000644000375200037520000001143511133644521017446 0ustar martinmartin Json_io sig
  val json_of_string :
    ?allow_comments:bool ->
    ?allow_nan:bool ->
    ?big_int_mode:bool -> ?recursive:bool -> string -> Json_type.t
  val load_json :
    ?allow_comments:bool ->
    ?allow_nan:bool ->
    ?big_int_mode:bool -> ?recursive:bool -> string -> Json_type.t
  module Compact :
    sig
      val print :
        ?allow_nan:bool ->
        ?recursive:bool -> Format.formatter -> Json_type.t -> unit
    end
  module Fast :
    sig
      val print :
        ?allow_nan:bool -> ?recursive:bool -> Buffer.t -> Json_type.t -> unit
    end
  module Pretty :
    sig
      val print :
        ?allow_nan:bool ->
        ?recursive:bool -> Format.formatter -> Json_type.t -> unit
    end
  val string_of_json :
    ?allow_nan:bool ->
    ?compact:bool -> ?recursive:bool -> Json_type.t -> string
  val save_json :
    ?allow_nan:bool ->
    ?compact:bool -> ?recursive:bool -> string -> Json_type.t -> unit
endjson-wheel-1.0.6/html/Json_type.html0000644000375200037520000001306211133644521016755 0ustar martinmartin Json_type
 Up  Next

Module Json_type


module Json_type: sig .. end
OCaml representation of JSON data

type json_type =
| Object of (string * json_type) list
| Array of json_type list
| String of string
| Int of int
| Float of float
| Bool of bool
| Null
A json_type is a boolean, integer, real, string, null. It can also be lists Array or string-keyed maps Object of json_type's. The JSON payload can only be an Object or Array.

This type is used by the parsing and printing functions from the Json_io module. Typically, a program would convert such data into a specialized type that uses records, etc. For the purpose of converting from and to other types, two submodules are provided: Json_type.Browse and Json_type.Build. They are meant to be opened using either open Json_type.Browse or open Json_type.Build. They provided simple functions for converting JSON data.

type t = json_type
t is an alias for json_type.
exception Json_error of string
Errors that are produced by the json-wheel library are represented using the Json_error exception.

Other exceptions may be raised when calling functions from the library. Either they come from the failure of external functions or like Not_found they are not errors per se, and are specifically documented.

module Browse: sig .. end
This submodule provides some simple functions for checking and reading the structure of JSON data. 
module Build: sig .. end
This submodule provides some simple functions for building JSON data from other OCaml types.
json-wheel-1.0.6/html/Json_io.Pretty.html0000644000375200037520000000353011133644521017670 0ustar martinmartin Json_io.Pretty
Previous  Up  

Module Json_io.Pretty


module Pretty: sig .. end
Conversion of JSON data to indented text.
val print : ?allow_nan:bool -> ?recursive:bool -> Format.formatter -> Json_type.t -> unit
Generic pretty-printing function. See the standard Format module for how to create and use formatters.

In general, Json_io.string_of_json and Json_io.save_json are more convenient.

json-wheel-1.0.6/html/index_types.html0000644000375200037520000000260311133644521017335 0ustar martinmartin Index of types

Index of types


J
json_type [Json_type]
A json_type is a boolean, integer, real, string, null.
jsontype [Json_compat]

T
t [Json_type]
t is an alias for json_type.

json-wheel-1.0.6/html/index_class_types.html0000644000375200037520000000141511133644521020522 0ustar martinmartin Index of class types

Index of class types


json-wheel-1.0.6/html/type_Json_io.Pretty.html0000644000375200037520000000233611133644521020734 0ustar martinmartin Json_io.Pretty sig
  val print :
    ?allow_nan:bool ->
    ?recursive:bool -> Format.formatter -> Json_type.t -> unit
endjson-wheel-1.0.6/html/index_attributes.html0000644000375200037520000000142711133644521020362 0ustar martinmartin Index of class attributes

Index of class attributes


json-wheel-1.0.6/html/index_module_types.html0000644000375200037520000000141711133644521020704 0ustar martinmartin Index of module types

Index of module types


json-wheel-1.0.6/html/type_Json_type.Build.html0000644000375200037520000000600711133644521021055 0ustar martinmartin Json_type.Build sig
  val null : Json_type.t
  val bool : bool -> Json_type.t
  val int : int -> Json_type.t
  val float : float -> Json_type.t
  val string : string -> Json_type.t
  val objekt : (string * Json_type.t) list -> Json_type.t
  val array : Json_type.t list -> Json_type.t
  val list : ('a -> Json_type.t) -> 'a list -> Json_type.t
  val option : Json_type.t option -> Json_type.t
  val optional : ('a -> Json_type.t) -> 'a option -> Json_type.t
endjson-wheel-1.0.6/html/Json_type.Browse.html0000644000375200037520000002717011133644521020222 0ustar martinmartin Json_type.Browse
 Up  Next

Module Json_type.Browse


module Browse: sig .. end
This submodule provides some simple functions for checking and reading the structure of JSON data.

Use open Json_type.Browse when you want to convert JSON data into another OCaml type.

val make_table : (string * Json_type.t) list -> (string, Json_type.t) Hashtbl.t
make_table creates a hash table from the contents of a JSON Object. For example, if x is a JSON Object, then the corresponding table can be created by let tbl = make_table (objekt x).

Hash tables are more efficient than lists if several fields must be extracted and converted into something like an OCaml record.

The key/value pairs are added from left to right. Therefore if there are several bindings for the same key, the latest to appear in the list will be the first in the list returned by Hashtbl.find_all.

val field : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t
field tbl key looks for a unique field key in hash table tbl. It raises a Json_error if key is not found in the table or if it is present multiple times.
val fieldx : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t
fieldx tbl key works like field tbl key, but returns Null if key is not found in the table. This function is convenient when assuming that a field which is set to Null is the same as if it were not defined.

For instance, optional int (fieldx tbl "year") looks in table tbl for a field "year". If this field is set to Null or if it is undefined, then None is returned, otherwise an Int is expected and returned, for example as Some 2006. If the value is of another JSON type than Int or Null, it causes an error.

val optfield : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t option
optfield tbl key queries hash table tbl for zero or one field key. The result is returned as None or Some result. If there are several fields with the same key, then a Json_error is produced.

Null is returned as Some Null, not as None. For other behaviors see Json_type.Browse.fieldx and Json_type.Browse.optfieldx.

val optfieldx : (string, Json_type.t) Hashtbl.t -> string -> Json_type.t option
optfieldx is the same as optfield except that it will never return Some Null but None instead.
val describe : Json_type.t -> string
describe x returns a short description of the given JSON data. Its purpose is to help build error messages.
val type_mismatch : string -> Json_type.t -> 'a
type_mismatch expected x raises the Json_error msg exception, where msg is a message that describes the error as a type mismatch between the element x and what is expected.
val is_null : Json_type.t -> bool
tells whether the given JSON element is null
val is_defined : Json_type.t -> bool
tells whether the given JSON element is not null
val null : Json_type.t -> unit
raises a Json_error exception if the given JSON value is not Null.
val string : Json_type.t -> string
reads a JSON element as a string or raises a Json_error exception.
val bool : Json_type.t -> bool
reads a JSON element as a bool or raises a Json_error exception.
val number : Json_type.t -> float
reads a JSON element as an int or a float and returns a float or raises a Json_error exception.
val int : Json_type.t -> int
reads a JSON element as an int or raises a Json_error exception.
val float : Json_type.t -> float
reads a JSON element as a float or raises a Json_error exception.
val array : Json_type.t -> Json_type.t list
reads a JSON element as a JSON Array and returns an OCaml list, or raises a Json_error exception.
val objekt : Json_type.t -> (string * Json_type.t) list
reads a JSON element as a JSON Object and returns an OCaml list, or raises a Json_error exception.

Note the unusual spelling. object being a keyword in OCaml, we use objekt. Object with a capital is still spelled Object.

val list : (Json_type.t -> 'a) -> Json_type.t -> 'a list
list f x maps a JSON Array x to an OCaml list, converting each element of list x using f. A Json_error exception is raised if the given element is not a JSON Array.

For example, converting a JSON array that must contain only ints is performed using list int x. Similarly, a list of lists of ints can be obtained using list (list int) x.

val option : Json_type.t -> Json_type.t option
option x returns None is x is Null and Some x otherwise.
val optional : (Json_type.t -> 'a) -> Json_type.t -> 'a option
optional f x maps x using the given function f and returns Some result, unless x is Null in which case it returns None.

For example, optional int x may return something like Some 123 or None or raise a Json_error exception in case x is neither Null nor an Int.

See also Json_type.Browse.fieldx.

json-wheel-1.0.6/html/Json_compat.html0000644000375200037520000000434211133644521017260 0ustar martinmartin Json_compat
Previous  Up  

Module Json_compat


module Json_compat: sig .. end
Pseudo-compatibility with other JSON implementation. Do not use this module in new programs.
type jsontype = Json_type.t 
val serialize : Json_type.t -> string
Deprecated.Use Json_io.string_of_json instead.
val deserialize : string -> Json_type.t
Deprecated.Use Json_io.json_of_string instead.
json-wheel-1.0.6/json_compat.ml0000644000375200037520000000055411133644521016021 0ustar martinmartin(** Pseudo-compatibility with other JSON implementation. Do not use this module in new programs. *) type jsontype = Json_type.t (** @deprecated Use {!Json_io.string_of_json} instead. *) let serialize x = Json_io.string_of_json x (** @deprecated Use {!Json_io.json_of_string} instead. *) let deserialize s = Json_io.json_of_string ~allow_comments:true s json-wheel-1.0.6/README0000644000375200037520000000407611133644521014036 0ustar martinmartinThis is an OCaml library which reads and writes data in the JSON format (JavaScript Object Notation). This format can be used as a light-weight replacement for XML. Visit http://www.json.org for more information about JSON. The documentation for this library is located at http://martin.jambon.free.fr/json-wheel/ Installation ============ Requirements: - OCaml - GNU make - the findlib library manager (ocamlfind command) - the netstring library From the source directory, do: make make install If you want to remove the package do: make uninstall Standard compliance =================== The JSON parser, in the default mode, conforms to the specifications of RFC 4627, with only some limitations due to the implementation of the corresponding OCaml types: * ints that are too large to be represented with the OCaml int type cause an error. The limit depends whether it is a 32-bit or 64-bit platform (see min_int and max_int). * floats may be represented with reduced precision as they must fit into the 8 bytes of the "double" format. * The size of OCaml strings is limited to about 16MB on 32-bit platforms, and much more on 64-bit platforms (see Sys.max_string_length). RFC 4627: http://www.ietf.org/rfc/rfc4627.txt?number=4627 The UTF-8 encoding is supported, however no attempt is made at checking whether strings are actually valid UTF-8 or not. Therefore, other ASCII-compatible encodings such as the ISO 8859 series are supported as well. Tests ===== Json.org provides a test suite. You can download the file (test.zip), unzip it in the parent directory, and run "make test". Look for ERROR messages, which indicate that a file that should fail actually passes or that a file that should pass fails the test. ../test/fail18.json doesn't pass: this is only because an int which is too large for the OCaml int type on a 32-bit platform. ../test/fail18.json passes: it is marked as "should fail" because is has a high number of nesting. Although the standard allows such restrictions, there are not mandatory at all. Our parser does not have such a restriction. json-wheel-1.0.6/check.sh0000755000375200037520000000120211133644521014556 0ustar martinmartin#!/bin/sh # Requires the suite test from http://www.json.org/JSON_checker/ # The JSON files should be unzipped in the parent directory, resulting # in a test directory that contains pass*.json and fail*.json. dir=../test if ! test -x ./jsoncat; then echo "./jsoncat is missing!"; exit 1 fi for file in $dir/fail*.json; do if ./jsoncat $* $file > /dev/null ; then echo "ERROR: $file shouldn't pass!" else echo "OK: $file doesn't pass, as expected." fi done for file in $dir/pass*.json; do if ./jsoncat $* $file > /dev/null ; then echo "OK: $file passes." else echo "ERROR: $file should pass!" fi done json-wheel-1.0.6/json_type.mli0000644000375200037520000001700511133644521015667 0ustar martinmartin(** OCaml representation of JSON data *) (** A [json_type] is a boolean, integer, real, string, null. It can also be lists [Array] or string-keyed maps [Object] of [json_type]'s. The JSON payload can only be an [Object] or [Array]. This type is used by the parsing and printing functions from the {!Json_io} module. Typically, a program would convert such data into a specialized type that uses records, etc. For the purpose of converting from and to other types, two submodules are provided: {!Json_type.Browse} and {!Json_type.Build}. They are meant to be opened using either [open Json_type.Browse] or [open Json_type.Build]. They provided simple functions for converting JSON data. *) type json_type = Object of (string * json_type) list | Array of json_type list | String of string | Int of int | Float of float | Bool of bool | Null (** [t] is an alias for [json_type]. *) type t = json_type (** Errors that are produced by the json-wheel library are represented using the [Json_error] exception. Other exceptions may be raised when calling functions from the library. Either they come from the failure of external functions or like [Not_found] they are not errors per se, and are specifically documented. *) exception Json_error of string (** This submodule provides some simple functions for checking and reading the structure of JSON data. Use [open Json_type.Browse] when you want to convert JSON data into another OCaml type. *) module Browse : sig (** [make_table] creates a hash table from the contents of a JSON [Object]. For example, if [x] is a JSON [Object], then the corresponding table can be created by [let tbl = make_table (objekt x)]. Hash tables are more efficient than lists if several fields must be extracted and converted into something like an OCaml record. The key/value pairs are added from left to right. Therefore if there are several bindings for the same key, the latest to appear in the list will be the first in the list returned by [Hashtbl.find_all]. *) val make_table : (string * t) list -> (string, t) Hashtbl.t (** [field tbl key] looks for a unique field [key] in hash table [tbl]. It raises a [Json_error] if [key] is not found in the table or if it is present multiple times. *) val field : (string, t) Hashtbl.t -> string -> t (** [fieldx tbl key] works like [field tbl key], but returns [Null] if [key] is not found in the table. This function is convenient when assuming that a field which is set to [Null] is the same as if it were not defined. For instance, [optional int (fieldx tbl "year")] looks in table [tbl] for a field ["year"]. If this field is set to [Null] or if it is undefined, then [None] is returned, otherwise an [Int] is expected and returned, for example as [Some 2006]. If the value is of another JSON type than [Int] or [Null], it causes an error. *) val fieldx : (string, t) Hashtbl.t -> string -> t (** [optfield tbl key] queries hash table [tbl] for zero or one field [key]. The result is returned as [None] or [Some result]. If there are several fields with the same [key], then a [Json_error] is produced. [Null] is returned as [Some Null], not as [None]. For other behaviors see {!Json_type.Browse.fieldx} and {!Json_type.Browse.optfieldx}. *) val optfield : (string, t) Hashtbl.t -> string -> t option (** [optfieldx] is the same as [optfield] except that it will never return [Some Null] but [None] instead. *) val optfieldx : (string, t) Hashtbl.t -> string -> t option (** [describe x] returns a short description of the given JSON data. Its purpose is to help build error messages. *) val describe : t -> string (** [type_mismatch expected x] raises the [Json_error msg] exception, where [msg] is a message that describes the error as a type mismatch between the element [x] and what is [expected]. *) val type_mismatch : string -> t -> 'a (** tells whether the given JSON element is null *) val is_null : t -> bool (** tells whether the given JSON element is not null *) val is_defined : t -> bool (** raises a [Json_error] exception if the given JSON value is not [Null]. *) val null : t -> unit (** reads a JSON element as a string or raises a [Json_error] exception. *) val string : t -> string (** reads a JSON element as a bool or raises a [Json_error] exception. *) val bool : t -> bool (** reads a JSON element as an int or a float and returns a float or raises a [Json_error] exception. *) val number : t -> float (** reads a JSON element as an int or raises a [Json_error] exception. *) val int : t -> int (** reads a JSON element as a float or raises a [Json_error] exception. *) val float : t -> float (** reads a JSON element as a JSON [Array] and returns an OCaml list, or raises a [Json_error] exception. *) val array : t -> t list (** reads a JSON element as a JSON [Object] and returns an OCaml list, or raises a [Json_error] exception. Note the unusual spelling. [object] being a keyword in OCaml, we use [objekt]. [Object] with a capital is still spelled [Object]. *) val objekt : t -> (string * t) list (** [list f x] maps a JSON [Array x] to an OCaml list, converting each element of list [x] using [f]. A [Json_error] exception is raised if the given element is not a JSON [Array]. For example, converting a JSON array that must contain only ints is performed using [list int x]. Similarly, a list of lists of ints can be obtained using [list (list int) x]. *) val list : (t -> 'a) -> t -> 'a list (** [option x] returns [None] is [x] is [Null] and [Some x] otherwise. *) val option : t -> t option (** [optional f x] maps x using the given function [f] and returns [Some result], unless [x] is [Null] in which case it returns [None]. For example, [optional int x] may return something like [Some 123] or [None] or raise a [Json_error] exception in case [x] is neither [Null] nor an [Int]. See also {!Json_type.Browse.fieldx}. *) val optional : (t -> 'a) -> t -> 'a option (**/**) val assert_object_or_array : t -> unit end (** This submodule provides some simple functions for building JSON data from other OCaml types. Use [open Json_type.Build] when you want to convert JSON data into another OCaml type. *) module Build : sig val null : t (** The [Null] value *) val bool : bool -> t (** builds a JSON [Bool] *) val int : int -> t (** builds a JSON [Int] *) val float : float -> t (** builds a JSON [Float] *) val string : string -> t (** builds a JSON [String] *) val objekt : (string * t) list -> t (** builds a JSON [Object]. See {!Json_type.Browse.objekt} for an explanation about the unusual spelling. *) val array : t list -> t (** builds a JSON [Array]. *) val list : ('a -> t) -> 'a list -> t (** [list f l] maps OCaml list [l] to a JSON list using function [f] to convert the elements into JSON values. For example, [list int [1; 2; 3]] is a shortcut for [Array [ Int 1; Int 2; Int 3 ]]. *) val option : t option -> t (** [option x] returns [Null] is [x] is [None], or [y] if [x] is [Some y]. *) val optional : ('a -> t) -> 'a option -> t (** [optional f x] returns [Null] if [x] is [None], or [f x] otherwise. For example, [list (optional int) [Some 1; Some 2; None]] returns [Array [ Int 1; Int 2; Null ]]. *) end (**/**) val string_of_loc : (Lexing.position * Lexing.position) -> string val json_error : string -> 'a json-wheel-1.0.6/json_type.ml0000644000375200037520000000615011133644521015515 0ustar martinmartinopen Printf open Lexing type json_type = Object of (string * json_type) list | Array of json_type list | String of string | Int of int | Float of float | Bool of bool | Null type t = json_type exception Json_error of string let json_error s = raise (Json_error s) module Browse = struct let make_table l = let tbl = Hashtbl.create (List.length l) in List.iter (fun (key, data) -> Hashtbl.add tbl key data) l; tbl let field tbl x = match Hashtbl.find_all tbl x with [y] -> y | [] -> json_error ("Missing field " ^ x) | _ -> json_error ("Only one field " ^ x ^ " is expected") let fieldx tbl x = match Hashtbl.find_all tbl x with [y] -> y | [] -> Null | _ -> json_error ("At most one field " ^ x ^ " is expected") let optfield tbl x = match Hashtbl.find_all tbl x with [y] -> Some y | [] -> None | _ -> json_error ("At most one field " ^ x ^ " is expected") let optfieldx tbl x = match Hashtbl.find_all tbl x with [y] -> if y = Null then None else Some y | [] -> None | _ -> json_error ("At most one field " ^ x ^ " is expected") let describe = function Bool true -> "true" | Bool false -> "false" | Int i -> string_of_int i | Float x -> string_of_float x | String s -> sprintf "%S" s | Object _ -> "an object" | Array _ -> "an array" | Null -> "null" let type_mismatch expected x = let descr = describe x in json_error (sprintf "Expecting %s, not %s" expected descr) let is_null x = x = Null let is_defined x = x <> Null let null = function Null -> () | x -> type_mismatch "a null value" x let string = function String s -> s | x -> type_mismatch "a string" x let bool = function Bool x -> x | x -> type_mismatch "a bool" x let number = function Float x -> x | Int i -> Pervasives.float i | x -> type_mismatch "a number" x let int = function Int x -> x | x -> type_mismatch "an int" x let float = function Float x -> x | x -> type_mismatch "a float" x let array = function Array x -> x | x -> type_mismatch "an array" x let objekt = function Object x -> x | x -> type_mismatch "an object" x let list f x = List.map f (array x) let option = function Null -> None | x -> Some x let optional f = function Null -> None | x -> Some (f x) let assert_object_or_array x = match x with Object _ | Array _ -> () | _ -> type_mismatch "an array or an object" x end module Build = struct let null = Null let bool x = Bool x let int x = Int x let float x = Float x let string x = String x let objekt l = Object l let array l = Array l let list f l = Array (List.map f l) let option = function None -> Null | Some x -> x let optional f = function None -> Null | Some x -> f x end let string_of_loc (pos1, pos2) = let line1 = pos1.pos_lnum and start1 = pos1.pos_bol in Printf.sprintf "File %S, line %i, characters %i-%i" pos1.pos_fname line1 (pos1.pos_cnum - start1) (pos2.pos_cnum - start1) json-wheel-1.0.6/META.template0000644000375200037520000000017711133644521015437 0ustar martinmartindescription = "JSON data format" requires = "netstring" archive(byte) = "jsonwheel.cma" archive(native) = "jsonwheel.cmxa" json-wheel-1.0.6/OCamlMakefile0000644000375200037520000007350011133644521015530 0ustar martinmartin########################################################################### # OCamlMakefile # Copyright (C) 1999-2004 Markus Mottl # # For updates see: # http://www.ocaml.info/home/ocaml_sources.html # # $Id: OCamlMakefile,v 1.72 2005/12/09 15:30:50 mottl Exp $ # ########################################################################### # Modified by damien for .glade.ml compilation # Set these variables to the names of the sources to be processed and # the result variable. Order matters during linkage! ifndef SOURCES SOURCES := foo.ml endif export SOURCES ifndef RES_CLIB_SUF RES_CLIB_SUF := _stubs endif export RES_CLIB_SUF ifndef RESULT RESULT := foo endif export RESULT export LIB_PACK_NAME ifndef DOC_FILES DOC_FILES := $(filter %.mli, $(SOURCES)) endif export DOC_FILES export BCSUFFIX export NCSUFFIX ifndef TOPSUFFIX TOPSUFFIX := .top endif export TOPSUFFIX # Eventually set include- and library-paths, libraries to link, # additional compilation-, link- and ocamlyacc-flags # Path- and library information needs not be written with "-I" and such... # Define THREADS if you need it, otherwise leave it unset (same for # USE_CAMLP4)! export THREADS export VMTHREADS export ANNOTATE export USE_CAMLP4 export INCDIRS export LIBDIRS export EXTLIBDIRS export RESULTDEPS export OCAML_DEFAULT_DIRS export LIBS export CLIBS export OCAMLFLAGS export OCAMLNCFLAGS export OCAMLBCFLAGS export OCAMLLDFLAGS export OCAMLNLDFLAGS export OCAMLBLDFLAGS ifndef OCAMLCPFLAGS OCAMLCPFLAGS := a endif export OCAMLCPFLAGS export PPFLAGS export YFLAGS export IDLFLAGS export OCAMLDOCFLAGS export OCAMLFIND_INSTFLAGS export DVIPSFLAGS export STATIC # Add a list of optional trash files that should be deleted by "make clean" export TRASH #################### variables depending on your OCaml-installation ifdef MINGW export MINGW WIN32 := 1 CFLAGS_WIN32 := -mno-cygwin endif ifdef MSVC export MSVC WIN32 := 1 ifndef STATIC CPPFLAGS_WIN32 := -DCAML_DLL endif CFLAGS_WIN32 += -nologo EXT_OBJ := obj EXT_LIB := lib ifeq ($(CC),gcc) # work around GNU Make default value ifdef THREADS CC := cl -MT else CC := cl endif endif ifeq ($(CXX),g++) # work around GNU Make default value CXX := $(CC) endif CFLAG_O := -Fo endif ifdef WIN32 EXT_CXX := cpp EXE := .exe endif ifndef EXT_OBJ EXT_OBJ := o endif ifndef EXT_LIB EXT_LIB := a endif ifndef EXT_CXX EXT_CXX := cc endif ifndef EXE EXE := # empty endif ifndef CFLAG_O CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! endif export CC export CXX export CFLAGS export CXXFLAGS export LDFLAGS export CPPFLAGS ifndef RPATH_FLAG RPATH_FLAG := -R endif export RPATH_FLAG ifndef MSVC ifndef PIC_CFLAGS PIC_CFLAGS := -fPIC endif ifndef PIC_CPPFLAGS PIC_CPPFLAGS := -DPIC endif endif export PIC_CFLAGS export PIC_CPPFLAGS BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) ifndef OCAMLFIND OCAMLFIND := ocamlfind endif export OCAMLFIND ifndef OCAMLC OCAMLC := ocamlc endif export OCAMLC ifndef OCAMLOPT OCAMLOPT := ocamlopt endif export OCAMLOPT ifndef OCAMLMKTOP OCAMLMKTOP := ocamlmktop endif export OCAMLMKTOP ifndef OCAMLCP OCAMLCP := ocamlcp endif export OCAMLCP ifndef OCAMLDEP OCAMLDEP := ocamldep endif export OCAMLDEP ifndef OCAMLLEX OCAMLLEX := ocamllex endif export OCAMLLEX ifndef OCAMLYACC OCAMLYACC := ocamlyacc endif export OCAMLYACC ifndef OCAMLMKLIB OCAMLMKLIB := ocamlmklib endif export OCAMLMKLIB ifndef OCAML_GLADECC OCAML_GLADECC := lablgladecc2 endif export OCAML_GLADECC ifndef OCAML_GLADECC_FLAGS OCAML_GLADECC_FLAGS := endif export OCAML_GLADECC_FLAGS ifndef CAMELEON_REPORT CAMELEON_REPORT := report endif export CAMELEON_REPORT ifndef CAMELEON_REPORT_FLAGS CAMELEON_REPORT_FLAGS := endif export CAMELEON_REPORT_FLAGS ifndef CAMELEON_ZOGGY CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo endif export CAMELEON_ZOGGY ifndef CAMELEON_ZOGGY_FLAGS CAMELEON_ZOGGY_FLAGS := endif export CAMELEON_ZOGGY_FLAGS ifndef OXRIDL OXRIDL := oxridl endif export OXRIDL ifndef CAMLIDL CAMLIDL := camlidl endif export CAMLIDL ifndef CAMLIDLDLL CAMLIDLDLL := camlidldll endif export CAMLIDLDLL ifndef NOIDLHEADER MAYBE_IDL_HEADER := -header endif export NOIDLHEADER export NO_CUSTOM ifndef CAMLP4 CAMLP4 := camlp4 endif export CAMLP4 ifndef REAL_OCAMLFIND ifdef PACKS ifndef CREATE_LIB ifdef THREADS PACKS += threads endif endif empty := space := $(empty) $(empty) comma := , ifdef PREDS PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS)) PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS)) OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES) # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES) OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES) else OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS)) OCAML_DEP_PACKAGES := endif OCAML_FIND_LINKPKG := -linkpkg REAL_OCAMLFIND := $(OCAMLFIND) endif endif export OCAML_FIND_PACKAGES export OCAML_DEP_PACKAGES export OCAML_FIND_LINKPKG export REAL_OCAMLFIND ifndef OCAMLDOC OCAMLDOC := ocamldoc endif export OCAMLDOC ifndef LATEX LATEX := latex endif export LATEX ifndef DVIPS DVIPS := dvips endif export DVIPS ifndef PS2PDF PS2PDF := ps2pdf endif export PS2PDF ifndef OCAMLMAKEFILE OCAMLMAKEFILE := OCamlMakefile endif export OCAMLMAKEFILE ifndef OCAMLLIBPATH OCAMLLIBPATH := \ $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) endif export OCAMLLIBPATH ifndef OCAML_LIB_INSTALL OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib endif export OCAML_LIB_INSTALL ########################################################################### #################### change following sections only if #################### you know what you are doing! # delete target files when a build command fails .PHONY: .DELETE_ON_ERROR .DELETE_ON_ERROR: # for pedants using "--warn-undefined-variables" export MAYBE_IDL export REAL_RESULT export CAMLIDLFLAGS export THREAD_FLAG export RES_CLIB export MAKEDLL export ANNOT_FLAG export C_OXRIDL export SUBPROJS export CFLAGS_WIN32 export CPPFLAGS_WIN32 INCFLAGS := SHELL := /bin/sh MLDEPDIR := ._d BCDIDIR := ._bcdi NCDIDIR := ._ncdi FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.$(EXT_CXX) %.rep %.zog %.glade FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES)) SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) FILTERED_REP := $(filter %.rep, $(FILTERED)) DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d) AUTO_REP := $(FILTERED_REP:.rep=.ml) FILTERED_ZOG := $(filter %.zog, $(FILTERED)) DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d) AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml) FILTERED_GLADE := $(filter %.glade, $(FILTERED)) DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d) AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml) FILTERED_ML := $(filter %.ml, $(FILTERED)) DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) FILTERED_MLI := $(filter %.mli, $(FILTERED)) DEP_MLI := $(FILTERED_MLI:.mli=.di) FILTERED_MLL := $(filter %.mll, $(FILTERED)) DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) AUTO_MLL := $(FILTERED_MLL:.mll=.ml) FILTERED_MLY := $(filter %.mly, $(FILTERED)) DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) FILTERED_IDL := $(filter %.idl, $(FILTERED)) DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) ifndef NOIDLHEADER C_IDL += $(FILTERED_IDL:.idl=.h) endif OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED)) DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di) AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL) FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE) ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE) MLDEPS := $(filter %.d, $(ALL_DEPS)) MLIDEPS := $(filter %.di, $(ALL_DEPS)) BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED)) IMPLO_INTF := $(ALLML:%.mli=%.mli.__) IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ $(basename $(file)).cmi $(basename $(file)).cmo) IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) INTF := $(filter %.cmi, $(IMPLO_INTF)) IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) IMPL_ASM := $(IMPL_CMO:.cmo=.asm) IMPL_S := $(IMPL_CMO:.cmo=.s) OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) EXECS := $(addsuffix $(EXE), \ $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) ifdef WIN32 EXECS += $(BCRESULT).dll $(NCRESULT).dll endif CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) ifneq ($(strip $(OBJ_LINK)),) RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) endif ifdef WIN32 DLLSONAME := $(CLIB_BASE).dll else DLLSONAME := dll$(CLIB_BASE).so endif NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \ $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \ $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \ $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \ $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \ $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o ifndef STATIC NONEXECS += $(DLLSONAME) endif ifndef LIBINSTALL_FILES LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB) ifndef STATIC ifneq ($(strip $(OBJ_LINK)),) LIBINSTALL_FILES += $(DLLSONAME) endif endif endif export LIBINSTALL_FILES ifdef WIN32 # some extra stuff is created while linking DLLs NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib endif TARGETS := $(EXECS) $(NONEXECS) # If there are IDL-files ifneq ($(strip $(FILTERED_IDL)),) MAYBE_IDL := -cclib -lcamlidl endif ifdef USE_CAMLP4 CAMLP4PATH := \ $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) INCFLAGS := -I $(CAMLP4PATH) CINCFLAGS := -I$(CAMLP4PATH) endif DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %) CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) ifndef MSVC CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \ $(EXTLIBDIRS:%=-L%) $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%) \ $(OCAML_DEFAULT_DIRS:%=-L%) endif ifndef PROFILING INTF_OCAMLC := $(OCAMLC) else ifndef THREADS INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) else # OCaml does not support profiling byte code # with threads (yet), therefore we force an error. ifndef REAL_OCAMLC $(error Profiling of multithreaded byte code not yet supported by OCaml) endif INTF_OCAMLC := $(OCAMLC) endif endif ifndef MSVC COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \ $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%) \ $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) else COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \ $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \ $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) " endif CLIBS_OPTS := $(CLIBS:%=-cclib -l%) ifdef MSVC ifndef STATIC # MSVC libraries do not have 'lib' prefix CLIBS_OPTS := $(CLIBS:%=-cclib %.lib) endif endif ifneq ($(strip $(OBJ_LINK)),) ifdef CREATE_LIB OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) else OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) endif else OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) endif # If we have to make byte-code ifndef REAL_OCAMLC BYTE_OCAML := y # EXTRADEPS is added dependencies we have to insert for all # executable files we generate. Ideally it should be all of the # libraries we use, but it's hard to find the ones that get searched on # the path since I don't know the paths built into the compiler, so # just include the ones with slashes in their names. EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) REAL_OCAMLC := $(INTF_OCAMLC) REAL_IMPL := $(IMPL_CMO) REAL_IMPL_INTF := $(IMPLO_INTF) IMPL_SUF := .cmo DEPFLAGS := MAKE_DEPS := $(MLDEPS) $(BCDEPIS) ifdef CREATE_LIB override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) ifndef STATIC ifneq ($(strip $(OBJ_LINK)),) MAKEDLL := $(DLLSONAME) ALL_LDFLAGS := -dllib $(DLLSONAME) endif endif endif ifndef NO_CUSTOM ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" ALL_LDFLAGS += -custom endif endif ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ $(COMMON_LDFLAGS) $(LIBS:%=%.cma) CAMLIDLDLLFLAGS := ifdef THREADS ifdef VMTHREADS THREAD_FLAG := -vmthread else THREAD_FLAG := -thread endif ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) ifndef CREATE_LIB ifndef REAL_OCAMLFIND ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS) endif endif endif # we have to make native-code else EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i)))) ifndef PROFILING SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) PLDFLAGS := else SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) PLDFLAGS := -p endif REAL_IMPL := $(IMPL_CMX) REAL_IMPL_INTF := $(IMPLX_INTF) IMPL_SUF := .cmx override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS) DEPFLAGS := -native MAKE_DEPS := $(MLDEPS) $(NCDEPIS) ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) CAMLIDLDLLFLAGS := -opt ifndef CREATE_LIB ALL_LDFLAGS += $(LIBS:%=%.cmxa) else override CFLAGS := $(PIC_CFLAGS) $(CFLAGS) override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS) endif ifdef THREADS THREAD_FLAG := -thread ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS) ifndef CREATE_LIB ifndef REAL_OCAMLFIND ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS) endif endif endif endif export MAKE_DEPS ifdef ANNOTATE ANNOT_FLAG := -dtypes else endif ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \ $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) ifdef make_deps -include $(MAKE_DEPS) PRE_TARGETS := endif ########################################################################### # USER RULES # Call "OCamlMakefile QUIET=" to get rid of all of the @'s. QUIET=@ # generates byte-code (default) byte-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes bc: byte-code byte-code-nolink: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(BCRESULT)" make_deps=yes bcnl: byte-code-nolink top: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes # generates native-code native-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes nc: native-code native-code-nolink: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes ncnl: native-code-nolink # generates byte-code libraries byte-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" \ CREATE_LIB=yes \ make_deps=yes bcl: byte-code-library # generates native-code libraries native-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).cmxa \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ CREATE_LIB=yes \ make_deps=yes ncl: native-code-library ifdef WIN32 # generates byte-code dll byte-code-dll: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).dll \ REAL_RESULT="$(BCRESULT)" \ make_deps=yes bcd: byte-code-dll # generates native-code dll native-code-dll: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).dll \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes ncd: native-code-dll endif # generates byte-code with debugging information debug-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dc: debug-code debug-code-nolink: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dcnl: debug-code-nolink # generates byte-code libraries with debugging information debug-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ CREATE_LIB=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dcl: debug-code-library # generates byte-code for profiling profiling-byte-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" PROFILING="y" \ make_deps=yes pbc: profiling-byte-code # generates native-code profiling-native-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ PROFILING="y" \ make_deps=yes pnc: profiling-native-code # generates byte-code libraries profiling-byte-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" PROFILING="y" \ CREATE_LIB=yes \ make_deps=yes pbcl: profiling-byte-code-library # generates native-code libraries profiling-native-code-library: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).cmxa \ REAL_RESULT="$(NCRESULT)" PROFILING="y" \ REAL_OCAMLC="$(OCAMLOPT)" \ CREATE_LIB=yes \ make_deps=yes pncl: profiling-native-code-library # packs byte-code objects pack-byte-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \ REAL_RESULT="$(BCRESULT)" \ PACK_LIB=yes make_deps=yes pabc: pack-byte-code # packs native-code objects pack-native-code: $(PRE_TARGETS) $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(NCRESULT).cmx $(NCRESULT).o \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ PACK_LIB=yes make_deps=yes panc: pack-native-code # generates HTML-documentation htdoc: doc/$(RESULT)/html # generates Latex-documentation ladoc: doc/$(RESULT)/latex # generates PostScript-documentation psdoc: doc/$(RESULT)/latex/doc.ps # generates PDF-documentation pdfdoc: doc/$(RESULT)/latex/doc.pdf # generates all supported forms of documentation doc: htdoc ladoc psdoc pdfdoc ########################################################################### # LOW LEVEL RULES $(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) \ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ $(REAL_IMPL) nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) ifdef WIN32 $(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ -o $@ $(REAL_IMPL) endif %$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(REAL_OCAMLFIND) $(OCAMLMKTOP) \ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ $(REAL_IMPL) .SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .$(EXT_CXX) .h .so \ .rep .zog .glade ifndef STATIC ifdef MINGW $(DLLSONAME): $(OBJ_LINK) $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \ -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \ $(OCAMLLIBPATH)/ocamlrun.a \ -Wl,--export-all-symbols \ -Wl,--no-whole-archive else ifdef MSVC $(DLLSONAME): $(OBJ_LINK) link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \ $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \ $(OCAMLLIBPATH)/ocamlrun.lib else $(DLLSONAME): $(OBJ_LINK) $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \ -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) \ $(OCAMLMKLIB_FLAGS) endif endif endif ifndef LIB_PACK_NAME $(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) else ifdef BYTE_OCAML $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(REAL_IMPL) else $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmx $(REAL_IMPL) endif $(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(LIB_PACK_NAME).cmo $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS) $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ $(OCAMLNLDFLAGS) -o $@ $(LIB_PACK_NAME).cmx endif $(RES_CLIB): $(OBJ_LINK) ifndef MSVC ifneq ($(strip $(OBJ_LINK)),) $(AR) rcs $@ $(OBJ_LINK) endif else ifneq ($(strip $(OBJ_LINK)),) lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK) endif endif .mli.cmi: $(EXTRADEPS) $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ else \ echo $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ fi .ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS) $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(ALL_OCAMLCFLAGS) $<; \ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c $(ALL_OCAMLCFLAGS) $<; \ else \ echo $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \ -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \ fi ifdef PACK_LIB $(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(REAL_IMPL) endif .PRECIOUS: %.ml %.ml: %.mll $(OCAMLLEX) $< .PRECIOUS: %.ml %.mli %.ml %.mli: %.mly $(OCAMLYACC) $(YFLAGS) $< $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \ if [ ! -z "$$pp" ]; then \ mv $*.ml $*.ml.temporary; \ echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \ cat $*.ml.temporary >> $*.ml; \ rm $*.ml.temporary; \ mv $*.mli $*.mli.temporary; \ echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \ cat $*.mli.temporary >> $*.mli; \ rm $*.mli.temporary; \ fi .PRECIOUS: %.ml %.ml: %.rep $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $< .PRECIOUS: %.ml %.ml: %.zog $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@ .PRECIOUS: %.ml %.ml: %.glade $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@ .PRECIOUS: %.ml %.mli %.ml %.mli: %.oxridl $(OXRIDL) $< .PRECIOUS: %.ml %.mli %_stubs.c %.h %.ml %.mli %_stubs.c %.h: %.idl $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ $(CAMLIDLFLAGS) $< $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi .c.$(EXT_OBJ): $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \ $(CPPFLAGS) $(CPPFLAGS_WIN32) \ $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $< .$(EXT_CXX).$(EXT_OBJ): $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \ -I'$(OCAMLLIBPATH)' \ $< $(CFLAG_O)$@ $(MLDEPDIR)/%.d: %.ml $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ $(DINCFLAGS) $< \> $@; \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ $(DINCFLAGS) $< > $@; \ else \ echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ fi $(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< \> $@; \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \ else \ echo $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \ fi doc/$(RESULT)/html: $(DOC_FILES) rm -rf $@ mkdir -p $@ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \ else \ echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -html -d $@ $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES); \ $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -html -d $@ $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES); \ fi doc/$(RESULT)/latex: $(DOC_FILES) rm -rf $@ mkdir -p $@ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \ $(DOC_FILES) -o $@/doc.tex; \ $(OCAMLDOC) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \ -o $@/doc.tex; \ else \ echo $(OCAMLDOC) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ $(OCAMLDOC) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \ $(INCFLAGS) $(DOC_FILES) -o $@/doc.tex; \ fi doc/$(RESULT)/latex/doc.ps: doc/$(RESULT)/latex cd doc/$(RESULT)/latex && \ $(LATEX) doc.tex && \ $(LATEX) doc.tex && \ $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) doc/$(RESULT)/latex/doc.pdf: doc/$(RESULT)/latex/doc.ps cd doc/$(RESULT)/latex && $(PS2PDF) $( `UTF32BE | '\000', _, '\000', _ -> `UTF16BE | _, '\000', '\000', '\000' -> `UTF32LE | _, '\000', _, '\000' -> `UTF16LE | _ -> `UTF8 let hexval c = match c with '0'..'9' -> int_of_char c - int_of_char '0' | 'a'..'f' -> int_of_char c - int_of_char 'a' + 10 | 'A'..'F' -> int_of_char c - int_of_char 'A' + 10 | _ -> assert false let make_int big_int_mode s = try INT (int_of_string s) with _ -> if big_int_mode then STRING s else json_error (s ^ " is too large for OCaml's type int, sorry") let utf8_of_point i = Netconversion.ustring_of_uchar `Enc_utf8 i let custom_error descr lexbuf = json_error (sprintf "%s:\n%s" (string_of_loc (loc lexbuf)) descr) let lexer_error descr lexbuf = custom_error (sprintf "%s '%s'" descr (Lexing.lexeme lexbuf)) lexbuf let set_file_name lexbuf name = lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = name } let newline lexbuf = let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum } type param = { allow_comments : bool; big_int_mode : bool; allow_nan : bool } } let space = [' ' '\t' '\r']+ let digit = ['0'-'9'] let nonzero = ['1'-'9'] let digits = digit+ let frac = '.' digits let e = ['e' 'E']['+' '-']? let exp = e digits let int = '-'? (digit | nonzero digits) let float = int frac | int exp | int frac exp let hex = [ '0'-'9' 'a'-'f' 'A'-'F' ] let unescaped = ['\x20'-'\x21' '\x23'-'\x5B' '\x5D'-'\xFF' ] rule token p = parse | "//"[^'\n']* { if p.allow_comments then token p lexbuf else lexer_error "Comments are not allowed: " lexbuf } | "/*" { if p.allow_comments then (comment lexbuf; token p lexbuf) else lexer_error "Comments are not allowed: " lexbuf } | '{' { OBJSTART } | '}' { OBJEND } | '[' { ARSTART } | ']' { AREND } | ',' { COMMA } | ':' { COLON } | "true" { BOOL true } | "false" { BOOL false } | "null" { NULL } | "NaN" { if p.allow_nan then FLOAT nan else lexer_error "NaN values are not allowed: " lexbuf } | "Infinity" { if p.allow_nan then FLOAT infinity else lexer_error "Infinite values are not allowed: " lexbuf } | "-Infinity" { if p.allow_nan then FLOAT neg_infinity else lexer_error "Infinite values are not allowed: " lexbuf } | '"' { STRING (string [] lexbuf) } | int { make_int p.big_int_mode (lexeme lexbuf) } | float { FLOAT (float_of_string (lexeme lexbuf)) } | "\n" { newline lexbuf; token p lexbuf } | space { token p lexbuf } | eof { EOF } | _ { lexer_error "Invalid token" lexbuf } and string l = parse '"' { String.concat "" (List.rev l) } | '\\' { let s = escaped_char lexbuf in string (s :: l) lexbuf } | unescaped+ { let s = lexeme lexbuf in string (s :: l) lexbuf } | _ as c { custom_error (sprintf "Unescaped control character \\u%04X or \ unterminated string" (int_of_char c)) lexbuf } | eof { custom_error "Unterminated string" lexbuf } and escaped_char = parse '"' | '\\' | '/' { lexeme lexbuf } | 'b' { "\b" } | 'f' { "\012" } | 'n' { "\n" } | 'r' { "\r" } | 't' { "\t" } | 'u' (hex hex hex hex as x) { let i = 0x1000 * hexval x.[0] + 0x100 * hexval x.[1] + 0x10 * hexval x.[2] + hexval x.[3] in utf8_of_point i } | _ { lexer_error "Invalid escape sequence" lexbuf } and comment = parse | "*/" { () } | eof { lexer_error "Unterminated comment" lexbuf } | '\n' { newline lexbuf; comment lexbuf } | _ { comment lexbuf } { let make_param ?(allow_comments = false) ?(allow_nan = false) ?(big_int_mode = false) () = { allow_comments = allow_comments; big_int_mode = big_int_mode; allow_nan = allow_nan } } json-wheel-1.0.6/json_io.ml0000644000375200037520000002752711133644521015156 0ustar martinmartintype t = Json_type.t open Json_type (*** Parsing ***) let check_string_is_utf8 s = let encoding = if String.length s < 4 then `UTF8 else Json_lexer.detect_encoding s.[0] s.[1] s.[2] s.[3] in if encoding <> `UTF8 then json_error "Only UTF-8 encoding is supported" let filter_result x = Browse.assert_object_or_array x; x let json_of_string ?allow_comments ?allow_nan ?big_int_mode ?(recursive = false) s = check_string_is_utf8 s; let p = Json_lexer.make_param ?allow_comments ?allow_nan ?big_int_mode () in let j = Json_parser.main (Json_lexer.token p) (Lexing.from_string s) in if not recursive then filter_result j else j let check_channel_is_utf8 ic = let start = pos_in ic in let encoding = try let c1 = input_char ic in let c2 = input_char ic in let c3 = input_char ic in let c4 = input_char ic in Json_lexer.detect_encoding c1 c2 c3 c4 with End_of_file -> `UTF8 in if encoding <> `UTF8 then json_error "Only UTF-8 encoding is supported"; (try seek_in ic start with _ -> json_error "Not a regular file") (* from_channel and from_channel4 work only on seekable devices (regular files) *) let from_channel p recursive file ic = check_channel_is_utf8 ic; let lexbuf = Lexing.from_channel ic in Json_lexer.set_file_name lexbuf file; let j = Json_parser.main (Json_lexer.token p) lexbuf in if recursive then j else filter_result j let load_json ?allow_comments ?allow_nan ?big_int_mode ?(recursive = false) file = let ic = open_in file in let x = let p = Json_lexer.make_param ?allow_comments ?allow_nan ?big_int_mode () in try `Result (from_channel p recursive file ic) with e -> `Exn e in close_in ic; match x with `Result x -> x | `Exn e -> raise e (*** Printing ***) (* JSON does not allow rendering floats with a trailing dot: that is, 1234. is not allowed, but 1234.0 is ok. here, we add a '0' if string_of_int result in a trailing dot *) let fprint_float allow_nan fmt f = match classify_float f with FP_nan -> if allow_nan then Format.fprintf fmt "NaN" else json_error "Not allowed to serialize NaN value" | FP_infinite -> if allow_nan then if f < 0. then Format.fprintf fmt "-Infinity" else Format.fprintf fmt "Infinity" else json_error "Not allowed to serialize infinite value" | FP_zero | FP_normal | FP_subnormal -> let s = string_of_float f in Format.fprintf fmt "%s" s; let s_len = String.length s in if s.[ s_len - 1 ] = '.' then Format.fprintf fmt "0" let escape_json_string buf s = for i = 0 to String.length s - 1 do let c = String.unsafe_get s i in match c with | '"' -> Buffer.add_string buf "\\\"" | '\t' -> Buffer.add_string buf "\\t" | '\r' -> Buffer.add_string buf "\\r" | '\b' -> Buffer.add_string buf "\\b" | '\n' -> Buffer.add_string buf "\\n" | '\012' -> Buffer.add_string buf "\\f" | '\\' -> Buffer.add_string buf "\\\\" (* | '/' -> "\\/" *) (* Forward slash can be escaped but doesn't have to *) | '\x00'..'\x1F' (* Control characters that must be escaped *) | '\x7F' (* DEL *) -> Printf.bprintf buf "\\u%04X" (int_of_char c) | _ -> (* Don't bother detecting or escaping multibyte chars *) Buffer.add_char buf c done let fquote_json_string fmt s = let buf = Buffer.create (String.length s) in escape_json_string buf s; Format.fprintf fmt "\"%s\"" (Buffer.contents buf) let bquote_json_string buf s = Printf.bprintf buf "\"%a\"" escape_json_string s module Compact = struct open Format let rec fprint_json allow_nan fmt = function Object o -> pp_print_string fmt "{"; fprint_object allow_nan fmt o; pp_print_string fmt "}" | Array a -> pp_print_string fmt "["; fprint_list allow_nan fmt a; pp_print_string fmt "]" | Bool b -> pp_print_string fmt (if b then "true" else "false") | Null -> pp_print_string fmt "null" | Int i -> pp_print_string fmt (string_of_int i) | Float f -> pp_print_string fmt (string_of_json_float allow_nan f) | String s -> fquote_json_string fmt s and fprint_list allow_nan fmt = function [] -> () | [x] -> fprint_json allow_nan fmt x | x :: tl -> fprint_json allow_nan fmt x; pp_print_string fmt ","; fprint_list allow_nan fmt tl and fprint_object allow_nan fmt = function [] -> () | [x] -> fprint_pair allow_nan fmt x | x :: tl -> fprint_pair allow_nan fmt x; pp_print_string fmt ","; fprint_object allow_nan fmt tl and fprint_pair allow_nan fmt (key, x) = fquote_json_string fmt key; fprintf fmt ":"; fprint_json allow_nan fmt x (* json does not allow rendering floats with a trailing dot: that is, 1234. is not allowed, but 1234.0 is ok. here, we add a '0' if string_of_int result in a trailing dot *) and string_of_json_float allow_nan f = let s = string_of_float f in let s_len = String.length s in if s.[ s_len - 1 ] = '.' then s ^ "0" else s let print ?(allow_nan = false) ?(recursive = false) fmt x = if not recursive then Browse.assert_object_or_array x; fprint_json allow_nan fmt x end module Fast = struct open Printf open Buffer (* Contiguous sequence of non-escaped characters are copied to the buffer using one call to Buffer.add_substring *) let rec buf_add_json_escstr1 buf s k1 l = if k1 < l then ( let k2 = buf_add_json_escstr2 buf s k1 k1 l in if k2 > k1 then Buffer.add_substring buf s k1 (k2 - k1); if k2 < l then ( let c = String.unsafe_get s k2 in ( match c with | '"' -> Buffer.add_string buf "\\\"" | '\t' -> Buffer.add_string buf "\\t" | '\r' -> Buffer.add_string buf "\\r" | '\b' -> Buffer.add_string buf "\\b" | '\n' -> Buffer.add_string buf "\\n" | '\012' -> Buffer.add_string buf "\\f" | '\\' -> Buffer.add_string buf "\\\\" (* | '/' -> "\\/" *) (* Forward slash can be escaped but doesn't have to *) | '\x00'..'\x1F' (* Control characters that must be escaped *) | '\x7F' (* DEL *) -> Printf.bprintf buf "\\u%04X" (int_of_char c) | _ -> assert false ); buf_add_json_escstr1 buf s (k2+1) l ) ) and buf_add_json_escstr2 buf s k1 k2 l = if k2 < l then ( let c = String.unsafe_get s k2 in match c with | '"' | '\t' | '\r' | '\b' | '\n' | '\012' | '\\' (*| '/'*) | '\x00'..'\x1F' | '\x7F' -> k2 | _ -> buf_add_json_escstr2 buf s k1 (k2+1) l ) else l and bquote_json_string buf s = Buffer.add_char buf '"'; buf_add_json_escstr1 buf s 0 (String.length s); Buffer.add_char buf '"' let rec bprint_json allow_nan buf = function Object o -> add_string buf "{"; bprint_object allow_nan buf o; add_string buf "}" | Array a -> add_string buf "["; bprint_list allow_nan buf a; add_string buf "]" | Bool b -> add_string buf (if b then "true" else "false") | Null -> add_string buf "null" | Int i -> add_string buf (string_of_int i) | Float f -> add_string buf (string_of_json_float allow_nan f) | String s -> bquote_json_string buf s and bprint_list allow_nan buf = function [] -> () | [x] -> bprint_json allow_nan buf x | x :: tl -> bprint_json allow_nan buf x; add_string buf ","; bprint_list allow_nan buf tl and bprint_object allow_nan buf = function [] -> () | [x] -> bprint_pair allow_nan buf x | x :: tl -> bprint_pair allow_nan buf x; add_string buf ","; bprint_object allow_nan buf tl and bprint_pair allow_nan buf (key, x) = bquote_json_string buf key; bprintf buf ":"; bprint_json allow_nan buf x (* json does not allow rendering floats with a trailing dot: that is, 1234. is not allowed, but 1234.0 is ok. here, we add a '0' if string_of_int result in a trailing dot *) and string_of_json_float allow_nan f = match classify_float f with FP_nan -> if allow_nan then "NaN" else json_error "Not allowed to serialize NaN value" | FP_infinite -> if allow_nan then if f < 0. then "-Infinity" else "Infinity" else json_error "Not allowed to serialize infinite value" | FP_zero | FP_normal | FP_subnormal -> let s = string_of_float f in let s_len = String.length s in if s.[ s_len - 1 ] = '.' then s ^ "0" else s let print ?(allow_nan = false) ?(recursive = false) buf x = if not recursive then Browse.assert_object_or_array x; bprint_json allow_nan buf x end (*** Pretty printing ***) module Pretty = struct open Format (* Printing anything but a value in a key:value pair. Opening and closing brackets in such arrays and objects are aligned vertically if they are not on the same line. *) let rec fprint_json allow_nan fmt = function Object l -> fprint_object allow_nan fmt l | Array l -> fprint_array allow_nan fmt l | Bool b -> fprintf fmt "%s" (if b then "true" else "false") | Null -> fprintf fmt "null" | Int i -> fprintf fmt "%i" i | Float f -> fprint_float allow_nan fmt f | String s -> fquote_json_string fmt s (* Printing an array which is not the value in a key:value pair *) and fprint_array allow_nan fmt = function [] -> fprintf fmt "[]" | x :: tl -> fprintf fmt "@[[@ "; fprint_json allow_nan fmt x; List.iter (fun x -> fprintf fmt ",@ "; fprint_json allow_nan fmt x) tl; fprintf fmt "@;<1 -2>]@]" (* Printing an object which is not the value in a key:value pair *) and fprint_object allow_nan fmt = function [] -> fprintf fmt "{}" | x :: tl -> fprintf fmt "@[{@ "; fprint_pair allow_nan fmt x; List.iter (fun x -> fprintf fmt ",@ "; fprint_pair allow_nan fmt x) tl; fprintf fmt "@;<1 -2>}@]" (* Printing a key:value pair. The opening bracket stays on the same line as the key, no matter what, and the closing bracket is either on the same line or vertically aligned with the beginning of the key. *) and fprint_pair allow_nan fmt (key, x) = match x with Object l -> (match l with [] -> fprintf fmt "%a: {}" fquote_json_string key | x :: tl -> fprintf fmt "@[%a: {@ " fquote_json_string key; fprint_pair allow_nan fmt x; List.iter (fun x -> fprintf fmt ",@ "; fprint_pair allow_nan fmt x) tl; fprintf fmt "@;<1 -2>}@]") | Array l -> (match l with [] -> fprintf fmt "%a: []" fquote_json_string key | x :: tl -> fprintf fmt "@[%a: [@ " fquote_json_string key; fprint_json allow_nan fmt x; List.iter (fun x -> fprintf fmt ",@ "; fprint_json allow_nan fmt x) tl; fprintf fmt "@;<1 -2>]@]") | _ -> (* An atom, perhaps a long string that would go to the next line *) fprintf fmt "@[%a:@;<1 2>%a@]" fquote_json_string key (fprint_json allow_nan) x let print ?(allow_nan = false) ?(recursive = false) fmt x = if not recursive then Browse.assert_object_or_array x; fprint_json allow_nan fmt x end let string_of_json ?allow_nan ?(compact = false) ?recursive x = let buf = Buffer.create 2000 in if compact then Fast.print ?allow_nan ?recursive buf x else (let fmt = Format.formatter_of_buffer buf in (match recursive with None | Some false -> Browse.assert_object_or_array x | Some true -> () ); let allow_nan = match allow_nan with None -> false | Some b -> b in Pretty.fprint_json allow_nan fmt x; Format.pp_print_flush fmt ()); Buffer.contents buf let save_json ?allow_nan ?(compact = false) ?recursive file x = let oc = open_out file in let print = if compact then Compact.print else Pretty.print in let fmt = Format.formatter_of_out_channel oc in try print ?allow_nan ?recursive fmt x; Format.pp_print_flush fmt (); close_out oc with e -> close_out_noerr oc; raise e json-wheel-1.0.6/LICENSE0000644000375200037520000000264211133644521014160 0ustar martinmartinCopyright (c) 2006 Wink Technologies, Inc. Copyright (c) 2006, 2009 Martin Jambon 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. json-wheel-1.0.6/Makefile0000644000375200037520000000556111133644521014616 0ustar martinmartinVERSION = 1.0.6 export VERSION RESULT = jsonwheel NAME = json-wheel ONAME = json_wheel SOURCES = \ json_type.mli json_type.ml \ json_parser.mli json_parser.mly \ json_lexer.mll \ json_io.mli json_io.ml \ json_compat.ml PACKS = netstring STDBIN = $(shell dirname `which ocamlfind`) ifndef PREFIX PREFIX = $(shell dirname $(STDBIN)) endif export PREFIX ifndef BINDIR BINDIR = $(PREFIX)/bin endif export BINDIR BYTERESULT = $(RESULT).cma json_*.cmo OPTRESULT = $(RESULT).cmxa $(RESULT).a json_*.cmx json_*.o .PHONY: default all opt install uninstall html archive test default: bcl ncl jsoncat all: bcl opt: ncl jsoncat install: $(MAKE) META ocamlfind install $(NAME) META json_*.cmi \ json_type.mli json_io.mli json_compat.ml \ `test -f $(RESULT).cma && echo $(BYTERESULT)` \ `test -f $(RESULT).cmxa && echo $(OPTRESULT)` if test -f jsoncat$(EXE); \ then install -m 0755 jsoncat$(EXE) $(BINDIR)/ ; \ else : ; fi uninstall: ocamlfind remove $(NAME) rm -f $(BINDIR)/jsoncat$(EXE) version.ml: Makefile echo 'let version = "$(VERSION)"' > version.ml jsoncat: version.ml jsoncat.ml $(MAKE) ncl ocamlfind ocamlopt -o jsoncat -package $(PACKS) -linkpkg \ $(RESULT).cmxa version.ml jsoncat.ml test: jsoncat ./jsoncat -test cmp sample-compact.json sample-compact2.json cmp sample-indented.json sample-indented2.json rm sample-compact.json sample-compact2.json \ sample-indented.json sample-indented2.json check: @echo "-------------------- Standard mode --------------------" ./check.sh @echo "--------------------- Big int mode --------------------" ./check.sh -b @echo "Some of the tests are known to produce an ERROR, see README." META: META.template Makefile echo 'name = "$(NAME)"' > META echo 'version = "$(VERSION)"' >> META cat META.template >> META html: ocamldoc -d html -html json_type.mli json_io.mli json_compat.ml archive: META html rm -rf /tmp/$(NAME) /tmp/$(NAME)-$(VERSION) && \ cp -r . /tmp/$(NAME) && \ cd /tmp/$(NAME) && \ $(MAKE) clean && \ rm -f *~ $(NAME)*.tar* && \ cd /tmp && cp -r $(NAME) $(NAME)-$(VERSION) && \ tar czf $(NAME).tar.gz $(NAME) && \ tar cjf $(NAME).tar.bz2 $(NAME) && \ tar czf $(NAME)-$(VERSION).tar.gz $(NAME)-$(VERSION) && \ tar cjf $(NAME)-$(VERSION).tar.bz2 $(NAME)-$(VERSION) mv /tmp/$(NAME).tar.gz /tmp/$(NAME).tar.bz2 . mv /tmp/$(NAME)-$(VERSION).tar.gz /tmp/$(NAME)-$(VERSION).tar.bz2 . cp $(NAME).tar.gz $(NAME).tar.bz2 $$WWW/ cp $(NAME)-$(VERSION).tar.gz $(NAME)-$(VERSION).tar.bz2 $$WWW/ cp LICENSE $$WWW/$(NAME)-license.txt echo 'let $(ONAME)_version = "$(VERSION)"' \ > $$WWW/$(NAME)-version.ml cp Changes $$WWW/$(NAME)-changes.txt mkdir -p $$WWW/$(NAME)-doc cp html/* $$WWW/$(NAME)-doc TRASH = jsoncat jsoncat.o jsoncat.cm* version.* \ sample-compact.json sample-compact2.json \ sample-indented.json sample-indented2.json OCAMLMAKEFILE = OCamlMakefile include $(OCAMLMAKEFILE) json-wheel-1.0.6/json_io.mli0000644000375200037520000000657411133644521015326 0ustar martinmartin(** Input and output functions for the JSON format as defined by {{:http://www.json.org/}http://www.json.org/} *) (** [json_of_string s] reads the given JSON string. If [allow_comments] is [true], then C++ style comments are allowed, i.e. [/* blabla possibly on several lines */] or [// blabla until the end of the line]. Comments are not part of the JSON specification and are disabled by default. If [allow_nan] is [true], then OCaml [nan], [infinity] and [neg_infinity] float values are represented using their Javascript counterparts [NaN], [Infinity] and [-Infinity]. If [big_int_mode] is [true], then JSON ints that cannot be represented using OCaml's int type are represented by strings. This would happen only for ints that are out of the range defined by [min_int] and [max_int], i.e. \[-1G, +1G\[ on a 32-bit platform. The default is [false] and a [Json_type.Json_error] exception is raised if an int is too big. If [recursive] is true, then all JSON values are accepted rather than just arrays and objects as specified by the standard. The default is [false]. *) val json_of_string : ?allow_comments:bool -> ?allow_nan:bool -> ?big_int_mode:bool -> ?recursive:bool -> string -> Json_type.t (** Same as [Json_io.json_of_string] but the argument is a file to read from. *) val load_json : ?allow_comments:bool -> ?allow_nan:bool -> ?big_int_mode:bool -> ?recursive:bool -> string -> Json_type.t (** Conversion of JSON data to compact text. *) module Compact : sig (** Generic printing function without superfluous space. See the standard [Format] module for how to create and use formatters. In general, {!Json_io.string_of_json} and {!Json_io.save_json} are more convenient. *) val print : ?allow_nan: bool -> ?recursive:bool -> Format.formatter -> Json_type.t -> unit end (** Conversion of JSON data to compact text, optimized for speed. *) module Fast : sig (** This function is faster than the one provided by the {!Json_io.Compact} submodule but it is less generic and is subject to the 16MB size limit of strings on 32-bit architectures. *) val print : ?allow_nan: bool -> ?recursive:bool -> Buffer.t -> Json_type.t -> unit end (** Conversion of JSON data to indented text. *) module Pretty : sig (** Generic pretty-printing function. See the standard [Format] module for how to create and use formatters. In general, {!Json_io.string_of_json} and {!Json_io.save_json} are more convenient. *) val print : ?allow_nan: bool -> ?recursive:bool -> Format.formatter -> Json_type.t -> unit end (** [string_of_json] converts JSON data to a string. By default, the output is indented. If the [compact] flag is set to true, the output will not contain superfluous whitespace and will be produced faster. If [allow_nan] is [true], then OCaml [nan], [infinity] and [neg_infinity] float values are represented using their Javascript counterparts [NaN], [Infinity] and [-Infinity]. *) val string_of_json : ?allow_nan: bool -> ?compact:bool -> ?recursive:bool -> Json_type.t -> string (** [save_json] works like {!Json_io.string_of_json} but saves the results directly into the file specified by the argument of type string. *) val save_json : ?allow_nan:bool -> ?compact:bool -> ?recursive:bool -> string -> Json_type.t -> unit json-wheel-1.0.6/jsoncat.ml0000644000375200037520000000651611133644521015152 0ustar martinmartinopen Printf open Arg open Json_type open Json_type.Build let time title f arg = let t1 = Unix.gettimeofday () in let result = f arg in let t2 = Unix.gettimeofday () in printf "%s: %.3f s\n%!" title (t2 -. t1); result let save_string file s = let oc = open_out file in output_string oc s; close_out oc let save file data compact = time ("Saving file " ^ file) (fun () -> Json_io.save_json file ~compact data) (); time ("Saving file (using string) " ^ file) (fun () -> save_string file (Json_io.string_of_json ~compact data)) (); if compact then (time "String conversion only" (fun () -> ignore (Json_io.string_of_json ~compact data)) ()) let load file = time ("Loading file " ^ file) Json_io.load_json file let create_samples () = let deep = Json_io.json_of_string "[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ \"Hi!\" ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]" in let s = String.make 1_000_000 'x' in for i = 0 to 127 do s.[i] <- char_of_int i done; let x = objekt [ "array", array (Array.to_list (Array.init 100_000 int)); "string", string s; "int", int max_int; "float", float 1e255; "deep_array", array (Array.to_list (Array.make 1000 deep)) ] in save "sample-indented.json" x false; save "sample-compact.json" x true let load_samples () = save "sample-indented2.json" (load "sample-indented.json") false; save "sample-compact2.json" (load "sample-compact.json") true let test () = create_samples (); load_samples () let main () = let usage = "\ *** This program is provided for your convenience as part of the json-wheel package for this particular version (" ^ Version.version ^ "). There is no guarantee of compatibility with future versions. *** Usage: jsoncat [options] file" in let big_int_mode = ref false in let allow_comments = ref false in let allow_nan = ref false in let compact = ref false in let file_name = ref None in let run_test = ref false in let show_time = ref false in Arg.parse [ "-big", Arg.Set big_int_mode, "Accept large ints and represent them as strings"; "-comments", Arg.Set allow_comments, "Allow C-style comments"; "-compact", Arg.Set compact, "Minimize the size of the output"; "-nan", Arg.Set allow_nan, "Allow Javascript NaN, -Infinity and Infinity values"; "-test", Arg.Set run_test, "Some benchmarks"; "-time", Arg.Set show_time, "Show execution times of parsing and printing"; ] (fun f -> file_name := Some f) usage; if !run_test then (test (); print_newline (); test ()) else let fn = match !file_name with None -> eprintf "%s\n%!" usage; exit 1 | Some fn -> fn in let j = try let load = Json_io.load_json ~allow_comments: !allow_comments ~allow_nan: !allow_nan ~big_int_mode: !big_int_mode in if !show_time then time "Loading from file" load fn else load fn with Json_error s -> eprintf "%s\n%!" s; exit 1 | e -> raise e in let export = Json_io.string_of_json ~allow_nan: !allow_nan ~compact:!compact in let result = if !show_time then time "Converting to string" export j else export j in print_endline result let _ = if not !Sys.interactive then main () json-wheel-1.0.6/Changes0000644000375200037520000000115411133644521014443 0ustar martinmartinVersion 1.0.6, 2009-01-15: failing on non-finite float values (nan, inf, -inf), or properly (de)serializing them using the Javascript notation (NaN, Infinity, -Infinity) if allow_nan is true. Version 1.0.5, 2009-01-13: added option for non object/array serialization. Version 1.0.4, 2007-03-17: * faster conversion to string * jsoncat utility is now compiled and installed Version 1.0.3, 2007-03-06: better indentation by the pretty-printer Version 1.0.2, 2007-02-16: faster output of JSON strings Version 1.0.1, 2006-12-04: fixes incorrect META file Version 1.0.0, 2006-12-03: first public release