From a61eeebed038c90346127f9bbcb50e266a2b87b1 Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Wed, 7 Aug 2024 12:25:49 +0200 Subject: [PATCH] Add ability to specify listings target in build tasks --- package.json | 12 +++++-- src/lsp/superbol_free_lib/vscode_extension.ml | 14 +++++--- .../superbol_tasks.ml | 36 +++++++++++-------- 3 files changed, 42 insertions(+), 20 deletions(-) diff --git a/package.json b/package.json index 688e808a..c224c09a 100644 --- a/package.json +++ b/package.json @@ -531,11 +531,19 @@ }, "cobc-path": { "title": "GnuCOBOL Compiler Executable", + "markdownDescription": "Path to the GnuCOBOL compiler executable; when `null`, defaults to the value of \"superbol.cobc-path\" from the workspace configuration, if defined, to \"cobc\" otherwise.", "type": [ "string", "null" - ], - "description": "Path to the GnuCOBOL compiler executable; when `null`, defaults to the value of \"superbol.cobc-path\" from the workspace configuration, if defined, to \"cobc\" otherwise." + ] + }, + "listings-target": { + "title": "Output file or directory for preprocessed program listings", + "markdownDescription": "Path to a directory where preprocessed program listings are generated; no listing is saved when `null`", + "type": [ + "string", + "null" + ] }, "extra-args": { "type": "array", diff --git a/src/lsp/superbol_free_lib/vscode_extension.ml b/src/lsp/superbol_free_lib/vscode_extension.ml index 015ef616..7fc8e621 100644 --- a/src/lsp/superbol_free_lib/vscode_extension.ml +++ b/src/lsp/superbol_free_lib/vscode_extension.ml @@ -450,10 +450,16 @@ let contributes = Manifest.PROPERTY.null_string "cobc-path" ~title:"GnuCOBOL Compiler Executable" - ~description:"Path to the GnuCOBOL compiler executable; when `null`, \ - defaults to the value of \"superbol.cobc-path\" from \ - the workspace configuration, if defined, to \"cobc\" \ - otherwise."; + ~markdownDescription: + "Path to the GnuCOBOL compiler executable; when `null`, defaults \ + to the value of \"superbol.cobc-path\" from the workspace \ + configuration, if defined, to \"cobc\" otherwise."; + + Manifest.PROPERTY.null_string "listings-target" + ~title:"Output file or directory for preprocessed program listings" + ~markdownDescription: + "Path to a directory where preprocessed program listings are \ + generated; no listing is saved when `null`"; Manifest.PROPERTY.array "extra-args" ~description:"Additional arguments passed to `cobc`"; diff --git a/src/vscode/superbol-vscode-platform/superbol_tasks.ml b/src/vscode/superbol-vscode-platform/superbol_tasks.ml index a59ab2ca..1f5a206d 100644 --- a/src/vscode/superbol-vscode-platform/superbol_tasks.ml +++ b/src/vscode/superbol-vscode-platform/superbol_tasks.ml @@ -32,6 +32,8 @@ let attributes_spec ~debug ~coverage ~executable = [%js.of: bool], executable); "cobc-path", C ([%js.to: string or_undefined], [%js.of: string], "cobc"); + "listings-target", C ([%js.to: string option or_undefined], + [%js.of: string option], None); "extra-args", C ([%js.to: string list or_undefined], [%js.of: string list], []); ] @@ -47,13 +49,8 @@ let attr_bool_flag key ~ok ?(ko = Fun.id) ~attributes args = | None when Superbol_workspace.bool key -> ok args | _ -> ko args -let string_arg ?(allow_empty = false) ~mk s args = - if s = "" && not allow_empty then args else mk s :: args - -(* let attr_string ?allow_empty key ~mk ~attributes args = *) -(* match List.assoc_opt key attributes with *) -(* | Some s -> string_arg ([%js.to: string] s) ?allow_empty ~mk args *) -(* | None -> args *) +let string_arg ?(allow_empty = false) ~append s args = + if s = "" && not allow_empty then args else append s args let config_string key ~config = string_arg @@ @@ -66,11 +63,18 @@ let config_strings key ~config ~append = with Not_found -> Superbol_workspace.strings key | Jsonoo.Decode_error _ -> [] (* Warning: silenced decode errors for now *) -let attr_strings key ~append ~attributes args = +let attr_strings key ?(append = List.append) ~attributes args = match List.assoc_opt key attributes with | Some l -> append ([%js.to: string list] l) args | None -> args +let attr_string_opt key ~append ~attributes args = + match List.assoc_opt key attributes with + | None -> args + | Some s -> match [%js.to: string option] s with + | None -> args + | Some s -> string_arg s ~allow_empty:false ~append args + (* let config_strings key ~config:_ ~append args = *) (* append (Superbol_workspace.string_list key) args *) @@ -119,22 +123,26 @@ let cobc_execution ?config attributes = List.append args end |> config_strings "cobol.copyexts" ~config - ~append:begin fun exts args -> - List.append args @@ List.flatten @@ List.map (fun e -> ["-ext"; e]) exts + ~append:begin fun exts -> + List.append @@ List.flatten @@ List.map (fun e -> ["-ext"; e]) exts end |> config_string "cobol.dialect" ~config - ~mk:(function "gnucobol" -> "-std=default" | s -> "-std=" ^ s) |> + ~append:begin function + | "gnucobol" -> List.cons "-std=default" + | s -> List.cons ("-std=" ^ s) + end|> config_string "cobol.source-format" ~config - ~mk:((^) "-fformat=") |> + ~append:(fun f -> List.cons ("-fformat=" ^ f)) |> attr_bool_flag "for-debug" ~attributes - ~ok:(fun args -> "-fsource-location" :: "-ftraceall" :: "-g" :: args) |> + ~ok:(List.append ["-fsource-location"; "-ftraceall"; "-g"]) |> attr_bool_flag "for-coverage" ~attributes ~ok:(List.cons "--coverage") |> attr_bool_flag "executable" ~attributes ~ok:(List.cons "-x") ~ko:(List.cons "-m") |> + attr_string_opt "listings-target" ~attributes + ~append:(fun t -> List.append ["-P"; t]) |> attr_strings "extra-args" ~attributes - ~append:(fun args' args -> args @ args') in `ShellExecution (ShellExecution.makeCommandArgs () ~command:(`String cobc)