Implement detection of sandbox (#445)

* Implement detection of opam switch

* Add esy sandbox detection

* update to promise_jsoo 0.3.0

Co-authored-by: Max Lantas <[email protected]>

dune-project

@@ -35,7 +35,7 @@
   (core_kernel
    (>= v0.14.0))
   (promise_jsoo
-   (>= 0.2.0))
+   (>= 0.3.0))
   (jsonoo
    (>= 0.2.0))))
 
@@ -50,6 +50,6 @@
   (gen_js_api
    (>= 1.0.6))
   (promise_jsoo
-   (>= 0.2.0))
+   (>= 0.3.0))
   (jsonoo
    (>= 0.2.0))))

src/cmd.ml

@@ -61,7 +61,9 @@ let check t =
     let+ s = check_spawn spawn in
     Spawn s
 
-let run ?cwd ?stdin = function
+let run ?cwd ?stdin =
+  let cwd = Option.map cwd ~f:Path.to_string in
+  function
   | Spawn { bin; args } ->
     ChildProcess.spawn (Path.to_string bin) (Array.of_list args) ?stdin
       (ChildProcess.Options.create ?cwd ())
@@ -92,9 +94,9 @@ let log ?(result : ChildProcess.return option) (t : t) =
   in
   log_json "external command" message
 
-let output ?stdin (t : t) =
+let output ?cwd ?stdin (t : t) =
   let open Promise.Syntax in
-  let+ (result : ChildProcess.return) = run ?stdin t in
+  let+ (result : ChildProcess.return) = run ?stdin ?cwd t in
   log ~result t;
   if result.exitCode = 0 then
     Ok result.stdout

src/cmd.mli

@@ -25,6 +25,7 @@ val check : t -> t Or_error.t Promise.t
 
 val log : ?result:ChildProcess.return -> t -> unit
 
-val output : ?stdin:string -> t -> (stdout, stderr) result Promise.t
+val output :
+  ?cwd:Path.t -> ?stdin:string -> t -> (stdout, stderr) result Promise.t
 
 val equal_spawn : spawn -> spawn -> bool

src/esy.ml

@@ -92,6 +92,15 @@ module State = struct
     | Pending
 end
 
+let find_manifest_in_dir dir =
+  let open Promise.Syntax in
+  let esy_file = Path.(dir / "esy.json") in
+  let package_file = Path.(dir / "package.json") in
+  [ esy_file; package_file ]
+  |> Promise.List.find_map (fun path ->
+         let+ file_exists = path |> Path.to_string |> Fs.exists in
+         Option.some_if file_exists path)
+
 let state t ~manifest =
   let root_str = Path.to_string manifest in
   let command = Cmd.append t [ "status"; "-P"; root_str ] in

src/esy.mli

@@ -11,6 +11,8 @@ type discover =
 
 val discover : dir:Path.t -> discover list Promise.t
 
+val find_manifest_in_dir : Path.t -> Path.t option Promise.t
+
 val exec : t -> manifest:Path.t -> args:string list -> Cmd.t
 
 val setup_toolchain : t -> manifest:Path.t -> unit Or_error.t Promise.t

src/opam.ml

@@ -5,11 +5,13 @@ module Switch = struct
     | Local of Path.t  (** if switch name is directory name where it's stored *)
     | Named of string  (** if switch is stored in ~/.opam *)
 
-  let make switch_name =
-    if Char.equal switch_name.[0] '/' then
-      Local (Path.of_string switch_name)
-    else
-      Named switch_name
+  let of_string = function
+    | "" -> None
+    | switch_name ->
+      if Char.equal switch_name.[0] '/' then
+        Some (Local (Path.of_string switch_name))
+      else
+        Some (Named switch_name)
 
   let name = function
     | Named s -> s
@@ -35,12 +37,7 @@ let make () =
 
 let parse_switch_list out =
   let lines = String.split_on_chars ~on:[ '\n' ] out in
-  let result =
-    lines
-    |> List.filter_map ~f:(function
-         | "" -> None
-         | s -> Some (Switch.make s))
-  in
+  let result = lines |> List.filter_map ~f:Switch.of_string in
   log "%d switches" (List.length result);
   result
 
@@ -54,6 +51,16 @@ let switch_list t =
     []
   | Ok out -> parse_switch_list out
 
+let switch_show ?cwd t =
+  let command = Cmd.append t [ "switch"; "show" ] in
+  let open Promise.Syntax in
+  let+ output = Cmd.output ?cwd (Spawn command) in
+  match output with
+  | Ok out -> Switch.of_string out
+  | Error _ ->
+    show_message `Warn "Unable to read the current switch.";
+    None
+
 let switch_arg switch = "--switch=" ^ Switch.name switch
 
 let exec t ~switch ~args =

src/opam.mli

@@ -3,7 +3,7 @@ module Switch : sig
     | Local of Path.t
     | Named of string
 
-  val make : string -> t
+  val of_string : string -> t option
 
   val name : t -> string
 
@@ -16,6 +16,8 @@ val make : unit -> t option Promise.t
 
 val switch_list : t -> Switch.t list Promise.t
 
+val switch_show : ?cwd:Path.t -> t -> Switch.t option Promise.t
+
 val exec : t -> switch:Switch.t -> args:string list -> Cmd.t
 
 val exists : t -> switch:Switch.t -> bool Promise.t

src/toolchain.ml

@@ -114,10 +114,12 @@ module Setting = struct
       in
       Esy manifest
     | Opam ->
-      let switch =
-        field "switch" (fun js -> Opam.Switch.make (decode_vars js)) json
-      in
-      Opam switch
+      field "switch"
+        (fun js ->
+          match Opam.Switch.of_string (decode_vars js) with
+          | Some switch -> Opam switch
+          | None -> Global)
+        json
     | Custom ->
       let template = field "template" decode_vars json in
       Custom template
@@ -184,6 +186,65 @@ let of_settings () : t option Promise.t =
   | Some Global -> Promise.return (Some Global)
   | Some (Custom template) -> Promise.return (Some (Custom template))
 
+let detect_esy_sandbox ~project_root esy () =
+  let open Promise.Option.Syntax in
+  let* esy = esy in
+  let open Promise.Syntax in
+  let+ esy_build_dir_exists, manifest =
+    Promise.all2
+      ( Fs.exists Path.(project_root / "_esy" |> Path.to_string)
+      , Esy.find_manifest_in_dir project_root )
+  in
+  match (esy_build_dir_exists, manifest) with
+  | true, _
+  | _, Some _ ->
+    (* Esy can be used with [esy.json], [package.json], or without any of those.
+        So we check if we find an [_esy] directory, which means the user created an Esy sandbox.
+
+       If we don't, but there is an [esy.json] file, we can assume the user wants to use Esy.
+    *)
+    Some (Esy (esy, project_root))
+  | false, None -> None
+
+let detect_opam_local_switch ~project_root opam () =
+  let open Promise.Option.Syntax in
+  let* opam = opam in
+  let* switch = Opam.switch_show ~cwd:project_root opam in
+  match switch with
+  | Local _ as switch -> Promise.Option.return (Opam (opam, switch))
+  | Named _ -> Promise.return None
+
+let detect_opam_sandbox ~project_root opam () =
+  let open Promise.Option.Syntax in
+  let* opam = opam in
+  let+ switch = Opam.switch_show ~cwd:project_root opam in
+  Opam (opam, switch)
+
+let detect () =
+  match Workspace.workspaceFolders () with
+  | [] -> Promise.return None
+  | [ workspace_folder ] ->
+    let project_root =
+      workspace_folder |> WorkspaceFolder.uri |> Uri.path |> Path.of_string
+    in
+    let available = available_toolchains () in
+    Promise.List.find_map
+      (fun f -> f ())
+      [ detect_opam_local_switch ~project_root available.opam
+      ; detect_esy_sandbox ~project_root available.esy
+      ; detect_opam_sandbox ~project_root available.opam
+      ]
+  | _ ->
+    (* If there are several workspace folders, skip the detection entirely. *)
+    Promise.return None
+
+let of_settings_or_detect () =
+  let open Promise.Syntax in
+  let* package_manager_opt = of_settings () in
+  match package_manager_opt with
+  | Some package_manager -> Promise.return (Some package_manager)
+  | None -> detect ()
+
 let save_to_settings toolchain =
   let to_setting = function
     | Esy (_, root) -> Setting.Esy root

src/toolchain.mli

@@ -30,6 +30,10 @@ val to_pretty_string : t -> string
 
 val of_settings : unit -> t option Promise.t
 
+val detect : unit -> t option Promise.t
+
+val of_settings_or_detect : unit -> t option Promise.t
+
 val save_to_settings : t -> unit Promise.t
 
 (** [select_toolchain_and_save] requires the process environment the plugin is being run in

src/vscode_ocaml_platform.ml

@@ -19,11 +19,7 @@ let activate (extension : ExtensionContext.t) =
      because we use vscode [output] pane for logs *)
   Process.Env.set "OCAML_LSP_SERVER_LOG" "-";
   let open Promise.Syntax in
-  let* toolchain =
-    Toolchain.of_settings ()
-    (* TODO: implement [Toolchain.from_settings_or_detect] that would
-       either get the sandbox from the settings or detect in a smart way (not simply Global) *)
-  in
+  let* toolchain = Toolchain.of_settings_or_detect () in
   let is_fallback = Option.is_empty toolchain in
   let toolchain = Option.value toolchain ~default:Toolchain.Global in
   Extension_instance.make toolchain

vscode-ocaml-platform.opam

@@ -22,7 +22,7 @@ depends: [
   "js_of_ocaml" {>= "3.7.0"}
   "gen_js_api" {>= "1.0.6"}
   "core_kernel" {>= "v0.14.0"}
-  "promise_jsoo" {>= "0.2.0"}
+  "promise_jsoo" {>= "0.3.0"}
   "jsonoo" {>= "0.2.0"}
   "odoc" {with-doc}
 ]

vscode.opam

@@ -20,7 +20,7 @@ depends: [
   "ocaml" {>= "4.11"}
   "js_of_ocaml" {>= "3.7.0"}
   "gen_js_api" {>= "1.0.6"}
-  "promise_jsoo" {>= "0.2.0"}
+  "promise_jsoo" {>= "0.3.0"}
   "jsonoo" {>= "0.2.0"}
   "odoc" {with-doc}
 ]