refactor: typed Filename.t

bin/alias.ml

@@ -56,7 +56,7 @@ let of_string (root : Workspace_root.t) ~recursive s ~contexts =
       [ Pp.textf "@ on the command line must be followed by a valid alias name" ]
   else (
     let dir = Path.parent_exn path in
-    let name = Alias.Name.of_string (Path.basename path) in
+    let name = Alias.Name.of_string (Path.basename path |> Filename.to_string) in
     in_dir ~name ~recursive ~contexts dir)
 ;;
 

bin/describe/aliases_targets.ml

@@ -29,7 +29,8 @@ let ls_term (fetch_results : Path.Build.t -> string list Action_builder.t) =
                 if
                   Dune_engine.Context_name.equal
                     context
-                    (Dune_engine.Context_name.of_string dir_context_name)
+                    (Dune_engine.Context_name.of_string
+                       (Filename.to_string dir_context_name))
                 then d
                 else
                   User_error.raise
@@ -129,8 +130,9 @@ module Targets_cmd = struct
         *)
         Some
           (match kind with
-           | Target.File -> Path.Build.basename path
-           | Directory -> Path.Build.basename path ^ Filename.dir_sep))
+           | Target.File -> Path.Build.basename path |> Filename.to_string
+           | Directory ->
+             (Path.Build.basename path |> Filename.to_string) ^ Filename.dir_sep))
   ;;
 
   let term = ls_term fetch_results

bin/dune_init.ml

@@ -635,7 +635,7 @@ module Component = struct
             in
             [ File.make_text
                 ~dir:(Path.Source.parent_exn opam_file)
-                (Path.Source.basename opam_file)
+                (Path.Source.basename opam_file |> Filename.to_string)
                 content
             ]
           | Esy -> [ File.make_text ~dir "package.json" "" ]

bin/exec.ml

@@ -88,7 +88,7 @@ let not_found_with_suggestions ~dir ~prog =
       |> List.filter ~f:(fun filename ->
         let ext = Filename.extension filename in
         Filename.Extension.Or_empty.check ext Filename.Extension.exe)
-      |> List.map ~f:(fun filename -> "./" ^ filename)
+      |> List.map ~f:(fun filename -> "./" ^ Filename.to_string filename)
     in
     User_message.did_you_mean prog ~candidates
   in
@@ -124,6 +124,10 @@ let dir_of_context common sctx =
 ;;
 
 let get_path common sctx ~prog =
+  if
+    String.equal (Filename.basename prog) Filename.current_dir_name
+    || String.equal (Filename.basename prog) Filename.parent_dir_name
+  then not_found ~hints:[] ~prog;
   let open Memo.O in
   let dir = dir_of_context common sctx in
   match Filename.analyze_program_name prog with

bin/install_uninstall.ml

@@ -97,7 +97,7 @@ module Workspace = struct
       let name = Package.name p in
       let dir = Package.dir p in
       Ok
-        (Path.Source.relative
+        (Path.Source.relative_fname
            dir
            (Dune_rules.Install_rules.install_file ~package:name ~findlib_toolchain))
   ;;
@@ -134,7 +134,7 @@ module Special_file = struct
     match e.section with
     | Lib ->
       let dst = Install.Entry.Dst.to_string e.dst in
-      if dst = Dune_findlib.Findlib.Package.meta_fn
+      if String.equal dst (Filename.to_string Dune_findlib.Findlib.Package.meta_fn)
       then Some META
       else if dst = Dune_package.fn
       then Some Dune_package

bin/ocaml/ocaml_merlin.ml

@@ -102,13 +102,13 @@ end = struct
      this directory. *)
   let get_merlin_files_paths dir =
     let merlin_path =
-      Path.Build.relative dir Dune_rules.Merlin_ident.merlin_folder_name
+      Path.Build.relative_fname dir Dune_rules.Merlin_ident.merlin_folder_name
     in
     Path.build merlin_path
     |> Path.readdir_unsorted
     |> Result.value ~default:[]
-    |> List.sort ~compare:String.compare
-    |> List.map ~f:(fun f -> Path.Build.relative merlin_path f |> Path.build)
+    |> List.sort ~compare:Filename.compare
+    |> List.map ~f:(fun f -> Path.Build.relative_fname merlin_path f |> Path.build)
   ;;
 
   module Merlin = Dune_rules.Merlin

bin/ocaml/top.ml

@@ -118,7 +118,7 @@ module Module = struct
     then User_error.raise [ Pp.text "file is missing an extension" ];
     let open Memo.O in
     let module_name =
-      let name = Filename.remove_extension filename in
+      let name = Filename.remove_extension filename |> Filename.to_string in
       Dune_lang.Module_name.of_string_user_error (Loc.none, name) |> User_error.ok_exn
     in
     let* expander = Super_context.expander sctx ~dir in

bin/print_rules.ml

@@ -207,7 +207,7 @@ let action_repr =
 
 let target_names ~root names =
   Filename.Set.to_list_map names ~f:(fun name ->
-    Path.Build.relative root name |> Path.Build.to_string)
+    Path.Build.relative_fname root name |> Path.Build.to_string)
 ;;
 
 let targets_repr =
@@ -223,7 +223,7 @@ let targets_repr =
 let rule_context (rule : Dune_engine.Reflection.Rule.t) =
   match Path.Build.extract_build_context rule.targets.Targets.Validated.root with
   | None -> None
-  | Some (context, _) -> Some context
+  | Some (context, _) -> Some (Filename.to_string context)
 ;;
 
 let rule_repr =

bin/runtest_common.ml

@@ -57,7 +57,7 @@ let find_cram_test cram_tests path =
     - [Error `Not_a_test] if not part of any test stanza *)
 let classify_ml_test ~sctx ~dir ~ml_file =
   let open Memo.O in
-  let ml_file_no_ext = Filename.remove_extension ml_file in
+  let ml_file_no_ext = Filename.remove_extension ml_file |> Filename.to_string in
   match Dune_lang.Module_name.of_string_opt ml_file_no_ext with
   | None -> Memo.return (Error `Not_a_test)
   | Some module_name ->
@@ -108,6 +108,7 @@ let all_tests_of_dir ~sctx parent_dir =
       |> Filename.Array.Set.to_list
       |> Memo.List.filter ~f:(fun ml_file ->
         classify_ml_test ~sctx ~dir:parent_dir ~ml_file >>| Result.is_ok)
+      >>| Filename.L.to_string
   and+ dir_candidates =
     let* parent_source_dir = Source_tree.find_dir parent_dir in
     match parent_source_dir with
@@ -158,7 +159,7 @@ let disambiguate_test_name ~sctx path =
           User_error.raise
             [ Pp.textf
                 "%S is used by multiple test executables and cannot be run directly."
-                filename
+                (Filename.to_string filename)
             ]
         | Error `Not_a_test ->
           (* Assume the user intended a directory for @runtest to be used. *)
@@ -182,7 +183,9 @@ let make_request ~scontexts ~to_cwd ~test_paths =
       | In_source_dir dir ->
         (* We need to adjust the path here to make up for the current working directory. *)
         let dir =
-          Path.Source.L.relative Path.Source.root (to_cwd @ Path.Source.explode dir)
+          Path.Source.L.relative
+            Path.Source.root
+            (to_cwd @ (Path.Source.explode dir |> Filename.L.to_string))
         in
         let sctx =
           match Context_name.Map.find scontexts Context_name.default with

bin/subst.ml

@@ -193,7 +193,7 @@ module Dune_project = struct
     ; project : Dune_project.t
     }
 
-  let filename = Path.Source.of_string Dune_project.filename
+  let filename = Path.Source.of_string (Filename.to_string Dune_project.filename)
 
   let load ~dir ~files ~infer_from_opam_files =
     let open Memo.O in
@@ -364,7 +364,7 @@ let subst vcs =
                  |> Filename.Array.Set.fold
                       ~init:Path.Source.Set.empty
                       ~f:(fun fname acc ->
-                        Path.Source.relative (Source_tree.Dir.path dir) fname
+                        Path.Source.relative_fname (Source_tree.Dir.path dir) fname
                         |> Path.Source.Set.add acc)
                  |> Memo.return)
        in
@@ -380,8 +380,7 @@ let subst vcs =
          (* Filter-out files form sub-directories *)
          List.filter_map files ~f:(fun fn ->
            let fn = Path.source fn in
-           (* CR-soon rgrinberg: this conversion to string looks wrong *)
-           if Path.is_root (Path.parent_exn fn) then Some (Path.to_string fn) else None)
+           if Path.is_root (Path.parent_exn fn) then Some (Path.basename fn) else None)
          |> Filename.Array.Set.of_list
        in
        Dune_project.load ~dir:Path.Source.root ~files ~infer_from_opam_files:true)

bin/workspace_root.ml

@@ -17,7 +17,7 @@ module Kind = struct
   let lowest_priority = max_int
 
   let of_dir_contents files =
-    if String.Set.mem files Source.Workspace.filename
+    if Filename.Set.mem files Source.Workspace.filename
     then Some Dune_workspace
     else if Filename.Set.mem files Dune_lang.Dune_project.filename
     then Some Dune_project
@@ -56,7 +56,9 @@ let find from =
         ];
       candidate
     | files ->
-      let files = String.Set.of_list (Array.to_list files) in
+      let files =
+        Array.to_list files |> List.map ~f:Filename.of_string_exn |> Filename.Set.of_list
+      in
       let candidate =
         let candidate_priority =
           match candidate with

otherlibs/stdune/src/filename.ml

@@ -2,11 +2,39 @@ include Stdlib.Filename
 
 type t = string
 
-let repr = Repr.string
+let is_valid s =
+  (not (String.is_empty s))
+  && (not (String.equal s current_dir_name))
+  && (not (String.equal s parent_dir_name))
+  && not (String.contains s '/')
+;;
+
+let of_string s = Option.some_if (is_valid s) s
+
+let of_string_exn s =
+  match of_string s with
+  | Some t -> t
+  | None ->
+    Code_error.raise
+      "Filename.of_string_exn: invalid filename"
+      [ "filename", Dyn.string s ]
+;;
+
+let to_string t = t
+let append dir t = concat dir (to_string t)
+let to_dyn t = Dyn.string (to_string t)
+let pp t = Pp.text (to_string t)
+let remove_extension t = Stdlib.Filename.remove_extension t
+let repr = Repr.view Repr.string ~to_:to_string
+
+module L = struct
+  let to_string t = t
+end
 
 module Extension = struct
   type t = string
 
+  let filename_of_string_exn = of_string_exn
   let corrected = ".corrected"
   let ml = ".ml"
   let mli = ".mli"
@@ -29,6 +57,7 @@ module Extension = struct
   let cmi_dump = ".cmi.dump"
   let cmo_dump = ".cmo.dump"
   let exe = ".exe"
+  let expected = ".expected"
   let bc = ".bc"
   let bc_exe = ".bc.exe"
   let ml_gen = ".ml-gen"
@@ -37,6 +66,7 @@ module Extension = struct
   let cms = ".cms"
   let cmsi = ".cmsi"
   let odoc = ".odoc"
+  let opam = ".opam"
   let d = ".d"
   let js = ".js"
   let h = ".h"
@@ -59,6 +89,7 @@ module Extension = struct
   ;;
 
   let to_string t = t
+  let to_filename t = filename_of_string_exn t
   let compare = String.compare
   let equal = String.equal
   let hash = String.hash
@@ -93,6 +124,12 @@ module Extension = struct
     let is_empty s = s = empty
     let is_extension s = not (is_empty s)
 
+    let drop_suffix string t =
+      if is_empty t
+      then string
+      else String.sub string ~pos:0 ~len:(String.length string - String.length t)
+    ;;
+
     let extension = function
       | "" -> None
       | s -> Some s
@@ -105,19 +142,67 @@ module Extension = struct
   end
 end
 
+let actions_dir_basename = ".actions"
+let bin_dir_basename = ".bin"
+let cc_vendor = "cc_vendor"
+let cinaps_corrected = ".cinaps-corrected"
+let checksum = "checksum"
+let coqc = "coqc"
+let corrected = Extension.to_filename Extension.corrected
+let dev_tool_dir_basename = ".dev-tool"
+let dev_tool_locks_dir_basename = ".dev-tool-locks"
+let doc_dir_basename = "_doc"
+let doc_new_dir_basename = "_doc_new"
+let dune = "dune"
+let dune_dir_basename = ".dune"
+let dune_file = "dune-file"
+let dune_project = "dune-project"
+let dune_workspace = "dune-workspace"
+let expected = Extension.to_filename Extension.expected
+let fdo_profile = ".fdo-profile"
+let formatted_dir_basename = ".formatted"
+let generated = ".generated"
+let git_dir_basename = ".git"
+let gmake = "gmake"
+let hg_dir_basename = ".hg"
+let jbuild = "jbuild"
+let json = Extension.to_filename Extension.json
+let js_dir_basename = Extension.to_filename Extension.js
+let lock_dune = "lock.dune"
+let linker_script = ".linker-script"
+let lock_dir_basename = ".lock"
+let make = "make"
+let mdx_deps = ".mdx.deps"
+let merlin_conf_dir_basename = ".merlin-conf"
+let meta = "META"
+let ocamlfind = "ocamlfind"
+let opam = "opam"
+let ppx_dir_basename = ".ppx"
+let pkg_dir_basename = ".pkg"
+let rocq = "rocq"
+let run_t = "run.t"
+let template = ".template"
+let topmod_dir_basename = ".topmod"
+let url = "url"
+let utop_dir_basename = ".utop"
+let findlib_conf = "findlib.conf"
+let extension fn = Stdlib.Filename.extension fn |> Extension.Or_empty.of_string_exn
+
 let split_extension fn =
   let ext = extension fn in
-  if String.is_empty ext
-  then fn, Extension.Or_empty.empty
-  else String.sub fn ~pos:0 ~len:(String.length fn - String.length ext), ext
+  Extension.Or_empty.drop_suffix fn ext, ext
 ;;
 
 let split_extension_after_dot fn =
-  match extension fn with
+  match Extension.Or_empty.to_string (extension fn) with
   | "" -> fn, ""
   | s -> String.split_n fn (String.length fn - String.length s + 1)
 ;;
 
+let add_extension fn ext = fn ^ Extension.to_string ext
+let set_extension fn ext = add_extension (remove_extension fn) ext
+let extend fn ~suffix = fn ^ suffix
+
 type program_name_kind =
   | In_path
   | Relative_to_current_dir
@@ -133,6 +218,7 @@ let analyze_program_name fn =
 
 let compare = String.compare
 let equal = String.equal
+let hash = String.hash
 let chop_extension = `Use_remove_extension
 
 module Set = String.Set
@@ -143,5 +229,5 @@ module Array = Array0.Sorted.Make (struct
     type nonrec t = t
 
     let compare = compare
-    let to_dyn = Dyn.string
+    let to_dyn t = Dyn.string (to_string t)
   end)