From 7820e29d288a839f8f816f1d3d2b8499efb3d633 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 25 Apr 2018 03:25:27 +0700 Subject: [PATCH] Port Io to use Path.t --- bin/main.ml | 11 ++++++----- src/action.ml | 37 ++++++++++++++++-------------------- src/build_system.ml | 27 ++++++++++++-------------- src/config.ml | 11 ++++++----- src/config.mli | 4 ++-- src/configurator/v1.ml | 15 ++++++++------- src/file_tree.ml | 5 +++-- src/findlib.ml | 6 +++--- src/installed_dune_file.ml | 2 +- src/installed_dune_file.mli | 2 +- src/jbuild.ml | 2 +- src/jbuild_load.ml | 19 +++++++++--------- src/lib.ml | 3 +-- src/log.ml | 2 +- src/main.ml | 4 ++-- src/main.mli | 2 +- src/meta.ml | 4 ++-- src/meta.mli | 2 +- src/opam_file.ml | 2 +- src/opam_file.mli | 4 +++- src/process.ml | 9 ++++++--- src/stdune/io.ml | 26 +++++++++++++------------ src/stdune/io.mli | 26 ++++++++++++------------- src/stdune/path.ml | 3 +++ src/stdune/path.mli | 1 + src/utils.ml | 6 +++--- src/vfile_kind.ml | 2 +- src/watermarks.ml | 19 +++++++++--------- src/workspace.ml | 2 +- src/workspace.mli | 2 +- test/blackbox-tests/cram.mll | 4 +++- test/unit-tests/tests.mlt | 3 ++- 32 files changed, 138 insertions(+), 129 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index eddd8876..6323efef 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -75,7 +75,7 @@ module Main = struct let setup ~log ?external_lib_deps_mode common = setup ~log - ?workspace_file:common.workspace_file + ?workspace_file:(Option.map ~f:Path.of_string common.workspace_file) ?only_packages:common.only_packages ?external_lib_deps_mode ?x:common.x @@ -182,7 +182,7 @@ let help_secs = type config_file = | No_config | Default - | This of string + | This of Path.t let incompatible a b = `Error (true, @@ -234,7 +234,7 @@ let common = let config = match config_file with | No_config -> Config.default - | This fname -> Config.load_config_file ~fname + | This fname -> Config.load_config_file fname | Default -> if Config.inside_dune then Config.default @@ -410,7 +410,7 @@ let common = let merge config_file no_config = match config_file, no_config with | None , false -> `Ok (None , Default) - | Some fn, false -> `Ok (Some "--config-file", This fn) + | Some fn, false -> `Ok (Some "--config-file", This (Path.of_string fn)) | None , true -> `Ok (Some "--no-config" , No_config) | Some _ , true -> incompatible "--no-config" "--config-file" in @@ -455,7 +455,7 @@ let common = else [] ; (match config_file with - | This fn -> ["--config-file"; fn] + | This fn -> ["--config-file"; Path.to_string fn] | No_config -> ["--no-config"] | Default -> []) ] @@ -859,6 +859,7 @@ let rules = ] in let go common out recursive makefile_syntax targets = + let out = Option.map ~f:Path.of_string out in set_common common ~targets; let log = Log.create common in Scheduler.go ~log ~common diff --git a/src/action.ml b/src/action.ml index 6dc2f76f..143a428b 100644 --- a/src/action.ml +++ b/src/action.ml @@ -641,17 +641,15 @@ module Promotion = struct Format.eprintf "Promoting %s to %s.@." (Path.to_string_maybe_quoted src) (Path.to_string_maybe_quoted dst); - Io.copy_file - ~src:(Path.to_string src) - ~dst:(Path.to_string dst) + Io.copy_file ~src ~dst end - let db_file = "_build/.to-promote" + let db_file = Path.of_string "_build/.to-promote" let dump_db db = if Sys.file_exists "_build" then begin match db with - | [] -> if Sys.file_exists db_file then Sys.remove db_file + | [] -> if Path.is_file db_file then Path.unlink_no_err db_file | l -> Io.write_file db_file (String.concat ~sep:"" @@ -659,8 +657,8 @@ module Promotion = struct end let load_db () = - if Sys.file_exists db_file then - Io.Sexp.load ~fname:db_file ~mode:Many + if Path.is_file db_file then + Io.Sexp.load db_file ~mode:Many |> List.map ~f:File.t else [] @@ -765,7 +763,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec t ~ectx ~dir ~stdout_to ~stderr_to ~env:(Env.add env ~var ~value) | Redirect (Stdout, fn, Echo s) -> - Io.write_file (Path.to_string fn) s; + Io.write_file fn s; Fiber.return () | Redirect (outputs, fn, Run (Ok prog, args)) -> let out = Process.File (Path.to_string fn) in @@ -784,7 +782,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to | Echo str -> exec_echo stdout_to str | Cat fn -> - Io.with_file_in (Path.to_string fn) ~f:(fun ic -> + Io.with_file_in fn ~f:(fun ic -> let oc = match stdout_to with | None -> stdout @@ -793,11 +791,11 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = Io.copy_channels ic oc); Fiber.return () | Copy (src, dst) -> - Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst); + Io.copy_file ~src ~dst; Fiber.return () | Symlink (src, dst) -> if Sys.win32 then - Io.copy_file ~src:(Path.to_string src) ~dst:(Path.to_string dst) + Io.copy_file ~src ~dst else begin let src = if Path.is_root dst then @@ -818,8 +816,8 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = end; Fiber.return () | Copy_and_add_line_directive (src, dst) -> - Io.with_file_in (Path.to_string src) ~f:(fun ic -> - Io.with_file_out (Path.to_string dst) ~f:(fun oc -> + Io.with_file_in src ~f:(fun ic -> + Io.with_file_out dst ~f:(fun oc -> let fn = Path.drop_optional_build_context src in let directive = if List.mem (Path.extension fn) ~set:[".c"; ".cpp"; ".h"] then @@ -840,7 +838,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = (Utils.bash_exn ~needed_to:"interpret (bash ...) actions") ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] | Write_file (fn, s) -> - Io.write_file (Path.to_string fn) s; + Io.write_file fn s; Fiber.return () | Rename (src, dst) -> Unix.rename (Path.to_string src) (Path.to_string dst); @@ -870,7 +868,7 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = exec_echo stdout_to s | Diff { optional; file1; file2 } -> if (optional && not (Path.exists file1 && Path.exists file2)) || - Io.compare_files (Path.to_string file1) (Path.to_string file2) = Eq then + Io.compare_files file1 file2 = Eq then Fiber.return () else begin let is_copied_from_source_tree file = @@ -892,21 +890,18 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to = List.fold_left ~init:(String.Set.of_list extras) ~f:(fun set source_path -> - Path.to_string source_path - |> Io.lines_of_file + Io.lines_of_file source_path |> String.Set.of_list |> String.Set.union set ) sources in - Io.write_lines - (Path.to_string target) - (String.Set.to_list lines); + Io.write_lines target (String.Set.to_list lines); Fiber.return () and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to = - let fn = Path.to_string fn in let oc = Io.open_out fn in + let fn = Path.to_string fn in let out = Some (fn, oc) in let stdout_to, stderr_to = match outputs with diff --git a/src/build_system.ml b/src/build_system.ml index 57000e14..dfb9205f 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -14,13 +14,13 @@ let misc_dir = Path.(relative build_dir) ".misc" module Promoted_to_delete = struct let db = ref [] - let fn = "_build/.to-delete-in-source-tree" + let fn = Path.of_string "_build/.to-delete-in-source-tree" let add p = db := p :: !db let load () = - if Sys.file_exists fn then - Io.Sexp.load ~fname:fn ~mode:Many + if Path.is_file fn then + Io.Sexp.load fn ~mode:Many |> List.map ~f:Path.t else [] @@ -460,8 +460,8 @@ module Build_exec = struct | Paths _ -> x | Paths_for_rule _ -> x | Paths_glob state -> get_glob_result_exn state - | Contents p -> Io.read_file (Path.to_string p) - | Lines_of p -> Io.lines_of_file (Path.to_string p) + | Contents p -> Io.read_file p + | Lines_of p -> Io.lines_of_file p | Vpath (Vspec.T (fn, kind)) -> let file : b File_spec.t = get_file bs fn (Sexp_file kind) in Option.value_exn file.data @@ -766,9 +766,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule = let in_source_tree = Option.value_exn (Path.drop_build_context path) in if mode = Promote_but_delete_on_clean then Promoted_to_delete.add in_source_tree; - Io.copy_file - ~src:(Path.to_string path) - ~dst:(Path.to_string in_source_tree))); + Io.copy_file ~src:path ~dst:in_source_tree)); t.hook Rule_completed end else begin t.hook Rule_completed; @@ -1108,7 +1106,7 @@ let stamp_file_for_files_of t ~dir ~ext = module Trace = struct type t = (Path.t, Digest.t) Hashtbl.t - let file = "_build/.db" + let file = Path.of_string "_build/.db" let dump (trace : t) = let sexp = @@ -1125,8 +1123,8 @@ module Trace = struct let load () = let trace = Hashtbl.create 1024 in - if Sys.file_exists file then begin - let sexp = Io.Sexp.load ~fname:file ~mode:Single in + if Path.is_file file then begin + let sexp = Io.Sexp.load file ~mode:Single in let bindings = let open Sexp.Of_sexp in list (pair Path.t (fun s -> Digest.from_hex (string s))) sexp @@ -1204,15 +1202,14 @@ let universe_file = Path.relative Path.build_dir ".universe-state" let update_universe t = (* To workaround the fact that [mtime] is not precise enough on OSX *) Utils.Cached_digest.remove universe_file; - let fname = Path.to_string universe_file in let n = - if Sys.file_exists fname then - Sexp.Of_sexp.int (Io.Sexp.load ~mode:Single ~fname) + 1 + if Path.is_file universe_file then + Sexp.Of_sexp.int (Io.Sexp.load ~mode:Single universe_file) + 1 else 0 in make_local_dirs t (Pset.singleton Path.build_dir); - Io.write_file fname (Sexp.to_string (Sexp.To_sexp.int n)) + Io.write_file universe_file (Sexp.to_string (Sexp.To_sexp.int n)) let do_build t ~request = entry_point t ~f:(fun () -> diff --git a/src/config.ml b/src/config.ml index 9e5dc406..b996c5ac 100644 --- a/src/config.ml +++ b/src/config.ml @@ -78,14 +78,15 @@ let t = ; concurrency }) -let user_config_file = Filename.concat Xdg.config_dir "dune/config" +let user_config_file = + Path.relative (Path.of_string Xdg.config_dir) "dune/config" -let load_config_file ~fname = - t (Io.Sexp.load_many_as_one ~fname) +let load_config_file p = + t (Io.Sexp.load_many_as_one p) let load_user_config_file () = - if Sys.file_exists user_config_file then - load_config_file ~fname:user_config_file + if Path.is_file user_config_file then + load_config_file user_config_file else default diff --git a/src/config.mli b/src/config.mli index 2f50db62..ee7787e9 100644 --- a/src/config.mli +++ b/src/config.mli @@ -52,9 +52,9 @@ val t : t Sexp.Of_sexp.t val merge : t -> Partial.t -> t val default : t -val user_config_file : string +val user_config_file : Path.t val load_user_config_file : unit -> t -val load_config_file : fname:string -> t +val load_config_file : Path.t -> t (** Set display mode to [Quiet] if it is [Progress], the output is not a tty and we are not running inside emacs. *) diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index f0b68e56..d96e27ec 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -144,8 +144,8 @@ let run t ~dir cmd = (Filename.quote stdout_fn) (Filename.quote stderr_fn) in - let stdout = Io.read_file stdout_fn in - let stderr = Io.read_file stderr_fn in + let stdout = Io.read_file (Path.of_string stdout_fn) in + let stderr = Io.read_file (Path.of_string stderr_fn) in logf t "-> process exited with code %d" exit_code; logf t "-> stdout:"; List.iter (String.split_lines stdout) ~f:(logf t " | %s"); @@ -239,7 +239,7 @@ let compile_and_link_c_prog t ?(c_flags=[]) ?(link_flags=[]) code = let c_fname = base ^ ".c" in let obj_fname = base ^ t.ext_obj in let exe_fname = base ^ ".exe" in - Io.write_file c_fname code; + Io.write_file (Path.of_string c_fname) code; logf t "compiling c program:"; List.iter (String.split_lines code) ~f:(logf t " | %s"); let run_ok args = @@ -269,7 +269,7 @@ let compile_c_prog t ?(c_flags=[]) code = let base = dir ^/ "test" in let c_fname = base ^ ".c" in let obj_fname = base ^ t.ext_obj in - Io.write_file c_fname code; + Io.write_file (Path.of_string c_fname) code; logf t "compiling c program:"; List.iter (String.split_lines code) ~f:(logf t " | %s"); let run_ok args = @@ -286,7 +286,7 @@ let compile_c_prog t ?(c_flags=[]) code = ] ]) in - if ok then Ok obj_fname else Error () + if ok then Ok (Path.of_string obj_fname) else Error () let c_test t ?c_flags ?link_flags code = match compile_and_link_c_prog t ?c_flags ?link_flags code with @@ -415,7 +415,7 @@ const char *s%i = "BEGIN-%i-false-END"; logf t "writing header file %s" fname; List.iter lines ~f:(logf t " | %s"); let tmp_fname = fname ^ ".tmp" in - Io.write_lines tmp_fname lines; + Io.write_lines (Path.of_string tmp_fname) lines; Sys.rename tmp_fname fname end @@ -481,8 +481,9 @@ module Pkg_config = struct end let write_flags fname s = + let path = Path.of_string fname in let sexp = Usexp.List(List.map ~f:Usexp.atom_or_quoted_string s) in - Io.write_file fname (Usexp.to_string sexp) + Io.write_file path (Usexp.to_string sexp) let main ?(args=[]) ~name f = let ocamlc = ref ( diff --git a/src/file_tree.ml b/src/file_tree.ml index 20272254..1364eefd 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -62,7 +62,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = let files = String.Set.of_list files in let ignored_sub_dirs = if not ignored && String.Set.mem files "jbuild-ignore" then - let ignore_file = Path.to_string (Path.relative path "jbuild-ignore") in + let ignore_file = Path.relative path "jbuild-ignore" in let files = Io.lines_of_file ignore_file in @@ -70,7 +70,8 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path = if Filename.dirname fn = Filename.current_dir_name then true else begin - Loc.(warn (of_pos (ignore_file, index + 1, 0, String.length fn)) + Loc.(warn (of_pos ( Path.to_string ignore_file + , index + 1, 0, String.length fn)) "subdirectory expression %s ignored" fn); false end diff --git a/src/findlib.ml b/src/findlib.ml index 107a7cc0..e534ed3b 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -99,7 +99,7 @@ module Config = struct if not (Path.exists conf_file) then die "@{Error@}: ocamlfind toolchain %s isn't defined in %a \ (context: %s)" toolchain Path.pp path context; - let vars = (Meta.load ~name:"" ~fn:(Path.to_string conf_file)).vars in + let vars = (Meta.load ~name:"" conf_file).vars in { vars = String.Map.map vars ~f:Rules.of_meta_rules ; preds = Ps.make [toolchain] } @@ -266,14 +266,14 @@ let find_and_acknowledge_meta t ~fq_name = if Path.exists fn then Some (sub_dir, fn, - Meta.load ~name:root_name ~fn:(Path.to_string fn)) + Meta.load ~name:root_name fn) else (* Alternative layout *) let fn = Path.relative dir ("META." ^ root_name) in if Path.exists fn then Some (dir, fn, - Meta.load ~fn:(Path.to_string fn) ~name:root_name) + Meta.load fn ~name:root_name) else loop dirs | [] -> diff --git a/src/installed_dune_file.ml b/src/installed_dune_file.ml index 8dde3ae8..c2a9b4e3 100644 --- a/src/installed_dune_file.ml +++ b/src/installed_dune_file.ml @@ -39,7 +39,7 @@ let of_sexp = (fun () l -> parse_sub_systems l) ] -let load ~fname = of_sexp (Io.Sexp.load ~mode:Single ~fname) +let load fname = of_sexp (Io.Sexp.load ~mode:Single fname) let gen confs = let sexps = diff --git a/src/installed_dune_file.mli b/src/installed_dune_file.mli index 18425920..d498cb00 100644 --- a/src/installed_dune_file.mli +++ b/src/installed_dune_file.mli @@ -2,5 +2,5 @@ open Stdune -val load : fname:string -> Jbuild.Sub_system_info.t Sub_system_name.Map.t +val load : Path.t -> Jbuild.Sub_system_info.t Sub_system_name.Map.t val gen : (Syntax.Version.t * Sexp.t) Sub_system_name.Map.t -> Sexp.t diff --git a/src/jbuild.ml b/src/jbuild.ml index f41befb1..e599b34e 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -1244,7 +1244,7 @@ module Stanzas = struct (Path.to_string_maybe_quoted file); if List.exists include_stack ~f:(fun (_, f) -> f = file) then raise (Include_loop (file, include_stack)); - let sexps = Io.Sexp.load ~fname:(Path.to_string file) ~mode:Many in + let sexps = Io.Sexp.load file ~mode:Many in parse pkgs sexps ~default_version:Jbuild_version.V1 ~file ~include_stack) ; cstr "documentation" (Documentation.v1 pkgs @> nil) (fun d -> [Documentation d]) diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 018f776f..aee09def 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -33,7 +33,7 @@ module Jbuilds = struct type requires = No_requires | Unix - let extract_requires ~fname str = + let extract_requires path str = let rec loop n lines acc = match lines with | [] -> acc @@ -48,7 +48,7 @@ module Jbuilds = struct | _ -> let start = { Lexing. - pos_fname = fname + pos_fname = Path.to_string path ; pos_lnum = n ; pos_cnum = 0 ; pos_bol = 0 @@ -64,9 +64,8 @@ module Jbuilds = struct loop 1 (String.split str ~on:'\n') No_requires let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target = - let plugin = Path.to_string plugin in let plugin_contents = Io.read_file plugin in - Io.with_file_out (Path.to_string wrapper) ~f:(fun oc -> + Io.with_file_out wrapper ~f:(fun oc -> let ocamlc_config = let vars = Ocaml_config.to_list context.ocaml_config @@ -105,8 +104,8 @@ end context.version_string ocamlc_config (Path.reach ~from:exec_dir target) - plugin plugin_contents); - extract_requires ~fname:plugin plugin_contents + (Path.to_string plugin) plugin_contents); + extract_requires plugin plugin_contents let eval { jbuilds; ignore_promoted_rules } ~(context : Context.t) = let open Fiber.O in @@ -157,7 +156,7 @@ end die "@{Error:@} %s failed to produce a valid jbuild file.\n\ Did you forgot to call [Jbuild_plugin.V*.send]?" (Path.to_string file); - let sexps = Io.Sexp.load ~fname:(Path.to_string generated_jbuild) ~mode:Many in + let sexps = Io.Sexp.load generated_jbuild ~mode:Many in Fiber.return (dir, scope, Stanzas.parse scope sexps ~file:generated_jbuild |> filter_stanzas ~ignore_promoted_rules)) >>| fun dynamic -> @@ -183,7 +182,7 @@ module Sexp_io = struct let load_many_or_ocaml_script fname = Io.with_file_in fname ~f:(fun ic -> - let state = Parser.create ~fname ~mode:Many in + let state = Parser.create ~fname:(Path.to_string fname) ~mode:Many in let buf = Bytes.create Io.buf_len in let rec loop stack = match input ic buf 0 Io.buf_len with @@ -212,7 +211,7 @@ end let load ~dir ~scope ~ignore_promoted_rules = let file = Path.relative dir "jbuild" in - match Sexp_io.load_many_or_ocaml_script (Path.to_string file) with + match Sexp_io.load_many_or_ocaml_script file with | Sexps sexps -> Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps ~file @@ -230,7 +229,7 @@ let load ?extra_ignored_subtrees ?(ignore_promoted_rules=false) () = match Filename.split_extension fn with | (pkg, ".opam") when pkg <> "" -> let version_from_opam_file = - let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in + let opam = Opam_file.load (Path.relative path fn) in match Opam_file.get_field opam "version" with | Some (String (_, s)) -> Some s | _ -> None diff --git a/src/lib.ml b/src/lib.ml index 7c0bc0aa..a3967af1 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -123,8 +123,7 @@ module Info = struct let sub_systems = match P.dune_file pkg with | None -> Sub_system_name.Map.empty - | Some fn -> - Installed_dune_file.load ~fname:(Path.to_string fn) + | Some fn -> Installed_dune_file.load fn in { loc = loc ; kind = Normal diff --git a/src/log.ml b/src/log.ml index 3297b850..c78811d3 100644 --- a/src/log.ml +++ b/src/log.ml @@ -14,7 +14,7 @@ let no_log = None let create ?(display=Config.default.display) () = if not (Sys.file_exists "_build") then Unix.mkdir "_build" 0o777; - let oc = Io.open_out "_build/log" in + let oc = Io.open_out (Path.of_string "_build/log") in Printf.fprintf oc "# %s\n# OCAMLPARAM: %s\n%!" (String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ") (match Env.get Env.initial "OCAMLPARAM" with diff --git a/src/main.ml b/src/main.ml index 4edc096e..81a3004b 100644 --- a/src/main.ml +++ b/src/main.ml @@ -30,7 +30,7 @@ let setup_env ~capture_outputs = let setup ?(log=Log.no_log) ?external_lib_deps_mode - ?workspace ?(workspace_file="jbuild-workspace") + ?workspace ?(workspace_file=Path.of_string "jbuild-workspace") ?only_packages ?extra_ignored_subtrees ?x @@ -55,7 +55,7 @@ let setup ?(log=Log.no_log) match workspace with | Some w -> w | None -> - if Sys.file_exists workspace_file then + if Path.is_file workspace_file then Workspace.load ?x workspace_file else { merlin_context = Some "default" diff --git a/src/main.mli b/src/main.mli index a98a9c90..3c22f0b6 100644 --- a/src/main.mli +++ b/src/main.mli @@ -20,7 +20,7 @@ val setup : ?log:Log.t -> ?external_lib_deps_mode:bool -> ?workspace:Workspace.t - -> ?workspace_file:string + -> ?workspace_file:Path.t -> ?only_packages:Package.Name.Set.t -> ?x:string -> ?ignore_promoted_rules:bool diff --git a/src/meta.ml b/src/meta.ml index a216c6d8..b9f57635 100644 --- a/src/meta.ml +++ b/src/meta.ml @@ -170,10 +170,10 @@ let rec simplify t = in { pkg with vars = String.Map.add pkg.vars rule.var rules }) -let load ~fn ~name = +let load p ~name = { name ; entries = - Io.with_lexbuf_from_file fn ~f:(fun lb -> + Io.with_lexbuf_from_file p ~f:(fun lb -> Parse.entries lb 0 []) } |> simplify diff --git a/src/meta.mli b/src/meta.mli index 9d3c9d5a..8c38f9da 100644 --- a/src/meta.mli +++ b/src/meta.mli @@ -42,7 +42,7 @@ module Simplified : sig val pp : Format.formatter -> t -> unit end -val load : fn:string -> name:string -> Simplified.t +val load : Path.t -> name:string -> Simplified.t (** Builtin META files for libraries distributed with the compiler. For when ocamlfind is not installed. *) diff --git a/src/opam_file.ml b/src/opam_file.ml index db518188..e6022100 100644 --- a/src/opam_file.ml +++ b/src/opam_file.ml @@ -6,7 +6,7 @@ type t = opamfile let load fn = Io.with_lexbuf_from_file fn ~f:(fun lb -> try - OpamBaseParser.main OpamLexer.token lb fn + OpamBaseParser.main OpamLexer.token lb (Path.to_string fn) with | OpamLexer.Error msg -> Loc.fail_lex lb "%s" msg diff --git a/src/opam_file.mli b/src/opam_file.mli index ecb7a964..9878cc5a 100644 --- a/src/opam_file.mli +++ b/src/opam_file.mli @@ -1,12 +1,14 @@ (** Parsing and interpretation of opam files *) +open Stdune + open OpamParserTypes (** Type of opam files *) type t = opamfile (** Load a file *) -val load : string -> t +val load : Path.t -> t (** Extracts a field *) val get_field : t -> string -> value option diff --git a/src/process.ml b/src/process.ml index c1077f9e..bde8d5c8 100644 --- a/src/process.ml +++ b/src/process.ml @@ -255,7 +255,7 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose match output_filename with | None -> "" | Some fn -> - let s = Io.read_file fn in + let s = Io.read_file (Path.of_string fn) in Temp.destroy fn; let len = String.length s in if len > 0 && s.[len - 1] <> '\n' then @@ -329,11 +329,14 @@ let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f = Temp.destroy fn; x) -let run_capture = run_capture_gen ~f:Io.read_file -let run_capture_lines = run_capture_gen ~f:Io.lines_of_file +let run_capture = + run_capture_gen ~f:(fun p -> Io.read_file (Path.of_string p)) +let run_capture_lines = + run_capture_gen ~f:(fun p -> Io.lines_of_file (Path.of_string p)) let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args = run_capture_gen ?dir ~env ~purpose fail_mode prog args ~f:(fun fn -> + let fn = Path.of_string fn in match Io.lines_of_file fn with | [x] -> x | l -> diff --git a/src/stdune/io.ml b/src/stdune/io.ml index 74ba8cb9..8a828ea0 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -1,9 +1,11 @@ module P = Pervasives -let open_in ?(binary=true) fn = +let open_in ?(binary=true) p = + let fn = Path.to_string p in if binary then P.open_in_bin fn else P.open_in fn -let open_out ?(binary=true) fn = +let open_out ?(binary=true) p = + let fn = Path.to_string p in if binary then P.open_out_bin fn else P.open_out fn let close_in = close_in @@ -12,14 +14,14 @@ let close_out = close_out let with_file_in ?binary fn ~f = Exn.protectx (open_in ?binary fn) ~finally:close_in ~f -let with_file_out ?binary fn ~f = - Exn.protectx (open_out ?binary fn) ~finally:close_out ~f +let with_file_out ?binary p ~f = + Exn.protectx (open_out ?binary p) ~finally:close_out ~f let with_lexbuf_from_file fn ~f = with_file_in fn ~f:(fun ic -> let lb = Lexing.from_channel ic in lb.lex_curr_p <- - { pos_fname = fn + { pos_fname = Path.to_string fn ; pos_lnum = 1 ; pos_bol = 0 ; pos_cnum = 0 @@ -69,7 +71,7 @@ let copy_file ~src ~dst = Exn.protectx (P.open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] perm - dst) + (Path.to_string dst)) ~finally:close_out ~f:(fun oc -> copy_channels ic oc)) @@ -82,9 +84,9 @@ let buf_len = 65_536 module Sexp = struct open Sexp - let load ~fname ~mode = - with_file_in fname ~f:(fun ic -> - let state = Parser.create ~fname ~mode in + let load path ~mode = + with_file_in path ~f:(fun ic -> + let state = Parser.create ~fname:(Path.to_string path) ~mode in let buf = Bytes.create buf_len in let rec loop stack = match input ic buf 0 buf_len with @@ -93,9 +95,9 @@ module Sexp = struct in loop Parser.Stack.empty) - let load_many_as_one ~fname = - match load ~fname ~mode:Many with - | [] -> Ast.List (Loc.in_file fname, []) + let load_many_as_one path = + match load path ~mode:Many with + | [] -> Ast.List (Loc.in_file (Path.to_string path), []) | x :: l -> let last = Option.value (List.last l) ~default:x in let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in diff --git a/src/stdune/io.mli b/src/stdune/io.mli index cc1a604a..4ff8583b 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -1,34 +1,34 @@ (** IO operations *) -val open_in : ?binary:bool (* default true *) -> string -> in_channel -val open_out : ?binary:bool (* default true *) -> string -> out_channel +val open_in : ?binary:bool (* default true *) -> Path.t -> in_channel +val open_out : ?binary:bool (* default true *) -> Path.t -> out_channel val close_in : in_channel -> unit val close_out : out_channel -> unit -val with_file_in : ?binary:bool (* default true *) -> string -> f:(in_channel -> 'a) -> 'a -val with_file_out : ?binary:bool (* default true *) -> string -> f:(out_channel -> 'a) -> 'a +val with_file_in : ?binary:bool (* default true *) -> Path.t -> f:(in_channel -> 'a) -> 'a +val with_file_out : ?binary:bool (* default true *) -> Path.t -> f:(out_channel -> 'a) -> 'a -val with_lexbuf_from_file : string -> f:(Lexing.lexbuf -> 'a) -> 'a +val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a -val lines_of_file : string -> string list +val lines_of_file : Path.t -> string list -val read_file : string -> string -val write_file : string -> string -> unit +val read_file : Path.t -> string +val write_file : Path.t -> string -> unit -val compare_files : string -> string -> Ordering.t +val compare_files : Path.t -> Path.t -> Ordering.t -val write_lines : string -> string list -> unit +val write_lines : Path.t -> string list -> unit val copy_channels : in_channel -> out_channel -> unit -val copy_file : src:string -> dst:string -> unit +val copy_file : src:Path.t -> dst:Path.t -> unit val read_all : in_channel -> string module Sexp : sig - val load : fname:string -> mode:'a Sexp.Parser.Mode.t -> 'a - val load_many_as_one : fname:string -> Sexp.Ast.t + val load : Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a + val load_many_as_one : Path.t -> Sexp.Ast.t end (**/**) diff --git a/src/stdune/path.ml b/src/stdune/path.ml index 4da893c1..ec369e39 100644 --- a/src/stdune/path.ml +++ b/src/stdune/path.ml @@ -431,6 +431,9 @@ let readdir t = Sys.readdir (to_string t) |> Array.to_list let is_directory t = try Sys.is_directory (to_string t) with Sys_error _ -> false +let is_file t = + try Sys.file_exists (to_string t) + with Sys_error _ -> false let rmdir t = Unix.rmdir (to_string t) let win32_unlink fn = try diff --git a/src/stdune/path.mli b/src/stdune/path.mli index 37d30150..1a7d6ae9 100644 --- a/src/stdune/path.mli +++ b/src/stdune/path.mli @@ -127,6 +127,7 @@ val insert_after_build_dir_exn : t -> string -> t val exists : t -> bool val readdir : t -> string list val is_directory : t -> bool +val is_file : t -> bool val rmdir : t -> unit val unlink : t -> unit val unlink_no_err : t -> unit diff --git a/src/utils.ml b/src/utils.ml index 257a27f9..f5c481a9 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -183,7 +183,7 @@ module Cached_digest = struct let remove fn = Hashtbl.remove cache fn - let db_file = "_build/.digest-db" + let db_file = Path.of_string "_build/.digest-db" let dump () = let module Pmap = Path.Map in @@ -203,8 +203,8 @@ module Cached_digest = struct Io.write_file db_file (Sexp.to_string sexp) let load () = - if Sys.file_exists db_file then begin - let sexp = Io.Sexp.load ~fname:db_file ~mode:Single in + if Path.is_file db_file then begin + let sexp = Io.Sexp.load db_file ~mode:Single in let bindings = let open Sexp.Of_sexp in list diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index 0c88e584..2de5f14b 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -55,7 +55,7 @@ struct let to_string path x = To_sexp.t path x |> Sexp.to_string let load path = - Of_sexp.t path (Io.Sexp.load ~fname:(Path.to_string path) ~mode:Single) + Of_sexp.t path (Io.Sexp.load path ~mode:Single) end diff --git a/src/watermarks.ml b/src/watermarks.ml index 26827bea..b85e75cf 100644 --- a/src/watermarks.ml +++ b/src/watermarks.ml @@ -19,7 +19,7 @@ let is_a_source_file fn = | _ -> true let make_watermark_map ~name ~version ~commit = - let opam_file = Opam_file.load (name ^ ".opam") in + let opam_file = Opam_file.load (Path.of_string (name ^ ".opam")) in let version_num = if String.is_prefix version ~prefix:"v" then String.sub version ~pos:1 ~len:(String.length version - 1) @@ -62,7 +62,7 @@ let make_watermark_map ~name ~version ~commit = ; "PKG_REPO" , opam_var "dev-repo" " " ] -let subst_string s ~fname ~map = +let subst_string s path ~map = let len = String.length s in let longest_var = String.longest (String.Map.keys map) in let loc_of_offset ~ofs ~len = @@ -70,7 +70,7 @@ let subst_string s ~fname ~map = if i = ofs then let pos = { Lexing. - pos_fname = fname + pos_fname = Path.to_string path ; pos_cnum = i ; pos_lnum = lnum ; pos_bol = bol @@ -151,17 +151,18 @@ let subst_string s ~fname ~map = Buffer.add_substring buf s pos (len - pos); Some (Buffer.contents buf) -let subst_file fn ~map = - let s = Io.read_file fn in +let subst_file path ~map = + let s = Io.read_file path in let s = - if Filename.dirname fn = "." && String.is_suffix fn ~suffix:".opam" then + if Path.is_root path + && String.is_suffix (Path.to_string path) ~suffix:".opam" then "version: \"%%" ^ "VERSION_NUM" ^ "%%\"\n" ^ s else s in - match subst_string s ~map ~fname:fn with + match subst_string s ~map path with | None -> () - | Some s -> Io.write_file fn s + | Some s -> Io.write_file path s let get_name ~files ?name () = let package_names = @@ -223,7 +224,7 @@ let subst_git ?name () = let watermarks = make_watermark_map ~name ~version ~commit in List.iter files ~f:(fun fn -> if is_a_source_file fn then - subst_file fn ~map:watermarks); + subst_file (Path.of_string fn) ~map:watermarks); Fiber.return () let subst ?name () = diff --git a/src/workspace.ml b/src/workspace.ml index 338ea240..fc7b2f89 100644 --- a/src/workspace.ml +++ b/src/workspace.ml @@ -135,4 +135,4 @@ let t ?x sexps = ; contexts = List.rev contexts } -let load ?x fname = t ?x (Io.Sexp.load ~fname ~mode:Many) +let load ?x p = t ?x (Io.Sexp.load p ~mode:Many) diff --git a/src/workspace.mli b/src/workspace.mli index 27463e9c..d4bac52e 100644 --- a/src/workspace.mli +++ b/src/workspace.mli @@ -28,4 +28,4 @@ type t = ; contexts : Context.t list } -val load : ?x:string -> string -> t +val load : ?x:string -> Path.t -> t diff --git a/test/blackbox-tests/cram.mll b/test/blackbox-tests/cram.mll index fc4f9b6c..95510d2b 100644 --- a/test/blackbox-tests/cram.mll +++ b/test/blackbox-tests/cram.mll @@ -143,7 +143,9 @@ and postprocess tbl b = parse | _ -> 255 in let ext_replace = make_ext_replace configurator in - List.iter (Io.lines_of_file temp_file) ~f:(fun line -> + Path.of_string temp_file + |> Io.lines_of_file + |> List.iter ~f:(fun line -> Printf.bprintf buf " %s\n" (ext_replace (Ansi_color.strip line))); if n <> 0 then Printf.bprintf buf " [%d]\n" n); diff --git a/test/unit-tests/tests.mlt b/test/unit-tests/tests.mlt index ca5fa667..0cded15a 100644 --- a/test/unit-tests/tests.mlt +++ b/test/unit-tests/tests.mlt @@ -52,7 +52,8 @@ open Meta #install_printer Simplified.pp;; let meta = - Meta.load ~name:"foo" ~fn:"test/unit-tests/findlib-db/foo/META" + Path.of_string "test/unit-tests/findlib-db/foo/META" + |> Meta.load ~name:"foo" [%%expect{| val meta : Jbuilder.Meta.Simplified.t =