Skip to content

Commit

Permalink
Improve the path custom conv to use original path when restoring args
Browse files Browse the repository at this point in the history
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
  • Loading branch information
rgrinberg committed Jul 11, 2018
1 parent 630c10e commit f9c1d56
Showing 1 changed file with 28 additions and 16 deletions.
44 changes: 28 additions & 16 deletions bin/main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,12 +7,36 @@ open Fiber.O
bootstrap, so we set this reference here *)
let () = suggest_function := Cmdliner_suggest.value

module Arg = struct
include Arg

let package_name =
Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp)

module Path : sig
type t
val path : t -> Path.t
val arg : t -> string

val conv : t conv
end = struct
type t = string

let path p = Path.of_filename_relative_to_initial_cwd p
let arg s = s

let conv = Arg.conv ((fun p -> Ok p), Format.pp_print_string)
end

let path = Path.conv
end

type common =
{ debug_dep_path : bool
; debug_findlib : bool
; debug_backtraces : bool
; profile : string option
; workspace_file : Path.t option
; workspace_file : Arg.Path.t option
; root : string
; target_prefix : string
; only_packages : Package.Name.Set.t option
Expand Down Expand Up @@ -83,7 +107,7 @@ module Main = struct
let setup ~log ?external_lib_deps_mode common =
setup
~log
?workspace_file:common.workspace_file
?workspace_file:(Option.map ~f:Arg.Path.path common.workspace_file)
?only_packages:common.only_packages
?external_lib_deps_mode
?x:common.x
Expand Down Expand Up @@ -185,18 +209,6 @@ let find_root () =
in
(dir, to_cwd)

module Arg = struct
include Arg

let package_name =
Arg.conv ((fun p -> Ok (Package.Name.of_string p)), Package.Name.pp)

let path =
Arg.conv ((fun p -> Ok (Path.of_filename_relative_to_initial_cwd p))
, Path.pp
)
end

let common_footer =
`Blocks
[ `S "BUGS"
Expand Down Expand Up @@ -263,7 +275,7 @@ let common =
let orig_args =
List.concat
[ dump_opt "--profile" profile
; dump_opt "--workspace" (Option.map ~f:Path.to_string workspace_file)
; dump_opt "--workspace" (Option.map ~f:Arg.Path.arg workspace_file)
; orig
]
in
Expand Down Expand Up @@ -490,7 +502,7 @@ let common =
let merge config_file no_config =
match config_file, no_config with
| None , false -> `Ok (None , Default)
| Some fn, false -> `Ok (Some "--config-file", This fn)
| Some fn, false -> `Ok (Some "--config-file", This (Arg.Path.path fn))
| None , true -> `Ok (Some "--no-config" , No_config)
| Some _ , true -> incompatible "--no-config" "--config-file"
in
Expand Down

0 comments on commit f9c1d56

Please sign in to comment.