248 lines
7.4 KiB
OCaml
248 lines
7.4 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2018. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
open Format
|
|
|
|
(* TODO: add section descriptions *)
|
|
|
|
let default_section_id = "default"
|
|
let default_section_title = "Miscellaneous"
|
|
|
|
(* Association list where keys are set of identifier's prefixes that
|
|
maps to a section title. The ordering of sections in the rst output
|
|
depends on their position in this list.
|
|
|
|
e.g. : an error which id is 'utils.Timeout' will be documented
|
|
under the `Miscellaneous` section which will be displayed at the
|
|
bottom of the document. Unprefixed ids or unreferenced prefixes
|
|
will default to `Miscellaneous` *)
|
|
let section_titles =
|
|
[ [ "proto.alpha" ], "Protocol Alpha";
|
|
[ "distributed_db" ; "node" ; "raw_store" ; "validator" ; "worker" ], "Shell" ;
|
|
[ "micheline" ; "michelson" ], "Michelson parsing/macros" ;
|
|
[ "rpc_client" ], "Client" ;
|
|
[ "cli"; "utils"; default_section_id ], default_section_title ;
|
|
]
|
|
let pp_rst_title ~char ppf title =
|
|
let sub = String.map (fun _ -> char) title in
|
|
fprintf ppf "@[<v 0>%s@\n@]@[<v 0>%s@\n@\n@]" title sub
|
|
|
|
let pp_rst_h1 = pp_rst_title ~char:'#'
|
|
let pp_rst_h2 = pp_rst_title ~char:'*'
|
|
(* let pp_rst_h3 = pp_rst_title ~char:'='
|
|
* let pp_rst_h4 = pp_rst_title ~char:'`' *)
|
|
|
|
let string_of_err_category =
|
|
let open Error_monad in function
|
|
| `Branch -> "branch"
|
|
| `Temporary -> "temporary"
|
|
| `Permanent -> "permanent"
|
|
|
|
let make_counter () =
|
|
let i = ref 1 in
|
|
fun () -> incr i; !i
|
|
|
|
let count = make_counter ()
|
|
|
|
let unique_label () =
|
|
let label = sprintf "ref%d" (count ()) in
|
|
label
|
|
|
|
let pp_print_html_tab_button fmt ?(default=false) ~shortlabel ~content idref =
|
|
fprintf fmt "<button class=\"tablinks%s\" onclick=\"showTab(this, '%s', '%s')\">%s</button>@ "
|
|
(if default then " defaultOpen" else "")
|
|
(idref ^ shortlabel) idref content
|
|
|
|
let pp_print_html_tabs fmt { Error_monad.id ; category ; description ; schema ; _ } =
|
|
let idref = unique_label () in
|
|
let descr_label = "descr" in
|
|
let schema_label = "schema" in
|
|
|
|
fprintf fmt "@[<v 2>.. raw:: html@ @ ";
|
|
fprintf fmt "@[<v 2><div class=\"tab\">@ ";
|
|
|
|
fprintf fmt "%a" (pp_print_html_tab_button ~default:true ~shortlabel:descr_label ~content:"Description") idref;
|
|
fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:schema_label ~content:"JSON Schema") idref;
|
|
fprintf fmt "@ </div>@ @]";
|
|
|
|
let description_content =
|
|
asprintf "<p>%s</p><p><i>Id</i> : %s<br/><i>Category</i> : %s</p>" description id (string_of_err_category category)
|
|
in
|
|
|
|
open_vbox 2;
|
|
|
|
(* Print description *)
|
|
begin
|
|
fprintf fmt "<div id=\"%s\" class=\"%s tabcontent\" style=\"min-height:100px; max-height:200px; overflow:auto\" >@ "
|
|
(idref ^ descr_label) idref;
|
|
fprintf fmt "%s@ " description_content;
|
|
fprintf fmt "</div>@]";
|
|
end;
|
|
|
|
(* Print schema *)
|
|
begin
|
|
(* Hack: negative offset in order to reduce the <pre>'s content left-margin *)
|
|
(* TODO: pretty-(html)-print the schema *)
|
|
open_vbox (-8);
|
|
fprintf fmt "<div id=\"%s\" class=\"%s tabcontent\" style=\"min-height:100px; max-height:200px; overflow:auto\" >@ "
|
|
(idref ^ schema_label) idref;
|
|
fprintf fmt "<%s>@ %a</%s>@ " "pre" Json_schema.pp schema "pre";
|
|
fprintf fmt "</div>";
|
|
close_box ();
|
|
end;
|
|
|
|
close_box ()
|
|
|
|
let pp_info_to_rst
|
|
ppf
|
|
(Error_monad.{ title ; _ } as error_info) =
|
|
let open Format in
|
|
|
|
fprintf ppf "**%s**@\n@\n" (if title = "" then "<Untitled>" else title);
|
|
fprintf ppf "@[<v>%a@ @ @]" pp_print_html_tabs error_info;
|
|
|
|
module ErrorSet = Set.Make(struct
|
|
type t = Error_monad.error_info
|
|
let compare { Error_monad.id ; _ } { Error_monad.id = id' ; _ } =
|
|
String.compare id id'
|
|
end)
|
|
|
|
module ErrorPartition = struct
|
|
include Map.Make(struct
|
|
include String
|
|
let titles = List.map snd section_titles
|
|
|
|
let compare s s' =
|
|
let idx s =
|
|
let rec loop acc = function
|
|
| [] -> assert false
|
|
| h::_ when h = s -> acc
|
|
| _::t -> loop (acc + 1) t
|
|
in loop 0 titles
|
|
in
|
|
Pervasives.compare (idx s) (idx s')
|
|
end)
|
|
|
|
let add_error (id : key) (error : Error_monad.error_info) (map : 'a t) =
|
|
let title =
|
|
try
|
|
snd
|
|
(List.find
|
|
(fun (id_set, _) ->
|
|
List.exists (fun pattern -> Stringext.find_from id ~pattern = Some 0) id_set)
|
|
section_titles)
|
|
with
|
|
| Not_found -> default_section_title
|
|
in
|
|
let set =
|
|
try find title map with Not_found -> ErrorSet.empty
|
|
in
|
|
add title (ErrorSet.add error set) map
|
|
end
|
|
|
|
let pp_error_map ppf (map : ErrorSet.t ErrorPartition.t) : unit =
|
|
let open Format in
|
|
ErrorPartition.iter (fun section_title set ->
|
|
fprintf ppf "%a" pp_rst_h2 section_title ;
|
|
|
|
ErrorSet.iter
|
|
(fun error_repr ->
|
|
fprintf ppf "@[%a@]@\n@\n" pp_info_to_rst error_repr
|
|
) set
|
|
) map
|
|
|
|
let script =
|
|
"<script>\
|
|
function showTab(elt, tab, ref) {\
|
|
var i, tabcontent, tablinks;\
|
|
\
|
|
tabcontent = document.getElementsByClassName(ref);\
|
|
for (i = 0; i < tabcontent.length; i++) {\
|
|
tabcontent[i].style.display = 'none';\
|
|
}\
|
|
\
|
|
tablinks = elt.parentNode.children;\
|
|
for (i = 0; i < tablinks.length; i++) {\
|
|
tablinks[i].className = tablinks[i].className.replace(' active', '');\
|
|
}\
|
|
\
|
|
document.getElementById(tab).style.display = 'block';\
|
|
elt.className += ' active';\
|
|
}\
|
|
\
|
|
document.addEventListener('DOMContentLoaded', function(){\
|
|
var a = document.getElementsByClassName('defaultOpen');\
|
|
for (i = 0; i < a.length; i++) { a[i].click() }\
|
|
})\
|
|
</script>"
|
|
|
|
let style =
|
|
"<style>\
|
|
.tab {\
|
|
overflow: hidden;\
|
|
border: 1px solid #ccc;\
|
|
background-color: #f1f1f1;\
|
|
}\
|
|
.tab button {\
|
|
background-color: inherit;\
|
|
float: left;\
|
|
border: none;\
|
|
outline: none;\
|
|
cursor: pointer;\
|
|
padding: 5px 10px;\
|
|
}\
|
|
.tab button:hover {\
|
|
background-color: #ddd;\
|
|
}\
|
|
.tab button.active {\
|
|
background-color: #ccc;\
|
|
}\
|
|
.tabcontent {\
|
|
display: none;\
|
|
padding: 6px 12px;\
|
|
border: 1px solid #ccc;\
|
|
border-top: none;\
|
|
margin-bottom: 20px;\
|
|
}\
|
|
pre {\
|
|
font-size: 12px\
|
|
}</style>"
|
|
|
|
let print_script ppf =
|
|
(* HACK : show/hide JSON schemas + style *)
|
|
fprintf ppf "@[<v 2>.. raw:: html@\n@\n" ;
|
|
fprintf ppf "@[<v 0>%s%s@]@\n@\n@]@]@." script style
|
|
|
|
(* Main *)
|
|
let () =
|
|
let open Format in
|
|
let ppf = std_formatter in
|
|
|
|
(* Header *)
|
|
let title = "RPC Errors" in
|
|
fprintf ppf "%a" pp_rst_h1 title ;
|
|
|
|
print_script ppf ;
|
|
|
|
fprintf ppf "This document references possible errors that can come\
|
|
from RPC calls. It is generated from the OCaml source\
|
|
code (master branch).@\n@\n" ;
|
|
|
|
(* Body *)
|
|
let map =
|
|
let all_errors =
|
|
Error_monad.get_registered_errors () in
|
|
List.fold_left
|
|
(fun acc ( Error_monad.{ id ; _ } as error ) ->
|
|
ErrorPartition.add_error id error acc
|
|
) ErrorPartition.empty all_errors
|
|
in
|
|
|
|
fprintf ppf "%a" pp_error_map map
|