WIP: add a way to link compiler sources

Add a way to manipulate compiler-sources var

Return right error in run_out

Source: support directories

Set compiler sources

update doc

WIP Revert "Remove reinstall command"

This reverts commit 7f0d8f6.

Use cram tests for reinstall

run can chdir

Add error when switch does not have a source tree

Extend Var

Record configure command

Better version of create2

doc/create.txt

@@ -18,6 +18,9 @@ DESCRIPTION
 
        Github pull request (short form)
            #number (repo defaults to "ocaml/ocaml")
+
+       Directory
+           path/to/sources
 ARGUMENTS
        SOURCE (required)
            Where to fetch the compiler.

doc/dune

@@ -17,3 +17,13 @@
  (alias runtest)
  (action
   (diff create.txt create.txt.gen)))
+
+(rule
+ (with-stdout-to
+  reinstall.txt.gen
+  (run opam-compiler reinstall --help=plain)))
+
+(rule
+ (alias runtest)
+ (action
+  (diff reinstall.txt reinstall.txt.gen)))

doc/opam-compiler.txt

@@ -8,6 +8,9 @@ COMMANDS
        create
            Create a switch from a compiler source
 
+       reinstall
+           Reinstall the compiler
+
 OPTIONS
        --help[=FMT] (default=auto)
            Show this help in format FMT. The value FMT must be one of `auto',

doc/reinstall.txt

@@ -0,0 +1,38 @@
+NAME
+       opam-compiler-reinstall - Reinstall the compiler
+
+SYNOPSIS
+       opam-compiler reinstall [OPTION]... 
+
+       Reinstall the compiler will propagate the changes done to its source.
+
+       There are two ways to reinstall:
+
+       Full (default)
+           Reinstall the compiler and all the packages in the switch. This
+           can be slow but is always safe.
+
+       Quick (unsafe)
+           Only reinstall the compiler. This is fast, but will break the
+           switch if the way it compiles is modified for example.
+OPTIONS
+       --dry-run
+           Do not perform external commands. Print them and continue as if
+           they worked.
+
+       --full
+           Perform a full reinstallation (default).
+
+       --help[=FMT] (default=auto)
+           Show this help in format FMT. The value FMT must be one of `auto',
+           `pager', `groff' or `plain'. With `auto', the format is `pager` or
+           `plain' whenever the TERM env var is `dumb' or undefined.
+
+       --quick
+           Perform a quick reinstallation (unsafe)
+
+       --switch=SWITCH_NAME
+           Use this name for the switch. If omitted, a name is inferred from
+           the source. This name is used as is by opam, so passing "." will
+           create a local switch in the current directory.
+

lib/cli.ml

@@ -8,10 +8,17 @@ type t =
       runner : Runner.t;
       github_client : Github_client.t;
     }
+  | Reinstall of {
+      mode : Op.reinstall_mode;
+      switch_name : Switch_name.t option;
+      runner : Runner.t;
+    }
 
 let eval = function
   | Create { source; switch_name; configure_command; runner; github_client } ->
       Op.create runner github_client source switch_name ~configure_command
+  | Reinstall { mode; switch_name; runner } ->
+      Op.reinstall runner mode ~name:switch_name
 
 let configure_command_explicit =
   let open Cmdliner.Arg in
@@ -66,6 +73,38 @@ let configure_command =
   in
   Cmdliner.Term.ret ret_term
 
+let dry_run =
+  let open Cmdliner.Arg in
+  let info =
+    info
+      ~doc:
+        "Do not perform external commands. Print them and continue as if they \
+         worked."
+      [ "dry-run" ]
+  in
+  value (flag info)
+
+let clients =
+  let open Let_syntax.Cmdliner in
+  let+ dry_run = dry_run in
+  let runner = if dry_run then Runner.dry_run else Runner.real in
+  let github_client =
+    if dry_run then Github_client.dry_run else Github_client.real
+  in
+  (runner, github_client)
+
+let switch_name =
+  let open Cmdliner.Arg in
+  let conv = conv (Switch_name.parse, Switch_name.pp) in
+  value
+    (opt (some conv) None
+       (info ~docv:"SWITCH_NAME"
+          ~doc:
+            "Use this name for the switch. If omitted, a name is inferred from \
+             the source. This name is used as is by opam, so passing \".\" \
+             will create a local switch in the current directory."
+          [ "switch" ]))
+
 module Create = struct
   module Source_with_original = struct
     type t = { source : Source.t; original : string }
@@ -88,38 +127,6 @@ module Create = struct
          None
          (info ~doc:"Where to fetch the compiler." ~docv:"SOURCE" []))
 
-  let switch_name =
-    let open Cmdliner.Arg in
-    let conv = conv (Switch_name.parse, Switch_name.pp) in
-    value
-      (opt (some conv) None
-         (info ~docv:"SWITCH_NAME"
-            ~doc:
-              "Use this name for the switch. If omitted, a name is inferred \
-               from the source. This name is used as is by opam, so passing \
-               \".\" will create a local switch in the current directory."
-            [ "switch" ]))
-
-  let dry_run =
-    let open Cmdliner.Arg in
-    let info =
-      info
-        ~doc:
-          "Do not perform external commands. Print them and continue as if \
-           they worked."
-        [ "dry-run" ]
-    in
-    value (flag info)
-
-  let clients =
-    let open Let_syntax.Cmdliner in
-    let+ dry_run = dry_run in
-    let runner = if dry_run then Runner.dry_run else Runner.real in
-    let github_client =
-      if dry_run then Github_client.dry_run else Github_client.real
-    in
-    (runner, github_client)
-
   let man =
     [
       `S Cmdliner.Manpage.s_description;
@@ -132,6 +139,7 @@ module Create = struct
       `I
         ( "Github pull request (short form)",
           "#number (repo defaults to \"ocaml/ocaml\")" );
+      `I ("Directory", "path/to/sources");
     ]
 
   let term =
@@ -149,12 +157,54 @@ module Create = struct
   let command = (term, info)
 end
 
+module Reinstall = struct
+  let reinstall_mode =
+    let open Cmdliner.Arg in
+    value
+      (vflag Op.Full
+         [
+           ( Full,
+             info ~doc:"Perform a full reinstallation (default)." [ "full" ] );
+           ( Quick,
+             info ~doc:"Perform a quick reinstallation (unsafe)" [ "quick" ] );
+         ])
+
+  let term =
+    let open Let_syntax.Cmdliner in
+    let+ mode = reinstall_mode
+    and+ switch_name = switch_name
+    and+ runner, _github_client = clients in
+    Reinstall { mode; switch_name; runner }
+
+  let man =
+    [
+      `P "Reinstall the compiler will propagate the changes done to its source.";
+      `P "There are two ways to reinstall:";
+      `I
+        ( "Full (default)",
+          "Reinstall the compiler and all the packages in the switch. This can \
+           be slow but is always safe." );
+      `I
+        ( "Quick (unsafe)",
+          "Only reinstall the compiler. This is fast, but will break the \
+           switch if the way it compiles is modified for example." );
+    ]
+
+  let info =
+    let open Cmdliner.Term in
+    info ~man ~doc:"Reinstall the compiler" "reinstall"
+
+  let command = (term, info)
+end
+
 let default =
   let open Cmdliner.Term in
   (ret (pure (`Help (`Auto, None))), info "opam-compiler")
 
 let main () =
-  let result = Cmdliner.Term.eval_choice default [ Create.command ] in
+  let result =
+    Cmdliner.Term.eval_choice default [ Create.command; Reinstall.command ]
+  in
   (match result with
   | `Ok op -> eval op |> Rresult.R.failwith_error_msg
   | `Version -> ()

lib/import.ml

@@ -42,10 +42,12 @@ let pp_cmd ppf cmd =
   Bos.Cmd.to_list cmd |> List.map quote_if_needed |> String.concat " "
   |> Format.pp_print_string ppf
 
-type error = [ `Command_failed of Bos.Cmd.t | `Unknown ]
+type error = [ `Command_failed of Bos.Cmd.t | `Unknown | `No_compiler_sources ]
 
 let translate_error s =
   let open Rresult.R in
   reword_error (function
     | `Unknown -> msgf "%s" s
-    | `Command_failed cmd -> msgf "%s - command failed: %a" s pp_cmd cmd)
+    | `Command_failed cmd -> msgf "%s - command failed: %a" s pp_cmd cmd
+    | `No_compiler_sources ->
+        msgf "%s - switch is not linked to compiler sources" s)

lib/import.mli

@@ -27,7 +27,7 @@ val pp_env : Format.formatter -> (string * string) list option -> unit
 
 val pp_cmd : Format.formatter -> Bos.Cmd.t -> unit
 
-type error = [ `Command_failed of Bos.Cmd.t | `Unknown ]
+type error = [ `Command_failed of Bos.Cmd.t | `Unknown | `No_compiler_sources ]
 
 val translate_error :
   string -> ('a, [< error ]) result -> ('a, [> Rresult.R.msg ]) result

lib/op.ml

@@ -24,7 +24,14 @@ let create runner github_client source switch_name ~configure_command =
        ~if_command_failed:(fun () ->
          Opam.remove_switch runner ~name:switch_name)
    in
-   Opam.set_base runner ~name:switch_name)
+   let* () = Opam.set_base runner ~name:switch_name in
+   match Source.compiler_sources source with
+   | None -> Ok ()
+   | Some sources ->
+       let* () =
+         Opam.set_compiler_sources runner ~name:switch_name (Some sources)
+       in
+       Opam.set_configure_command runner ~name:switch_name configure_command)
   |> translate_error "Cannot create switch"
 
 type reinstall_mode = Quick | Full
@@ -33,8 +40,17 @@ let reinstall_packages_if_needed runner = function
   | Quick -> Ok ()
   | Full -> Opam.reinstall_packages runner
 
-let reinstall runner mode ~configure_command =
+let unwrap_compiler_sources = function
+  | None -> Error `No_compiler_sources
+  | Some v -> Ok v
+
+let reinstall runner mode ~name =
   let open Let_syntax.Result in
-  (let* () = Opam.reinstall_compiler runner ~configure_command in
+  (let* compiler_sources_opt = Opam.get_compiler_sources runner ~name in
+   let* compiler_sources = unwrap_compiler_sources compiler_sources_opt in
+   let* configure_command = Opam.get_configure_command runner ~name in
+   let* () =
+     Opam.reinstall_compiler runner ~compiler_sources ~configure_command
+   in
    reinstall_packages_if_needed runner mode)
   |> translate_error "Could not reinstall"

lib/op.mli

@@ -11,5 +11,5 @@ type reinstall_mode = Quick | Full
 val reinstall :
   Runner.t ->
   reinstall_mode ->
-  configure_command:Bos.Cmd.t option ->
+  name:Switch_name.t option ->
   (unit, [> Rresult.R.msg ]) result

lib/opam.ml

@@ -64,22 +64,22 @@ let set_base runner ~name =
 let update runner ~name =
   run_opam runner [ A "update"; switch name; ocaml_variants ]
 
-let reinstall_configure runner ~configure_command =
+let reinstall_configure runner ~configure_command ~compiler_sources =
   let open Let_syntax.Result in
   let* prefix = run_out_opam runner [ A "config"; A "var"; A "prefix" ] in
   let base_command =
     Option.value configure_command ~default:Bos.Cmd.(v "./configure")
   in
   let command = Bos.Cmd.(base_command % "--prefix" % prefix) in
-  Runner.run runner command
+  Runner.run ~chdir:compiler_sources runner command
 
-let reinstall_compiler runner ~configure_command =
+let reinstall_compiler runner ~compiler_sources ~configure_command =
   let open Let_syntax.Result in
   let make = Bos.Cmd.(v "make") in
   let make_install = Bos.Cmd.(v "make" % "install") in
-  let* () = reinstall_configure runner ~configure_command in
-  let* () = Runner.run runner make in
-  Runner.run runner make_install
+  let* () = reinstall_configure runner ~compiler_sources ~configure_command in
+  let* () = Runner.run ~chdir:compiler_sources runner make in
+  Runner.run ~chdir:compiler_sources runner make_install
 
 let reinstall_packages runner =
   run_opam runner
@@ -88,3 +88,55 @@ let reinstall_packages runner =
 let remove_switch runner ~name =
   run_opam runner
     [ A "switch"; A "remove"; A "--yes"; A (Switch_name.to_string name) ]
+
+module Var = struct
+  type t = Compiler_sources | Configure_command
+
+  let prefix = "compiler-"
+
+  let suffix = function
+    | Compiler_sources -> "sources"
+    | Configure_command -> "configure-command"
+
+  let to_string var = prefix ^ suffix var
+
+  let get runner ~name var decode =
+    let open Let_syntax.Result in
+    let pattern = Format.sprintf "%%{%s}%%" (to_string var) in
+    let switch =
+      match name with Some name -> L [ switch name ] | None -> L []
+    in
+    let* output =
+      run_out_opam runner [ A "config"; switch; A "expand"; A pattern ]
+    in
+    if String.equal output "" then Ok None
+    else
+      match decode output with
+      | Ok x -> Ok (Some x)
+      | Error (`Msg _) -> Error `Unknown
+
+  let set runner ~name var encode = function
+    | None -> Ok ()
+    | Some value ->
+        run_opam runner
+          [
+            A "config";
+            switch name;
+            A "set";
+            A (to_string var);
+            A (encode value);
+          ]
+end
+
+let get_compiler_sources runner ~name =
+  Var.get runner ~name Compiler_sources Fpath.of_string
+
+let set_compiler_sources runner ~name value =
+  Var.set runner ~name Compiler_sources Fpath.to_string value
+
+let get_configure_command runner ~name =
+  Var.get runner ~name Configure_command Bos.Cmd.of_string
+
+let set_configure_command runner ~name value =
+  let cmd_to_string cmd = Format.asprintf "%a" pp_cmd cmd in
+  Var.set runner ~name Configure_command cmd_to_string value