From f9c1d56f55aa264a65b08823f917bad48288855b Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Wed, 11 Jul 2018 16:57:29 +0200
Subject: [PATCH] Improve the path custom conv to use original path when
 restoring args

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 bin/main.ml | 44 ++++++++++++++++++++++++++++----------------
 1 file changed, 28 insertions(+), 16 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index 8c0e6655..fb9480c3 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -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
@@ -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
@@ -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"
@@ -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
@@ -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