diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml index cbbe7976d33..fbdafc4e7f5 100644 --- a/bin/describe/describe_workspace.ml +++ b/bin/describe/describe_workspace.ml @@ -630,15 +630,14 @@ let term : unit Term.t = (Memo.List.map ~f:(fun dir -> let p = Path.Source.(relative root) (Common.prefix_target common dir) in let s = Path.source p in - if not @@ Path.exists s - then + match Path.stat s with + | Ok { Unix.st_kind = Unix.S_DIR; _ } -> Memo.return p + | Ok _ -> User_error.raise - [ Pp.textf "No such file or directory: %s" (Path.to_string s) ]; - if not @@ Path.is_directory s - then + [ Pp.textf "File exists, but is not a directory: %s" (Path.to_string s) ] + | Error _ -> User_error.raise - [ Pp.textf "File exists, but is not a directory: %s" (Path.to_string s) ]; - Memo.return p)) + [ Pp.textf "No such file or directory: %s" (Path.to_string s) ])) >>= Crawl.workspace options setup context >>| Sanitize_for_tests.Workspace.sanitize context >>| Descr.Workspace.to_dyn options diff --git a/bin/dune_init.ml b/bin/dune_init.ml index 945925ad4c1..8e2a805a85b 100644 --- a/bin/dune_init.ml +++ b/bin/dune_init.ml @@ -118,24 +118,23 @@ module File = struct let name = "dune" in let full_path = Path.relative path name in let content = - if not (Path.exists full_path) - then [] - else if Path.is_directory full_path - then + match Path.stat full_path with + | Ok { Unix.st_kind = S_REG; _ } -> + (match Io.with_lexbuf_from_file ~f:Dune_lang.Format.parse full_path with + | Dune_lang.Format.Sexps content -> content + | Dune_lang.Format.OCaml_syntax _ -> + User_error.raise + [ Pp.textf + "Cannot load dune file %s because it uses OCaml syntax" + (Path.to_string_maybe_quoted full_path) + ]) + | Ok { Unix.st_kind = S_DIR; _ } -> User_error.raise [ Pp.textf "\"%s\" already exists and is a directory" (Path.to_absolute_filename full_path) ] - else ( - match Io.with_lexbuf_from_file ~f:Dune_lang.Format.parse full_path with - | Dune_lang.Format.Sexps content -> content - | Dune_lang.Format.OCaml_syntax _ -> - User_error.raise - [ Pp.textf - "Cannot load dune file %s because it uses OCaml syntax" - (Path.to_string_maybe_quoted full_path) - ]) + | _ -> [] in Dune { path; name; content } ;; diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml index 85f9a16b4db..06000231469 100644 --- a/bin/install_uninstall.ml +++ b/bin/install_uninstall.ml @@ -378,9 +378,9 @@ module File_ops_real (W : sig match Fpath.mkdir_p (Path.to_string p) with | Created -> () | Already_exists -> - (match Path.is_directory p with - | true -> () - | false -> + (match Path.stat_exn p with + | { Unix.st_kind = S_DIR; _ } -> () + | _ -> User_error.raise [ Pp.textf "Please delete file %s manually." (Path.to_string_maybe_quoted p) ]) ;; @@ -753,9 +753,11 @@ let install_uninstall ~what = if copy then let* () = - (match Path.is_directory dst with - | true -> Ops.remove_dir_if_exists ~if_non_empty:Fail dst - | false -> Ops.remove_file_if_exists dst); + (match Path.stat dst with + | Ok { Unix.st_kind = S_DIR; _ } -> + Ops.remove_dir_if_exists ~if_non_empty:Fail dst + | Ok { Unix.st_kind = S_REG; _ } -> Ops.remove_file_if_exists dst + | _ -> ()); print_line ~verbosity "%s %s" diff --git a/bin/ocaml/utop.ml b/bin/ocaml/utop.ml index b2c65a66c1a..23c77785c17 100644 --- a/bin/ocaml/utop.ml +++ b/bin/ocaml/utop.ml @@ -19,8 +19,12 @@ let term = and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in let config = Common.init common in let dir = Common.prefix_target common dir in - if not (Path.is_directory (Path.of_string dir)) - then User_error.raise [ Pp.textf "cannot find directory: %s" (String.maybe_quoted dir) ]; + let () = + match Path.stat (Path.of_string dir) with + | Ok { Unix.st_kind = S_DIR; _ } -> () + | _ -> + User_error.raise [ Pp.textf "cannot find directory: %s" (String.maybe_quoted dir) ] + in let sctx, utop_path = Scheduler.go ~common ~config (fun () -> let open Fiber.O in diff --git a/otherlibs/stdune/src/path.mli b/otherlibs/stdune/src/path.mli index 617cae062cd..a87437bdbdb 100644 --- a/otherlibs/stdune/src/path.mli +++ b/otherlibs/stdune/src/path.mli @@ -348,10 +348,6 @@ val readdir_unsorted_with_kinds Result.t val is_dir_sep : char -> bool - -(** [is_dir t] checks if [t] is a directory. It swallows permission errors so the preferred way is to use [stat] instead *) -val is_directory : t -> bool - val rmdir : t -> unit val unlink : t -> unit val unlink_no_err : t -> unit diff --git a/src/dune_engine/no_io.ml b/src/dune_engine/no_io.ml index 95066bb0b75..21716c85e6c 100644 --- a/src/dune_engine/no_io.ml +++ b/src/dune_engine/no_io.ml @@ -6,7 +6,6 @@ module Path = struct module Untracked = struct let exists = exists - let is_directory = is_directory let readdir_unsorted = readdir_unsorted let readdir_unsorted_with_kinds = readdir_unsorted_with_kinds let stat = stat diff --git a/src/dune_file_watcher/dune_file_watcher.ml b/src/dune_file_watcher/dune_file_watcher.ml index 500285925ea..9ebbbed3098 100644 --- a/src/dune_file_watcher/dune_file_watcher.ml +++ b/src/dune_file_watcher/dune_file_watcher.ml @@ -682,15 +682,16 @@ let wait_for_initial_watches_established_blocking t = (* Return the parent directory of [ext] if [ext] denotes a file. *) let parent_directory ext = let rec loop p = - if Path.is_directory (Path.external_ p) - then Some ext - else ( - match Path.External.parent p with - | None -> - User_warning.emit - [ Pp.textf "Refusing to watch %s" (Path.External.to_string ext) ]; - None - | Some ext -> loop ext) + match Path.stat (Path.external_ p) with + | Ok { Unix.st_kind = S_DIR; _ } -> Some p + | Ok { Unix.st_kind = S_REG; _ } -> + (match Path.External.parent p with + | None -> + User_warning.emit + [ Pp.textf "Refusing to watch %s" (Path.External.to_string ext) ]; + None + | Some p -> loop p) + | _ -> None in loop ext ;; diff --git a/src/dune_pkg/lock_dir.ml b/src/dune_pkg/lock_dir.ml index 77ac621da07..c259da381f3 100644 --- a/src/dune_pkg/lock_dir.ml +++ b/src/dune_pkg/lock_dir.ml @@ -352,19 +352,17 @@ module Write_disk = struct values indicate that it's unsafe to remove the existing directory and lock directory regeneration should not proceed. *) let check_existing_lock_dir path = - match Path.exists path with - | false -> Ok `Non_existant - | true -> - (match Path.is_directory path with - | false -> Error `Not_directory - | true -> - let metadata_path = Path.relative path metadata in - (match Path.exists metadata_path && not (Path.is_directory metadata_path) with - | false -> Error `No_metadata_file - | true -> - (match Metadata.load metadata_path ~f:(Fun.const (Decoder.return ())) with - | Ok () -> Ok `Is_existing_lock_dir - | Error exn -> Error (`Failed_to_parse_metadata exn)))) + match Path.stat path with + | Ok { Unix.st_kind = S_DIR; _ } -> + let metadata_path = Path.relative path metadata in + (match Path.stat metadata_path with + | Ok { Unix.st_kind = S_REG; _ } -> + (match Metadata.load metadata_path ~f:(Fun.const (Decoder.return ())) with + | Ok () -> Ok `Is_existing_lock_dir + | Error exn -> Error (`Failed_to_parse_metadata exn)) + | _ -> Error `No_metadata_file) + | Ok _ -> Error `Not_directory + | Error _ -> Ok `Non_existant ;; (* Removes the exitsing lock directory at the specified path if it exists and @@ -473,16 +471,14 @@ struct ;; let check_path lock_dir_path = - match Path.exists (Path.source lock_dir_path) with - | false -> + match Path.stat (Path.source lock_dir_path) with + | Ok { Unix.st_kind = S_DIR; _ } -> () + | Ok _ -> + User_error.raise + [ Pp.textf "%s is not a directory" (Path.Source.to_string lock_dir_path) ] + | Error _ -> User_error.raise [ Pp.textf "%s does not exist" (Path.Source.to_string lock_dir_path) ] - | true -> - (match Path.is_directory (Path.source lock_dir_path) with - | false -> - User_error.raise - [ Pp.textf "%s is not a directory" (Path.Source.to_string lock_dir_path) ] - | true -> ()) ;; let load lock_dir_path = diff --git a/src/dune_pkg/opam_repo.ml b/src/dune_pkg/opam_repo.ml index bdc1a4d1ae7..9b21c4c4857 100644 --- a/src/dune_pkg/opam_repo.ml +++ b/src/dune_pkg/opam_repo.ml @@ -55,26 +55,25 @@ let validate_repo_file opam_repo_dir_path = ;; let of_opam_repo_dir_path opam_repo_dir_path = - if not (Path.exists opam_repo_dir_path) - then - User_error.raise - [ Pp.textf "%s does not exist" (Path.to_string_maybe_quoted opam_repo_dir_path) ]; - if not (Path.is_directory opam_repo_dir_path) - then - User_error.raise - [ Pp.textf "%s is not a directory" (Path.to_string_maybe_quoted opam_repo_dir_path) - ]; let packages_dir_path = opam_repo_dir_path / "packages" in - if not (Path.exists packages_dir_path && Path.is_directory packages_dir_path) - then + match Path.stat opam_repo_dir_path, Path.stat packages_dir_path with + | Ok { Unix.st_kind = S_DIR; _ }, Ok { Unix.st_kind = S_DIR; _ } -> + validate_repo_file opam_repo_dir_path; + { packages_dir_path } + | Ok { Unix.st_kind = S_DIR; _ }, _ -> User_error.raise [ Pp.textf "%s doesn't look like a path to an opam repository as it lacks a subdirectory \ named \"packages\"" (Path.to_string_maybe_quoted opam_repo_dir_path) - ]; - validate_repo_file opam_repo_dir_path; - { packages_dir_path } + ] + | Ok _, _ -> + User_error.raise + [ Pp.textf "%s is not a directory" (Path.to_string_maybe_quoted opam_repo_dir_path) + ] + | Error _, _ -> + User_error.raise + [ Pp.textf "%s does not exist" (Path.to_string_maybe_quoted opam_repo_dir_path) ] ;; (* Return the path to the directory containing the version directories for a package name *)