From 6956e8751dd55f31a89abe4150e92c5c44e5cbdb Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 26 Oct 2019 12:57:22 -0500 Subject: [PATCH] Add hex michelson output, use enums for format options --- src/bin/cli.ml | 14 +++++++---- src/bin/cli_helpers.ml | 13 +++-------- src/bin/cli_helpers.mli | 2 +- src/main/display.ml | 23 +++++-------------- src/main/display.mli | 9 +++----- vendors/ligo-utils/tezos-utils/x_michelson.ml | 10 +++++++- 6 files changed, 32 insertions(+), 39 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 3ff01bd1e..1142a1f31 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -75,20 +75,26 @@ let display_format = let docv = "DISPLAY_FORMAT" in let doc = "$(docv) is the format that will be used by the CLI. Available formats are 'dev', 'json', and 'human-readable' (default). When human-readable lacks details (we are still tweaking it), please contact us and use another format in the meanwhile." in info ~docv ~doc ["format" ; "display-format"] in - value @@ opt string "human-readable" info + value @@ + opt + (enum [("human-readable", `Human_readable); ("dev", `Dev); ("json", `Json)]) + `Human_readable + info let michelson_code_format = let open Arg in let info = let docv = "MICHELSON_FORMAT" in - let doc = "$(docv) is the format that will be used by compile-contract for the resulting Michelson. Available formats are 'micheline', and 'michelson' (default). Micheline is the format used by [XXX]." in + let doc = "$(docv) is the format that will be used by compile-contract for the resulting Michelson. Available formats are 'text' (default), 'json' and 'hex'." in info ~docv ~doc ["michelson-format"] in - value @@ opt string "michelson" info + value @@ + opt + (enum [("text", `Text); ("json", `Json); ("hex", `Hex)]) + `Text info let compile_file = let f source_file entry_point syntax display_format michelson_format = toplevel ~display_format @@ - let%bind michelson_format = Main.Display.michelson_format_of_string michelson_format in let%bind contract = trace (simple_info "compiling contract to michelson") @@ Ligo.Compile.Of_source.compile_file_contract_entry source_file entry_point (Syntax_name syntax) in diff --git a/src/bin/cli_helpers.ml b/src/bin/cli_helpers.ml index 7057e0975..cb25dd084 100644 --- a/src/bin/cli_helpers.ml +++ b/src/bin/cli_helpers.ml @@ -1,16 +1,9 @@ open Trace open Main.Display -let toplevel ~(display_format : string) (x : string result) = - let display_format = - try display_format_of_string display_format - with _ -> ( - Format.printf "bad display format %s, try looking at DISPLAY_FORMAT in the man (--help)." display_format ; - failwith "Display format" - ) - in +let toplevel ~(display_format : display_format) (x : string result) = match x with - | Ok _ -> Format.printf "%a\n%!" (formatted_string_result_pp display_format) x + | Ok _ -> Format.printf "%a%!" (formatted_string_result_pp display_format) x | Error _ -> - Format.eprintf "%a\n%!" (formatted_string_result_pp display_format) x ; + Format.eprintf "%a%!" (formatted_string_result_pp display_format) x ; exit 1 diff --git a/src/bin/cli_helpers.mli b/src/bin/cli_helpers.mli index 18fce0b58..e3e57f0a5 100644 --- a/src/bin/cli_helpers.mli +++ b/src/bin/cli_helpers.mli @@ -1,3 +1,3 @@ open Trace -val toplevel : display_format : string -> string result -> unit +val toplevel : display_format : Main.Display.display_format -> string result -> unit diff --git a/src/main/display.ml b/src/main/display.ml index 614ca60c7..da22fa883 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -87,13 +87,6 @@ type display_format = [ | `Dev ] -let display_format_of_string = fun s : display_format -> - match s with - | "dev" -> `Dev - | "json" -> `Json - | "human-readable" -> `Human_readable - | _ -> failwith "bad display_format" - let formatted_string_result_pp (display_format : display_format) = match display_format with | `Human_readable -> string_result_pp_hr @@ -101,16 +94,12 @@ let formatted_string_result_pp (display_format : display_format) = | `Json -> string_result_pp_json type michelson_format = [ - | `Michelson - | `Micheline + | `Text + | `Json + | `Hex ] -let michelson_format_of_string = fun s : michelson_format result -> - match s with - | "michelson" -> ok `Michelson - | "micheline" -> ok `Micheline - | _ -> simple_fail "bad michelson format" - let michelson_pp (mf : michelson_format) = match mf with - | `Michelson -> Michelson.pp - | `Micheline -> Michelson.pp_json + | `Text -> Michelson.pp + | `Json -> Michelson.pp_json + | `Hex -> Michelson.pp_hex diff --git a/src/main/display.mli b/src/main/display.mli index dc6cc2408..9dea6d65c 100644 --- a/src/main/display.mli +++ b/src/main/display.mli @@ -21,15 +21,12 @@ type display_format = [ | `Dev ] -val display_format_of_string : string -> display_format - val formatted_string_result_pp : display_format -> Format.formatter -> string Simple_utils.Trace.result -> unit type michelson_format = [ - | `Michelson - | `Micheline + | `Text + | `Json + | `Hex ] -val michelson_format_of_string : string -> michelson_format Simple_utils.Trace.result - val michelson_pp : michelson_format -> Format.formatter -> Tezos_utils.Michelson.michelson -> unit diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index a922fa382..5f9549998 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -1,7 +1,8 @@ open Tezos_micheline open Micheline -include Memory_proto_alpha.Protocol.Michelson_v1_primitives +open Memory_proto_alpha.Protocol +include Michelson_v1_primitives type michelson = (int, prim) node type t = michelson @@ -97,3 +98,10 @@ let pp_json ppf (michelson : michelson) = ) in Format.fprintf ppf "%a" Tezos_data_encoding.Json.pp json + +let pp_hex ppf (michelson : michelson) = + let canonical = strip_locations michelson in + let bytes = Tezos_data_encoding.Binary_writer.to_bytes_exn Script_repr.expr_encoding canonical in + let bytes = Tezos_stdlib.MBytes.to_bytes bytes in + let hex = Hex.of_bytes bytes in + Format.fprintf ppf "%a" Hex.pp hex