matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Port Io to use Path.t

This commit is contained in:
Rudi Grinberg 2018-04-25 03:25:27 +07:00
parent 79e434c658
commit 7820e29d28
32 changed files with 138 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
bin/main.ml
View File

@ -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

37
src/action.ml
View File

@ -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

27
src/build_system.ml
View File

@ -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 () ->

11
src/config.ml
View File

@ -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

4
src/config.mli
View File

@ -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. *)

15
src/configurator/v1.ml
View File

@ -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 (

5
src/file_tree.ml
View File

@ -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

6
src/findlib.ml
View File

@ -99,7 +99,7 @@ module Config = struct
if not (Path.exists conf_file) then
die "@{<error>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
| [] ->

2
src/installed_dune_file.ml
View File

@ -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 =

2
src/installed_dune_file.mli
View File

@ -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

2
src/jbuild.ml
View File

@ -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])

19
src/jbuild_load.ml
View File

@ -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>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

3
src/lib.ml
View File

@ -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

2
src/log.ml
View File

@ -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

4
src/main.ml
View File

@ -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"

2
src/main.mli
View File

@ -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

4
src/meta.ml
View File

@ -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

2
src/meta.mli
View File

@ -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. *)

2
src/opam_file.ml
View File

@ -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

4
src/opam_file.mli
View File

@ -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

9
src/process.ml
View File

@ -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 ->

26
src/stdune/io.ml
View File

@ -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

26
src/stdune/io.mli
View File

@ -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
(**/**)

3
src/stdune/path.ml
View File

@ -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

1
src/stdune/path.mli
View File

@ -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

6
src/utils.ml
View File

@ -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

2
src/vfile_kind.ml
View File

@ -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

19
src/watermarks.ml
View File

@ -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 () =

2
src/workspace.ml
View File

@ -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)

2
src/workspace.mli
View File

@ -28,4 +28,4 @@ type t =
; contexts : Context.t list
}
val load : ?x:string -> string -> t
val load : ?x:string -> Path.t -> t

4
test/blackbox-tests/cram.mll
View File

@ -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);

3
test/unit-tests/tests.mlt
View File

@ -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 =