balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

more formats

Browse Source
This commit is contained in:
galfour 2019-09-20 11:59:44 +02:00
parent e3179bd7c7
commit 2a90be292c
3 changed files with 91 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
src/bin/cli.ml
View File

@ -45,89 +45,91 @@ let amount =
info ~docv ~doc ["amount"] in
value @@ opt string "0" info
let display_format =
let open Arg in
let info =
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
let compile_file =
let f source entry_point syntax =
toplevel @@
let f source entry_point syntax display_format =
toplevel ~display_format @@
let%bind contract =
trace (simple_info "compiling contract to michelson") @@
Ligo.Compile.Of_source.compile_file_contract_entry source entry_point (Syntax_name syntax) in
Format.printf "%a\n" Tezos_utils.Michelson.pp contract.body ;
ok ()
ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp contract.body
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ syntax) in
Term.(const f $ source 0 $ entry_point 1 $ syntax $ display_format) in
let cmdname = "compile-contract" in
let docs = "Subcommand: compile a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
(term , Term.info ~docs cmdname)
let compile_parameter =
let f source entry_point expression syntax =
toplevel @@
let f source entry_point expression syntax display_format =
toplevel ~display_format @@
let%bind value =
trace (simple_error "compile-input") @@
Ligo.Compile.Of_source.compile_file_contract_parameter source entry_point expression (Syntax_name syntax) in
Format.printf "%a\n" Tezos_utils.Michelson.pp value;
ok ()
ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax) in
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax $ display_format) in
let cmdname = "compile-parameter" in
let docs = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
(term , Term.info ~docs cmdname)
let compile_storage =
let f source entry_point expression syntax =
toplevel @@
let f source entry_point expression syntax display_format =
toplevel ~display_format @@
let%bind value =
trace (simple_error "compile-storage") @@
Ligo.Compile.Of_source.compile_file_contract_storage source entry_point expression (Syntax_name syntax) in
Format.printf "%a\n" Tezos_utils.Michelson.pp value;
ok ()
ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax) in
Term.(const f $ source 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format) in
let cmdname = "compile-storage" in
let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in
(term , Term.info ~docs cmdname)
let dry_run =
let f source entry_point storage input amount syntax =
toplevel @@
let f source entry_point storage input amount syntax display_format =
toplevel ~display_format @@
let%bind output =
Ligo.Run.Of_source.run_contract ~amount source entry_point storage input (Syntax_name syntax) in
Format.printf "%a\n" Ast_simplified.PP.expression output ;
ok ()
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ syntax) in
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ syntax $ display_format) in
let cmdname = "dry-run" in
let docs = "Subcommand: run a smart-contract with the given storage and input." in
(term , Term.info ~docs cmdname)
let run_function =
let f source entry_point parameter amount syntax =
toplevel @@
let f source entry_point parameter amount syntax display_format =
toplevel ~display_format @@
let%bind output =
Ligo.Run.Of_source.run_function ~amount source entry_point parameter (Syntax_name syntax) in
Format.printf "%a\n" Ast_simplified.PP.expression output ;
ok ()
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax) in
Term.(const f $ source 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ syntax $ display_format) in
let cmdname = "run-function" in
let docs = "Subcommand: run a function with the given parameter." in
(term , Term.info ~docs cmdname)
let evaluate_value =
let f source entry_point amount syntax =
toplevel @@
let f source entry_point amount syntax display_format =
toplevel ~display_format @@
let%bind output =
Ligo.Run.Of_source.evaluate ~amount source entry_point (Syntax_name syntax) in
Format.printf "%a\n" Ast_simplified.PP.expression output ;
ok ()
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
in
let term =
Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax) in
Term.(const f $ source 0 $ entry_point 1 $ amount $ syntax $ display_format) in
let cmdname = "evaluate-value" in
let docs = "Subcommand: evaluate a given definition." in
(term , Term.info ~docs cmdname)

17
src/bin/cli_helpers.ml
View File

@ -1,9 +1,12 @@
open Trace
open Main.Display
let toplevel x =
match x with
| Trace.Ok ((), annotations) -> ignore annotations; ()
| Error ss -> (
Format.printf "%a%!" Main.Display.error_pp (ss ())
)
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
Format.printf "%a" (formatted_string_result_pp display_format) x

55
src/main/display.ml
View File

@ -1,8 +1,6 @@
open Trace
open! Trace
let dev = false
let rec error_pp out (e : error) =
let rec error_pp ?(dev = false) out (e : error) =
let open JSON_string_utils in
let message =
let opt = e |> member "message" |> string in
@ -50,7 +48,52 @@ let rec error_pp out (e : error) =
print "%s%s%s%s%s" location title error_code message data
) else (
print "%s%s%s.\n%s%s\n%a\n%a\n" title error_code message data location
(Format.pp_print_list error_pp) infos
(Format.pp_print_list error_pp) children
(Format.pp_print_list (error_pp ~dev)) infos
(Format.pp_print_list (error_pp ~dev)) children
)
let result_pp_hr f out (r : _ result) =
match r with
| Ok (s , _) -> Format.fprintf out "%a" f s
| Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ())
let string_result_pp_hr = result_pp_hr (fun out s -> Format.fprintf out "%s" s)
let result_pp_dev f out (r : _ result) =
match r with
| Ok (s , _) -> Format.fprintf out "%a" f s
| Error e -> Format.fprintf out "%a" (error_pp ~dev:false) (e ())
let string_result_pp_dev = result_pp_hr (fun out s -> Format.fprintf out "%s" s)
let string_result_pp_json out (r : string result) =
let status_json status content : J.t = `Assoc ([
("status" , `String status) ;
("content" , content) ;
]) in
match r with
| Ok (x , _) -> (
Format.fprintf out "%a" J.pp (status_json "ok" (`String x))
)
| Error e -> (
Format.fprintf out "%a" J.pp (status_json "error" (e ()))
)
type display_format = [
| `Human_readable
| `Json
| `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
| `Dev -> string_result_pp_dev
| `Json -> string_result_pp_json