pax_global_header00006660000000000000000000000064122667050600014516gustar00rootroot0000000000000052 comment=cf9686cce7496abbd9b121b1b1fa78aa1fc3a953 easy-format-1.0.2/000077500000000000000000000000001226670506000137455ustar00rootroot00000000000000easy-format-1.0.2/Changes000066400000000000000000000016021226670506000152370ustar00rootroot000000000000002012-02-03: Release 1.0.1 - Nothing new other than the way of building the tar.gz package. 2008-07-13: Release 1.0.0, slightly incompatible with 0.9.0 Incompatibilities: - Deprecated use of Easy_format.Param. Instead, inherit from Easy_format.list, Easy_format.label or Easy_format.atom. - Atom nodes have now one additional argument for parameters. - All record types have been extended with more fields. Using the "with" mechanism for inheritance is the best way of limiting future incompatibilities. New features: - Support for separators that stick to the next list item - More wrapping options - Added Custom kind of nodes for using Format directly or existing pretty-printers - Support for markup and escaping, allowing to produce colorized output (HTML, terminal, ...) without interfering with the computation of line breaks and spacing. 2008-07-09: First release 0.9.0 easy-format-1.0.2/LICENSE000066400000000000000000000025601226670506000147550ustar00rootroot00000000000000Copyright (c) 2008 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. easy-format-1.0.2/META.tpl000066400000000000000000000002671226670506000152210ustar00rootroot00000000000000name = "easy-format" description = "Indentation made easy(ier)" archive(byte) = "easy_format.cmo" archive(native) = "easy_format.cmx" archive(native,plugin) = "easy_format.cmxs" easy-format-1.0.2/Makefile000066400000000000000000000043301226670506000154050ustar00rootroot00000000000000VERSION = 1.0.2 export VERSION NATDYNLINK := $(shell if [ -f `ocamlc -where`/dynlink.cmxa ]; then echo YES; else echo NO; fi) ifeq "${NATDYNLINK}" "YES" CMXS=easy_format.cmxs endif .PHONY: default all opt test doc soft-clean clean default: all opt all: ocamlc -c easy_format.mli ocamlc -c -dtypes easy_format.ml touch bytecode opt: easy_format.cmx $(CMXS) touch nativecode easy_format.cmx: ocamlc -c easy_format.mli ocamlopt -c -dtypes easy_format.ml easy_format.cmxs: easy_format.cmx ocamlopt -I . -shared -linkall -o easy_format.cmxs easy_format.cmx test: all simple_example.out ocamlc -o test_easy_format -dtypes easy_format.cmo test_easy_format.ml ./test_easy_format > test_easy_format.out ocamlc -o lambda_example -dtypes easy_format.cmo lambda_example.ml ./lambda_example > lambda_example.out simple_example: all simple_example.ml ocamlc -o simple_example -dtypes easy_format.cmo simple_example.ml simple_example.out: simple_example ./simple_example > simple_example.out doc: ocamldoc/index.html easy_format_example.html ocamldoc/index.html: easy_format.mli mkdir -p ocamldoc ocamldoc -d ocamldoc -html $< easy_format_example.html: simple_example.out simple_example.ml cat simple_example.ml > easy_format_example.ml echo '(* Output: ' >> easy_format_example.ml cat simple_example.out >> easy_format_example.ml echo '*)' >> easy_format_example.ml ocamlc -c -dtypes easy_format_example.ml caml2html easy_format_example.ml -t -o easy_format_example.html soft-clean: rm -f *.cm[iox] *.cmxs *.o *.annot \ test_easy_format lambda_example simple_example \ bytecode nativecode clean: soft-clean rm -f *.out ocamldoc/* \ easy_format_example.* cd examples; $(MAKE) clean COMMON_INSTALL_FILES = META easy_format.cmi easy_format.mli BC_INSTALL_FILES = easy_format.cmo NC_INSTALL_FILES = easy_format.cmx easy_format.o $(CMXS) install: echo "version = \"$(VERSION)\"" > META; cat META.tpl >> META INSTALL_FILES="$(COMMON_INSTALL_FILES)"; \ if test -f bytecode; then \ INSTALL_FILES="$$INSTALL_FILES $(BC_INSTALL_FILES)"; \ fi; \ if test -f nativecode; then \ INSTALL_FILES="$$INSTALL_FILES $(NC_INSTALL_FILES)"; \ fi; \ ocamlfind install easy-format $$INSTALL_FILES uninstall: ocamlfind remove easy-format easy-format-1.0.2/README.md000066400000000000000000000010321226670506000152200ustar00rootroot00000000000000Easy-format: indentation made easy ================================== Documentation ------------- The documentation is at http://mjambon.com/easy-format.html Installation ------------ Installation requires ocamlfind. ``` $ make $ make install ``` Uninstallation -------------- ``` $ make uninstall ``` Examples -------- Some examples can be run with `make test` before installing. More examples that require Easy-format to be installed and possibly dependencies on other packages can be found in the `examples/` subdirectory. easy-format-1.0.2/TODO000066400000000000000000000000071226670506000144320ustar00rootroot00000000000000$Id$ easy-format-1.0.2/easy_format.ml000066400000000000000000000313351226670506000166150ustar00rootroot00000000000000(* $Id$ *) open Format type wrap = [ `Wrap_atoms | `Always_wrap | `Never_wrap | `Force_breaks | `No_breaks ] type style_name = string type style = { tag_open : string; tag_close : string } type atom_param = { atom_style : style_name option; } let atom = { atom_style = None } type list_param = { space_after_opening : bool; space_after_separator : bool; space_before_separator : bool; separators_stick_left : bool; space_before_closing : bool; stick_to_label : bool; align_closing : bool; wrap_body : wrap; indent_body : int; list_style : style_name option; opening_style : style_name option; body_style : style_name option; separator_style : style_name option; closing_style : style_name option; } let list = { space_after_opening = true; space_after_separator = true; space_before_separator = false; separators_stick_left = true; space_before_closing = true; stick_to_label = true; align_closing = true; wrap_body = `Wrap_atoms; indent_body = 2; list_style = None; opening_style = None; body_style = None; separator_style = None; closing_style = None; } type label_param = { space_after_label : bool; indent_after_label : int; label_style : style_name option; } let label = { space_after_label = true; indent_after_label = 2; label_style = None; } type t = Atom of string * atom_param | List of (string * string * string * list_param) * t list | Label of (t * label_param) * t | Custom of (formatter -> unit) type escape = [ `None | `Escape of ((string -> int -> int -> unit) -> string -> int -> int -> unit) | `Escape_string of (string -> string) ] type styles = (style_name * style) list module Pretty = struct (* Relies on the fact that mark_open_tag and mark_close_tag are called exactly once before calling pp_output_string once. It's a reasonable assumption although not guaranteed by the documentation of the Format module. *) let set_escape fmt escape = let print0, flush0 = pp_get_formatter_output_functions fmt () in let tagf0 = pp_get_formatter_tag_functions fmt () in let is_tag = ref false in let mot tag = is_tag := true; tagf0.mark_open_tag tag in let mct tag = is_tag := true; tagf0.mark_close_tag tag in let print s p n = if !is_tag then (print0 s p n; is_tag := false) else escape print0 s p n in let tagf = { tagf0 with mark_open_tag = mot; mark_close_tag = mct } in pp_set_formatter_output_functions fmt print flush0; pp_set_formatter_tag_functions fmt tagf let set_escape_string fmt esc = let escape print s p n = let s0 = String.sub s p n in let s1 = esc s0 in print s1 0 (String.length s1) in set_escape fmt escape let define_styles fmt escape l = if l <> [] then ( pp_set_tags fmt true; let tbl1 = Hashtbl.create (2 * List.length l) in let tbl2 = Hashtbl.create (2 * List.length l) in List.iter ( fun (style_name, style) -> Hashtbl.add tbl1 style_name style.tag_open; Hashtbl.add tbl2 style_name style.tag_close ) l; let mark_open_tag style_name = try Hashtbl.find tbl1 style_name with Not_found -> "" in let mark_close_tag style_name = try Hashtbl.find tbl2 style_name with Not_found -> "" in let tagf = { (pp_get_formatter_tag_functions fmt ()) with mark_open_tag = mark_open_tag; mark_close_tag = mark_close_tag } in pp_set_formatter_tag_functions fmt tagf ); (match escape with `None -> () | `Escape esc -> set_escape fmt esc | `Escape_string esc -> set_escape_string fmt esc) let pp_open_xbox fmt p indent = match p.wrap_body with `Always_wrap | `Never_wrap | `Wrap_atoms -> pp_open_hvbox fmt indent | `Force_breaks -> pp_open_vbox fmt indent | `No_breaks -> pp_open_hbox fmt () let extra_box p l = let wrap = match p.wrap_body with `Always_wrap -> true | `Never_wrap | `Force_breaks | `No_breaks -> false | `Wrap_atoms -> List.for_all (function Atom _ -> true | _ -> false) l in if wrap then ((fun fmt -> pp_open_hovbox fmt 0), (fun fmt -> pp_close_box fmt ())) else ((fun fmt -> ()), (fun fmt -> ())) let pp_open_nonaligned_box fmt p indent l = match p.wrap_body with `Always_wrap -> pp_open_hovbox fmt indent | `Never_wrap -> pp_open_hvbox fmt indent | `Wrap_atoms -> if List.for_all (function Atom _ -> true | _ -> false) l then pp_open_hovbox fmt indent else pp_open_hvbox fmt indent | `Force_breaks -> pp_open_vbox fmt indent | `No_breaks -> pp_open_hbox fmt () let open_tag fmt = function None -> () | Some s -> pp_open_tag fmt s let close_tag fmt = function None -> () | Some _ -> pp_close_tag fmt () let tag_string fmt o s = match o with None -> pp_print_string fmt s | Some tag -> pp_open_tag fmt tag; pp_print_string fmt s; pp_close_tag fmt () let rec fprint_t fmt = function Atom (s, p) -> tag_string fmt p.atom_style s; | List ((_, _, _, p) as param, l) -> open_tag fmt p.list_style; if p.align_closing then fprint_list fmt None param l else fprint_list2 fmt param l; close_tag fmt p.list_style | Label (label, x) -> fprint_pair fmt label x | Custom f -> f fmt and fprint_list_body_stick_left fmt p sep hd tl = open_tag fmt p.body_style; fprint_t fmt hd; List.iter ( fun x -> if p.space_before_separator then pp_print_string fmt " "; tag_string fmt p.separator_style sep; if p.space_after_separator then pp_print_space fmt () else pp_print_cut fmt (); fprint_t fmt x ) tl; close_tag fmt p.body_style and fprint_list_body_stick_right fmt p sep hd tl = open_tag fmt p.body_style; fprint_t fmt hd; List.iter ( fun x -> if p.space_before_separator then pp_print_space fmt () else pp_print_cut fmt (); tag_string fmt p.separator_style sep; if p.space_after_separator then pp_print_string fmt " "; fprint_t fmt x ) tl; close_tag fmt p.body_style and fprint_opt_label fmt = function None -> () | Some (lab, lp) -> open_tag fmt lp.label_style; fprint_t fmt lab; close_tag fmt lp.label_style; if lp.space_after_label then pp_print_string fmt " " (* Either horizontal or vertical list *) and fprint_list fmt label ((op, sep, cl, p) as param) = function [] -> fprint_opt_label fmt label; tag_string fmt p.opening_style op; if p.space_after_opening || p.space_before_closing then pp_print_string fmt " "; tag_string fmt p.closing_style cl | hd :: tl as l -> if tl = [] || p.separators_stick_left then fprint_list_stick_left fmt label param hd tl l else fprint_list_stick_right fmt label param hd tl l and fprint_list_stick_left fmt label (op, sep, cl, p) hd tl l = let indent = p.indent_body in pp_open_xbox fmt p indent; fprint_opt_label fmt label; tag_string fmt p.opening_style op; if p.space_after_opening then pp_print_space fmt () else pp_print_cut fmt (); let open_extra, close_extra = extra_box p l in open_extra fmt; fprint_list_body_stick_left fmt p sep hd tl; close_extra fmt; if p.space_before_closing then pp_print_break fmt 1 (-indent) else pp_print_break fmt 0 (-indent); tag_string fmt p.closing_style cl; pp_close_box fmt () and fprint_list_stick_right fmt label (op, sep, cl, p) hd tl l = let base_indent = p.indent_body in let sep_indent = String.length sep + (if p.space_after_separator then 1 else 0) in let indent = base_indent + sep_indent in pp_open_xbox fmt p indent; fprint_opt_label fmt label; tag_string fmt p.opening_style op; if p.space_after_opening then pp_print_space fmt () else pp_print_cut fmt (); let open_extra, close_extra = extra_box p l in open_extra fmt; fprint_t fmt hd; List.iter ( fun x -> if p.space_before_separator then pp_print_break fmt 1 (-sep_indent) else pp_print_break fmt 0 (-sep_indent); tag_string fmt p.separator_style sep; if p.space_after_separator then pp_print_string fmt " "; fprint_t fmt x ) tl; close_extra fmt; if p.space_before_closing then pp_print_break fmt 1 (-indent) else pp_print_break fmt 0 (-indent); tag_string fmt p.closing_style cl; pp_close_box fmt () (* align_closing = false *) and fprint_list2 fmt (op, sep, cl, p) = function [] -> tag_string fmt p.opening_style op; if p.space_after_opening || p.space_before_closing then pp_print_string fmt " "; tag_string fmt p.closing_style cl | hd :: tl as l -> tag_string fmt p.opening_style op; if p.space_after_opening then pp_print_string fmt " "; pp_open_nonaligned_box fmt p 0 l ; if p.separators_stick_left then fprint_list_body_stick_left fmt p sep hd tl else fprint_list_body_stick_right fmt p sep hd tl; pp_close_box fmt (); if p.space_before_closing then pp_print_string fmt " "; tag_string fmt p.closing_style cl (* Printing a label: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 fmt ((lab, lp) as label) x = match x with List ((op, sep, cl, p), l) when p.stick_to_label && p.align_closing -> fprint_list fmt (Some label) (op, sep, cl, p) l | _ -> let indent = lp.indent_after_label in pp_open_hvbox fmt 0; open_tag fmt lp.label_style; fprint_t fmt lab; close_tag fmt lp.label_style; if lp.space_after_label then pp_print_break fmt 1 indent else pp_print_break fmt 0 indent; fprint_t fmt x; pp_close_box fmt () let to_formatter fmt x = fprint_t fmt x; pp_print_flush fmt () let to_buffer ?(escape = `None) ?(styles = []) buf x = let fmt = Format.formatter_of_buffer buf in define_styles fmt escape styles; to_formatter fmt x let to_string ?escape ?styles x = let buf = Buffer.create 500 in to_buffer ?escape ?styles buf x; Buffer.contents buf let to_channel ?(escape = `None) ?(styles = []) oc x = let fmt = formatter_of_out_channel oc in define_styles fmt escape styles; to_formatter fmt x let to_stdout ?escape ?styles x = to_channel ?escape ?styles stdout x let to_stderr ?escape ?styles x = to_channel ?escape ?styles stderr x end module Compact = struct open Printf let rec fprint_t buf = function Atom (s, _) -> Buffer.add_string buf s | List (param, l) -> fprint_list buf param l | Label (label, x) -> fprint_pair buf label x | Custom f -> (* Will most likely not be compact *) let fmt = formatter_of_buffer buf in f fmt; pp_print_flush fmt () and fprint_list buf (op, sep, cl, _) = function [] -> bprintf buf "%s%s" op cl | x :: tl -> Buffer.add_string buf op; fprint_t buf x; List.iter ( fun x -> Buffer.add_string buf sep; fprint_t buf x ) tl; Buffer.add_string buf cl and fprint_pair buf (label, _) x = fprint_t buf label; fprint_t buf x let to_buffer buf x = fprint_t buf x let to_string x = let buf = Buffer.create 500 in to_buffer buf x; Buffer.contents buf let to_formatter fmt x = let s = to_string x in Format.fprintf fmt "%s" s; pp_print_flush fmt () let to_channel oc x = let buf = Buffer.create 500 in to_buffer buf x; Buffer.output_buffer oc buf let to_stdout x = to_channel stdout x let to_stderr x = to_channel stderr x end (* Obsolete *) module Param = struct let list_true = { space_after_opening = true; space_after_separator = true; space_before_separator = true; separators_stick_left = true; space_before_closing = true; stick_to_label = true; align_closing = true; wrap_body = `Wrap_atoms; indent_body = 2; list_style = None; opening_style = None; body_style = None; separator_style = None; closing_style = None; } let list_false = { space_after_opening = false; space_after_separator = false; space_before_separator = false; separators_stick_left = false; space_before_closing = false; stick_to_label = false; align_closing = false; wrap_body = `Wrap_atoms; indent_body = 2; list_style = None; opening_style = None; body_style = None; separator_style = None; closing_style = None; } let label_true = { space_after_label = true; indent_after_label = 2; label_style = None; } let label_false = { space_after_label = false; indent_after_label = 2; label_style = None; } end easy-format-1.0.2/easy_format.mli000066400000000000000000000157611226670506000167730ustar00rootroot00000000000000(* $Id$ *) (** Easy_format: indentation made easy. *) (** This module provides a functional, simplified layer over the Format module of the standard library. Input data must be first modelled as a tree using 3 kinds of nodes: - atoms - lists - labelled nodes Atoms represent any text that is guaranteed to be printed as-is. Lists can model any sequence of items such as arrays of data or lists of definitions that are labelled with something like "int main", "let x =" or "x:". *) type wrap = [ `Wrap_atoms | `Always_wrap | `Never_wrap | `Force_breaks | `No_breaks ] (** List wrapping conditions: - [`Wrap_atoms]: wrap if the list contains only atoms - [`Always_wrap]: always wrap when needed - [`Never_wrap]: never wrap, i.e. the list is either horizontal or vertical - [`Force_breaks]: align vertically, i.e. always break line between list items and align the left edge of each item. - [`No_breaks]: align horizontally, i.e. never break line between list items *) type style_name = string type style = { tag_open : string; tag_close : string } (** Pair of opening and closing tags that are inserted around text after pretty-printing. *) type atom_param = { atom_style : style_name option; (** Default: [None] *) } val atom : atom_param (** List-formatting parameters. Always derive a new set of parameters from an existing record. See {!Easy_format.list}. *) type list_param = { space_after_opening : bool; (** Whether there must be some whitespace after the opening string. Default: [true] *) space_after_separator : bool; (** Whether there must be some whitespace after the item separators. Default: [true] *) space_before_separator : bool; (** Whether there must be some whitespace before the item separators. Default: [false] *) separators_stick_left : bool; (** Whether the separators must stick to the item on the left. Default: [true] *) space_before_closing : bool; (** Whether there must be some whitespace before the closing string. Default: [true] *) stick_to_label : bool; (** Whether the opening string should be fused with the preceding label. Default: [true] *) align_closing : bool; (** Whether the beginning of the closing string must be aligned with the beginning of the opening string (stick_to_label = false) or with the beginning of the label if any (stick_to_label = true). Default: [true] *) wrap_body : wrap; (** Defines under which conditions the list body may be wrapped, i.e. allow several lines and several list items per line. Default: [`Wrap_atom_list] *) indent_body : int; (** Extra indentation of the list body. Default: [2] *) list_style : style_name option; (** Default: [None] *) opening_style : style_name option; (** Default: [None] *) body_style : style_name option; (** Default: [None] *) separator_style : style_name option; (** Default: [None] *) closing_style : style_name option; (** Default: [None] *) } val list : list_param (** Default list-formatting parameters, using the default values described in the type definition above. In order to make code compatible with future versions of the library, the record inheritance syntax should be used, e.g. [ { list with align_closing = false } ]. If new record fields are added, the program would still compile and work as before. *) (** Label-formatting parameters. Always derive a new set of parameters from an existing record. See {!Easy_format.label}. *) type label_param = { space_after_label : bool; (** Whether there must be some whitespace after the label. Default: [true] *) indent_after_label : int; (** Extra indentation before the item that comes after a label. Default: [2] *) label_style : style_name option; (** Default: [None] *) } val label : label_param (** Default label-formatting parameters, using the default values described in the type definition above. In order to make code compatible with future versions of the library, the record inheritance syntax should be used, e.g. [ { label with indent_after_label = 0 } ]. If new record fields are added, the program would still compile and work as before. *) type t = Atom of string * atom_param (** Plain string normally without line breaks. *) | List of ( string (* opening *) * string (* separator *) * string (* closing *) * list_param ) * t list (** [List ((opening, separator, closing, param), nodes)] *) | Label of (t * label_param) * t (** [Label ((label, param), node)]: labelled node. *) | Custom of (Format.formatter -> unit) (** User-defined printing function that allows to use the Format module directly if necessary. It is responsible for leaving the formatter in a clean state. *) (** The type of the tree to be pretty-printed. Each node contains its own formatting parameters. Detail of a list node [List ((opening, separator, closing, param), nodes)]: - [opening]: opening string such as ["\{"] ["\["] ["("] ["begin"] [""] etc. - [separator]: node separator such as [";"] [","] [""] ["+"] ["|"] etc. - [closing]: closing string such as ["\}"] ["\]"] [")"] ["end"] [""] etc. - [nodes]: elements of the list. *) type escape = [ `None | `Escape of ((string -> int -> int -> unit) -> string -> int -> int -> unit) | `Escape_string of (string -> string) ] type styles = (style_name * style) list (** The regular pretty-printing functions *) module Pretty : sig val define_styles : Format.formatter -> escape -> styles -> unit val to_formatter : Format.formatter -> t -> unit val to_buffer : ?escape:escape -> ?styles:styles -> Buffer.t -> t -> unit val to_string : ?escape:escape -> ?styles:styles -> t -> string val to_channel : ?escape:escape -> ?styles:styles -> out_channel -> t -> unit val to_stdout : ?escape:escape -> ?styles:styles -> t -> unit val to_stderr : ?escape:escape -> ?styles:styles -> t -> unit end (** No spacing or newlines other than those in the input data or those produced by [Custom] printing. *) module Compact : sig val to_buffer : Buffer.t -> t -> unit val to_string : t -> string val to_channel : out_channel -> t -> unit val to_stdout : t -> unit val to_stderr : t -> unit val to_formatter : Format.formatter -> t -> unit end (**/**) (** Deprecated. Predefined sets of parameters *) module Param : sig val list_true : list_param (** Deprecated. All boolean fields set to true. indent_body = 2. *) val label_true : label_param (** Deprecated. All boolean fields set to true. indent_after_label = 2. *) val list_false : list_param (** Deprecated. All boolean fields set to false. indent_body = 2. *) val label_false : label_param (** Deprecated. All boolean fields set to false. indent_after_label = 2. *) end easy-format-1.0.2/examples/000077500000000000000000000000001226670506000155635ustar00rootroot00000000000000easy-format-1.0.2/examples/Makefile000066400000000000000000000001651226670506000172250ustar00rootroot00000000000000# $Id$ .PHONY: clean jsonpp jsonpp: ocamlscript jsonpp.ml sample.json > sample.html clean: rm -f *.exe sample.html easy-format-1.0.2/examples/jsonpp.ml000077500000000000000000000114041226670506000174310ustar00rootroot00000000000000#! /usr/bin/env ocamlscript Ocaml.packs := ["json-wheel"; "easy-format"] -- (* $Id$ *) open Json_type open Easy_format (* 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 jstring_of_float 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 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 jstring_of_string s = let buf = Buffer.create (String.length s) in Buffer.add_char buf '"'; escape_json_string buf s; Buffer.add_char buf '"'; Buffer.contents buf let null = { atom_style = Some "null" } let bool = { atom_style = Some "bool" } let int = { atom_style = Some "int" } let float = { atom_style = Some "float" } let string = { atom_style = Some "string" } let label_string = { atom_style = Some "label" } let colon = { atom_style = Some "punct" } let array = { list with opening_style = Some "punct"; separator_style = Some "punct"; closing_style = Some "punct" } let label_with_colon = { list with space_after_opening = false; space_before_closing = false; space_after_separator = false; wrap_body = `No_breaks } let rec format = function Null -> Atom ("null", null) | Bool b -> Atom (string_of_bool b, bool) | Int i -> Atom (string_of_int i, int) | Float f -> Atom (jstring_of_float f, float) | String s -> Atom (jstring_of_string s, string) | Array l -> List (("[", ",", "]", array), List.map format l) | Object l -> List (("{", ",", "}", array), List.map format_field l) and format_field (s, x) = let lab = List (("", "", "", label_with_colon), [ Atom (jstring_of_string s, label_string); Atom (":", colon) ]) in Label ((lab, label), format x) let html_escape_string s = let buf = Buffer.create (2 * String.length s) in for i = 0 to String.length s - 1 do match s.[i] with '&' -> Buffer.add_string buf "&" | '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | c -> Buffer.add_char buf c done; Buffer.contents buf let html_escape = `Escape_string html_escape_string let html_style = [ "null", { tag_open = ""; tag_close = "" }; "bool", { tag_open = ""; tag_close = "" }; "int", { tag_open = ""; tag_close = "" }; "float", { tag_open = ""; tag_close = "" }; "string", { tag_open = ""; tag_close = "" }; "label", { tag_open = ""; tag_close = "" }; "punct", { tag_open = ""; tag_close = "" }; ] let print_html json = print_string "\ JSON 
";
  Pretty.to_stdout ~escape: html_escape ~styles: html_style (format json);
  print_string "\
" let _ = let options = [] in let files = ref [] in let anon_fun s = files := s :: !files in let usage_msg = Printf.sprintf "Usage: %s " Sys.argv.(0) in Arg.parse options anon_fun usage_msg; let file = match !files with [s] -> s | _ -> Arg.usage options usage_msg; exit 1 in let json = Json_io.load_json ~allow_comments:true file in print_html json easy-format-1.0.2/examples/sample.json000066400000000000000000000150611226670506000177420ustar00rootroot00000000000000[ { "abc": [ { "x": "y", "y": { "z": "aaa" }, "a": [ "abc", "long long long.........................................................................................." ], "a long label ...............................................": [ 123, 456, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ] }, [ "a", "b", "c", "d" ], { "x": true, "y": { "z": false }, "a": [ null, "long long long.........................................................................................." ], "a long label ...............................................": [ 1.23, 4.56, "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ] }, "xyz" ] }, // From this point, examples were taken from http://www.json.org/example.html { "glossary": { "title": "example glossary", "GlossDiv": { "title": "S", "GlossList": { "GlossEntry": { "ID": "SGML", "SortAs": "SGML", "GlossTerm": "Standard Generalized Markup Language", "Acronym": "SGML", "Abbrev": "ISO 8879:1986", "GlossDef": { "para": "A meta-markup language, used to create markup languages such as DocBook.", "GlossSeeAlso": ["GML", "XML"] }, "GlossSee": "markup" } } } } }, {"menu": { "id": "file", "value": "File", "popup": { "menuitem": [ {"value": "New", "onclick": "CreateNewDoc()"}, {"value": "Open", "onclick": "OpenDoc()"}, {"value": "Close", "onclick": "CloseDoc()"} ] } }}, {"widget": { "debug": "on", "window": { "title": "Sample Konfabulator Widget", "name": "main_window", "width": 500, "height": 500 }, "image": { "src": "Images/Sun.png", "name": "sun1", "hOffset": 250, "vOffset": 250, "alignment": "center" }, "text": { "data": "Click Here", "size": 36, "style": "bold", "name": "text1", "hOffset": 250, "vOffset": 100, "alignment": "center", "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;" } }}, {"web-app": { "servlet": [ { "servlet-name": "cofaxCDS", "servlet-class": "org.cofax.cds.CDSServlet", "init-param": { "configGlossary:installationAt": "Philadelphia, PA", "configGlossary:adminEmail": "ksm@pobox.com", "configGlossary:poweredBy": "Cofax", "configGlossary:poweredByIcon": "/images/cofax.gif", "configGlossary:staticPath": "/content/static", "templateProcessorClass": "org.cofax.WysiwygTemplate", "templateLoaderClass": "org.cofax.FilesTemplateLoader", "templatePath": "templates", "templateOverridePath": "", "defaultListTemplate": "listTemplate.htm", "defaultFileTemplate": "articleTemplate.htm", "useJSP": false, "jspListTemplate": "listTemplate.jsp", "jspFileTemplate": "articleTemplate.jsp", "cachePackageTagsTrack": 200, "cachePackageTagsStore": 200, "cachePackageTagsRefresh": 60, "cacheTemplatesTrack": 100, "cacheTemplatesStore": 50, "cacheTemplatesRefresh": 15, "cachePagesTrack": 200, "cachePagesStore": 100, "cachePagesRefresh": 10, "cachePagesDirtyRead": 10, "searchEngineListTemplate": "forSearchEnginesList.htm", "searchEngineFileTemplate": "forSearchEngines.htm", "searchEngineRobotsDb": "WEB-INF/robots.db", "useDataStore": true, "dataStoreClass": "org.cofax.SqlDataStore", "redirectionClass": "org.cofax.SqlRedirection", "dataStoreName": "cofax", "dataStoreDriver": "com.microsoft.jdbc.sqlserver.SQLServerDriver", "dataStoreUrl": "jdbc:microsoft:sqlserver://LOCALHOST:1433;DatabaseName=goon", "dataStoreUser": "sa", "dataStorePassword": "dataStoreTestQuery", "dataStoreTestQuery": "SET NOCOUNT ON;select test='test';", "dataStoreLogFile": "/usr/local/tomcat/logs/datastore.log", "dataStoreInitConns": 10, "dataStoreMaxConns": 100, "dataStoreConnUsageLimit": 100, "dataStoreLogLevel": "debug", "maxUrlLength": 500}}, { "servlet-name": "cofaxEmail", "servlet-class": "org.cofax.cds.EmailServlet", "init-param": { "mailHost": "mail1", "mailHostOverride": "mail2"}}, { "servlet-name": "cofaxAdmin", "servlet-class": "org.cofax.cds.AdminServlet"}, { "servlet-name": "fileServlet", "servlet-class": "org.cofax.cds.FileServlet"}, { "servlet-name": "cofaxTools", "servlet-class": "org.cofax.cms.CofaxToolsServlet", "init-param": { "templatePath": "toolstemplates/", "log": 1, "logLocation": "/usr/local/tomcat/logs/CofaxTools.log", "logMaxSize": "", "dataLog": 1, "dataLogLocation": "/usr/local/tomcat/logs/dataLog.log", "dataLogMaxSize": "", "removePageCache": "/content/admin/remove?cache=pages&id=", "removeTemplateCache": "/content/admin/remove?cache=templates&id=", "fileTransferFolder": "/usr/local/tomcat/webapps/content/fileTransferFolder", "lookInContext": 1, "adminGroupID": 4, "betaServer": true}}], "servlet-mapping": { "cofaxCDS": "/", "cofaxEmail": "/cofaxutil/aemail/*", "cofaxAdmin": "/admin/*", "fileServlet": "/static/*", "cofaxTools": "/tools/*"}, "taglib": { "taglib-uri": "cofax.tld", "taglib-location": "/WEB-INF/tlds/cofax.tld"}}}, {"menu": { "header": "SVG Viewer", "items": [ {"id": "Open"}, {"id": "OpenNew", "label": "Open New"}, null, {"id": "ZoomIn", "label": "Zoom In"}, {"id": "ZoomOut", "label": "Zoom Out"}, {"id": "OriginalView", "label": "Original View"}, null, {"id": "Quality"}, {"id": "Pause"}, {"id": "Mute"}, null, {"id": "Find", "label": "Find..."}, {"id": "FindAgain", "label": "Find Again"}, {"id": "Copy"}, {"id": "CopyAgain", "label": "Copy Again"}, {"id": "CopySVG", "label": "Copy SVG"}, {"id": "ViewSVG", "label": "View SVG"}, {"id": "ViewSource", "label": "View Source"}, {"id": "SaveAs", "label": "Save As"}, null, {"id": "Help"}, {"id": "About", "label": "About Adobe CVG Viewer..."} ] }} ] easy-format-1.0.2/lambda_example.ml000066400000000000000000000047461226670506000172450ustar00rootroot00000000000000type lambda = Lambda of string * lambda | Var of string | Apply of lambda * lambda (* We make the page more narrow for illustration purposes *) let _ = Format.set_margin 20 (* \n f x. n (\g h. h (g f)) (\u. x) (\u. u) *) (* \n. \f. \x. n (\g. \h. h (g f)) (\u. x) (\u. u) *) let sample_data = Lambda ( "n", (Lambda ( "f", (Lambda ( "x", Apply ( Apply ( Apply ( Var "n", (Lambda ( "g", (Lambda ( "h", Apply (Var "h", Apply (Var "g", Var "f")) ) ) ) ) ), (Lambda ("u", Var "x")) ), (Lambda ("u", Var "u")) ) ) ) ) ) ) (****************************************************************************) (* Example from http://caml.inria.fr/resources/doc/guides/format.html using Format directly. *) open Format let ident = pp_print_string;; let kwd = pp_print_string;; let rec pr_exp0 ppf = function | Var s -> ident ppf s | lam -> fprintf ppf "@[<1>(%a)@]" pr_lambda lam and pr_app ppf = function | e -> fprintf ppf "@[<2>%a@]" pr_other_applications e and pr_other_applications ppf f = match f with | Apply (f, arg) -> fprintf ppf "%a@ %a" pr_app f pr_exp0 arg | f -> pr_exp0 ppf f and pr_lambda ppf = function | Lambda (s, lam) -> fprintf ppf "@[<1>%a%a%a@ %a@]" kwd "\\" ident s kwd "." pr_lambda lam | e -> pr_app ppf e;; let print_lambda x = pr_lambda std_formatter x; pp_print_flush std_formatter () let _ = print_endline "Example from \ http://caml.inria.fr/resources/doc/guides/format.html#example"; print_lambda sample_data; print_newline () (***************************************************************************) (* Same example, using Easy_format *) open Printf open Easy_format let p1 = { label with indent_after_label = 1 } let p2 = { label with indent_after_label = 2 } let paren_style = { list with space_after_opening = false; space_before_closing = false; align_closing = false } let rec exp0_node = function Var s -> Atom (s, atom) | lam -> List (("(", "", ")", paren_style), [lambda_node lam]) and app_node = function Apply (f, arg) -> Label ((app_node f, p2), exp0_node arg) | f -> exp0_node f and lambda_node = function Lambda (s, lam) -> Label ((Atom (sprintf "\\%s." s, atom), p1), lambda_node lam) | e -> app_node e let _ = print_endline "Same, using Easy_format:"; Pretty.to_stdout (lambda_node sample_data); print_newline () easy-format-1.0.2/simple_example.ml000066400000000000000000000142651226670506000173130ustar00rootroot00000000000000(* $Id$ *) (* A fairly complete demonstration of the features provided by Easy-format. *) open Easy_format let list = { list with list_style = Some "list"; opening_style = Some "op"; body_style = Some "body"; separator_style = Some "sep"; closing_style = Some "cl" } let atom = { atom_style = Some "atom" } let label = { label with label_style = Some "label" } let tuple_param = { list with space_after_opening = false; space_before_closing = false; align_closing = false } let operator_param = { list with space_after_opening = false; space_before_closing = false; separators_stick_left = false; space_before_separator = true; space_after_separator = true; align_closing = true } let html_escape_string s = let buf = Buffer.create (2 * String.length s) in for i = 0 to String.length s - 1 do match s.[i] with '&' -> Buffer.add_string buf "&" | '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | c -> Buffer.add_char buf c done; Buffer.contents buf let html_escape = `Escape_string html_escape_string let html_style = [ "atom", { tag_open = ""; tag_close = "" }; "body", { tag_open = ""; tag_close = "" }; "list", { tag_open = ""; tag_close = "" }; "op", { tag_open = ""; tag_close = "" }; "cl", { tag_open = ""; tag_close = "" }; "sep", { tag_open = ""; tag_close = "" }; "label", { tag_open = ""; tag_close = "" }; ] let format_tuple f l = List (("(", ",", ")", tuple_param), List.map f l) let format_int x = Atom (string_of_int x, atom) let format_float x = Atom (Printf.sprintf "%.5f" x, atom) let format_sum ?(wrap = `Wrap_atoms) l = List (("(", "+", ")", { operator_param with wrap_body = wrap }), List.map format_int l) let format_array ~align_closing ~wrap f a = let l = Array.to_list (Array.map f a) in List (("[|", ";", "|]", { list with align_closing = align_closing; wrap_body = wrap }), l) let format_matrix ?(align_closing1 = true) ?(align_closing2 = true) ?(wrap1 = `Wrap_atoms) ?(wrap2 = `Wrap_atoms) m = format_array ~align_closing: align_closing1 ~wrap: wrap1 (format_array ~align_closing: align_closing2 ~wrap: wrap2 format_float) m let format_record f l0 = let l = List.map (fun (s, x) -> Label ((Atom (s ^ ":", atom), label), f x)) l0 in List (("{", ";", "}", list), l) let begin_style = { label with indent_after_label = 0 }, ("begin", ";", "end", { list with stick_to_label = false }) let curly_style = label, ("{", ";", "}", list) let format_function_definition (body_label, body_param) name param body = Label ( ( Label ( (Atom ("function " ^ name, atom), label), List (("(", ",", ")", tuple_param), List.map (fun s -> Atom (s, atom)) param) ), body_label ), List (body_param, List.map (fun s -> Atom (s, atom)) body) ) let print_margin fmt () = let margin = Format.pp_get_margin fmt () in for i = 1 to margin do print_char '+' done; print_newline () let with_margin ?(html = false) margin f x = let fmt = Format.formatter_of_out_channel stdout in Format.pp_set_margin fmt margin; if html then Pretty.define_styles fmt html_escape html_style; print_margin fmt (); f fmt x; Format.pp_print_flush fmt (); print_newline () let print s = Printf.printf "\n*** %s ***\n%!" s let print_tuple fmt l = Pretty.to_formatter fmt (format_tuple format_int l) let print_sum ?wrap fmt l = Pretty.to_formatter fmt (format_sum ?wrap l) let print_matrix ?align_closing1 ?align_closing2 ?wrap1 ?wrap2 m fmt () = Pretty.to_formatter fmt (format_matrix ?align_closing1 ?align_closing2 ?wrap1 ?wrap2 m) let print_function_definition style name param fmt body = Pretty.to_formatter fmt (format_function_definition style name param body) let _ = let ints = Array.to_list (Array.init 10 (fun i -> i)) in (* A simple tuple that fits on one line *) with_margin 80 print_tuple ints; with_margin 20 print_tuple ints; (* Printed as a sum *) with_margin 80 print_sum ints; with_margin ~html:true 80 print_sum ints; with_margin 20 (print_sum ~wrap:`Always_wrap) ints; with_margin 20 (print_sum ~wrap:`Never_wrap) ints; (* Triangular array of arrays showing wrapping of lists of atoms *) let m = Array.init 20 (fun i -> Array.init i (fun i -> sqrt (float i))) in (* Default style *) print "default style"; with_margin 80 (print_matrix m) (); (* Other styles *) print "style 1"; with_margin 80 (print_matrix ~align_closing1: false ~align_closing2: false m) (); print "style 2"; with_margin 80 (print_matrix ~align_closing1: false ~align_closing2: false ~wrap2: `Never_wrap m) (); print "style 3"; with_margin 80 (print_matrix ~align_closing1: false ~align_closing2: false ~wrap2: `Always_wrap m) (); print "style 4"; with_margin 80 (print_matrix ~align_closing2: false ~wrap1: `Always_wrap ~wrap2: `Always_wrap m) (); print "style 5"; with_margin 80 (print_matrix ~align_closing1: false ~wrap1: `Always_wrap ~wrap2: `Always_wrap m) (); print "style 6"; with_margin 80 (print_matrix ~wrap2: `Force_breaks m) (); print "style 7"; with_margin 80 (print_matrix ~wrap1: `Always_wrap ~wrap2: `No_breaks m) (); print "style 8"; with_margin 80 (print_matrix ~wrap2: `No_breaks m) (); print "style 9"; with_margin 80 (print_matrix ~wrap1: `No_breaks m) (); print "style 10"; with_margin 80 (print_matrix ~wrap1: `No_breaks ~wrap2: `Force_breaks m) (); print "style 11"; with_margin 80 (print_matrix ~wrap2: `Never_wrap m) (); (* A function definition, showed with different right-margin settings and either begin-end or { } around the function body. *) let program html margin style = with_margin ~html margin (print_function_definition style "hello" ["arg1";"arg2";"arg3"]) [ "print \"hello\""; "return (1 < 2)" ] in List.iter ( fun style -> List.iter ( fun margin -> program false margin style; program true margin style ) [ 10; 20; 30; 40; 80 ] ) [ curly_style; begin_style ] easy-format-1.0.2/test_easy_format.ml000066400000000000000000000042021226670506000176450ustar00rootroot00000000000000(* $Id$ *) open Easy_format let make_data list_param label_param atom_param = let obj_param = ("{", ",", "}", list_param) in let array_param = ("[", ",", "]", list_param) in let at s = Atom (s, atom_param) in let obj = List ( obj_param, [ Label ( (at "x:", label_param), at "y" ); Label ( (at "y:", label_param), List (obj_param, [Label ((at "z:", label_param), at "aaa")]) ); Label ( (at "a:", label_param), List ( array_param, [ at "abc"; at "\"long long long......................................\ ....................................................\""; ] ) ); Label ( (at "\"a long label ..................\ .............................\":", label_param), List ( array_param, [ at "123"; at "456"; at "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ] ) ) ] ) in let array = List (array_param, [ at "a"; at "b"; at "c"; at "d" ]) in Label ( (at "abc:", label_param), List ( array_param, [ obj; array; obj; at "xyz"; ] ) ) let _ = let x1 = make_data list label atom in let x2 = make_data { list with space_after_opening = false; space_after_separator = false; space_before_closing = false; stick_to_label = false; align_closing = false } { label with space_after_label = true } atom in let x3 = make_data { list with space_after_opening = false; space_before_separator = true; space_after_separator = true; separators_stick_left = false; space_before_closing = false; stick_to_label = true; align_closing = true } { label with space_after_label = true } atom in let x4 = make_data { list with stick_to_label = false } label atom in Easy_format.Pretty.to_stdout x1; print_newline (); Easy_format.Pretty.to_stdout x2; print_newline (); Easy_format.Pretty.to_stdout x3; print_newline (); Easy_format.Pretty.to_stdout x4; print_newline (); Easy_format.Compact.to_stdout x1; print_newline ()