Skip to content

Commit f9c1d56

Browse files
committed
Improve the path custom conv to use original path when restoring args
Signed-off-by: Rudi Grinberg <[email protected]>
1 parent 630c10e commit f9c1d56

File tree

1 file changed

+28
-16
lines changed

1 file changed

+28
-16
lines changed

bin/main.ml

Lines changed: 28 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,36 @@ open Fiber.O
77
bootstrap, so we set this reference here *)
88
let () = suggest_function := Cmdliner_suggest.value
99

10+
module Arg = struct
11+
include Arg
12+
13+
let package_name =
14+
Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp)
15+
16+
module Path : sig
17+
type t
18+
val path : t -> Path.t
19+
val arg : t -> string
20+
21+
val conv : t conv
22+
end = struct
23+
type t = string
24+
25+
let path p = Path.of_filename_relative_to_initial_cwd p
26+
let arg s = s
27+
28+
let conv = Arg.conv ((fun p -> Ok p), Format.pp_print_string)
29+
end
30+
31+
let path = Path.conv
32+
end
33+
1034
type common =
1135
{ debug_dep_path : bool
1236
; debug_findlib : bool
1337
; debug_backtraces : bool
1438
; profile : string option
15-
; workspace_file : Path.t option
39+
; workspace_file : Arg.Path.t option
1640
; root : string
1741
; target_prefix : string
1842
; only_packages : Package.Name.Set.t option
@@ -83,7 +107,7 @@ module Main = struct
83107
let setup ~log ?external_lib_deps_mode common =
84108
setup
85109
~log
86-
?workspace_file:common.workspace_file
110+
?workspace_file:(Option.map ~f:Arg.Path.path common.workspace_file)
87111
?only_packages:common.only_packages
88112
?external_lib_deps_mode
89113
?x:common.x
@@ -185,18 +209,6 @@ let find_root () =
185209
in
186210
(dir, to_cwd)
187211

188-
module Arg = struct
189-
include Arg
190-
191-
let package_name =
192-
Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp)
193-
194-
let path =
195-
Arg.conv ((fun p -> Ok (Path.of_filename_relative_to_initial_cwd p))
196-
, Path.pp
197-
)
198-
end
199-
200212
let common_footer =
201213
`Blocks
202214
[ `S "BUGS"
@@ -263,7 +275,7 @@ let common =
263275
let orig_args =
264276
List.concat
265277
[ dump_opt "--profile" profile
266-
; dump_opt "--workspace" (Option.map ~f:Path.to_string workspace_file)
278+
; dump_opt "--workspace" (Option.map ~f:Arg.Path.arg workspace_file)
267279
; orig
268280
]
269281
in
@@ -490,7 +502,7 @@ let common =
490502
let merge config_file no_config =
491503
match config_file, no_config with
492504
| None , false -> `Ok (None , Default)
493-
| Some fn, false -> `Ok (Some "--config-file", This fn)
505+
| Some fn, false -> `Ok (Some "--config-file", This (Arg.Path.path fn))
494506
| None , true -> `Ok (Some "--no-config" , No_config)
495507
| Some _ , true -> incompatible "--no-config" "--config-file"
496508
in

0 commit comments

Comments
 (0)