Move Path to Stdune

* This requires moving Fatal_error and Loc_error to Stdune.Exn as well

* Clflags.workspace_root can no longer be used in Path.to_absolute_filename. We
  just take a parameter instead for now.

src/action_intf.ml

@@ -1,3 +1,5 @@
+open Stdune
+
 module Outputs = struct
   type t =
     | Stdout

src/bin.mli

@@ -1,5 +1,7 @@
 (** OCaml binaries *)
 
+open Stdune
+
 (** Character used to separate entries in [PATH] and similar
     environment variables *)
 val path_sep : char

src/dep_path.mli

@@ -1,5 +1,7 @@
 (** Dependency path *)
 
+open Stdune
+
 module Entry : sig
   type t =
     | Path of Path.t

src/errors.ml

@@ -1,4 +1,5 @@
-exception Fatal_error of string
+open Stdune
+
 exception Already_reported
 
 let err_buf = Buffer.create 128
@@ -13,4 +14,4 @@ let kerrf fmt ~f =
     err_ppf fmt
 
 let die fmt =
-  kerrf fmt ~f:(fun s -> raise (Fatal_error s))
+  kerrf fmt ~f:(fun s -> raise (Exn.Fatal_error s))

src/errors.mli

@@ -3,15 +3,6 @@
 (* CR-soon diml: stop including this in [Import] *)
 (** This module is included in [Import] *)
 
-(* CR-soon diml:
-   - Rename to [User_error]
-   - change the [string] argument to [Loc.t option * string] and get rid of
-   [Loc.Error]. The two are a bit confusing
-   - change [string] to [Colors.Style.t Pp.t]
-*)
-(** A fatal error, that should be reported to the user in a nice way *)
-exception Fatal_error of string
-
 (* CR-soon diml: we won't need this once we can generate rules dynamically *)
 (** Raised for errors that have already been reported to the user and shouldn't be
     reported again. This might happen when trying to build a dependency that has already
@@ -19,7 +10,7 @@ exception Fatal_error of string
 exception Already_reported
 
 (* CR-soon diml: Rename to [user_errorf]. *)
-(** Raise a [Fatal_error] exception *)
+(** Raise a [Exn.Fatal_error] exception *)
 val die : ('a, Format.formatter, unit, 'b) format4 -> 'a
 
 (**/**)

src/install_rules.mli

@@ -1,3 +1,5 @@
+open Stdune
+
 module type Params = sig
   val sctx : Super_context.t
 end

src/jbuild_load.ml

@@ -136,7 +136,7 @@ end
         List.concat
           [ [ "-I"; "+compiler-libs" ]
           ; cmas
-          ; [ Path.to_absolute_filename wrapper ]
+          ; [ Path.to_absolute_filename wrapper ~root:!Clflags.workspace_root ]
           ]
       in
       (* CR-someday jdimino: if we want to allow plugins to use findlib:

src/jbuild_load.mli

@@ -1,4 +1,4 @@
-open Jbuild
+open Stdune
 
 module Jbuilds : sig
   type t
@@ -6,14 +6,14 @@ module Jbuilds : sig
   val eval
     :  t
     -> context:Context.t
-    -> (Path.t * Scope_info.t * Stanzas.t) list Fiber.t
+    -> (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list Fiber.t
 end
 
 type conf =
   { file_tree : File_tree.t
   ; jbuilds   : Jbuilds.t
   ; packages  : Package.t Package.Name.Map.t
-  ; scopes    : Scope_info.t list
+  ; scopes    : Jbuild.Scope_info.t list
   }
 
 val load

src/loc.ml

@@ -32,16 +32,14 @@ let of_lexbuf lb =
   ; stop  = Lexing.lexeme_end_p   lb
   }
 
-exception Error of t * string
-
 let exnf t fmt =
   Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
-  kerrf fmt ~f:(fun s -> Error (t, s))
+  kerrf fmt ~f:(fun s -> Exn.Loc_error (t, s))
 
 let fail t fmt =
   Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
   kerrf fmt ~f:(fun s ->
-    raise (Error (t, s)))
+    raise (Exn.Loc_error (t, s)))
 
 let fail_lex lb fmt =
   fail (of_lexbuf lb) fmt

src/loc.mli

@@ -7,8 +7,6 @@ val sexp_of_t : t -> Usexp.t
 
 val of_lexbuf : Lexing.lexbuf -> t
 
-exception Error of t * string
-
 val exnf     : t             -> ('a, Format.formatter, unit, exn) format4 -> 'a
 val fail     : t             -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
 val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b ) format4 -> 'a

src/menhir.mli

@@ -1,5 +1,7 @@
 (** Menhir rules *)
 
+open Stdune
+
 (** Generate the rules for a [(menhir ...)] stanza. Return the list of
     targets that are generated by these rules. This list of targets is
     used by the code that computes the list of modules in the

src/merlin.ml

@@ -70,7 +70,7 @@ let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } =
   | Pps { pps; flags } ->
     let exe = Preprocessing.get_ppx_driver sctx ~scope pps in
     let command =
-      List.map (Path.to_absolute_filename exe
+      List.map (Path.to_absolute_filename exe ~root:!Clflags.workspace_root
                 :: "--as-ppx"
                 :: Preprocessing.cookie_library_name libname
                 @ flags)

src/modules_partitioner.mli

@@ -1,5 +1,7 @@
 (** Checks modules partitioning inside a directory *)
 
+open Stdune
+
 type t
 
 val create

src/ocaml_flags.mli

@@ -1,5 +1,7 @@
 (** OCaml flags *)
 
+open Stdune
+
 type t
 
 val make

src/ocamldep.mli

@@ -1,5 +1,7 @@
 (** ocamldep management *)
 
+open Stdune
+
 module Dep_graph : sig
   type t
 

src/package.ml

@@ -1,3 +1,4 @@
+open Stdune
 
 module Name = struct
   include Interned.Make()

src/package.mli

@@ -1,5 +1,7 @@
 (** Information about a package defined in the workspace *)
 
+open Stdune
+
 module Name : sig
   type t
 

src/print_diff.mli

@@ -1,2 +1,4 @@
+open Stdune
+
 (** Diff two files that are expected not to match. *)
 val print : Path.t -> Path.t -> _ Fiber.t

src/report_error.ml

@@ -25,7 +25,7 @@ let report_with_backtrace exn =
   | Some p -> p
   | None ->
     match exn with
-    | Loc.Error (loc, msg) ->
+    | Exn.Loc_error (loc, msg) ->
       let loc =
         { loc with
           start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
@@ -55,7 +55,7 @@ let report_with_backtrace exn =
         loc = Some loc
       ; pp  = fun ppf -> Format.fprintf ppf "@{<error>Error@}: %s\n" msg
       }
-    | Fatal_error msg ->
+    | Exn.Fatal_error msg ->
       { p with pp = fun ppf ->
           if msg.[String.length msg - 1] = '\n' then
             Format.fprintf ppf "%s" msg

src/scope.mli

@@ -1,5 +1,7 @@
 (** Scopes *)
 
+open Stdune
+
 (** Representation of a Scope. It contain a library database for all
     the private libraries in the scope. *)
 type t

src/stdune/exn.ml

@@ -2,10 +2,21 @@ type t = exn
 
 exception Code_error of Usexp.t
 
+exception Fatal_error of string
+
+exception Loc_error of Usexp.Loc.t * string
+
 external raise         : exn -> _ = "%raise"
 external raise_notrace : exn -> _ = "%raise_notrace"
 external reraise       : exn -> _ = "%reraise"
 
+let fatalf ?loc fmt =
+  Format.ksprintf (fun s ->
+    match loc with
+    | None -> raise (Fatal_error s)
+    | Some loc -> raise (Loc_error (loc, s))
+  ) fmt
+
 let protectx x ~f ~finally =
   match f x with
   | y           -> finally x; y

src/stdune/exn.mli

@@ -4,6 +4,23 @@
     shouldn't try to be developer friendly rather than user friendly. *)
 exception Code_error of Usexp.t
 
+
+(* CR-soon diml:
+   - Rename to [User_error]
+   - change the [string] argument to [Loc.t option * string] and get rid of
+   [Loc.Error]. The two are a bit confusing
+   - change [string] to [Colors.Style.t Pp.t]
+*)
+(** A fatal error, that should be reported to the user in a nice way *)
+exception Fatal_error of string
+
+exception Loc_error of Usexp.Loc.t * string
+
+val fatalf
+  :  ?loc:Usexp.Loc.t
+  -> ('a, unit, string, string, string, 'b) format6
+  -> 'a
+
 val code_error : string -> (string * Usexp.t) list -> _
 
 type t = exn

src/stdune/path.ml

@@ -1,5 +1,3 @@
-open Stdune
-
 let explode_path =
   let rec loop path acc =
     let dir  = Filename.dirname  path in
@@ -96,11 +94,11 @@ module Local = struct
   let relative ?error_loc t path =
     let rec loop t components =
       match components with
-      | [] -> Ok t
+      | [] -> Result.Ok t
       | "." :: rest -> loop t rest
       | ".." :: rest ->
         begin match t with
-        | "" -> Error ()
+        | "" -> Result.Error ()
         | t -> loop (parent t) rest
         end
       | fn :: rest ->
@@ -109,9 +107,9 @@ module Local = struct
         | _ -> loop (t ^ "/" ^ fn) rest
     in
     match loop t (explode_path path) with
-    | Ok t -> t
+    | Result.Ok t -> t
     | Error () ->
-       Loc.fail_opt error_loc "path outside the workspace: %s from %s" path
+       Exn.fatalf ?loc:error_loc "path outside the workspace: %s from %s" path
          (to_string t)
 
   let is_canonicalized =
@@ -280,9 +278,8 @@ let absolute fn =
   else
     fn
 
-let to_absolute_filename t =
+let to_absolute_filename t ~root =
   if is_local t then begin
-    let root = !Clflags.workspace_root in
     assert (not (Filename.is_relative root));
     Filename.concat root (to_string t)
   end else

src/stdune/path.mli

@@ -1,5 +1,3 @@
-open Import
-
 (** In the current workspace (anything under the current project root) *)
 module Local : sig
   type t
@@ -50,7 +48,7 @@ module Map : Map.S with type key = t
 
 val kind : t -> Kind.t
 
-val of_string : ?error_loc:Loc.t -> string -> t
+val of_string : ?error_loc:Usexp.Loc.t -> string -> t
 val to_string : t -> string
 
 (** [to_string_maybe_quoted t] is [maybe_quoted (to_string t)] *)
@@ -61,15 +59,15 @@ val is_root : t -> bool
 
 val is_local : t -> bool
 
-val relative : ?error_loc:Loc.t -> t -> string -> t
+val relative : ?error_loc:Usexp.Loc.t -> t -> string -> t
 
 (** Create an external path. If the argument is relative, assume it is
     relative to the initial directory jbuilder was launched in. *)
 val absolute : string -> t
 
-(** Convert a path to an absolute filename. Must be called after the
-    workspace root has been set. *)
-val to_absolute_filename : t -> string
+(** Convert a path to an absolute filename. Must be called after the workspace
+    root has been set. [root] is the root directory of local paths *)
+val to_absolute_filename : t -> root:string -> string
 
 val reach : t -> from:t -> string
 val reach_for_running : t -> from:t -> string
@@ -147,4 +145,4 @@ val extension : t -> string
 *)
 val drop_prefix : t -> prefix:t -> string option
 
-val pp : t Fmt.t
+val pp : Format.formatter -> t -> unit

src/stdune/stdune.ml

@@ -19,6 +19,7 @@ module Staged     = Staged
 module String     = String
 module Char       = Char
 module Sexp       = Sexp
+module Path       = Path
 
 external reraise : exn -> _ = "%reraise"
 

src/utop.ml

@@ -11,7 +11,8 @@ let pp_ml fmt include_dirs =
   let pp_include fmt =
     let pp_sep fmt () = Format.fprintf fmt "@ ; " in
     Format.pp_print_list ~pp_sep (fun fmt p ->
-      Format.fprintf fmt "%S" (Path.to_absolute_filename p)
+      Format.fprintf fmt "%S" (Path.to_absolute_filename p
+                                 ~root:!Clflags.workspace_root)
     ) fmt
   in
   Format.fprintf fmt "@[<v 2>Clflags.include_dirs :=@ [ %a@ ]@];@."

src/utop.mli

@@ -1,5 +1,7 @@
 (** Utop rules *)
 
+open Stdune
+
 val utop_exe : Path.t -> Path.t
 (** Return the path of the utop bytecode binary inside a directory where
     some libraries are defined. *)

test/unit-tests/action.mlt

@@ -12,7 +12,7 @@ let infer (a : Action.t) =
   (List.map (Path.Set.to_list x.deps) ~f:Path.to_string,
    List.map (Path.Set.to_list x.targets) ~f:Path.to_string)
 [%%expect{|
-val p : ?error_loc:Jbuilder.Loc.t -> string -> Jbuilder.Path.t = <fun>
+val p : ?error_loc:Usexp.Loc.t -> string -> Jbuilder.Import.Path.t = <fun>
 val infer : Jbuilder.Action.t -> string list * string list = <fun>
 |}]
 

test/unit-tests/path.mlt

@@ -8,44 +8,44 @@ let r = Path.(relative root);;
 
 Path.(let p = relative root "foo" in descendant p ~of_:p)
 [%%expect{|
-val r : string -> Jbuilder.Path.t = <fun>
-- : Jbuilder.Path.t option = Some foo
+val r : string -> Jbuilder.Import.Path.t = <fun>
+- : Jbuilder.Import.Path.t option = Some foo
 |}]
 
 (* different strings but same length *)
 Path.(descendant (relative root "foo") ~of_:(relative root "bar"))
 [%%expect{|
-- : Jbuilder.Path.t option = None
+- : Jbuilder.Import.Path.t option = None
 |}]
 
 Path.(descendant (r "foo") ~of_:(r "foo/"))
 [%%expect{|
-- : Jbuilder.Path.t option = Some foo
+- : Jbuilder.Import.Path.t option = Some foo
 |}]
 
 Path.(descendant (r "foo/") ~of_:(r "foo"))
 [%%expect{|
-- : Jbuilder.Path.t option = Some foo
+- : Jbuilder.Import.Path.t option = Some foo
 |}]
 
 Path.(descendant (r "foo/bar") ~of_:(r "foo"))
 [%%expect{|
-- : Jbuilder.Path.t option = Some bar
+- : Jbuilder.Import.Path.t option = Some bar
 |}]
 
 Path.(descendant Path.root ~of_:(r "foo"))
 [%%expect{|
-- : Jbuilder.Path.t option = None
+- : Jbuilder.Import.Path.t option = None
 |}]
 
 Path.(descendant Path.root ~of_:Path.root)
 [%%expect{|
-- : Jbuilder.Path.t option = Some .
+- : Jbuilder.Import.Path.t option = Some .
 |}]
 
 Path.(descendant (r "foo") ~of_:Path.root)
 [%%expect{|
-- : Jbuilder.Path.t option = Some foo
+- : Jbuilder.Import.Path.t option = Some foo
 |}]
 
 Path.explode (Path.of_string "a/b/c");