Merge branch '199-add-an-option-to-specify-output' into 'dev'

Resolve "Add an option to specify output"

Closes #199

See merge request ligolang/ligo!704

src/bin/cli.ml

@@ -124,6 +124,14 @@ let display_format =
     human_readable
     info
 
+let output_file =
+  let open Arg in
+  let info  =
+    let docv = "OUTPUT_FILE" in
+    let doc = "$(docv) if used, prints the output into the specified file instead of stdout" in
+    info ~docv ~doc ["output" ; "output-file"] in
+  value @@ opt (some string) None info
+
 let michelson_code_format =
   let open Arg in
   let info  =
@@ -150,15 +158,15 @@ module Decompile = Ligo.Decompile
 module Run = Ligo.Run.Of_michelson
 
 let compile_file =
-  let f source_file entry_point syntax display_format disable_typecheck michelson_format =
+  let f source_file entry_point syntax display_format disable_typecheck michelson_format output_file =
-    return_result ~display_format (Tezos_utils.Michelson.michelson_format michelson_format) @@
+    return_result ~output_file ~display_format (Tezos_utils.Michelson.michelson_format michelson_format) @@
       let%bind typed,_    = Compile.Utils.type_file source_file syntax (Contract entry_point) in
       let%bind mini_c     = Compile.Of_typed.compile typed in
       let%bind michelson  = Compile.Of_mini_c.aggregate_and_compile_contract mini_c entry_point in
       Compile.Of_michelson.build_contract ~disable_typecheck michelson
   in
   let term =
-    Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format $ disable_michelson_typechecking $ michelson_code_format) in
+    Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format $ disable_michelson_typechecking $ michelson_code_format $ output_file) in
   let cmdname = "compile-contract" in
   let doc = "Subcommand: Compile a contract." in
   (Term.ret term , Term.info ~doc cmdname)
@@ -257,7 +265,7 @@ let measure_contract =
       let%bind contract   = Compile.Utils.compile_file source_file syntax entry_point in
       ok @@ Tezos_utils.Michelson.measure contract in
     let format = Display.bind_format Formatter.contract_size_format Main.Formatter.error_format in
-    toplevel ~display_format (Display.Displayable { value ; format }) (returned_value value)
+    toplevel ~display_format (Display.Displayable { value ; format }) value
   in
   let term =
     Term.(const f $ source_file 0 $ entry_point 1 $ syntax $ display_format) in
@@ -436,7 +444,7 @@ let dump_changelog =
   let f display_format =
     let value = [%blob "../../CHANGELOG.md"] in
     let format = Formatter.changelog_format in
-    toplevel ~display_format (Display.Displayable {value ; format}) (returned_value (ok ())) in
+    toplevel ~display_format (Display.Displayable {value ; format}) (ok value) in
   let term =
     Term.(const f $ display_format) in
   let cmdname = "changelog" in

src/bin/cli_helpers.ml

@@ -1,23 +1,28 @@
 open Cmdliner
 open Main.Display
 
-let returned_value : (_,_) result -> unit -> unit Term.ret = 
+let return_good v = `Ok v
-  fun v () -> match v with
+let return_bad v = `Error (false, Format.asprintf "@[<hv>error@ %s@]" v)
-  | Ok _ -> `Ok ()
-  | Error _ -> `Error (false, "error")
 
-let toplevel : display_format:ex_display_format -> displayable -> (unit -> unit Term.ret) -> unit Term.ret =
+let toplevel : ?output_file:string option -> display_format:ex_display_format -> displayable -> ('value, Main_errors.Types.all) result -> unit Term.ret =
-  fun ~display_format disp return ->
+  fun ?(output_file=None) ~display_format disp value ->
     let (Ex_display_format t) = display_format in
     let as_str : string =
       match t with
       | Human_readable -> convert ~display_format:t disp ;
       | Dev -> convert ~display_format:t disp ;
-    | Json -> Yojson.to_string @@ convert ~display_format:t disp in
+      | Json -> Yojson.to_string @@ convert ~display_format:t disp
-  Format.printf "%s\n" as_str ;
+    in
-  return ()
+    match value with
+    | Ok _ ->
+      let fmt = match output_file with
+        | Some file_path -> Format.formatter_of_out_channel @@ open_out file_path
+        | None -> Format.std_formatter
+      in
+      return_good @@ Format.fprintf fmt "%s\n" as_str
+    | Error _ -> return_bad as_str
 
-let return_result : display_format:ex_display_format -> 'value format -> ('value, Main_errors.Types.all) result -> unit Term.ret =
+let return_result : ?output_file:string option -> display_format:ex_display_format -> 'value format -> ('value, Main_errors.Types.all) result -> unit Term.ret =
-  fun ~display_format value_format value ->
+  fun ?(output_file=None) ~display_format value_format value ->
-    let format = Display.bind_format value_format Main.Formatter.error_format in
+    let format = bind_format value_format Main.Formatter.error_format in
-    toplevel ~display_format (Display.Displayable {value ; format}) (returned_value value)
+    toplevel ~output_file ~display_format (Displayable {value ; format}) value

src/bin/cli_helpers.mli

@@ -1,6 +1,5 @@
 open Cmdliner
 open Display
 
-val toplevel : display_format:ex_display_format -> displayable -> (unit -> unit Term.ret) -> unit Term.ret
+val toplevel : ?output_file:string option -> display_format:ex_display_format -> displayable -> ('value, Main_errors.Types.all) result -> unit Term.ret
-val returned_value : (_,_) Trace.result -> unit -> unit Term.ret
+val return_result : ?output_file:string option -> display_format:ex_display_format -> 'value format -> ('value, Main_errors.Types.all) result -> unit Term.ret
-val return_result : display_format:ex_display_format -> 'value format -> ('value, Main_errors.Types.all) result -> unit Term.ret

src/bin/expect_tests/contract_tests.ml

@@ -1461,7 +1461,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
   [%expect {|
 ligo: error
-in file "create_contract_toplevel.mligo", line 3, characters 4-8
+      in file "create_contract_toplevel.mligo", line 3, characters 0-3
       Constant declaration 'main'
       in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8
       Free variable 'store' is not allowed in CREATE_CONTRACT lambda
@@ -1477,7 +1477,7 @@ If you're not sure how to fix this error, you can do one of the following:
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
   [%expect {|
 ligo: error
-in file "create_contract_var.mligo", line 5, characters 4-8
+      in file "create_contract_var.mligo", line 5, characters 0-3
       Constant declaration 'main'
       in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5
       Free variable 'a' is not allowed in CREATE_CONTRACT lambda

src/bin/expect_tests/help_tests.ml

@@ -246,6 +246,10 @@ let%expect_test _ =
                compile-contract for the resulting Michelson. Available formats
                are 'text' (default), 'json' and 'hex'.
 
+           --output-file=OUTPUT_FILE, --output=OUTPUT_FILE
+               OUTPUT_FILE if used, prints the output into the specified file
+               instead of stdout
+
            -s SYNTAX, --syntax=SYNTAX (absent=auto)
                SYNTAX is the syntax that will be used. Currently supported
                syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,

src/bin/expect_tests/michelson_converter.ml

@@ -9,7 +9,7 @@ let%expect_test _ =
   run_ligo_bad [ "interpret" ; "--init-file="^(bad_contract "michelson_converter_no_annotation.mligo") ; "l4"] ;
   [%expect {|
     ligo: error
-    in file "michelson_converter_no_annotation.mligo", line 4, characters 4-6
+          in file "michelson_converter_no_annotation.mligo", line 4, characters 9-39
           Constant declaration 'l4'
           Can't retrieve type declaration order in the converted record, you need to annotate it
 
@@ -24,7 +24,7 @@ let%expect_test _ =
   run_ligo_bad [ "interpret" ; "--init-file="^(bad_contract "michelson_converter_short_record.mligo") ; "l1"] ;
   [%expect {|
     ligo: error
-    in file "michelson_converter_short_record.mligo", line 4, characters 4-6
+          in file "michelson_converter_short_record.mligo", line 4, characters 9-44
           Constant declaration 'l1'
           in file "michelson_converter_short_record.mligo", line 1, characters 10-23
           Converted record must have at least two elements

src/bin/expect_tests/michelson_or_tests.ml

@@ -30,7 +30,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "bad_michelson_or.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "bad_michelson_or.mligo", line 5, characters 4-8
+          in file "bad_michelson_or.mligo", line 5, characters 0-3
           Constant declaration 'main'
           in file "bad_michelson_or.mligo", line 6, characters 12-27
           michelson_or contructor M_right must be annotated with a sum type

src/bin/expect_tests/typer_error_tests.ml

@@ -4,7 +4,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_function_annotation_1.mligo"; "main"];
   [%expect {|
     ligo: error
-    in file "error_function_annotation_1.mligo", line 1, characters 4-8
+          in file "error_function_annotation_1.mligo", line 1, characters 0-3
           Constant declaration 'main'
           Bad types: expected int -> unit got int -> int
 
@@ -19,7 +19,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_function_annotation_2.mligo"; "f"];
   [%expect {|
     ligo: error
-    in file "error_function_annotation_2.mligo", line 1, characters 4-5
+          in file "error_function_annotation_2.mligo", line 1, characters 14-43
           Constant declaration 'f'
           Bad types: expected int got ( int * int ) -> int
 
@@ -34,7 +34,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_function_annotation_3.mligo"; "f"];
   [%expect {|
     ligo: error
-    in file "error_function_annotation_3.mligo", line 6, characters 4-8
+          in file "error_function_annotation_3.mligo", line 6, characters 0-3
           Constant declaration 'main'
           Bad types:
           expected ( int * sum[Add -> int , Sub -> int] ) -> ( (type_operator: list(operation)) * sum[Add -> int , Sub -> int] )
@@ -65,7 +65,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_type.ligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_type.ligo", line 3, characters 6-9
+          in file "error_type.ligo", line 3, characters 18-28
           Constant declaration 'foo'
           Expected arguments with one of the following combinations of type:
           (nat , nat) or (int , int) or (mutez , mutez) or (nat , int) or (int , nat) or (timestamp , int) or (int , timestamp)
@@ -82,7 +82,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_1.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_typer_1.mligo", line 3, characters 4-7
+          in file "error_typer_1.mligo", line 3, characters 19-27
           Constant declaration 'foo'
           Bad types: expected string got int
 
@@ -97,7 +97,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_2.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_typer_2.mligo", line 3, characters 4-7
+          in file "error_typer_2.mligo", line 3, characters 24-39
           Constant declaration 'foo'
           Bad types:
           expected (type_operator: list(string))
@@ -114,7 +114,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_3.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_typer_3.mligo", line 3, characters 4-7
+          in file "error_typer_3.mligo", line 3, characters 34-53
           Constant declaration 'foo'
           Bad types:
           expected ( int * string * sum[false -> unit , true -> unit] )
@@ -131,7 +131,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_4.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_typer_4.mligo", line 4, characters 4-7
+          in file "error_typer_4.mligo", line 4, characters 17-56
           Constant declaration 'foo'
           Bad types:
           expected record[a -> int , c -> sum[false -> unit , true -> unit] , d -> string]
@@ -163,7 +163,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_6.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_typer_6.mligo", line 1, characters 4-7
+          in file "error_typer_6.mligo", line 1, characters 30-64
           Constant declaration 'foo'
           Bad types:
           expected (type_operator: Map (int,string))
@@ -180,7 +180,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_7.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "error_typer_7.mligo", line 4, characters 4-7
+          in file "error_typer_7.mligo", line 4, characters 17-56
           Constant declaration 'foo'
           Bad types:
           expected record[a -> int , b -> string]
@@ -197,7 +197,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/id.mligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "id.mligo", line 28, characters 4-7
+          in file "id.mligo", line 28, characters 0-3
           Constant declaration 'buy'
           in file "id.mligo", line 3, character 18 to line 7, character 1
           Expected an option but got record[controller -> address , owner -> address , profile -> bytes]
@@ -236,7 +236,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/failwith_wrong_type.ligo" ; "main" ] ;
   [%expect {|
     ligo: error
-    in file "failwith_wrong_type.ligo", line 2, characters 6-9
+          in file "failwith_wrong_type.ligo", line 2, characters 19-46
           Constant declaration 'bad'
           Expected arguments with one of the following combinations of type:
           (string) or (nat) or (int)

src/passes/09-typing/08-typer-common/errors.ml

@@ -257,10 +257,10 @@ let rec error_ppformat : display_format:string display_format ->
       Format.fprintf f
         "%a"
         (error_ppformat ~display_format) err
-    | `Typer_constant_declaration_tracer (name,_ae,_,err) ->
+    | `Typer_constant_declaration_tracer (name,ae,_,err) ->
       Format.fprintf f
         "@[<hv>%a@ Constant declaration '%a'@ %a@]"
-        Location.pp name.location
+        Location.pp ae.location
         Ast_core.PP.expression_variable name
       (error_ppformat ~display_format) err
     | `Typer_match_error (expected,actual,loc) ->