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

Merge pull request #722 from rgrinberg/path-everywhere 

Use Path where Possible
This commit is contained in:
Rudi Grinberg 2018-04-25 21:21:37 +07:00 committed by GitHub
parent 2af69cb303 a1835c7fa0
commit 4240c632b4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
40 changed files with 283 additions and 253 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
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 -> [])
]
@ -728,7 +728,7 @@ let clean =
set_common common ~targets:[];
Build_system.files_in_source_tree_to_delete ()
|> List.iter ~f:Path.unlink_no_err;
Path.(rm_rf (append root (of_string "_build")))
Path.rm_rf Path.build_dir
end
in
( Term.(const go $ common)
@ -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
@ -1006,8 +1007,7 @@ let install_uninstall ~what =
>>= fun libdir ->
Fiber.parallel_iter install_files ~f:(fun path ->
let purpose = Process.Build_job install_files in
Process.run ~purpose ~env:setup.env Strict
(Path.to_string opam_installer)
Process.run ~purpose ~env:setup.env Strict opam_installer
([ sprintf "-%c" what.[0]
; Path.to_string path
; "--prefix"

47
src/action.ml
View File

@ -612,7 +612,10 @@ open Fiber.O
let get_std_output : _ -> Process.std_output_to = function
| None -> Terminal
| Some (fn, oc) -> Opened_file { filename = fn; tail = false; desc = Channel oc }
| Some (fn, oc) ->
Opened_file { filename = fn
; tail = false
; desc = Channel oc }
module Promotion = struct
module File = struct
@ -641,17 +644,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.relative_to_build_dir ".to-promote"
let dump_db db =
if Sys.file_exists "_build" then begin
if Path.build_dir_exists () then begin
match db with
| [] -> if Sys.file_exists db_file then Sys.remove db_file
| [] -> if Path.exists db_file then Path.unlink_no_err db_file
| l ->
Io.write_file db_file
(String.concat ~sep:""
@ -659,8 +660,8 @@ module Promotion = struct
end
let load_db () =
if Sys.file_exists db_file then
Sexp.load ~fname:db_file ~mode:Many
if Path.exists db_file then
Io.Sexp.load db_file ~mode:Many
|> List.map ~f:File.t
else
[]
@ -737,7 +738,7 @@ let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args =
invalid_prefix ("_build/" ^ target.name);
invalid_prefix ("_build/install/" ^ target.name);
end;
Process.run Strict ~dir:(Path.to_string dir) ~env
Process.run Strict ~dir ~env
~stdout_to ~stderr_to
~purpose:ectx.purpose
(Path.reach_for_running ~from:dir prog) args
@ -765,10 +766,10 @@ 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
let out = Process.File fn in
let stdout_to, stderr_to =
match outputs with
| Stdout -> (out, get_std_output stderr_to)
@ -784,7 +785,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 +794,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 +819,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 +841,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 +871,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,20 +893,16 @@ 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 out = Some (fn, oc) in
let stdout_to, stderr_to =

33
src/build_system.ml
View File

@ -14,20 +14,20 @@ 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.relative_to_build_dir ".to-delete-in-source-tree"
let add p = db := p :: !db
let load () =
if Sys.file_exists fn then
Sexp.load ~fname:fn ~mode:Many
if Path.exists fn then
Io.Sexp.load fn ~mode:Many
|> List.map ~f:Path.t
else
[]
let dump () =
let db = Pset.union (Pset.of_list !db) (Pset.of_list (load ())) in
if Sys.file_exists "_build" then
if Path.build_dir_exists () then
Io.write_file fn
(String.concat ~sep:""
(List.map (Pset.to_list db) ~f:(fun p ->
@ -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.relative_to_build_dir ".db"
let dump (trace : t) =
let sexp =
@ -1120,13 +1118,13 @@ module Trace = struct
Sexp.List [ Path.sexp_of_t path;
Atom (Sexp.Atom.of_digest hash) ]))
in
if Sys.file_exists "_build" then
if Path.build_dir_exists () then
Io.write_file file (Sexp.to_string sexp)
let load () =
let trace = Hashtbl.create 1024 in
if Sys.file_exists file then begin
let sexp = Sexp.load ~fname:file ~mode:Single in
if Path.exists 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 (Sexp.load ~mode:Single ~fname) + 1
if Path.exists 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 () ->
@ -1455,7 +1452,7 @@ let get_collector t ~dir =
(if Path.is_in_source_tree dir then
"Build_system.get_collector called on source directory"
else if dir = Path.build_dir then
"Build_system.get_collector called on _build"
"Build_system.get_collector called on build_dir"
else if not (Path.is_local dir) then
"Build_system.get_collector called on external directory"
else

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 (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.exists 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 (

17
src/context.ml
View File

@ -109,7 +109,7 @@ let opam_config_var ~env ~cache var =
match Bin.opam with
| None -> Fiber.return None
| Some fn ->
Process.run_capture (Accept All) (Path.to_string fn) ~env
Process.run_capture (Accept All) fn ~env
["config"; "var"; var]
>>| function
| Ok s ->
@ -151,7 +151,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () =
| Some s -> Fiber.return (Path.absolute s)
| None ->
Process.run_capture_line ~env Strict
(Path.to_string fn) ["printconf"; "conf"]
fn ["printconf"; "conf"]
>>| Path.absolute)
in
@ -232,7 +232,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () =
| None -> args
| Some s -> "-toolchain" :: s :: args
in
Process.run_capture_lines ~env Strict (Path.to_string fn) args
Process.run_capture_lines ~env Strict fn args
>>| fun l ->
(* Don't prepend the contents of [OCAMLPATH] since findlib
does it already *)
@ -258,8 +258,7 @@ let create ~(kind : Kind.t) ~path ~env ~name ~merlin ~targets () =
Fiber.fork_and_join
findlib_path
(fun () ->
Process.run_capture_lines ~env Strict
(Path.to_string ocamlc) ["-config"]
Process.run_capture_lines ~env Strict ocamlc ["-config"]
>>| fun lines ->
let open Result.O in
ocaml_config_ok_exn
@ -411,10 +410,9 @@ let create_for_opam ?root ~env ~targets ~switch ~name ?(merlin=false) () =
(match root with
| Some root -> Fiber.return root
| None ->
Process.run_capture_line Strict ~env
(Path.to_string fn) ["config"; "var"; "root"])
Process.run_capture_line Strict ~env fn ["config"; "var"; "root"])
>>= fun root ->
Process.run_capture ~env Strict (Path.to_string fn)
Process.run_capture ~env Strict fn
["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"]
>>= fun s ->
let vars =
@ -465,8 +463,7 @@ let install_ocaml_libdir t =
(* If ocamlfind is present, it has precedence over everything else. *)
match which t "ocamlfind" with
| Some fn ->
(Process.run_capture_line ~env:t.env Strict
(Path.to_string fn) ["printconf"; "destdir"]
(Process.run_capture_line ~env:t.env Strict fn ["printconf"; "destdir"]
>>| fun s ->
Some (Path.absolute s))
| None ->

2
src/context.mli
View File

@ -8,7 +8,7 @@
- opam switch contexts, where one opam switch correspond to one context
each context is built into a sub-directory of "_build":
each context is built into a sub-directory of Path.build_dir (usually _build):
- _build/default for the default context
- _build/<switch> for other contexts

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

60
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
@ -148,16 +147,14 @@ end
in
]}
*)
Process.run Strict ~dir:(Path.to_string dir)
~env:context.env
(Path.to_string context.ocaml)
Process.run Strict ~dir ~env:context.env context.ocaml
args
>>= fun () ->
if not (Path.exists generated_jbuild) then
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 = 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 ->
@ -171,9 +168,48 @@ type conf =
; scopes : Scope_info.t list
}
module Sexp_io = struct
open Sexp
let ocaml_script_prefix = "(* -*- tuareg -*- *)"
let ocaml_script_prefix_len = String.length ocaml_script_prefix
type sexps_or_ocaml_script =
| Sexps of Ast.t list
| Ocaml_script
let load_many_or_ocaml_script fname =
Io.with_file_in fname ~f:(fun ic ->
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
| 0 -> Parser.feed_eoi state stack
| n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack)
in
let rec loop0 stack i =
match input ic buf i (Io.buf_len - i) with
| 0 ->
let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in
Sexps (Parser.feed_eoi state stack)
| n ->
let i = i + n in
if i < ocaml_script_prefix_len then
loop0 stack i
else if Bytes.sub_string buf 0 ocaml_script_prefix_len
[@warning "-6"]
= ocaml_script_prefix then
Ocaml_script
else
let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in
Sexps (loop stack)
in
loop0 Parser.Stack.empty 0)
end
let load ~dir ~scope ~ignore_promoted_rules =
let file = Path.relative dir "jbuild" in
match Sexp.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
@ -191,7 +227,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

5
src/log.ml
View File

@ -12,9 +12,8 @@ type t = real option
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
Path.ensure_build_dir_exists ();
let oc = Io.open_out (Path.relative_to_build_dir "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.exists 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

15
src/print_diff.ml
View File

@ -9,9 +9,9 @@ let print path1 path2 =
Path.extract_build_context_dir path2
with
| Some (dir1, f1), Some (dir2, f2) when dir1 = dir2 ->
(Path.to_string dir1, Path.to_string f1, Path.to_string f2)
(dir1, Path.to_string f1, Path.to_string f2)
| _ ->
(".", Path.to_string path1, Path.to_string path2)
(Path.root, Path.to_string path1, Path.to_string path2)
in
let loc = Loc.in_file file1 in
let fallback () =
@ -24,8 +24,7 @@ let print path1 path2 =
| None -> fallback ()
| Some prog ->
Format.eprintf "%a@?" Loc.print loc;
Process.run ~dir ~env:Env.initial Strict (Path.to_string prog)
["-u"; file1; file2]
Process.run ~dir ~env:Env.initial Strict prog ["-u"; file1; file2]
>>= fun () ->
fallback ()
in
@ -35,18 +34,18 @@ let print path1 path2 =
let cmd =
sprintf "%s %s %s" cmd (quote_for_shell file1) (quote_for_shell file2)
in
Process.run ~dir ~env:Env.initial Strict (Path.to_string sh) [arg; cmd]
Process.run ~dir ~env:Env.initial Strict sh [arg; cmd]
>>= fun () ->
die "command reported no differences: %s"
(if dir = "." then
(if Path.is_root dir then
cmd
else
sprintf "cd %s && %s" (quote_for_shell dir) cmd)
sprintf "cd %s && %s" (quote_for_shell (Path.to_string dir)) cmd)
| None ->
match Bin.which "patdiff" with
| None -> normal_diff ()
| Some prog ->
Process.run ~dir ~env:Env.initial Strict (Path.to_string prog)
Process.run ~dir ~env:Env.initial Strict prog
[ "-keep-whitespace"
; "-location-style"; "omake"
; if Lazy.force Colors.stderr_supports_colors then

52
src/process.ml
View File

@ -31,11 +31,11 @@ let map_result
type std_output_to =
| Terminal
| File of string
| File of Path.t
| Opened_file of opened_file
and opened_file =
{ filename : string
{ filename : Path.t
; desc : opened_file_desc
; tail : bool
}
@ -49,22 +49,21 @@ type purpose =
| Build_job of Path.t list
module Temp = struct
let tmp_files = ref String.Set.empty
let tmp_files = ref Path.Set.empty
let () =
at_exit (fun () ->
let fns = !tmp_files in
tmp_files := String.Set.empty;
String.Set.iter fns ~f:(fun fn ->
try Sys.force_remove fn with _ -> ()))
tmp_files := Path.Set.empty;
Path.Set.iter fns ~f:Path.unlink_no_err)
let create prefix suffix =
let fn = Filename.temp_file prefix suffix in
tmp_files := String.Set.add !tmp_files fn;
let fn = Path.of_string (Filename.temp_file prefix suffix) in
tmp_files := Path.Set.add !tmp_files fn;
fn
let destroy fn =
(try Sys.force_remove fn with Sys_error _ -> ());
tmp_files := String.Set.remove !tmp_files fn
Path.unlink_no_err fn;
tmp_files := Path.Set.remove !tmp_files fn
end
module Fancy = struct
@ -113,6 +112,7 @@ module Fancy = struct
| x :: rest -> x :: colorize_args rest
let command_line ~prog ~args ~dir ~stdout_to ~stderr_to =
let prog = Path.to_string prog in
let quote = quote_for_shell in
let prog = colorize_prog (quote prog) in
let s =
@ -121,21 +121,23 @@ module Fancy = struct
let s =
match dir with
| None -> s
| Some dir -> sprintf "(cd %s && %s)" dir s
| Some dir -> sprintf "(cd %s && %s)" (Path.to_string dir) s
in
match stdout_to, stderr_to with
| (File fn1 | Opened_file { filename = fn1; _ }),
(File fn2 | Opened_file { filename = fn2; _ }) when fn1 = fn2 ->
sprintf "%s &> %s" s fn1
sprintf "%s &> %s" s (Path.to_string fn1)
| _ ->
let s =
match stdout_to with
| Terminal -> s
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s > %s" s fn
| File fn | Opened_file { filename = fn; _ } ->
sprintf "%s > %s" s (Path.to_string fn)
in
match stderr_to with
| Terminal -> s
| File fn | Opened_file { filename = fn; _ } -> sprintf "%s 2> %s" s fn
| File fn | Opened_file { filename = fn; _ } ->
sprintf "%s 2> %s" s (Path.to_string fn)
let pp_purpose ppf = function
| Internal_job ->
@ -190,7 +192,8 @@ end
let get_std_output ~default = function
| Terminal -> (default, None)
| File fn ->
let fd = Unix.openfile fn [O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE] 0o666 in
let fd = Unix.openfile (Path.to_string fn)
[O_WRONLY; O_CREAT; O_TRUNC; O_SHARE_DELETE] 0o666 in
(fd, Some (Fd fd))
| Opened_file { desc; tail; _ } ->
let fd =
@ -216,8 +219,12 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
let display = Scheduler.display scheduler in
let dir =
match dir with
| Some "." -> None
| _ -> dir
| Some p ->
if Path.is_root p then
None
else
Some p
| None -> dir
in
let id = gen_id () in
let ok_codes = accepted_codes fail_mode in
@ -225,12 +232,13 @@ let run_internal ?dir ?(stdout_to=Terminal) ?(stderr_to=Terminal) ~env ~purpose
if display = Verbose then
Format.eprintf "@{<kwd>Running@}[@{<id>%d@}]: %s@." id
(Colors.strip_colors_for_stderr command_line);
let prog = Path.to_string prog in
let argv = Array.of_list (prog :: args) in
let output_filename, stdout_fd, stderr_fd, to_close =
match stdout_to, stderr_to with
| (Terminal, _ | _, Terminal) when !Clflags.capture_outputs ->
let fn = Temp.create "jbuilder" ".output" in
let fd = Unix.openfile fn [O_WRONLY; O_SHARE_DELETE] 0 in
let fd = Unix.openfile (Path.to_string fn) [O_WRONLY; O_SHARE_DELETE] 0 in
(Some fn, fd, fd, Some fd)
| _ ->
(None, Unix.stdout, Unix.stderr, None)
@ -323,13 +331,14 @@ let run ?dir ?stdout_to ?stderr_to ~env ?(purpose=Internal_job) fail_mode
let run_capture_gen ?dir ~env ?(purpose=Internal_job) fail_mode prog args ~f =
let fn = Temp.create "jbuild" ".output" in
map_result fail_mode
(run_internal ?dir ~stdout_to:(File fn) ~env ~purpose fail_mode prog args)
(run_internal ?dir ~stdout_to:(File fn)
~env ~purpose fail_mode prog args)
~f:(fun () ->
let x = f fn in
Temp.destroy fn;
x)
let run_capture = run_capture_gen ~f:Io.read_file
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_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args =
@ -338,10 +347,11 @@ let run_capture_line ?dir ~env ?(purpose=Internal_job) fail_mode prog args =
| [x] -> x
| l ->
let cmdline =
let prog = Path.to_string prog in
let s = String.concat (prog :: args) ~sep:" " in
match dir with
| None -> s
| Some dir -> sprintf "cd %s && %s" dir s
| Some dir -> sprintf "cd %s && %s" (Path.to_string dir) s
in
match l with
| [] ->

20
src/process.mli
View File

@ -17,11 +17,11 @@ type ('a, 'b) failure_mode =
(** Where to redirect standard output *)
type std_output_to =
| Terminal
| File of string
| File of Path.t
| Opened_file of opened_file
and opened_file =
{ filename : string
{ filename : Path.t
; desc : opened_file_desc
; tail : bool
(** If [true], the descriptor is closed after starting the command *)
@ -38,39 +38,39 @@ type purpose =
(** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *)
val run
: ?dir:string
: ?dir:Path.t
-> ?stdout_to:std_output_to
-> ?stderr_to:std_output_to
-> env:Env.t
-> ?purpose:purpose
-> (unit, 'a) failure_mode
-> string
-> Path.t
-> string list
-> 'a Fiber.t
(** Run a command and capture its output *)
val run_capture
: ?dir:string
: ?dir:Path.t
-> env:Env.t
-> ?purpose:purpose
-> (string, 'a) failure_mode
-> string
-> Path.t
-> string list
-> 'a Fiber.t
val run_capture_line
: ?dir:string
: ?dir:Path.t
-> env:Env.t
-> ?purpose:purpose
-> (string, 'a) failure_mode
-> string
-> Path.t
-> string list
-> 'a Fiber.t
val run_capture_lines
: ?dir:string
: ?dir:Path.t
-> env:Env.t
-> ?purpose:purpose
-> (string list, 'a) failure_mode
-> string
-> Path.t
-> string list
-> 'a Fiber.t

2
src/scheduler.ml
View File

@ -72,7 +72,7 @@ let log t = t.log
let display t = t.display
let with_chdir t ~dir ~f =
Sys.chdir dir;
Sys.chdir (Path.to_string dir);
protectx () ~finally:(fun () -> Sys.chdir t.original_cwd) ~f
let hide_status_line s =

4
src/scheduler.mli
View File

@ -1,5 +1,7 @@
(** Scheduling *)
open Stdune
(** [go ?log ?config ?gen_status_line fiber] runs the following fiber until it
terminates. [gen_status_line] is used to print a status line when [config.display =
Progress]. *)
@ -27,7 +29,7 @@ val wait_for_available_job : unit -> t Fiber.t
val log : t -> Log.t
(** Execute the given callback with current directory temporarily changed *)
val with_chdir : t -> dir:string -> f:(unit -> 'a) -> 'a
val with_chdir : t -> dir:Path.t -> f:(unit -> 'a) -> 'a
(** Display mode for this scheduler *)
val display : t -> Config.Display.t

39
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,10 +71,35 @@ 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))
(* TODO: diml: improve this *)
let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2)
let buf_len = 65_536
module Sexp = struct
open Sexp
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
| 0 -> Parser.feed_eoi state stack
| n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack)
in
loop Parser.Stack.empty)
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
Ast.List (loc, x :: l)
end

31
src/stdune/io.mli
View File

@ -1,27 +1,36 @@
(** 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 : Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a
val load_many_as_one : Path.t -> Sexp.Ast.t
end
(**/**)
(* used in jbuild_load *)
val buf_len : int

10
src/stdune/path.ml
View File

@ -426,7 +426,9 @@ let explode_exn t =
Exn.code_error "Path.explode_exn"
["path", Sexp.atom_or_quoted_string t]
let exists t = Sys.file_exists (to_string t)
let exists t =
try Sys.file_exists (to_string t)
with Sys_error _ -> false
let readdir t = Sys.readdir (to_string t) |> Array.to_list
let is_directory t =
try Sys.is_directory (to_string t)
@ -451,6 +453,12 @@ let unlink t =
unlink_operation (to_string t)
let unlink_no_err t = try unlink t with _ -> ()
let build_dir_exists () = is_directory build_dir
let ensure_build_dir_exists () = Local.mkdir_p build_dir
let relative_to_build_dir = relative build_dir
let extend_basename t ~suffix = t ^ suffix
let insert_after_build_dir_exn =

8
src/stdune/path.mli
View File

@ -70,7 +70,7 @@ val absolute : string -> t
val to_absolute_filename : t -> root:string -> string
val reach : t -> from:t -> string
val reach_for_running : t -> from:t -> string
val reach_for_running : t -> from:t -> t
val descendant : t -> of_:t -> t option
val is_descendant : t -> of_:t -> bool
@ -146,3 +146,9 @@ val extension : t -> string
val drop_prefix : t -> prefix:t -> string option
val pp : Format.formatter -> t -> unit
val build_dir_exists : unit -> bool
val ensure_build_dir_exists : unit -> unit
val relative_to_build_dir : string -> t

56
src/stdune/sexp.ml
View File

@ -1,61 +1,5 @@
include Usexp
let buf_len = 65_536
let load ~fname ~mode =
Io.with_file_in fname ~f:(fun ic ->
let state = Parser.create ~fname ~mode in
let buf = Bytes.create buf_len in
let rec loop stack =
match input ic buf 0 buf_len with
| 0 -> Parser.feed_eoi state stack
| n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack)
in
loop Parser.Stack.empty)
let load_many_as_one ~fname =
match load ~fname ~mode:Many with
| [] -> Ast.List (Loc.in_file fname, [])
| x :: l ->
let last = Option.value (List.last l) ~default:x in
let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in
Ast.List (loc, x :: l)
let ocaml_script_prefix = "(* -*- tuareg -*- *)"
let ocaml_script_prefix_len = String.length ocaml_script_prefix
type sexps_or_ocaml_script =
| Sexps of Ast.t list
| Ocaml_script
let load_many_or_ocaml_script fname =
Io.with_file_in fname ~f:(fun ic ->
let state = Parser.create ~fname ~mode:Many in
let buf = Bytes.create buf_len in
let rec loop stack =
match input ic buf 0 buf_len with
| 0 -> Parser.feed_eoi state stack
| n -> loop (Parser.feed_subbytes state buf ~pos:0 ~len:n stack)
in
let rec loop0 stack i =
match input ic buf i (buf_len - i) with
| 0 ->
let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in
Sexps (Parser.feed_eoi state stack)
| n ->
let i = i + n in
if i < ocaml_script_prefix_len then
loop0 stack i
else if Bytes.sub_string buf 0 ocaml_script_prefix_len
[@warning "-6"]
= ocaml_script_prefix then
Ocaml_script
else
let stack = Parser.feed_subbytes state buf ~pos:0 ~len:i stack in
Sexps (loop stack)
in
loop0 Parser.Stack.empty 0)
module type Combinators = sig
type 'a t
val unit : unit t

9
src/stdune/sexp.mli
View File

@ -1,14 +1,5 @@
include module type of struct include Usexp end with module Loc := Usexp.Loc
val load : fname:string -> mode:'a Parser.Mode.t -> 'a
val load_many_as_one : fname:string -> Ast.t
type sexps_or_ocaml_script =
| Sexps of Ast.t list
| Ocaml_script
val load_many_or_ocaml_script : string -> sexps_or_ocaml_script
module type Combinators = sig
type 'a t
val unit : unit t

8
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.relative_to_build_dir ".digest-db"
let dump () =
let module Pmap = Path.Map in
@ -199,12 +199,12 @@ module Cached_digest = struct
(Int64.bits_of_float file.timestamp))
]))
in
if Sys.file_exists "_build" then
if Path.build_dir_exists () then
Io.write_file db_file (Sexp.to_string sexp)
let load () =
if Sys.file_exists db_file then begin
let sexp = Sexp.load ~fname:db_file ~mode:Single in
if Path.exists 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 (Sexp.load ~fname:(Path.to_string path) ~mode:Single)
Of_sexp.t path (Io.Sexp.load path ~mode:Single)
end

21
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 =
@ -200,7 +201,7 @@ let subst_git ?name () =
let rev = "HEAD" in
let git =
match Bin.which "git" with
| Some x -> Path.to_string x
| Some x -> x
| None -> Utils.program_not_found "git"
in
let env = Env.initial in
@ -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 (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 =