2016-12-02 13:54:32 +00:00
|
|
|
open Import
|
2017-06-02 13:32:05 +00:00
|
|
|
open Jbuild
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-02-26 19:49:54 +00:00
|
|
|
module Jbuilds = struct
|
2017-02-26 21:28:30 +00:00
|
|
|
type script =
|
2017-06-05 12:42:13 +00:00
|
|
|
{ dir : Path.t
|
|
|
|
; scope : Scope.t
|
2017-02-26 21:28:30 +00:00
|
|
|
}
|
|
|
|
|
2017-02-26 19:49:54 +00:00
|
|
|
type one =
|
2017-06-05 12:42:13 +00:00
|
|
|
| Literal of (Path.t * Scope.t * Stanza.t list)
|
2017-02-26 21:28:30 +00:00
|
|
|
| Script of script
|
2017-02-26 12:20:47 +00:00
|
|
|
|
2017-02-26 19:49:54 +00:00
|
|
|
type t = one list
|
|
|
|
|
2017-03-01 16:09:02 +00:00
|
|
|
let generated_jbuilds_dir = Path.(relative root) "_build/.jbuilds"
|
2017-02-26 19:49:54 +00:00
|
|
|
|
|
|
|
let ensure_parent_dir_exists path =
|
|
|
|
match Path.kind path with
|
|
|
|
| Local path -> Path.Local.ensure_parent_directory_exists path
|
|
|
|
| External _ -> ()
|
|
|
|
|
2017-06-06 09:23:22 +00:00
|
|
|
let extract_requires ~fname str =
|
|
|
|
let rec loop n lines acc =
|
|
|
|
match lines with
|
|
|
|
| [] -> acc
|
|
|
|
| line :: lines ->
|
|
|
|
let acc =
|
|
|
|
match Scanf.sscanf line "#require %S" (fun x -> x) with
|
|
|
|
| exception _ -> acc
|
|
|
|
| s ->
|
|
|
|
match String.split s ~on:',' with
|
|
|
|
| [] -> acc
|
|
|
|
| ["unix"] as l -> l
|
|
|
|
| _ ->
|
|
|
|
let start =
|
|
|
|
{ Lexing.
|
|
|
|
pos_fname = fname
|
|
|
|
; pos_lnum = n
|
|
|
|
; pos_cnum = 0
|
|
|
|
; pos_bol = 0
|
|
|
|
}
|
|
|
|
in
|
|
|
|
Loc.fail
|
|
|
|
{ start; stop = { start with pos_cnum = String.length line } }
|
|
|
|
"Using libraries other that \"unix\" is not supported.\n\
|
|
|
|
See the manual for details.";
|
|
|
|
in
|
|
|
|
loop (n + 1) lines acc
|
|
|
|
in
|
|
|
|
loop 1 (String.split str ~on:'\n') []
|
2017-02-28 06:01:27 +00:00
|
|
|
|
2017-02-28 05:38:30 +00:00
|
|
|
let create_plugin_wrapper (context : Context.t) ~exec_dir ~plugin ~wrapper ~target =
|
2017-02-28 06:01:27 +00:00
|
|
|
let plugin = Path.to_string plugin in
|
2017-05-18 16:11:39 +00:00
|
|
|
let plugin_contents = Io.read_file plugin in
|
|
|
|
Io.with_file_out (Path.to_string wrapper) ~f:(fun oc ->
|
2017-02-26 19:49:54 +00:00
|
|
|
Printf.fprintf oc {|
|
2017-06-08 10:33:59 +00:00
|
|
|
let () =
|
|
|
|
Hashtbl.add Toploop.directive_table "require" (Toploop.Directive_string ignore);
|
|
|
|
Hashtbl.add Toploop.directive_table "use" (Toploop.Directive_string (fun _ ->
|
|
|
|
failwith "#use is not allowed inside jbuild in OCaml syntax"));
|
|
|
|
Hashtbl.add Toploop.directive_table "use_mod" (Toploop.Directive_string (fun _ ->
|
|
|
|
failwith "#use is not allowed inside jbuild in OCaml syntax"))
|
|
|
|
|
2017-02-26 19:49:54 +00:00
|
|
|
module Jbuild_plugin = struct
|
|
|
|
module V1 = struct
|
|
|
|
let context = %S
|
|
|
|
let ocaml_version = %S
|
|
|
|
|
|
|
|
let ocamlc_config =
|
|
|
|
[ %s
|
|
|
|
]
|
|
|
|
|
|
|
|
let send s =
|
2017-02-28 05:38:30 +00:00
|
|
|
let oc = open_out_bin %S in
|
2017-02-26 19:49:54 +00:00
|
|
|
output_string oc s;
|
|
|
|
close_out oc
|
|
|
|
end
|
|
|
|
end
|
2017-02-28 05:38:30 +00:00
|
|
|
# 1 %S
|
|
|
|
%s|}
|
2017-02-26 19:49:54 +00:00
|
|
|
context.name
|
|
|
|
context.version
|
|
|
|
(String.concat ~sep:"\n ; "
|
|
|
|
(let longest = List.longest_map context.ocamlc_config ~f:fst in
|
|
|
|
List.map context.ocamlc_config ~f:(fun (k, v) ->
|
2017-02-28 05:38:30 +00:00
|
|
|
Printf.sprintf "%-*S , %S" (longest + 2) k v)))
|
|
|
|
(Path.reach ~from:exec_dir target)
|
2017-02-28 06:01:27 +00:00
|
|
|
plugin plugin_contents);
|
2017-06-06 09:23:22 +00:00
|
|
|
extract_requires ~fname:plugin plugin_contents
|
2017-02-26 19:49:54 +00:00
|
|
|
|
|
|
|
let eval jbuilds ~(context : Context.t) =
|
|
|
|
let open Future in
|
|
|
|
List.map jbuilds ~f:(function
|
2017-05-05 10:21:46 +00:00
|
|
|
| Literal x -> return x
|
2017-06-05 12:42:13 +00:00
|
|
|
| Script { dir; scope } ->
|
2017-02-26 19:49:54 +00:00
|
|
|
let file = Path.relative dir "jbuild" in
|
|
|
|
let generated_jbuild =
|
|
|
|
Path.append (Path.relative generated_jbuilds_dir context.name) file
|
|
|
|
in
|
|
|
|
let wrapper = Path.extend_basename generated_jbuild ~suffix:".ml" in
|
|
|
|
ensure_parent_dir_exists generated_jbuild;
|
2017-02-28 06:31:02 +00:00
|
|
|
let requires =
|
2017-02-28 18:17:15 +00:00
|
|
|
create_plugin_wrapper context ~exec_dir:dir ~plugin:file ~wrapper
|
|
|
|
~target:generated_jbuild
|
2017-02-28 06:01:27 +00:00
|
|
|
in
|
2017-12-21 11:57:45 +00:00
|
|
|
let context = Option.value context.for_host ~default:context in
|
2017-02-28 06:31:02 +00:00
|
|
|
let pkgs =
|
2017-03-15 08:59:00 +00:00
|
|
|
List.map requires ~f:(Findlib.find_exn context.findlib
|
|
|
|
~required_by:[Utils.jbuild_name_in ~dir:dir])
|
2017-04-26 14:04:32 +00:00
|
|
|
|> Findlib.closure ~required_by:dir ~local_public_libs:String_map.empty
|
2017-02-28 06:31:02 +00:00
|
|
|
in
|
|
|
|
let includes =
|
|
|
|
List.fold_left pkgs ~init:Path.Set.empty ~f:(fun acc pkg ->
|
|
|
|
Path.Set.add pkg.Findlib.dir acc)
|
|
|
|
|> Path.Set.elements
|
|
|
|
|> List.concat_map ~f:(fun path ->
|
|
|
|
[ "-I"; Path.to_string path ])
|
|
|
|
in
|
|
|
|
let cmas =
|
|
|
|
List.concat_map pkgs ~f:(fun pkg -> pkg.archives.byte)
|
|
|
|
in
|
|
|
|
let args =
|
|
|
|
List.concat
|
|
|
|
[ [ "-I"; "+compiler-libs" ]
|
|
|
|
; includes
|
2017-07-25 13:08:39 +00:00
|
|
|
; List.map cmas ~f:(Path.reach ~from:dir)
|
2017-09-22 10:15:15 +00:00
|
|
|
; [ Path.to_absolute_filename wrapper ]
|
2017-02-28 06:31:02 +00:00
|
|
|
]
|
|
|
|
in
|
|
|
|
(* CR-someday jdimino: if we want to allow plugins to use findlib:
|
|
|
|
{[
|
|
|
|
let args =
|
|
|
|
match context.toplevel_path with
|
|
|
|
| None -> args
|
|
|
|
| Some path -> "-I" :: Path.reach ~from:dir path :: args
|
|
|
|
in
|
|
|
|
]}
|
|
|
|
*)
|
2017-02-27 11:37:28 +00:00
|
|
|
Future.run Strict ~dir:(Path.to_string dir) ~env:context.env
|
2017-02-28 06:31:02 +00:00
|
|
|
(Path.to_string context.ocaml)
|
|
|
|
args
|
2017-02-26 19:49:54 +00:00
|
|
|
>>= fun () ->
|
2017-03-21 14:03:33 +00:00
|
|
|
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);
|
2017-12-12 10:16:17 +00:00
|
|
|
let sexps = Sexp.load ~fname:(Path.to_string generated_jbuild) ~mode:Many in
|
2018-01-22 11:32:40 +00:00
|
|
|
return (dir, scope, Stanzas.parse scope sexps ~file:generated_jbuild))
|
2017-02-26 19:49:54 +00:00
|
|
|
|> Future.all
|
2017-02-25 18:21:23 +00:00
|
|
|
end
|
|
|
|
|
2016-12-15 11:20:46 +00:00
|
|
|
type conf =
|
2016-12-31 15:12:39 +00:00
|
|
|
{ file_tree : File_tree.t
|
2017-02-26 19:49:54 +00:00
|
|
|
; jbuilds : Jbuilds.t
|
2017-02-24 18:21:22 +00:00
|
|
|
; packages : Package.t String_map.t
|
2017-12-17 14:56:05 +00:00
|
|
|
; scopes : Scope.t list
|
2016-12-15 11:20:46 +00:00
|
|
|
}
|
|
|
|
|
2017-06-05 12:42:13 +00:00
|
|
|
let load ~dir ~scope =
|
2017-02-26 19:49:54 +00:00
|
|
|
let file = Path.relative dir "jbuild" in
|
2017-12-12 10:16:17 +00:00
|
|
|
match Sexp.load_many_or_ocaml_script (Path.to_string file) with
|
2017-02-26 19:49:54 +00:00
|
|
|
| Sexps sexps ->
|
2018-01-22 11:32:40 +00:00
|
|
|
Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps ~file)
|
2017-02-26 19:49:54 +00:00
|
|
|
| Ocaml_script ->
|
2017-06-05 12:42:13 +00:00
|
|
|
Script { dir; scope }
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-09-29 13:27:27 +00:00
|
|
|
let load ?extra_ignored_subtrees () =
|
|
|
|
let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
|
2017-09-29 13:09:41 +00:00
|
|
|
let packages =
|
|
|
|
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
|
2017-02-23 16:44:17 +00:00
|
|
|
let path = File_tree.Dir.path dir in
|
2017-03-15 11:41:44 +00:00
|
|
|
let files = File_tree.Dir.files dir in
|
2017-09-29 13:09:41 +00:00
|
|
|
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
|
|
|
|
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
|
|
|
|
match Opam_file.get_field opam "version" with
|
|
|
|
| Some (String (_, s)) -> Some s
|
|
|
|
| _ -> None
|
|
|
|
in
|
|
|
|
(pkg,
|
|
|
|
{ Package. name = pkg
|
|
|
|
; path
|
|
|
|
; version_from_opam_file
|
|
|
|
}) :: acc
|
|
|
|
| _ -> acc))
|
2017-03-15 11:41:44 +00:00
|
|
|
in
|
|
|
|
let packages =
|
|
|
|
String_map.of_alist_multi packages
|
2017-02-24 18:21:22 +00:00
|
|
|
|> String_map.mapi ~f:(fun name pkgs ->
|
|
|
|
match pkgs with
|
|
|
|
| [pkg] -> pkg
|
2017-02-23 16:44:17 +00:00
|
|
|
| _ ->
|
|
|
|
die "Too many opam files for package %S:\n%s"
|
2017-02-24 18:21:22 +00:00
|
|
|
name
|
2017-02-23 16:44:17 +00:00
|
|
|
(String.concat ~sep:"\n"
|
2017-02-24 18:21:22 +00:00
|
|
|
(List.map pkgs ~f:(fun pkg ->
|
2017-06-08 13:11:31 +00:00
|
|
|
sprintf "- %s" (Path.to_string (Package.opam_file pkg))))))
|
2017-02-23 16:44:17 +00:00
|
|
|
in
|
2017-06-05 12:42:13 +00:00
|
|
|
let scopes =
|
2017-02-24 18:21:22 +00:00
|
|
|
String_map.values packages
|
|
|
|
|> List.map ~f:(fun pkg -> (pkg.Package.path, pkg))
|
2017-02-23 16:44:17 +00:00
|
|
|
|> Path.Map.of_alist_multi
|
2017-06-05 12:42:13 +00:00
|
|
|
|> Path.Map.map ~f:Scope.make
|
2017-02-23 16:44:17 +00:00
|
|
|
in
|
2017-12-17 14:56:05 +00:00
|
|
|
let scopes =
|
|
|
|
if Path.Map.mem Path.root scopes then
|
|
|
|
scopes
|
|
|
|
else
|
|
|
|
Path.Map.add scopes ~key:Path.root ~data:Scope.empty
|
|
|
|
in
|
2017-06-05 12:42:13 +00:00
|
|
|
let rec walk dir jbuilds scope =
|
2017-09-29 13:27:27 +00:00
|
|
|
if File_tree.Dir.ignored dir then
|
|
|
|
jbuilds
|
2017-09-29 13:09:41 +00:00
|
|
|
else begin
|
|
|
|
let path = File_tree.Dir.path dir in
|
|
|
|
let files = File_tree.Dir.files dir in
|
|
|
|
let sub_dirs = File_tree.Dir.sub_dirs dir in
|
|
|
|
let scope = Path.Map.find_default path scopes ~default:scope in
|
|
|
|
let jbuilds =
|
|
|
|
if String_set.mem "jbuild" files then
|
|
|
|
let jbuild = load ~dir:path ~scope in
|
|
|
|
jbuild :: jbuilds
|
|
|
|
else
|
|
|
|
jbuilds
|
|
|
|
in
|
2017-09-29 13:27:27 +00:00
|
|
|
String_map.fold sub_dirs ~init:jbuilds
|
|
|
|
~f:(fun ~key:_ ~data:dir jbuilds ->
|
|
|
|
walk dir jbuilds scope)
|
2017-09-29 13:09:41 +00:00
|
|
|
end
|
2016-12-15 11:20:46 +00:00
|
|
|
in
|
2017-09-29 13:27:27 +00:00
|
|
|
let jbuilds = walk (File_tree.root ftree) [] Scope.empty in
|
2016-12-31 15:12:39 +00:00
|
|
|
{ file_tree = ftree
|
2017-02-25 18:21:23 +00:00
|
|
|
; jbuilds
|
2016-12-15 11:20:46 +00:00
|
|
|
; packages
|
2017-12-17 14:56:05 +00:00
|
|
|
; scopes = Path.Map.values scopes
|
2016-12-15 11:20:46 +00:00
|
|
|
}
|