diff --git a/docs/Makefile b/docs/Makefile index 377089a70..8d659e4be 100644 --- a/docs/Makefile +++ b/docs/Makefile @@ -7,13 +7,16 @@ BUILDDIR = _build DOCGENDIR = doc_gen DOCERRORDIR = $(DOCGENDIR)/errors -DOCRPCDIR = $(DOCGENDIR)/rpcs +DOCRPCDIR = $(DOCGENDIR)/rpcs all: html linkcheck linkcheck: $(SPHINXBUILD) -b linkcheck "$(SOURCEDIR)" "$(BUILDDIR)" +introduction/readme.rst: ../README.rst + sed 's/TEZOS/How to build and run/' $< > $@ + api/errors.rst: $(DOCERRORDIR)/error_doc.ml @jbuilder build $(DOCERRORDIR)/error_doc.exe ../_build/default/docs/$(DOCERRORDIR)/error_doc.exe > api/errors.rst @@ -31,4 +34,4 @@ html: Makefile api/errors.rst api/rpc.rst clean: @-rm -Rf "$(BUILDDIR)" - @-rm -Rf introduction/readme.rst api/errors.rst + @-rm -Rf introduction/readme.rst api/errors.rst api/rpc.rst diff --git a/docs/doc_gen/errors/error_doc.ml b/docs/doc_gen/errors/error_doc.ml index d30ffe014..bd6877d91 100644 --- a/docs/doc_gen/errors/error_doc.ml +++ b/docs/doc_gen/errors/error_doc.ml @@ -7,7 +7,9 @@ (* *) (**************************************************************************) -(* Todo : add section descriptions *) +open Format + +(* TODO: add section descriptions *) let default_section_id = "default" let default_section_title = "Miscellaneous" @@ -21,45 +23,20 @@ let default_section_title = "Miscellaneous" bottom of the document. Unprefixed ids or unreferenced prefixes will default to `Miscellaneous` *) let section_titles = - [ - [ "proto" ], "Protocol Alpha"; - [ "baking" ], "Baking" ; - [ "contract" ], "Smart Contracts" ; - [ "distributed_db" ], "Database" ; - [ "micheline" ; "michelson" ], "Smart Contracts" ; - (* [ "michelson" ], "Michelson" ; *) - [ "node" ], "Client Node" ; - [ "operation" ], "Operations" ; - [ "prevalidation" ], "Prevalidation" ; - [ "raw_store" ], "Store" ; - [ "rpc_client" ], "RPC Client" ; - [ "tez" ], "Tezos operations" ; - [ "validator" ], "Validator" ; - [ "worker" ], "Worker" ; - (* [ "cli" ], "Command Line" ; *) + [ [ "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 categories_detail = - [ "temporary", "An error resulting from an operation that might be \ - valid in the future, for example, a contract’s balance \ - being too low to execute the intended operation. This \ - can be fixed by adding more to the contract’s balance." - ; "branch", "An error that occurs in one branch of the chain, but may not \ - occur in a different one. For example, receiving an \ - operation for an old or future protocol version." - ; "permanent", "An error that is not recoverable because the operation \ - is never going to be valid. For example, an invalid ꜩ \ - notation." ] - let pp_rst_title ~char ppf title = let sub = String.map (fun _ -> char) title in - Format.fprintf ppf "@[%s@\n@]@[%s@\n@\n@]" title sub + fprintf ppf "@[%s@\n@]@[%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 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 @@ -67,28 +44,68 @@ let string_of_err_category = | `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 "@ " + (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 "@[.. raw:: html@ @ "; + fprintf fmt "@[
@ "; + + 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 "@
@ @]"; + + let description_content = + asprintf "

%s

Id : %s
Category : %s

" description id (string_of_err_category category) + in + + open_vbox 2; + + (* Print description *) + begin + fprintf fmt "
@ " + (idref ^ descr_label) idref; + fprintf fmt "%s@ " description_content; + fprintf fmt "
@]"; + end; + + (* Print schema *) + begin + (* Hack: negative offset in order to reduce the 
's content left-margin *)
+    (* TODO: pretty-(html)-print the schema *)
+    open_vbox (-8);
+    fprintf fmt "
@ "
+      (idref ^ schema_label) idref;
+    fprintf fmt "<%s>@ %a@ " "pre" Json_schema.pp schema "pre";
+    fprintf fmt "
";
+    close_box ();
+  end;
+
+  close_box ()
+
 let pp_info_to_rst
     ppf
-    { Error_monad.id ; title ; category ; description ; schema } =
+    (Error_monad.{ title ; _ } as error_info) =
   let open Format in
 
-  fprintf ppf "@[- **%s**@,@,"
-    (if title = "" then "" else title) ;
-
-  fprintf ppf "@[%s@\n@\n@]"
-    (if description = "" then "Not description available" else description) ;
-
-  fprintf ppf "@[* *Id* : %s@\n@\n@]" id ;
-
-  fprintf ppf "@[* *Category* : %s@\n@\n@]" (string_of_err_category category) ;
-
-  fprintf ppf "@[.. container:: schema-button@\n@\n" ;
-  fprintf ppf "@[Show schema@]@]@\n@\n" ;
-
-  fprintf ppf "@[.. container:: schema@\n@\n" ;
-  fprintf ppf "@[.. code-block:: json@\n@\n" ;
-
-  fprintf ppf "@[%a@]@]@]@]" Json_schema.pp schema
+  fprintf ppf "**%s**@\n@\n" (if title = "" then "" else title);
+  fprintf ppf "@[%a@ @ @]" pp_print_html_tabs error_info;
 
 module ErrorSet = Set.Make(struct
     type t = Error_monad.error_info
@@ -113,32 +130,20 @@ module ErrorPartition = struct
     end)
 
   let add_error (id : key) (error : Error_monad.error_info) (map : 'a t) =
-    let lr_opt = Stringext.cut id ~on:"." in
-
-    let id_prefix =
-      match lr_opt with
-      | None -> default_section_id
-      | Some (prefix, _r) -> prefix
-    in
-
     let title =
       try
-        snd (List.find
-               (fun (id_set, _) -> List.mem id_prefix id_set)
-               section_titles)
+        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
+      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 =
@@ -152,21 +157,67 @@ let pp_error_map ppf (map : ErrorSet.t ErrorPartition.t) : unit =
         ) set
     ) map
 
+let script =
+  ""
+
+let style =
+  ""
+
 let print_script ppf =
   (* HACK : show/hide JSON schemas + style *)
-  Format.fprintf ppf "@[.. raw:: html@\n@\n" ;
-  Format.fprintf ppf "@[%s%s@]@\n@\n@]"
-    ""
-    ""
+  fprintf ppf "@[.. raw:: html@\n@\n" ;
+  fprintf ppf "@[%s%s@]@\n@\n@]@]@." script style
 
 (* Main *)
 let () =
@@ -174,22 +225,14 @@ let () =
   let ppf = std_formatter in
 
   (* Header *)
-  let title = "Tezos Client Errors" in
+  let title = "RPC Errors" in
   fprintf ppf "%a" pp_rst_h1 title ;
 
   print_script ppf ;
 
-  fprintf ppf "This document references possible errors.@\n@\n" ;
-
-  fprintf ppf "There are three categories of error :@\n@\n" ;
-
-  List.iter (fun (cat, descr) ->
-      fprintf ppf "- :literal:`%s` - %s@\n@\n" cat descr) categories_detail ;
-
-  fprintf ppf "See `The Error Monad`_ for further details.@\n@\n" ;
-  fprintf
-    ppf ".. _The Error Monad: \
-         ../tutorials/error_monad.html#the-actual-tezos-error-monad@\n@\n" ;
+  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 =
diff --git a/docs/doc_gen/errors/jbuild b/docs/doc_gen/errors/jbuild
index cbc469f98..2680e9ebc 100644
--- a/docs/doc_gen/errors/jbuild
+++ b/docs/doc_gen/errors/jbuild
@@ -4,13 +4,12 @@
  ((name error_doc)
   (libraries
    (tezos-shell
-    tezos-embedded-protocol-alpha))
+    tezos-client-alpha))
   (flags (:standard -w -9+27-30-32-40@8
           -open Tezos_base
           -open Tezos_error_monad
           -open Tezos_data_encoding
-          -open Tezos_embedded_protocol_alpha
-          -open Tezos_embedded_protocol_environment_alpha
+          -open Tezos_client_alpha
           -safe-string
           -linkall))))
 
diff --git a/docs/doc_gen/rpcs/rpc_doc.ml b/docs/doc_gen/rpcs/rpc_doc.ml
index bf0e7da22..e96e84680 100644
--- a/docs/doc_gen/rpcs/rpc_doc.ml
+++ b/docs/doc_gen/rpcs/rpc_doc.ml
@@ -7,124 +7,13 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(* Utility functions *)
-
-exception Unsupported_construct
-
-type input = {
-  int : int -> int -> string option -> string list -> int ;
-  float : string option -> string list -> float ;
-  string : string option -> string list -> string ;
-  bool : string option -> string list -> bool ;
-  continue : string option -> string list -> bool ;
-  display : string -> unit ;
-}
-
-open Json_schema
-
-(* generic JSON generation from a schema with callback for random or
-   interactive filling *)
-let fill_in ?(show_optionals=true) input schema : ([> `A of 'a list | `Null | `O of (string * 'a) list | `String of string ]
-                                                   as 'a) =
-  let rec element path { title ; kind }=
-    match kind with
-    | Integer { minimum ; maximum } ->
-        let minimum =
-          match minimum with
-          | None -> min_int
-          | Some (m, `Inclusive) -> int_of_float m
-          | Some (m, `Exclusive) -> int_of_float m + 1 in
-        let maximum =
-          match maximum with
-          | None -> max_int
-          | Some (m, `Inclusive) -> int_of_float m
-          | Some (m, `Exclusive) -> int_of_float m - 1 in
-        let i = input.int minimum maximum title path  in
-        `Float (float i)
-    | Number _ ->
-        let f = input.float title path in
-        `Float f
-    | Boolean ->
-        let f = input.bool title path in
-        `Bool f
-    | String _ ->
-        let f = input.string title path in
-        `String f
-    | Combine ((One_of | Any_of), elts) ->
-        let nb = List.length elts in
-        let n = input.int 0 (nb - 1) (Some "Select the schema to follow") path in
-        element path (List.nth elts n)
-    | Combine ((All_of | Not), _) ->  raise Unsupported_construct
-    | Def_ref name ->
-        (`String (Json_query.json_pointer_of_path name))
-    | Id_ref _ | Ext_ref _ ->
-        raise Unsupported_construct
-    | Array (elts, _) ->
-        let rec fill_loop acc n ls =
-          match ls with
-          | [] -> acc
-          | elt :: elts ->
-              let json = element (string_of_int n :: path) elt in
-              fill_loop (json :: acc) (succ n) elts
-        in
-        let acc = fill_loop [] 0 elts in
-        (`A (List.rev acc))
-    | Object { properties } ->
-        let properties =
-          if show_optionals
-          then properties
-          else (List.filter (fun (_, _, b, _) -> b) properties) in
-        let rec fill_loop acc ls =
-          match ls with
-          | [] -> acc
-          | (n, elt, _, _) :: elts ->
-              let json = element (n :: path) elt in
-              fill_loop ((n, json) :: acc) elts
-        in
-        let acc = fill_loop [] properties in
-        (`O (List.rev acc))
-    | Monomorphic_array (elt, specs) ->
-        let rec fill_loop acc min n max =
-          if n > max then
-            acc
-          else
-            let json = element (string_of_int n :: path) elt in
-            if n < min || input.continue title path then
-              fill_loop (json :: acc) min (succ n) max
-            else (json :: acc)
-        in
-        let max = match specs.max_items with None -> max_int | Some m -> m in
-        let acc = fill_loop [] specs.min_items 0 max in
-        `A (List.rev acc)
-    | Any -> raise Unsupported_construct
-    | Dummy -> raise Unsupported_construct
-    | Null -> `Null
-  in
-  element [] (Json_schema.root schema)
-
-let random_fill_in ?(show_optionals=true) schema =
-  let display _ = () in
-  let int min max _ _ =
-    let max = Int64.of_int max
-    and min = Int64.of_int min in
-    let range = Int64.sub max min in
-    let random_int64 = Int64.add (Random.int64 range) min in
-    Int64.to_int random_int64 in
-  let string _title _ = "" in
-  let float _ _ = Random.float infinity in
-  let bool _ _ =  (Random.int 2 = 0) in
-  let continue _ _ =  (Random.int 4 = 0) in
-  fill_in ~show_optionals
-    { int ; float ; string ; bool ; display ; continue }
-    schema
-
 type service_repr =
   { path : string list ;
     meth : Resto.meth ;
     description : string ;
-    input : Json_schema.schema option;
-    output : Json_schema.schema ;
-    example : string option;
+    input : Json_schema.schema option ;
+    output : Json_schema.schema option ;
+    example : string option ;
     error : Json_schema.schema option
   }
 
@@ -137,51 +26,28 @@ let make_descr = function
   | None | Some "" -> "No description"
   | Some s -> s
 
+(** Inspect a JSON schema: if it doesn't contain any field (e.g. { }),
+    return None *)
+let normalize_json_schema = function
+  | None -> None
+  | Some schema ->
+      let open Json_schema in
+      let elt = root schema in
+      match elt.kind with
+      | Object specs when
+          specs = object_specs ||
+          specs = { object_specs with additional_properties = None } ->
+          None
+      | _ -> Some schema
+
 let repr_of_service path
     RPC_description.{ description ; error ;
-                      meth ; input ; output ; _ }  : service_repr=
-  (* let escape_html_string str =
-   *   let open Stringext in
-   *   let str = replace_all str ~pattern:"<" ~with_:"<" in
-   *   replace_all str ~pattern:">" ~with_:">"
-   * in
-   *
-   * let example = begin
-   *   try
-   *     match input with
-   *     | None -> None
-   *     | Some input  -> begin
-   *         let path = List.map escape_html_string path |> String.concat "/" in
-   *         Printf.eprintf "%s\n%!" path;
-   *         let json = random_fill_in ~show_optionals:true input in
-   *         let tezos_client_cmd_example =
-   *           Format.sprintf "tezos-client rpc call /%s with '%s'"
-   *             path
-   *             (Data_encoding.Json.to_string ~minify:true json)
-   *         in
-   *         let curl_cmd_example =
-   *           Format.sprintf "curl -X %s -H \"Content-type: application/json\" http://%s/%s -d '%s'"
-   *             (RPC_service.string_of_meth meth)
-   *             "127.0.0.1:18731"
-   *             path
-   *             (Data_encoding.Json.to_string ~minify:true json)
-   *         in
-   *         let open Format in
-   *         Some (
-   *           List.fold_left (fun acc s ->
-   *               (Format.sprintf "
%s
" s) :: acc)
-   *             [] [ curl_cmd_example ; tezos_client_cmd_example ]
-   *           |> String.concat "or"
-   *         )
-   *
-   *       end
-   *   with | Unsupported_construct -> None
-   * end in *)
-
+                      meth ; input ; output ; _ }  : service_repr =
   { path ; meth ;
     description = make_descr description ;
-    input ; output ;
-    example=None ; error = Some error  }
+    input = normalize_json_schema input ;
+    output = normalize_json_schema (Some output) ;
+    example = None ; error = Some error  }
 
 open Format
 
@@ -216,34 +82,15 @@ let rec pp_print_service_tree fmt = function
         ) l;
       fprintf fmt "@]"
 
-let collected_args = ref []
-
-let pp_print_collected_args ppf () =
-  let open Resto.Arg in
-  fprintf ppf "@[";
-  List.iter
-    (function
-      | { name ; descr=Some d } ->
-          fprintf ppf "@[**<%s>** : @[%s@]@]@ @ " name d;
-      | { descr=None ; _ } -> assert false
-    )
-    (List.rev !collected_args);
-  fprintf ppf "@]"
-
 let make_tree cctxt path =
-  let collect arg =
-    if not (arg.RPC_arg.descr = None ||
-            (List.exists (fun { Resto.Arg.name } -> name = arg.name)
-               !collected_args)) then
-      collected_args := arg :: !collected_args
-  in
+  (* TODO : add automatic example generation *)
   let open RPC_description in
   describe cctxt ~recurse:true path >>=? fun dir ->
   let rec loop path : _ directory -> service_tree list = function
     | Dynamic descr ->
         [ Node ({ path ; meth=`POST ;
                   description=make_descr descr ;
-                  input = None ; output = Json_schema.any ;
+                  input = None ; output = None ;
                   example = None ; error = None }, []) ]
 
     | Empty -> []
@@ -274,7 +121,6 @@ let make_tree cctxt path =
         end
 
     | Static { services ; subdirs = Some (Arg (arg, solo)) } ->
-        collect arg;
         let name = Printf.sprintf "<%s>" arg.RPC_arg.name in
 
         let services = RPC_service.MethMap.bindings services in
@@ -372,7 +218,7 @@ let rec pp_print_rst_hierarchy fmt ~title node =
     let rec loop str =
       let open Stringext in
       if find_from str ~pattern:"--" <> None then
-        loop (Stringext.replace_all_assoc str [("--","-")])
+        loop (replace_all_assoc str [("--","-")])
       else
         str
     in loop rst_name
@@ -446,29 +292,20 @@ let pp_print_html_tab_content fmt ~tag ~shortlabel ~pp_content ~content path =
   fprintf fmt "<%s>@ %a@ " tag pp_content content tag;
   fprintf fmt "@]"
 
-let pp_print_html_tab_content_example fmt ~shortlabel ~pp_content ~content path =
-  let target_ref = ref_of_path path in
-  fprintf fmt "@[
@ %a
@]"
-    (target_ref ^ shortlabel) target_ref pp_content content
-
-let pp_print_html_tabs fmt { path ; description ; input ; output ; example ; error } =
+let pp_print_html_tabs fmt { path ; description ; input ; output ; _ (* example ; error *) } =
   fprintf fmt "@[.. raw:: html@ @ ";
   fprintf fmt "@[
@ ";
 
   fprintf fmt "%a" (pp_print_html_tab_button ~default:true ~shortlabel:"descr" ~content:"Description") path;
   (match input with
    | Some _ ->
-       fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"input" ~content:"Input") path;
-   | None -> ());
-  fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"output" ~content:"Output") path;
-  (match example with
-   | Some _ ->
-       fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"example" ~content:"Example") path;
-   | None -> ());
-  (match error with
-   | Some _ ->
-       fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"error" ~content:"Errors") path;
+       fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"input" ~content:"Input schema") path;
    | None -> ());
+  fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"output" ~content:"Output schema") path;
+  (* (match example with
+   *  | Some _ ->
+   *      fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:"example" ~content:"Example") path;
+   *  | None -> ()); *)
   fprintf fmt "
@]@ ";
 
   fprintf fmt "%a@ " (pp_print_html_tab_content ~tag:"p" ~shortlabel:"descr"
@@ -477,16 +314,15 @@ let pp_print_html_tabs fmt { path ; description ; input ; output ; example ; err
    | Some x -> fprintf fmt "%a@ " (pp_print_html_tab_content ~tag:"pre" ~shortlabel:"input"
                                      ~pp_content:Json_schema.pp ~content:x) path;
    | None -> ());
-  fprintf fmt "%a@ " (pp_print_html_tab_content ~tag:"pre" ~shortlabel:"output"
-                        ~pp_content:Json_schema.pp ~content:output) path;
-  (match example with
-   | Some x -> fprintf fmt "%a@ " (pp_print_html_tab_content_example ~shortlabel:"example"
-                                     ~pp_content:pp_print_string ~content:x) path;
-   | None -> ());
-  (match error with
-   | Some x -> fprintf fmt "%a@ " (pp_print_html_tab_content ~tag:"pre" ~shortlabel:"error"
+  (match output with
+   | Some x -> fprintf fmt "%a@ " (pp_print_html_tab_content ~tag:"pre" ~shortlabel:"output"
                                      ~pp_content:Json_schema.pp ~content:x) path;
    | None -> ());
+  (* (match example with
+   *  | Some x -> fprintf fmt "%a@ " (pp_print_html_tab_content ~tag:"pre" ~shortlabel:"example"
+   *                                    ~pp_content:pp_print_string ~content:x) path;
+   *  | None -> ()); *)
+
   fprintf fmt "@]"
 
 let pp_print_rst_full_service fmt ({ path ; meth } as repr) =
@@ -536,11 +372,7 @@ let style =
    }\
    pre {\
    font-size: 12px\
-   }\
-   .cmdline { font-family: monospace; background: #343131; padding: 2px 8px;\
-   border-radius:10px; color: white; margin: 5px; }\
-   .cmdline+.cmddoc { margin: -5px 5px 0 20px; padding: 5px }\
-   "
+   }"
 
 let script =
   "