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

Simplify jbuild.ml wrappers

This commit is contained in:
Jérémie Dimino 2017-02-28 05:38:30 +00:00
parent bad68218b9
commit 9123508e43
1 changed files with 11 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/jbuild_load.ml
View File

@ -14,17 +14,15 @@ module Jbuilds = struct
type t = one list type t = one list
let generated_jbuilds_dir = Path.(relative root) "_build/.jbuilds" let generated_jbuilds_dir = Path.(relative root) "_build/.jbuilds"
let contexts_files_dir = Path.(relative root) "_build/.contexts"
let ensure_parent_dir_exists path = let ensure_parent_dir_exists path =
match Path.kind path with match Path.kind path with
| Local path -> Path.Local.ensure_parent_directory_exists path | Local path -> Path.Local.ensure_parent_directory_exists path
| External _ -> () | External _ -> ()
let create_context_file (context : Context.t) = let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target =
let file = Path.relative contexts_files_dir (context.name ^ ".ml") in with_file_out (Path.to_string wrapper) ~f:(fun oc ->
ensure_parent_dir_exists file; let plugin = Path.to_string plugin in
with_file_out (Path.to_string file) ~f:(fun oc ->
Printf.fprintf oc {| Printf.fprintf oc {|
module Jbuild_plugin = struct module Jbuild_plugin = struct
module V1 = struct module V1 = struct
@ -36,23 +34,24 @@ module Jbuild_plugin = struct
] ]
let send s = let send s =
let oc = open_out_bin Sys.argv.(1) in let oc = open_out_bin %S in
output_string oc s; output_string oc s;
close_out oc close_out oc
end end
end end
|} # 1 %S
%s|}
context.name context.name
context.version context.version
(String.concat ~sep:"\n ; " (String.concat ~sep:"\n ; "
(let longest = List.longest_map context.ocamlc_config ~f:fst in (let longest = List.longest_map context.ocamlc_config ~f:fst in
List.map context.ocamlc_config ~f:(fun (k, v) -> List.map context.ocamlc_config ~f:(fun (k, v) ->
Printf.sprintf "%-*S , %S" (longest + 2) k v)))); Printf.sprintf "%-*S , %S" (longest + 2) k v)))
file (Path.reach ~from:exec_dir target)
plugin (read_file plugin))
let eval jbuilds ~(context : Context.t) = let eval jbuilds ~(context : Context.t) =
let open Future in let open Future in
let context_files = Hashtbl.create 8 in
List.map jbuilds ~f:(function List.map jbuilds ~f:(function
| Literal (path, stanzas) -> | Literal (path, stanzas) ->
return (path, stanzas) return (path, stanzas)
@ -65,25 +64,10 @@ end
in in
let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in
ensure_parent_dir_exists generated_jbuild; ensure_parent_dir_exists generated_jbuild;
let context_file, context_file_contents = create_plugin_wrapper context ~exec_dir:dir ~plugin:file ~wrapper ~target:generated_jbuild;
Hashtbl.find_or_add context_files context.name ~f:(fun () ->
let file = create_context_file context in
(file, read_file (Path.to_string file)))
in
Printf.ksprintf (write_file (Path.to_string wrapper))
"# 1 %S\n\
%s\n\
# 1 %S\n\
%s"
(Path.to_string context_file)
context_file_contents
(Path.to_string file)
(read_file (Path.to_string file));
Future.run Strict ~dir:(Path.to_string dir) ~env:context.env Future.run Strict ~dir:(Path.to_string dir) ~env:context.env
(Path.to_string context.Context.ocaml) (Path.to_string context.Context.ocaml)
[ Path.reach ~from:dir wrapper [ Path.reach ~from:dir wrapper ]
; Path.reach ~from:dir generated_jbuild
]
>>= fun () -> >>= fun () ->
let sexps = Sexp_load.many (Path.to_string generated_jbuild) in let sexps = Sexp_load.many (Path.to_string generated_jbuild) in
return (dir, Stanzas.parse sexps ~dir ~visible_packages)) return (dir, Stanzas.parse sexps ~dir ~visible_packages))