Return [result] from [Workspace_root.create] (ocaml#10894)

This makes it possible to check whether the user is currently inside a
dune project. This is needed for dev-tools to have fallback behaviour
when run outside of a dune project which is necessary to allow users
to configure their editors to invoke dev-tools via dune. For example,
if a user configures their editor to start ocamllsp with the command
`dune ocamllsp`, dune needs to be able to handle the case where the
user edits an ocaml file outside of a dune project, for example by
attempting to invoke ocamllsp from PATH.

Signed-off-by: Stephen Sherratt <[email protected]>

bin/common.ml

@@ -598,8 +598,10 @@ module Builder = struct
     ; log_file : Dune_util.Log.File.t
     }
 
+  let root t = t.root
   let set_root t root = { t with root = Some root }
   let forbid_builds t = { t with allow_builds = false; no_print_directory = true }
+  let default_root_is_cwd t = t.default_root_is_cwd
   let set_default_root_is_cwd t x = { t with default_root_is_cwd = x }
   let set_log_file t x = { t with log_file = x }
   let disable_log_file t = { t with log_file = No_log_file }
@@ -1136,7 +1138,7 @@ let print_entering_message c =
    we should probably refactor that at some point. *)
 let build (builder : Builder.t) =
   let root =
-    Workspace_root.create
+    Workspace_root.create_exn
       ~default_is_cwd:builder.default_root_is_cwd
       ~specified_by_user:builder.root
   in

bin/common.mli

@@ -28,8 +28,10 @@ val prefix_target : t -> string -> string
 module Builder : sig
   type t
 
+  val root : t -> string option
   val set_root : t -> string -> t
   val forbid_builds : t -> t
+  val default_root_is_cwd : t -> bool
   val set_default_root_is_cwd : t -> bool -> t
   val set_log_file : t -> Dune_util.Log.File.t -> t
   val disable_log_file : t -> t

bin/workspace_root.ml

@@ -96,22 +96,32 @@ let create ~default_is_cwd ~specified_by_user =
         | None -> if default_is_cwd then Some cwd else None)
   with
   | Some { Candidate.dir; to_cwd; kind } ->
-    { kind
-    ; dir
-    ; to_cwd
-    ; reach_from_root_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
-    }
+    Ok
+      { kind
+      ; dir
+      ; to_cwd
+      ; reach_from_root_prefix =
+          String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
+      }
   | None ->
-    User_error.raise
-      [ Pp.text "I cannot find the root of the current workspace/project."
-      ; Pp.text "If you would like to create a new dune project, you can type:"
-      ; Pp.nop
-      ; Pp.verbatim "    dune init project NAME"
-      ; Pp.nop
-      ; Pp.text
-          "Otherwise, please make sure to run dune inside an existing project or \
-           workspace. For more information about how dune identifies the root of the \
-           current workspace/project, please refer to \
-           https://dune.readthedocs.io/en/stable/usage.html#finding-the-root"
-      ]
+    Error
+      User_error.(
+        make
+          [ Pp.text "I cannot find the root of the current workspace/project."
+          ; Pp.text "If you would like to create a new dune project, you can type:"
+          ; Pp.nop
+          ; Pp.verbatim "    dune init project NAME"
+          ; Pp.nop
+          ; Pp.text
+              "Otherwise, please make sure to run dune inside an existing project or \
+               workspace. For more information about how dune identifies the root of the \
+               current workspace/project, please refer to \
+               https://dune.readthedocs.io/en/stable/usage.html#finding-the-root"
+          ])
+;;
+
+let create_exn ~default_is_cwd ~specified_by_user =
+  match create ~default_is_cwd ~specified_by_user with
+  | Ok x -> x
+  | Error e -> raise (User_error.E e)
 ;;

bin/workspace_root.mli

@@ -1,3 +1,5 @@
+open! Stdune
+
 (** Finding the root of the workspace *)
 
 module Kind : sig
@@ -16,4 +18,9 @@ type t =
   ; kind : Kind.t
   }
 
-val create : default_is_cwd:bool -> specified_by_user:string option -> t
+val create
+  :  default_is_cwd:bool
+  -> specified_by_user:string option
+  -> (t, User_message.t) result
+
+val create_exn : default_is_cwd:bool -> specified_by_user:string option -> t