Make Path.parent return option

Use _exn whenever we know the parent exists

bin/main.ml

@@ -116,7 +116,7 @@ let request_of_targets (setup : Main.setup) targets =
     match target with
     | File path -> Build.path path
     | Alias_rec path ->
-      let dir = Path.parent path in
+      let dir = Path.parent_exn path in
       let name = Path.basename path in
       let contexts, dir =
         match Path.extract_build_context dir with
@@ -594,11 +594,7 @@ let resolve_package_install setup pkg =
 
 let target_hint (setup : Main.setup) path =
   assert (Path.is_local path);
-  let sub_dir =
-    if Path.is_root path then
-      path
-    else
-      Path.parent path in
+  let sub_dir = Option.value ~default:path (Path.parent path) in
   let candidates = Build_system.all_targets setup.build_system in
   let candidates =
     if Path.is_in_build_dir path then
@@ -613,7 +609,7 @@ let target_hint (setup : Main.setup) path =
     (* Only suggest hints for the basename, otherwise it's slow when there are lots of
        files *)
     List.filter_map candidates ~f:(fun path ->
-      if Path.parent path = sub_dir then
+      if Path.parent_exn path = sub_dir then
         Some (Path.to_string path)
       else
         None)

src/action.ml

@@ -801,10 +801,9 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
       Io.copy_file ~src ~dst
     else begin
       let src =
-        if Path.is_root dst then
-          Path.to_string src
-        else
-          Path.reach ~from:(Path.parent dst) src
+        match Path.parent dst with
+        | None -> Path.to_string src
+        | Some from -> Path.reach ~from src
       in
       let dst = Path.to_string dst in
       match Unix.readlink dst with

src/build_interpret.ml

@@ -45,7 +45,7 @@ let inspect_path file_tree path =
       if Path.is_root path then
         Some Dir
       else if File_tree.file_exists file_tree
-                (Path.parent   path)
+                (Path.parent_exn path)
                 (Path.basename path) then
         Some Reg
       else
@@ -97,7 +97,7 @@ let static_deps t ~all_targets ~file_tree =
         match !state with
         | Decided (_, t) -> loop t acc
         | Undecided (then_, else_) ->
-          let dir = Path.parent p in
+          let dir = Path.parent_exn p in
           let targets = all_targets ~dir in
           if Pset.mem targets p then begin
             state := Decided (true, then_);
@@ -208,10 +208,10 @@ module Rule = struct
       | [] ->
         invalid_arg "Build_interpret.Rule.make: rule has no targets"
       | x :: l ->
-        let dir = Path.parent (Target.path x) in
+        let dir = Path.parent_exn (Target.path x) in
         List.iter l ~f:(fun target ->
           let path = Target.path target in
-          if Path.parent path <> dir then
+          if Path.parent_exn path <> dir then
             match loc with
             | None ->
               Exn.code_error "rule has targets in different directories"

src/build_system.ml

@@ -236,7 +236,7 @@ module Alias0 = struct
         Loc.fail loc "Invalid alias!\n\
                       Tried to reference path outside build dir: %S"
           (Path.to_string_maybe_quoted path);
-      { dir = Path.parent path
+      { dir = Path.parent_exn path
       ; name = Path.basename path
       }
   end
@@ -536,7 +536,7 @@ let add_spec t fn spec ~copy_source =
   | Some (File_spec.T { rule; _ }) ->
     match copy_source, rule.mode with
     | true, (Standard | Not_a_rule_stanza) ->
-      Loc.warn (Internal_rule.loc rule ~dir:(Path.parent fn)
+      Loc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
                   ~file_tree:t.file_tree)
         "File %s is both generated by a rule and present in the source tree.\n\
          As a result, the rule is currently ignored, however this will become an error \
@@ -1056,7 +1056,7 @@ and wait_for_file t fn =
   match Hashtbl.find t.files fn with
   | Some file -> wait_for_file_found fn file
   | None ->
-    let dir = Path.parent fn in
+    let dir = Path.parent_exn fn in
     if Path.is_in_build_dir dir then begin
       load_dir t ~dir;
       match Hashtbl.find t.files fn with
@@ -1247,7 +1247,8 @@ module Ir_set = Set.Make(Internal_rule)
 
 let rules_for_files t paths =
   List.filter_map paths ~f:(fun path ->
-    if Path.is_in_build_dir path then load_dir t ~dir:(Path.parent path);
+    if Path.is_in_build_dir path then
+      load_dir t ~dir:(Path.parent_exn path);
     match Hashtbl.find t.files path with
     | None -> None
     | Some (File_spec.T { rule; _ }) -> Some rule)
@@ -1341,8 +1342,9 @@ let build_rules_internal ?(recursive=false) t ~request =
   let rules_seen = ref Rule.Id.Set.empty in
   let rules = ref [] in
   let rec loop fn =
-    let dir = Path.parent fn in
-    if Path.is_in_build_dir dir then load_dir t ~dir;
+    let dir = Path.parent_exn fn in
+    if Path.is_in_build_dir dir then
+      load_dir t ~dir;
     match Hashtbl.find t.files fn with
     | Some file ->
       file_found fn file
@@ -1462,9 +1464,9 @@ let package_deps t pkg files =
 let rec add_build_dir_to_keep t ~dir =
   if not (Pset.mem t.build_dirs_to_keep dir) then begin
     t.build_dirs_to_keep <- Pset.add t.build_dirs_to_keep dir;
-    let dir = Path.parent dir in
-    if not (Path.is_root dir) then
-      add_build_dir_to_keep t ~dir
+    Option.iter (Path.parent dir) ~f:(fun dir ->
+      if not (Path.is_root dir) then
+        add_build_dir_to_keep t ~dir)
   end
 
 let get_collector t ~dir =
@@ -1577,4 +1579,5 @@ module Alias = struct
                    } :: def.actions
 end
 
-let is_target t file = Pset.mem (targets_of t ~dir:(Path.parent file)) file
+let is_target t file =
+  Pset.mem (targets_of t ~dir:(Path.parent_exn file)) file

src/context.ml

@@ -181,7 +181,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets ~profile () =
         | Some x -> x
         | None -> prog_not_found_in_path "ocamlc"
     in
-    let dir = Path.parent ocamlc in
+    let dir = Path.parent_exn ocamlc in
     let ocaml_tool_not_found prog =
       die "ocamlc found in %s, but %s/%s doesn't exist (context: %s)"
         (Path.to_string dir) (Path.to_string dir) prog name
@@ -246,7 +246,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets ~profile () =
           | None ->
             (* If neither opam neither ocamlfind are present, assume
                that libraries are [dir ^ "/../lib"] *)
-            ocamlpath @ [Path.relative (Path.parent dir) "lib"]
+            ocamlpath @ [Path.relative (Path.parent_exn dir) "lib"]
     in
     let ocaml_config_ok_exn = function
       | Ok x -> x
@@ -460,7 +460,7 @@ let which t s = which ~cache:t.which_cache ~path:t.path s
 let install_prefix t =
   opam_config_var t "prefix" >>| function
   | Some x -> Path.absolute x
-  | None   -> Path.parent t.ocaml_bin
+  | None   -> Path.parent_exn t.ocaml_bin
 
 let install_ocaml_libdir t =
   match t.kind, t.findlib_toolchain, Setup.library_destdir with

src/file_tree.ml

@@ -131,7 +131,8 @@ let rec find_dir t path =
     | None ->
       match
         let open Option.O in
-        find_dir t (Path.parent path)
+        Path.parent path
+        >>= find_dir t
         >>= fun parent ->
         String.Map.find (Dir.sub_dirs parent) (Path.basename path)
       with
@@ -159,7 +160,7 @@ let dir_exists t path = Option.is_some (find_dir t path)
 
 let exists t path =
   dir_exists t path ||
-  file_exists t (Path.parent path) (Path.basename path)
+  file_exists t (Path.parent_exn path) (Path.basename path)
 
 let files_recursively_in t ?(prefix_with=Path.root) path =
   match find_dir t path with

src/gen_rules.ml

@@ -211,7 +211,7 @@ module Gen(P : Install_rules.Params) = struct
       Loc.fail loc "%s is not a sub-directory of %s"
         (Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir);
     let glob = Path.basename glob_in_src in
-    let src_in_src = Path.parent glob_in_src in
+    let src_in_src = Path.parent_exn glob_in_src in
     let re =
       match Glob_lexer.parse_string glob with
       | Ok re ->
@@ -967,7 +967,7 @@ module Gen(P : Install_rules.Params) = struct
         let src_dir =
           let loc = String_with_vars.loc glob in
           let src_glob = SC.expand_vars sctx ~dir glob ~scope in
-          Path.parent (Path.relative src_dir src_glob ~error_loc:loc)
+          Path.parent_exn (Path.relative src_dir src_glob ~error_loc:loc)
         in
         Some
           (Merlin.make ()
@@ -997,7 +997,7 @@ module Gen(P : Install_rules.Params) = struct
             Option.is_none
               (File_tree.find_dir (SC.file_tree sctx)
                  (Path.drop_build_context_exn dir)) then
-           SC.load_dir sctx ~dir:(Path.parent dir));
+           SC.load_dir sctx ~dir:(Path.parent_exn dir));
     match components with
     | [] -> These (String.Set.of_list [".js"; "_doc"; ".ppx"])
     | [(".js"|"_doc"|".ppx")] -> All

src/jbuild.ml

@@ -1291,7 +1291,7 @@ module Stanzas = struct
       ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
       ; cstr_loc "include" (relative_file @> nil) (fun loc fn ->
           let include_stack = (loc, file) :: include_stack in
-          let dir = Path.parent file in
+          let dir = Path.parent_exn file in
           let file = Path.relative dir fn in
           if not (Path.exists file) then
             Loc.fail loc "File %s doesn't exist."

src/scope.ml

@@ -31,7 +31,7 @@ module DB = struct
             [ "dir"    , Path.sexp_of_t dir
             ; "context", Sexp.To_sexp.string t.context
             ];
-        let scope = loop (Path.parent d) in
+        let scope = loop (Path.parent_exn d) in
         Hashtbl.add t.by_dir d scope;
         scope
     in

src/stdune/path.ml

@@ -341,8 +341,20 @@ let basename t =
 
 let parent t =
   match kind t with
-  | Local t -> Local.parent t
-  | External t -> Filename.dirname t
+  | Local "" -> None
+  | Local t -> Some (Local.parent t)
+  | External t ->
+    let parent = Filename.dirname t in
+    if parent = t then
+      None
+    else
+      Some parent
+
+let parent_exn t =
+  match parent t with
+  | Some p -> p
+  | None -> Exn.code_error "Path.parent_exn: t is root"
+              ["t", sexp_of_t t]
 
 let build_prefix = "_build/"
 

src/stdune/path.mli

@@ -78,7 +78,8 @@ val is_descendant : t -> of_:t -> bool
 val append : t -> t -> t
 
 val basename : t -> string
-val parent : t -> t
+val parent : t -> t option
+val parent_exn : t -> t
 
 val extend_basename : t -> suffix:string -> t
 

src/super_context.ml

@@ -113,10 +113,13 @@ module Env = struct
   let rec get t ~dir =
     match Hashtbl.find t.env dir with
     | None ->
-      if Path.is_root dir then raise_notrace Exit;
-      let node = get t ~dir:(Path.parent dir) in
-      Hashtbl.add t.env dir node;
-      node
+      begin match Path.parent dir with
+      | None -> raise_notrace Exit
+      | Some parent ->
+        let node = get t ~dir:parent in
+        Hashtbl.add t.env dir node;
+        node
+      end
     | Some node -> node
 
   let get t ~dir =
@@ -334,7 +337,7 @@ let create
             if ctx_dir = Scope.root scope then
               None
             else
-              Some (lazy (Env.get t ~dir:(Path.parent ctx_dir)))
+              Some (lazy (Env.get t ~dir:(Path.parent_exn ctx_dir)))
           in
           Hashtbl.add t.env ctx_dir
             { dir          = ctx_dir
@@ -480,7 +483,7 @@ module Deps = struct
           Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s) in
         match Glob_lexer.parse_string (Path.basename path) with
         | Ok re ->
-          let dir = Path.parent path in
+          let dir = Path.parent_exn path in
           Build.paths_glob ~loc ~dir (Re.compile re)
         | Error (_pos, msg) ->
           Loc.fail loc "invalid glob: %s" msg
@@ -793,7 +796,7 @@ module Action = struct
     in
     let targets = Pset.to_list targets in
     List.iter targets ~f:(fun target ->
-      if Path.parent target <> dir then
+      if Path.parent_exn target <> dir then
         Loc.fail loc
           "This action has targets in a different directory than the current \
            one, this is not allowed by Jbuilder at the moment:\n%s"

src/utils.ml

@@ -85,7 +85,7 @@ let analyse_target fn =
               assert (String.length digest = 32);
               name
           in
-          Alias (ctx, Path.relative (Path.parent fn) basename)
+          Alias (ctx, Path.relative (Path.parent_exn fn) basename)
     end
   | Some ("install", _) -> Other fn
   | Some (ctx, sub) -> Regular (ctx, sub)

test/unit-tests/path.mlt

@@ -163,6 +163,6 @@ Path.rm_rf (Path.of_string "/does/not/exist/foo/bar/baz")
 [%%expect{|
 Exception: Stdune__Exn.Code_error <abstr>.
 Raised at file "src/stdune/exn.ml", line 30, characters 37-131
-Called from file "src/stdune/path.ml", line 496, characters 4-127
+Called from file "src/stdune/path.ml", line 505, characters 4-127
 Called from file "toplevel/toploop.ml", line 180, characters 17-56
 |}]