From 428ec0ea30861e41ce935e815b6bb99fd38a70b4 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 25 Jun 2021 17:41:10 +0200 Subject: [PATCH 1/4] 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 7f0d8f69a27e0f452cbef5c3f35426dccf923466. 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 | 3 + doc/dune | 10 +++ doc/opam-compiler.txt | 3 + doc/reinstall.txt | 38 ++++++++++ lib/cli.ml | 116 ++++++++++++++++++++--------- lib/import.ml | 6 +- lib/import.mli | 2 +- lib/op.ml | 20 ++++- lib/op.mli | 2 +- lib/opam.ml | 64 ++++++++++++++-- lib/opam.mli | 17 ++++- lib/runner.ml | 35 ++++++--- lib/runner.mli | 2 + lib/source.ml | 26 +++++-- lib/source.mli | 7 +- lib/switch_name.ml | 18 ++++- test/cram/create.t | 8 ++ test/cram/reinstall.t | 40 ++++++++++ test/opam/client.ml | 24 ++++++ test/unit/mock.ml | 4 +- test/unit/test.ml | 2 +- test/unit/test_op.ml | 132 ++++++++++++++++----------------- test/unit/test_source.ml | 6 +- test/unit/test_switch_name.ml | 20 +++++ test/unit/test_switch_name.mli | 1 + 25 files changed, 472 insertions(+), 134 deletions(-) create mode 100644 doc/reinstall.txt create mode 100644 test/cram/reinstall.t create mode 100644 test/unit/test_switch_name.ml create mode 100644 test/unit/test_switch_name.mli diff --git a/doc/create.txt b/doc/create.txt index 3c5ed6b..db4ff23 100644 --- a/doc/create.txt +++ b/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. diff --git a/doc/dune b/doc/dune index e94a183..2dc3b9b 100644 --- a/doc/dune +++ b/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))) diff --git a/doc/opam-compiler.txt b/doc/opam-compiler.txt index cd702b5..c14d6a1 100644 --- a/doc/opam-compiler.txt +++ b/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', diff --git a/doc/reinstall.txt b/doc/reinstall.txt new file mode 100644 index 0000000..cd7a33a --- /dev/null +++ b/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. + diff --git a/lib/cli.ml b/lib/cli.ml index 02b998e..dc9e577 100644 --- a/lib/cli.ml +++ b/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 -> () diff --git a/lib/import.ml b/lib/import.ml index 4e7b987..b236df3 100644 --- a/lib/import.ml +++ b/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) diff --git a/lib/import.mli b/lib/import.mli index 9187937..c4159bf 100644 --- a/lib/import.mli +++ b/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 diff --git a/lib/op.ml b/lib/op.ml index 5ffaf02..1dff677 100644 --- a/lib/op.ml +++ b/lib/op.ml @@ -23,7 +23,12 @@ let create runner github_client source switch_name ~configure_command = try_ (Opam.pin_add runner switch_name url ~configure_command) ~if_command_failed:(fun () -> Opam.remove_switch runner switch_name) in - Opam.set_base runner switch_name) + let* () = Opam.set_base runner switch_name in + match Source.compiler_sources source with + | None -> Ok () + | Some sources -> + let* () = Opam.set_compiler_sources runner switch_name (Some sources) in + Opam.set_configure_command runner switch_name configure_command) |> translate_error "Cannot create switch" type reinstall_mode = Quick | Full @@ -32,8 +37,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" diff --git a/lib/op.mli b/lib/op.mli index 89ede15..904c9e2 100644 --- a/lib/op.mli +++ b/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 diff --git a/lib/opam.ml b/lib/opam.ml index bd12d50..1c75f9a 100644 --- a/lib/opam.ml +++ b/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 diff --git a/lib/opam.mli b/lib/opam.mli index 02d4f38..52105d7 100644 --- a/lib/opam.mli +++ b/lib/opam.mli @@ -15,8 +15,23 @@ val set_base : Runner.t -> Switch_name.t -> (unit, error) result val update : Runner.t -> Switch_name.t -> (unit, error) result val reinstall_compiler : - Runner.t -> configure_command:Bos.Cmd.t option -> (unit, error) result + Runner.t -> + compiler_sources:Fpath.t -> + configure_command:Bos.Cmd.t option -> + (unit, error) result val reinstall_packages : Runner.t -> (unit, error) result val remove_switch : Runner.t -> Switch_name.t -> (unit, error) result + +val get_compiler_sources : + Runner.t -> Switch_name.t option -> (Fpath.t option, error) result + +val set_compiler_sources : + Runner.t -> Switch_name.t -> Fpath.t option -> (unit, error) result + +val get_configure_command : + Runner.t -> Switch_name.t option -> (Bos.Cmd.t option, error) result + +val set_configure_command : + Runner.t -> Switch_name.t -> Bos.Cmd.t option -> (unit, error) result diff --git a/lib/runner.ml b/lib/runner.ml index 3a46ef8..95153cb 100644 --- a/lib/runner.ml +++ b/lib/runner.ml @@ -4,7 +4,10 @@ type run_error = [ `Command_failed of Bos.Cmd.t | `Unknown ] type t = { run : - ?extra_env:(string * string) list -> Bos.Cmd.t -> (unit, run_error) result; + ?extra_env:(string * string) list -> + ?chdir:Fpath.t -> + Bos.Cmd.t -> + (unit, run_error) result; run_out : ?extra_env:(string * string) list -> Bos.Cmd.t -> (string, run_error) result; } @@ -22,10 +25,18 @@ module Real = struct let seq = List.to_seq l in Some (Astring.String.Map.add_seq seq cur) - let run ?extra_env cmd = + let with_chdir ~f = function + | None -> f () + | Some dir -> + let open Let_syntax.Result in + let* r = Bos.OS.Dir.with_current dir f () in + r + + let run ?extra_env ?chdir cmd = let open Let_syntax.Result in let* env = explicit_env extra_env in - Bos.OS.Cmd.in_null |> Bos.OS.Cmd.run_in ?env cmd + with_chdir chdir ~f:(fun () -> + Bos.OS.Cmd.in_null |> Bos.OS.Cmd.run_in ?env cmd) |> Rresult.R.reword_error (fun _ -> `Command_failed cmd) let run_out ?extra_env cmd = @@ -33,7 +44,7 @@ module Real = struct let* env = explicit_env extra_env in Bos.OS.Cmd.run_out ?env cmd |> Bos.OS.Cmd.to_string - |> Rresult.R.reword_error (fun _ -> `Unknown) + |> Rresult.R.reword_error (fun _ -> `Command_failed cmd) end let real = @@ -41,13 +52,17 @@ let real = { run; run_out } module Dry_run = struct - let run ?extra_env cmd = - Format.printf "Run: %a%a\n" pp_env extra_env pp_cmd cmd; + let pp_chdir ppf = function + | None -> () + | Some p -> Format.fprintf ppf "cd %a && " Fpath.pp p + + let run ?extra_env ?chdir cmd = + Format.printf "Run: %a%a%a\n" pp_env extra_env pp_chdir chdir pp_cmd cmd; Ok () let run_out ?extra_env cmd = Format.printf "Run_out: %a%a\n" pp_env extra_env pp_cmd cmd; - Ok "output" + Format.kasprintf Rresult.R.ok "$(%a%a)" pp_env extra_env pp_cmd cmd end let dry_run = @@ -59,5 +74,7 @@ let run_out t ?extra_env cmd = : (_, run_error) result :> (_, [> run_error ]) result) -let run t ?extra_env cmd = - (t.run ?extra_env cmd : (_, run_error) result :> (_, [> run_error ]) result) +let run t ?extra_env ?chdir cmd = + (t.run ?extra_env ?chdir cmd + : (_, run_error) result + :> (_, [> run_error ]) result) diff --git a/lib/runner.mli b/lib/runner.mli index 9bd4351..afeac36 100644 --- a/lib/runner.mli +++ b/lib/runner.mli @@ -1,6 +1,7 @@ type t = { run : ?extra_env:(string * string) list -> + ?chdir:Fpath.t -> Bos.Cmd.t -> (unit, [ `Command_failed of Bos.Cmd.t | `Unknown ]) result; run_out : @@ -16,6 +17,7 @@ val dry_run : t val run : t -> ?extra_env:(string * string) list -> + ?chdir:Fpath.t -> Bos.Cmd.t -> (unit, [> `Command_failed of Bos.Cmd.t | `Unknown ]) result diff --git a/lib/source.ml b/lib/source.ml index 89bd09d..2a707af 100644 --- a/lib/source.ml +++ b/lib/source.ml @@ -1,6 +1,9 @@ open! Import -type t = Github_branch of Branch.t | Github_PR of Pull_request.t +type t = + | Github_branch of Branch.t + | Github_PR of Pull_request.t + | Directory of Fpath.t let github_pr pr = Github_PR pr @@ -27,16 +30,21 @@ let parse_as_branch s = let parse_as_pr s = Option.map github_pr (Pull_request.parse s) +let parse_as_directory s = + match Fpath.of_string s with Ok p -> Some (Directory p) | Error _ -> None + let parse s = - match parse_as_branch s with - | Some r -> Ok r - | None -> ( - match parse_as_pr s with Some r -> Ok r | None -> Error `Unknown) + let ( let/ ) f k = match f s with Some r -> Ok r | None -> k () in + let/ () = parse_as_branch in + let/ () = parse_as_pr in + let/ () = parse_as_directory in + Error `Unknown let pp ppf = function | Github_branch branch -> Format.fprintf ppf "Github_branch %a" Branch.pp branch | Github_PR pr -> Format.fprintf ppf "Github_PR %a" Pull_request.pp pr + | Directory p -> Format.fprintf ppf "Directory %a" Fpath.pp p let raw_switch_name source = match source with @@ -44,6 +52,7 @@ let raw_switch_name source = Format.asprintf "%s/%s:%s" user repo branch | Github_PR { user; repo; number } -> Format.asprintf "%s/%s#%d" user repo number + | Directory p -> Format.asprintf "%a" Fpath.pp p let global_switch_name source = Switch_name.escape_string (raw_switch_name source) @@ -59,6 +68,7 @@ let extra_description source (client : Github_client.t) = let open Let_syntax.Option in let+ { title; _ } = Result.to_option (client.pr_info pr) in title + | Directory _ -> None let switch_description source client = Format.asprintf "[opam-compiler] %s%a" (raw_switch_name source) @@ -72,5 +82,11 @@ let switch_target source github_client = let open Let_syntax.Result in let+ { source_branch; _ } = Github_client.pr_info github_client pr in Branch.git_url source_branch + | Directory path -> Ok (Format.asprintf "file://%a" Fpath.pp path) let equal (x : t) y = x = y + +let compiler_sources = function + | Github_branch _ -> None + | Github_PR _ -> None + | Directory p -> Some p diff --git a/lib/source.mli b/lib/source.mli index 70a952d..d440ccd 100644 --- a/lib/source.mli +++ b/lib/source.mli @@ -1,4 +1,7 @@ -type t = Github_branch of Branch.t | Github_PR of Pull_request.t +type t = + | Github_branch of Branch.t + | Github_PR of Pull_request.t + | Directory of Fpath.t val switch_target : t -> Github_client.t -> (string, [> `Unknown ]) result @@ -11,3 +14,5 @@ val pp : Format.formatter -> t -> unit val equal : t -> t -> bool val parse : string -> (t, [ `Unknown ]) result + +val compiler_sources : t -> Fpath.t option diff --git a/lib/switch_name.ml b/lib/switch_name.ml index a0ecd5d..b641526 100644 --- a/lib/switch_name.ml +++ b/lib/switch_name.ml @@ -8,8 +8,22 @@ let to_string s = s let invalid_chars = [ '/'; ':'; '#' ] -let escape_string = - String.map (fun c -> if List.mem c invalid_chars then '-' else c) +let count_leading_dashes s = + let exception Done in + let r = ref 0 in + (try String.iter (function '-' -> incr r | _ -> raise Done) s + with Done -> ()); + !r + +let strip_leading_dashes s = + let n = count_leading_dashes s in + let s_len = String.length s in + String.sub s n (s_len - n) + +let escape_string s = + s + |> String.map (fun c -> if List.mem c invalid_chars then '-' else c) + |> strip_leading_dashes let parse s = if List.exists (fun c -> String.contains s c) invalid_chars then diff --git a/test/cram/create.t b/test/cram/create.t index f2f98f6..b7e39d8 100644 --- a/test/cram/create.t +++ b/test/cram/create.t @@ -19,6 +19,14 @@ Github PR numbers are also accepted: Run: OPAMCLI=2.0 opam pin add --switch ocaml-ocaml-1234 --yes ocaml-variants git+https://github.com/user-ocaml-ocaml-1234/repo-ocaml-ocaml-1234#branch-ocaml-ocaml-1234 Run: OPAMCLI=2.0 opam switch set-base --switch ocaml-ocaml-1234 ocaml-variants +Directories are supported. + + $ opam-compiler create --dry-run /home/me/ocaml + Run: OPAMCLI=2.0 opam switch create home-me-ocaml --empty --description "[opam-compiler] /home/me/ocaml" + Run: OPAMCLI=2.0 opam pin add --switch home-me-ocaml --yes ocaml-variants file:///home/me/ocaml + Run: OPAMCLI=2.0 opam switch set-base --switch home-me-ocaml ocaml-variants + Run: OPAMCLI=2.0 opam config --switch home-me-ocaml set compiler-sources /home/me/ocaml + An explicit configure step can be passed: $ opam-compiler create --dry-run USER/REPO:BRANCH --configure-command "./configure --enable-x" diff --git a/test/cram/reinstall.t b/test/cram/reinstall.t new file mode 100644 index 0000000..e147af0 --- /dev/null +++ b/test/cram/reinstall.t @@ -0,0 +1,40 @@ + $ opam-compiler reinstall --dry-run + Run_out: OPAMCLI=2.0 opam config expand %{compiler-sources}% + Run_out: OPAMCLI=2.0 opam config expand %{compiler-configure-command}% + Run_out: OPAMCLI=2.0 opam config var prefix + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && $(OPAMCLI=2.0 opam config expand %{compiler-configure-command}%) --prefix "$(OPAMCLI=2.0 opam config var prefix)" + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && make + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && make install + Run: OPAMCLI=2.0 opam reinstall --assume-built --working-dir ocaml-variants + +Quick can be passed: + + $ opam-compiler reinstall --dry-run --quick + Run_out: OPAMCLI=2.0 opam config expand %{compiler-sources}% + Run_out: OPAMCLI=2.0 opam config expand %{compiler-configure-command}% + Run_out: OPAMCLI=2.0 opam config var prefix + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && $(OPAMCLI=2.0 opam config expand %{compiler-configure-command}%) --prefix "$(OPAMCLI=2.0 opam config var prefix)" + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && make + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && make install + +Full will reinstall opam packages (and is the default): + + $ opam-compiler reinstall --dry-run --full + Run_out: OPAMCLI=2.0 opam config expand %{compiler-sources}% + Run_out: OPAMCLI=2.0 opam config expand %{compiler-configure-command}% + Run_out: OPAMCLI=2.0 opam config var prefix + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && $(OPAMCLI=2.0 opam config expand %{compiler-configure-command}%) --prefix "$(OPAMCLI=2.0 opam config var prefix)" + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && make + Run: cd $(OPAMCLI=2.0 opam config expand %{compiler-sources}%) && make install + Run: OPAMCLI=2.0 opam reinstall --assume-built --working-dir ocaml-variants + +Switch name can be passed explicitly: + + $ opam-compiler reinstall --dry-run --switch NAME + Run_out: OPAMCLI=2.0 opam config --switch NAME expand %{compiler-sources}% + Run_out: OPAMCLI=2.0 opam config --switch NAME expand %{compiler-configure-command}% + Run_out: OPAMCLI=2.0 opam config var prefix + Run: cd $(OPAMCLI=2.0 opam config --switch NAME expand %{compiler-sources}%) && $(OPAMCLI=2.0 opam config --switch NAME expand %{compiler-configure-command}%) --prefix "$(OPAMCLI=2.0 opam config var prefix)" + Run: cd $(OPAMCLI=2.0 opam config --switch NAME expand %{compiler-sources}%) && make + Run: cd $(OPAMCLI=2.0 opam config --switch NAME expand %{compiler-sources}%) && make install + Run: OPAMCLI=2.0 opam reinstall --assume-built --working-dir ocaml-variants diff --git a/test/opam/client.ml b/test/opam/client.ml index 4bc00bf..6a74334 100755 --- a/test/opam/client.ml +++ b/test/opam/client.ml @@ -1,6 +1,10 @@ open Opam_compiler open! Import +let pp_option pp ppf = function + | None -> Format.fprintf ppf "None" + | Some x -> Format.fprintf ppf "Some %a" pp x + let () = let open Let_syntax.Result in let runner = Runner.real in @@ -14,4 +18,24 @@ let () = (let* name = Switch_name.parse name in translate_error "remove" (Opam.remove_switch runner name)) |> Rresult.R.failwith_error_msg + | [| _; "compiler-sources"; name |] -> + (let* name = Switch_name.parse name in + let+ path = + translate_error "compiler-sources" + (Opam.get_compiler_sources runner (Some name)) + in + Format.printf "compiler-sources: %a\n" (pp_option Fpath.pp) path) + |> Rresult.R.failwith_error_msg + | [| _; "set-compiler-sources"; name; value_s |] -> + (let* name = Switch_name.parse name in + let* value = Fpath.of_string value_s in + translate_error "set-compiler-sources" + (Opam.set_compiler_sources runner name (Some value))) + |> Rresult.R.failwith_error_msg + | [| _; "reinstall-compiler"; compiler_sources_s |] -> + (let* compiler_sources = Fpath.of_string compiler_sources_s in + translate_error "reinstall-compiler" + (Opam.reinstall_compiler runner ~compiler_sources + ~configure_command:None)) + |> Rresult.R.failwith_error_msg | _ -> assert false diff --git a/test/unit/mock.ml b/test/unit/mock.ml index 76e8954..2f6014e 100644 --- a/test/unit/mock.ml +++ b/test/unit/mock.ml @@ -1,13 +1,13 @@ type ('a, 'b) expectation = 'a * 'b +let expect expected ~and_return:return_value = (expected, return_value) + type ('a, 'b) t = { testable : 'a Alcotest.testable; loc : string; mutable expectations : ('a, 'b) expectation list; } -let expect expected ~and_return:return_value = (expected, return_value) - let call t got = match t.expectations with | [] -> diff --git a/test/unit/test.ml b/test/unit/test.ml index ff26d7b..2fc11bf 100644 --- a/test/unit/test.ml +++ b/test/unit/test.ml @@ -1,3 +1,3 @@ -let all_tests = Test_op.tests @ Test_source.tests +let all_tests = Test_op.tests @ Test_source.tests @ Test_switch_name.tests let () = Alcotest.run "opam-compiler" all_tests diff --git a/test/unit/test_op.ml b/test/unit/test_op.ml index 8cc6984..8ccb38e 100644 --- a/test/unit/test_op.ml +++ b/test/unit/test_op.ml @@ -1,5 +1,5 @@ open Opam_compiler -open Import +open! Import let msg = Alcotest.testable Rresult.R.pp_msg ( = ) @@ -8,6 +8,12 @@ let cmd = Alcotest.testable pp_cmd Bos.Cmd.equal type call_run = { command : Bos.Cmd.t; extra_env : (string * string) list option; + chdir : Fpath.t option; +} + +type call_run_out = { + command : Bos.Cmd.t; + extra_env : (string * string) list option; } let alcotest_contramap (type a) ~f t = @@ -19,8 +25,9 @@ let alcotest_contramap (type a) ~f t = let mock_runner loc expectations = let call_run_testable = alcotest_contramap - Alcotest.(pair cmd (option (list (pair string string)))) - ~f:(fun { command; extra_env } -> (command, extra_env)) + Alcotest.( + triple cmd (option (list (pair string string))) (option (module Fpath))) + ~f:(fun { command; extra_env; chdir } -> (command, extra_env, chdir)) in let call_run_out_testable = alcotest_contramap @@ -30,7 +37,7 @@ let mock_runner loc expectations = let call_run, call_run_out, check = Mock.create2 call_run_testable call_run_out_testable loc expectations in - let run ?extra_env command = call_run { command; extra_env } in + let run ?extra_env ?chdir command = call_run { command; extra_env; chdir } in let run_out ?extra_env command = call_run_out { command; extra_env } in let runner = { Runner.run; run_out } in (runner, check) @@ -61,13 +68,17 @@ let create_tests = v "opam" % "switch" % "create" % "USER-REPO-BRANCH" % "--empty" % "--description" % "[opam-compiler] USER/REPO:BRANCH") in - let create_call = { command = create_cmd; extra_env = opam_cli_env } in + let create_call = + { command = create_cmd; extra_env = opam_cli_env; chdir = None } + in let pin_add_cmd = Bos.Cmd.( v "opam" % "pin" % "add" % "--switch" % "USER-REPO-BRANCH" % "--yes" % "ocaml-variants" % "git+https://github.com/USER/REPO#BRANCH") in - let pin_add_call = { command = pin_add_cmd; extra_env = opam_cli_env } in + let pin_add_call = + { command = pin_add_cmd; extra_env = opam_cli_env; chdir = None } + in [ test "create: create fails with unknown error" [ Mock.expect create_call ~and_return:(Error `Unknown) ] @@ -83,6 +94,7 @@ let create_tests = Bos.Cmd.( v "opam" % "switch" % "remove" % "--yes" % "USER-REPO-BRANCH"); extra_env = opam_cli_env; + chdir = None; } ~and_return:(Ok ()); ] @@ -94,78 +106,66 @@ let create_tests = ] let reinstall_tests = - let test name mode configure_command expectations ~expected = + let test name ~expectations ~expected = ( name, `Quick, fun () -> let runner, check = mock_runner __LOC__ expectations in - let got = Op.reinstall runner mode ~configure_command in + let got = Op.reinstall runner Quick ~name:None in Alcotest.check Alcotest.(result unit msg) __LOC__ expected got; check () ) in - let expect_run ~command ~extra_env ~and_return = - Either.Left (Mock.expect { command; extra_env } ~and_return) + let expect_run ~command ~extra_env ~chdir ~and_return = + Either.Left (Mock.expect { command; extra_env; chdir } ~and_return) in let expect_run_out ~command ~extra_env ~and_return = Either.Right (Mock.expect { command; extra_env } ~and_return) in [ - test "reinstall (quick)" Quick None - [ - expect_run_out - ~command:Bos.Cmd.(v "opam" % "config" % "var" % "prefix") - ~extra_env:opam_cli_env ~and_return:(Ok "PREFIX"); - expect_run - ~command:Bos.Cmd.(v "./configure" % "--prefix" % "PREFIX") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command:Bos.Cmd.(v "make") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command:Bos.Cmd.(v "make" % "install") - ~extra_env:None ~and_return:(Ok ()); - ] - ~expected:(Ok ()); - test "reinstall (full)" Full None - [ - expect_run_out - ~command:Bos.Cmd.(v "opam" % "config" % "var" % "prefix") - ~extra_env:opam_cli_env ~and_return:(Ok "PREFIX"); - expect_run - ~command:Bos.Cmd.(v "./configure" % "--prefix" % "PREFIX") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command:Bos.Cmd.(v "make") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command:Bos.Cmd.(v "make" % "install") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command: - Bos.Cmd.( - v "opam" % "reinstall" % "--assume-built" % "--working-dir" - % "ocaml-variants") - ~extra_env:opam_cli_env ~and_return:(Ok ()); - ] - ~expected:(Ok ()); - test "reinstall (different configure command)" Quick - (Some Bos.Cmd.(v "./configure" % "--enable-something")) - [ - expect_run_out - ~command:Bos.Cmd.(v "opam" % "config" % "var" % "prefix") - ~extra_env:opam_cli_env ~and_return:(Ok "PREFIX"); - expect_run - ~command: - Bos.Cmd.( - v "./configure" % "--enable-something" % "--prefix" % "PREFIX") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command:Bos.Cmd.(v "make") - ~extra_env:None ~and_return:(Ok ()); - expect_run - ~command:Bos.Cmd.(v "make" % "install") - ~extra_env:None ~and_return:(Ok ()); - ] + test "reinstall: switch does not have sources" + ~expectations: + [ + expect_run_out + ~command: + Bos.Cmd.(v "opam" % "config" % "expand" % "%{compiler-sources}%") + ~extra_env:opam_cli_env ~and_return:(Ok ""); + ] + ~expected: + (Error + (`Msg + "Could not reinstall - switch is not linked to compiler sources")); + test "reinstall: switch does not have a configure command sources" + ~expectations: + [ + expect_run_out + ~command: + Bos.Cmd.(v "opam" % "config" % "expand" % "%{compiler-sources}%") + ~extra_env:opam_cli_env ~and_return:(Ok "COMPILER-SOURCES"); + expect_run_out + ~command: + Bos.Cmd.( + v "opam" % "config" % "expand" + % "%{compiler-configure-command}%") + ~extra_env:opam_cli_env ~and_return:(Ok ""); + expect_run_out + ~command:Bos.Cmd.(v "opam" % "config" % "var" % "prefix") + ~extra_env:opam_cli_env ~and_return:(Ok "PREFIX"); + expect_run + ~command:Bos.Cmd.(v "./configure" % "--prefix" % "PREFIX") + ~extra_env:None + ~chdir:(Some (Fpath.v "COMPILER-SOURCES")) + ~and_return:(Ok ()); + expect_run + ~command:Bos.Cmd.(v "make") + ~extra_env:None + ~chdir:(Some (Fpath.v "COMPILER-SOURCES")) + ~and_return:(Ok ()); + expect_run + ~command:Bos.Cmd.(v "make" % "install") + ~extra_env:None + ~chdir:(Some (Fpath.v "COMPILER-SOURCES")) + ~and_return:(Ok ()); + ] ~expected:(Ok ()); ] diff --git a/test/unit/test_source.ml b/test/unit/test_source.ml index 170c7e3..01400ee 100644 --- a/test/unit/test_source.ml +++ b/test/unit/test_source.ml @@ -13,6 +13,7 @@ let parse_tests = let got = Source.parse s in Alcotest.(check (result (module Source) error) __LOC__ expected got) ) in + let fpath_exn s = Fpath.of_string s |> Rresult.R.failwith_error_msg in [ test "full branch syntax" "user/repo:branch" (Ok (Github_branch { user = "user"; repo = "repo"; branch = "branch" })); @@ -26,13 +27,16 @@ let parse_tests = (Ok (Github_PR { user = "user"; repo = "repo"; number = 1234 })); test "defaults to main repo" "#1234" (Ok (Github_PR { user = "ocaml"; repo = "ocaml"; number = 1234 })); - test "something that does not parse" "a-random-string" (Error `Unknown); + test "something that does not parse" "" (Error `Unknown); test "users can have dashes" "user-with-dashes/repo#1234" (Ok (Github_PR { user = "user-with-dashes"; repo = "repo"; number = 1234 })); test "repos can have dashes" "user/repo-with-dashes#1234" (Ok (Github_PR { user = "user"; repo = "repo-with-dashes"; number = 1234 })); + test "relative directory" "." (Ok (Directory (fpath_exn "."))); + test "absolute directory" "/home/me/ocaml" + (Ok (Directory (fpath_exn "/home/me/ocaml"))); ] let switch_target_tests = diff --git a/test/unit/test_switch_name.ml b/test/unit/test_switch_name.ml new file mode 100644 index 0000000..23af56a --- /dev/null +++ b/test/unit/test_switch_name.ml @@ -0,0 +1,20 @@ +open Opam_compiler + +let switch_name_escape_string_tests = + let test ~name s ~expected = + ( name, + `Quick, + fun () -> + let got = Switch_name.escape_string s in + let expected = Switch_name.of_string_exn expected in + Alcotest.check (module Switch_name) __LOC__ expected got ) + in + [ + test ~name:"slash is escaped" "a/b" ~expected:"a-b"; + test ~name:"colon is escaped" "a:b" ~expected:"a-b"; + test ~name:"hash is escaped" "a#b" ~expected:"a-b"; + test ~name:"leading dashes are removed" "/home/me/ocaml" + ~expected:"home-me-ocaml"; + ] + +let tests = [ ("Switch_name escape_string", switch_name_escape_string_tests) ] diff --git a/test/unit/test_switch_name.mli b/test/unit/test_switch_name.mli new file mode 100644 index 0000000..c3be591 --- /dev/null +++ b/test/unit/test_switch_name.mli @@ -0,0 +1 @@ +val tests : unit Alcotest.test list From 89d82e15f2817b9562c3e1d3f3c11cc06010baac Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Tue, 13 Jul 2021 17:57:12 +0200 Subject: [PATCH 2/4] Use Re --- lib/switch_name.ml | 27 +++++++++++---------------- 1 file changed, 11 insertions(+), 16 deletions(-) diff --git a/lib/switch_name.ml b/lib/switch_name.ml index b641526..3987331 100644 --- a/lib/switch_name.ml +++ b/lib/switch_name.ml @@ -8,22 +8,17 @@ let to_string s = s let invalid_chars = [ '/'; ':'; '#' ] -let count_leading_dashes s = - let exception Done in - let r = ref 0 in - (try String.iter (function '-' -> incr r | _ -> raise Done) s - with Done -> ()); - !r - -let strip_leading_dashes s = - let n = count_leading_dashes s in - let s_len = String.length s in - String.sub s n (s_len - n) - -let escape_string s = - s - |> String.map (fun c -> if List.mem c invalid_chars then '-' else c) - |> strip_leading_dashes +let strip_leading_dashes = + let open Re in + let re = compile (seq [ bos; rep1 (char '-') ]) in + replace_string re ~by:"" + +let remove_invalid_chars = + let open Re in + let re = compile (alt (List.map char invalid_chars)) in + replace_string re ~by:"-" + +let escape_string s = s |> remove_invalid_chars |> strip_leading_dashes let parse s = if List.exists (fun c -> String.contains s c) invalid_chars then From 24e15555ba6602a95df0897c04df5d66ece35a2f Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Thu, 15 Jul 2021 14:59:35 +0200 Subject: [PATCH 3/4] Directories need to be absolute --- lib/cli.ml | 8 ++++---- lib/source.ml | 14 ++++++++------ lib/source.mli | 2 +- test/cram/create.t | 8 ++++++++ test/unit/test_source.ml | 12 +++++++++--- 5 files changed, 30 insertions(+), 14 deletions(-) diff --git a/lib/cli.ml b/lib/cli.ml index dc9e577..c080801 100644 --- a/lib/cli.ml +++ b/lib/cli.ml @@ -109,10 +109,10 @@ module Create = struct module Source_with_original = struct type t = { source : Source.t; original : string } - let of_string s = - match Source.parse s with - | Ok source -> Ok { source; original = s } - | Error `Unknown -> Rresult.R.error_msgf "Invalid source: %S" s + let of_string original = + let open Let_syntax.Result in + let+ source = Source.parse original in + { source; original } let pp ppf { original; _ } = Format.pp_print_string ppf original diff --git a/lib/source.ml b/lib/source.ml index 2a707af..e38259d 100644 --- a/lib/source.ml +++ b/lib/source.ml @@ -31,14 +31,16 @@ let parse_as_branch s = let parse_as_pr s = Option.map github_pr (Pull_request.parse s) let parse_as_directory s = - match Fpath.of_string s with Ok p -> Some (Directory p) | Error _ -> None + match Fpath.of_string s with + | Ok p when Fpath.is_abs p -> Ok (Directory p) + | Ok _ -> Rresult.R.error_msgf "Source should be an absolute directory" + | Error _ -> Rresult.R.error_msgf "Invalid path: %S" s let parse s = - let ( let/ ) f k = match f s with Some r -> Ok r | None -> k () in - let/ () = parse_as_branch in - let/ () = parse_as_pr in - let/ () = parse_as_directory in - Error `Unknown + let ( let/ ) x k = match x with Some r -> Ok r | None -> k () in + let/ () = parse_as_branch s in + let/ () = parse_as_pr s in + parse_as_directory s let pp ppf = function | Github_branch branch -> diff --git a/lib/source.mli b/lib/source.mli index d440ccd..fb4ce8e 100644 --- a/lib/source.mli +++ b/lib/source.mli @@ -13,6 +13,6 @@ val pp : Format.formatter -> t -> unit val equal : t -> t -> bool -val parse : string -> (t, [ `Unknown ]) result +val parse : string -> (t, Rresult.R.msg) result val compiler_sources : t -> Fpath.t option diff --git a/test/cram/create.t b/test/cram/create.t index b7e39d8..c5cb703 100644 --- a/test/cram/create.t +++ b/test/cram/create.t @@ -27,6 +27,14 @@ Directories are supported. Run: OPAMCLI=2.0 opam switch set-base --switch home-me-ocaml ocaml-variants Run: OPAMCLI=2.0 opam config --switch home-me-ocaml set compiler-sources /home/me/ocaml +Directories need to be absolute paths. + + $ opam-compiler create --dry-run somewhere + opam-compiler: SOURCE argument: Source should be an absolute directory + Usage: opam-compiler create [OPTION]... SOURCE + Try `opam-compiler create --help' or `opam-compiler --help' for more information. + [124] + An explicit configure step can be passed: $ opam-compiler create --dry-run USER/REPO:BRANCH --configure-command "./configure --enable-x" diff --git a/test/unit/test_source.ml b/test/unit/test_source.ml index 01400ee..7ca2bed 100644 --- a/test/unit/test_source.ml +++ b/test/unit/test_source.ml @@ -5,13 +5,15 @@ let error = let equal_error = ( = ) in Alcotest.testable pp_error equal_error +let msg = Alcotest.testable Rresult.R.pp_msg ( = ) + let parse_tests = let test name s expected = ( name, `Quick, fun () -> let got = Source.parse s in - Alcotest.(check (result (module Source) error) __LOC__ expected got) ) + Alcotest.(check (result (module Source) msg) __LOC__ expected got) ) in let fpath_exn s = Fpath.of_string s |> Rresult.R.failwith_error_msg in [ @@ -27,16 +29,20 @@ let parse_tests = (Ok (Github_PR { user = "user"; repo = "repo"; number = 1234 })); test "defaults to main repo" "#1234" (Ok (Github_PR { user = "ocaml"; repo = "ocaml"; number = 1234 })); - test "something that does not parse" "" (Error `Unknown); + test "something that does not parse" "" + (Rresult.R.error_msg "Invalid path: \"\""); test "users can have dashes" "user-with-dashes/repo#1234" (Ok (Github_PR { user = "user-with-dashes"; repo = "repo"; number = 1234 })); test "repos can have dashes" "user/repo-with-dashes#1234" (Ok (Github_PR { user = "user"; repo = "repo-with-dashes"; number = 1234 })); - test "relative directory" "." (Ok (Directory (fpath_exn "."))); + test "relative directory" "." + (Rresult.R.error_msg "Source should be an absolute directory"); test "absolute directory" "/home/me/ocaml" (Ok (Directory (fpath_exn "/home/me/ocaml"))); + test "invalid directory name" "/home\x00" + (Rresult.R.error_msg "Invalid path: \"/home\\000\""); ] let switch_target_tests = From 87352bbee3201b939baf67f666913ca74ff0ea94 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 16 Jul 2021 14:45:54 +0200 Subject: [PATCH 4/4] Move variable handling to op --- lib/op.ml | 38 +++++++++++++++++++++++++++++++---- lib/opam.ml | 49 ++++++++++----------------------------------- lib/opam.mli | 21 ++++++++++--------- test/opam/client.ml | 19 +++++++++--------- 4 files changed, 66 insertions(+), 61 deletions(-) diff --git a/lib/op.ml b/lib/op.ml index 1dff677..4a60fa3 100644 --- a/lib/op.ml +++ b/lib/op.ml @@ -9,6 +9,36 @@ let try_ r ~if_command_failed = e | Error _ as e -> e +let compiler_sources = "sources" + +let configure_command = "configure-command" + +let decode_using f x = + let open Let_syntax.Result in + let* ro = x in + match ro with + | None -> Ok None + | Some r -> ( + match f r with Error _ -> Error `Unknown | Ok p -> Ok (Some p)) + +let get_compiler_sources runner name = + Opam.get_variable runner name ~variable:compiler_sources + |> decode_using Fpath.of_string + +let set_compiler_sources runner name path = + Opam.set_variable runner name ~variable:compiler_sources + ~value:(Fpath.to_string path) + +let get_configure_command runner name = + Opam.get_variable runner name ~variable:configure_command + |> decode_using Bos.Cmd.of_string + +let set_configure_command runner name command = + Opam.set_variable runner name ~variable:configure_command + ~value:(Format.asprintf "%a" pp_cmd command) + +let iter ~f = function None -> Ok () | Some x -> f x + let create runner github_client source switch_name ~configure_command = let switch_name = match switch_name with @@ -27,8 +57,8 @@ let create runner github_client source switch_name ~configure_command = match Source.compiler_sources source with | None -> Ok () | Some sources -> - let* () = Opam.set_compiler_sources runner switch_name (Some sources) in - Opam.set_configure_command runner switch_name configure_command) + let* () = set_compiler_sources runner switch_name sources in + iter configure_command ~f:(set_configure_command runner switch_name)) |> translate_error "Cannot create switch" type reinstall_mode = Quick | Full @@ -43,9 +73,9 @@ let unwrap_compiler_sources = function let reinstall runner mode ~name = let open Let_syntax.Result in - (let* compiler_sources_opt = Opam.get_compiler_sources runner name in + (let* compiler_sources_opt = 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* configure_command = get_configure_command runner name in let* () = Opam.reinstall_compiler runner ~compiler_sources ~configure_command in diff --git a/lib/opam.ml b/lib/opam.ml index 1c75f9a..bd39f33 100644 --- a/lib/opam.ml +++ b/lib/opam.ml @@ -90,53 +90,26 @@ let remove_switch runner name = [ 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 to_string var = prefix ^ var - let get runner ~name var decode = + let get runner name ~variable = let open Let_syntax.Result in - let pattern = Format.sprintf "%%{%s}%%" (to_string var) in + let pattern = Format.sprintf "%%{%s}%%" (to_string variable) in let switch = match name with Some name -> L [ switch name ] | None -> L [] in - let* output = + 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 + if String.equal output "" then None else Some output -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 set runner name ~variable ~value = + run_opam runner + [ A "config"; switch name; A "set"; A (to_string variable); A value ] +end -let get_configure_command runner name = - Var.get runner ~name Configure_command Bos.Cmd.of_string +let get_variable = Var.get -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 +let set_variable = Var.set diff --git a/lib/opam.mli b/lib/opam.mli index 52105d7..847d4fa 100644 --- a/lib/opam.mli +++ b/lib/opam.mli @@ -24,14 +24,15 @@ val reinstall_packages : Runner.t -> (unit, error) result val remove_switch : Runner.t -> Switch_name.t -> (unit, error) result -val get_compiler_sources : - Runner.t -> Switch_name.t option -> (Fpath.t option, error) result - -val set_compiler_sources : - Runner.t -> Switch_name.t -> Fpath.t option -> (unit, error) result - -val get_configure_command : - Runner.t -> Switch_name.t option -> (Bos.Cmd.t option, error) result +val get_variable : + Runner.t -> + Switch_name.t option -> + variable:string -> + (string option, error) result -val set_configure_command : - Runner.t -> Switch_name.t -> Bos.Cmd.t option -> (unit, error) result +val set_variable : + Runner.t -> + Switch_name.t -> + variable:string -> + value:string -> + (unit, error) result diff --git a/test/opam/client.ml b/test/opam/client.ml index 6a74334..68d44c2 100755 --- a/test/opam/client.ml +++ b/test/opam/client.ml @@ -5,6 +5,8 @@ let pp_option pp ppf = function | None -> Format.fprintf ppf "None" | Some x -> Format.fprintf ppf "Some %a" pp x +let pp_string ppf s = Format.fprintf ppf "%S" s + let () = let open Let_syntax.Result in let runner = Runner.real in @@ -18,19 +20,18 @@ let () = (let* name = Switch_name.parse name in translate_error "remove" (Opam.remove_switch runner name)) |> Rresult.R.failwith_error_msg - | [| _; "compiler-sources"; name |] -> + | [| _; "get-var"; name; variable |] -> (let* name = Switch_name.parse name in - let+ path = - translate_error "compiler-sources" - (Opam.get_compiler_sources runner (Some name)) + let+ r = + translate_error "get-var" + (Opam.get_variable runner (Some name) ~variable) in - Format.printf "compiler-sources: %a\n" (pp_option Fpath.pp) path) + Format.printf "get-var: %a\n" (pp_option pp_string) r) |> Rresult.R.failwith_error_msg - | [| _; "set-compiler-sources"; name; value_s |] -> + | [| _; "set-var"; name; variable; value |] -> (let* name = Switch_name.parse name in - let* value = Fpath.of_string value_s in - translate_error "set-compiler-sources" - (Opam.set_compiler_sources runner name (Some value))) + translate_error "set-var" + (Opam.set_variable runner name ~variable ~value)) |> Rresult.R.failwith_error_msg | [| _; "reinstall-compiler"; compiler_sources_s |] -> (let* compiler_sources = Fpath.of_string compiler_sources_s in