2017-02-21 15:09:58 +00:00
|
|
|
open Jbuilder
|
|
|
|
open Import
|
|
|
|
open Jbuilder_cmdliner.Cmdliner
|
|
|
|
|
2017-02-23 16:44:17 +00:00
|
|
|
(* Things in src/ don't depend on cmdliner to speed up the bootstrap, so we set this
|
|
|
|
reference here *)
|
|
|
|
let () = suggest_function := Jbuilder_cmdliner.Cmdliner_suggest.value
|
|
|
|
|
2017-02-21 15:09:58 +00:00
|
|
|
let (>>=) = Future.(>>=)
|
|
|
|
|
|
|
|
type common =
|
2017-02-27 15:04:49 +00:00
|
|
|
{ concurrency : int
|
|
|
|
; debug_rules : bool
|
|
|
|
; debug_dep_path : bool
|
|
|
|
; debug_findlib : bool
|
|
|
|
; dev_mode : bool
|
|
|
|
; workspace_file : string option
|
2017-02-21 15:09:58 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
let set_common c =
|
|
|
|
Clflags.concurrency := c.concurrency;
|
|
|
|
Clflags.debug_rules := c.debug_rules;
|
|
|
|
Clflags.debug_dep_path := c.debug_dep_path;
|
2017-02-24 12:19:02 +00:00
|
|
|
Clflags.debug_findlib := c.debug_findlib;
|
|
|
|
Clflags.dev_mode := c.dev_mode
|
2017-02-21 15:09:58 +00:00
|
|
|
|
2017-02-27 15:04:49 +00:00
|
|
|
module Main = struct
|
|
|
|
include Jbuilder.Main
|
|
|
|
|
|
|
|
let setup common =
|
|
|
|
setup ?workspace_file:common.workspace_file ()
|
|
|
|
end
|
|
|
|
|
|
|
|
let create_log = Main.create_log
|
|
|
|
|
2017-02-21 15:09:58 +00:00
|
|
|
let copts_sect = "COMMON OPTIONS"
|
|
|
|
let help_secs =
|
|
|
|
[ `S copts_sect
|
|
|
|
; `P "These options are common to all commands."
|
|
|
|
; `S "MORE HELP"
|
|
|
|
; `P "Use `$(mname) $(i,COMMAND) --help' for help on a single command."
|
|
|
|
; `S "BUGS"
|
|
|
|
; `P "Check bug reports at https://github.com/janestreet/jbuilder/issues"
|
|
|
|
]
|
|
|
|
|
|
|
|
let common =
|
2017-02-27 15:04:49 +00:00
|
|
|
let make concurrency debug_rules debug_dep_path debug_findlib dev_mode workspace_file =
|
2017-02-24 12:19:02 +00:00
|
|
|
{ concurrency
|
|
|
|
; debug_rules
|
|
|
|
; debug_dep_path
|
|
|
|
; debug_findlib
|
|
|
|
; dev_mode
|
2017-02-27 15:04:49 +00:00
|
|
|
; workspace_file
|
2017-02-24 12:19:02 +00:00
|
|
|
}
|
|
|
|
in
|
2017-02-21 15:09:58 +00:00
|
|
|
let docs = copts_sect in
|
|
|
|
let concurrency =
|
|
|
|
Arg.(value & opt int !Clflags.concurrency & info ["j"] ~docs) in
|
|
|
|
let drules = Arg.(value & flag & info ["drules"] ~docs) in
|
|
|
|
let ddep_path = Arg.(value & flag & info ["ddep-path"] ~docs) in
|
|
|
|
let dfindlib = Arg.(value & flag & info ["dfindlib"] ~docs) in
|
2017-02-24 12:19:02 +00:00
|
|
|
let dev = Arg.(value & flag & info ["dev"] ~docs) in
|
2017-02-27 15:04:49 +00:00
|
|
|
let workspace_file =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some file) None
|
|
|
|
& info ["workspace"] ~docs
|
|
|
|
~doc:"Use this specific workspace file instead of looking it up")
|
|
|
|
in
|
|
|
|
Term.(const make
|
|
|
|
$ concurrency
|
|
|
|
$ drules
|
|
|
|
$ ddep_path
|
|
|
|
$ dfindlib
|
|
|
|
$ dev
|
|
|
|
$ workspace_file
|
|
|
|
)
|
2017-02-21 15:09:58 +00:00
|
|
|
|
2017-02-24 16:29:08 +00:00
|
|
|
let installed_libraries =
|
|
|
|
let doc = "Print out libraries installed on the system." in
|
|
|
|
let go common =
|
|
|
|
set_common common;
|
|
|
|
Future.Scheduler.go ~log:(create_log ())
|
2017-02-26 20:53:32 +00:00
|
|
|
(Context.default () >>= fun ctx ->
|
2017-02-28 06:01:27 +00:00
|
|
|
let findlib = ctx.findlib in
|
2017-02-24 16:29:08 +00:00
|
|
|
let pkgs = Findlib.all_packages findlib in
|
|
|
|
let max_len = List.longest_map pkgs ~f:(fun p -> p.name) in
|
|
|
|
List.iter pkgs ~f:(fun pkg ->
|
|
|
|
let ver =
|
|
|
|
match pkg.Findlib.version with
|
|
|
|
| "" -> "n/a"
|
|
|
|
| v -> v
|
|
|
|
in
|
|
|
|
Printf.printf "%-*s (version: %s)\n" max_len pkg.name ver);
|
|
|
|
Future.return ())
|
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common)
|
|
|
|
, Term.info "installed-libraries" ~doc
|
|
|
|
)
|
|
|
|
|
2017-02-24 15:41:52 +00:00
|
|
|
let resolve_package_install setup pkg =
|
|
|
|
match Main.package_install_file setup pkg with
|
|
|
|
| Ok path -> path
|
|
|
|
| Error () ->
|
|
|
|
die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages))
|
|
|
|
|
2017-02-27 15:04:49 +00:00
|
|
|
let build_package common pkg =
|
2017-02-23 11:45:03 +00:00
|
|
|
Future.Scheduler.go ~log:(create_log ())
|
2017-02-27 15:04:49 +00:00
|
|
|
(Main.setup common >>= fun setup ->
|
2017-02-24 15:41:52 +00:00
|
|
|
Build_system.do_build_exn setup.build_system
|
|
|
|
[resolve_package_install setup pkg])
|
2017-02-21 15:09:58 +00:00
|
|
|
|
|
|
|
let build_package =
|
2017-02-24 16:29:08 +00:00
|
|
|
let doc = "Build a single package in release mode." in
|
2017-02-23 10:23:15 +00:00
|
|
|
let name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
2017-02-21 15:09:58 +00:00
|
|
|
let go common pkg =
|
|
|
|
set_common common;
|
2017-02-27 15:04:49 +00:00
|
|
|
build_package common pkg
|
2017-02-21 15:09:58 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
|
|
|
$ Arg.(required & pos 0 (some string) None name_))
|
|
|
|
, Term.info "build-package" ~doc ~man:help_secs)
|
|
|
|
|
|
|
|
let external_lib_deps packages =
|
2017-02-23 11:45:03 +00:00
|
|
|
let log = create_log () in
|
2017-02-21 15:09:58 +00:00
|
|
|
let deps =
|
2017-02-24 13:08:37 +00:00
|
|
|
Path.Map.fold (Main.external_lib_deps ~log ~packages ()) ~init:String_map.empty
|
2017-02-21 15:09:58 +00:00
|
|
|
~f:(fun ~key:_ ~data:deps acc -> Build.merge_lib_deps deps acc)
|
|
|
|
in
|
|
|
|
String_map.iter deps ~f:(fun ~key:n ~data ->
|
|
|
|
match (data : Build.lib_dep_kind) with
|
|
|
|
| Required -> Printf.printf "%s\n" n
|
|
|
|
| Optional -> Printf.printf "%s (optional)\n" n)
|
|
|
|
|
|
|
|
let external_lib_deps =
|
2017-02-24 16:29:08 +00:00
|
|
|
let doc = "Print out external library dependencies." in
|
2017-02-23 10:23:15 +00:00
|
|
|
let name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
2017-02-21 15:09:58 +00:00
|
|
|
let go common packages =
|
|
|
|
set_common common;
|
|
|
|
external_lib_deps packages
|
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
|
|
|
$ Arg.(non_empty & pos_all string [] name_))
|
|
|
|
, Term.info "external-lib-deps" ~doc ~man:help_secs)
|
|
|
|
|
2017-02-24 12:31:01 +00:00
|
|
|
type target =
|
|
|
|
| File of Path.t
|
|
|
|
| Alias of Path.t * Alias.t
|
|
|
|
|
|
|
|
let resolve_targets (setup : Main.setup) user_targets =
|
2017-02-23 10:03:35 +00:00
|
|
|
match user_targets with
|
|
|
|
| [] -> []
|
|
|
|
| _ ->
|
2017-02-24 12:31:01 +00:00
|
|
|
let targets =
|
2017-02-25 02:14:32 +00:00
|
|
|
List.concat_map user_targets ~f:(fun s ->
|
2017-02-24 12:31:01 +00:00
|
|
|
if String.is_prefix s ~prefix:"@" then
|
|
|
|
let s = String.sub s ~pos:1 ~len:(String.length s - 1) in
|
|
|
|
let path = Path.relative Path.root s in
|
|
|
|
if Path.is_root path then
|
|
|
|
die "@ on the command line must be followed by a valid alias name"
|
|
|
|
else
|
|
|
|
let dir = Path.parent path in
|
2017-02-25 01:33:37 +00:00
|
|
|
let name = Path.basename path in
|
2017-02-25 02:14:32 +00:00
|
|
|
[Alias (path, Alias.make ~dir name)]
|
2017-02-23 10:03:35 +00:00
|
|
|
else
|
2017-02-25 02:14:32 +00:00
|
|
|
let path = Path.relative Path.root s in
|
2017-02-25 14:01:08 +00:00
|
|
|
let can't_build path =
|
|
|
|
die "Don't know how to build %s" (Path.to_string path)
|
|
|
|
in
|
|
|
|
if not (Path.is_local path) then
|
2017-02-25 02:14:32 +00:00
|
|
|
[File path]
|
2017-02-25 14:01:08 +00:00
|
|
|
else if Path.is_in_build_dir path then begin
|
|
|
|
if Build_system.is_target setup.build_system path then
|
|
|
|
[File path]
|
|
|
|
else
|
|
|
|
can't_build path
|
|
|
|
end else
|
2017-02-25 02:14:32 +00:00
|
|
|
match
|
2017-02-25 14:01:08 +00:00
|
|
|
let l =
|
|
|
|
List.filter_map setup.contexts ~f:(fun ctx ->
|
|
|
|
let path = Path.append ctx.Context.build_dir path in
|
|
|
|
if Build_system.is_target setup.build_system path then
|
|
|
|
Some (File path)
|
|
|
|
else
|
|
|
|
None)
|
|
|
|
in
|
|
|
|
if Build_system.is_target setup.build_system path ||
|
|
|
|
Path.exists path then
|
|
|
|
File path :: l
|
|
|
|
else
|
|
|
|
l
|
2017-02-25 02:14:32 +00:00
|
|
|
with
|
2017-02-25 14:01:08 +00:00
|
|
|
| [] -> can't_build path
|
2017-02-25 02:14:32 +00:00
|
|
|
| l -> l
|
|
|
|
)
|
2017-02-23 10:03:35 +00:00
|
|
|
in
|
|
|
|
Printf.printf "Building the following targets:\n";
|
2017-02-24 12:31:01 +00:00
|
|
|
List.iter targets ~f:(function
|
|
|
|
| File path ->
|
|
|
|
Printf.printf "- %s\n" (Path.to_string path)
|
|
|
|
| Alias (path, _) ->
|
|
|
|
Printf.printf "- alias %s\n" (Path.to_string path));
|
2017-02-23 10:03:35 +00:00
|
|
|
flush stdout;
|
2017-02-24 12:31:01 +00:00
|
|
|
List.map targets ~f:(function
|
|
|
|
| File path -> path
|
|
|
|
| Alias (_, alias) -> Alias.file alias)
|
2017-02-23 10:03:35 +00:00
|
|
|
|
2017-02-24 15:47:09 +00:00
|
|
|
let build_targets =
|
2017-02-24 16:29:08 +00:00
|
|
|
let doc = "Build targets." in
|
2017-02-23 10:23:15 +00:00
|
|
|
let name_ = Arg.info [] ~docv:"TARGET" in
|
2017-02-21 15:09:58 +00:00
|
|
|
let go common targets =
|
|
|
|
set_common common;
|
2017-02-23 11:45:03 +00:00
|
|
|
Future.Scheduler.go ~log:(create_log ())
|
2017-02-27 15:04:49 +00:00
|
|
|
(Main.setup common >>= fun setup ->
|
2017-02-23 14:58:18 +00:00
|
|
|
let targets = resolve_targets setup targets in
|
|
|
|
Build_system.do_build_exn setup.build_system targets) in
|
2017-02-21 15:09:58 +00:00
|
|
|
( Term.(const go
|
|
|
|
$ common
|
|
|
|
$ Arg.(non_empty & pos_all string [] name_))
|
2017-02-24 15:47:09 +00:00
|
|
|
, Term.info "build" ~doc ~man:help_secs)
|
2017-02-21 15:09:58 +00:00
|
|
|
|
2017-02-23 13:17:25 +00:00
|
|
|
let runtest =
|
2017-02-24 16:29:08 +00:00
|
|
|
let doc = "Run tests." in
|
2017-02-23 13:17:25 +00:00
|
|
|
let name_ = Arg.info [] ~docv:"DIR" in
|
|
|
|
let go common dirs =
|
|
|
|
set_common common;
|
|
|
|
Future.Scheduler.go ~log:(create_log ())
|
2017-02-27 15:04:49 +00:00
|
|
|
(Main.setup common >>= fun setup ->
|
2017-02-23 13:17:25 +00:00
|
|
|
let targets =
|
|
|
|
List.map dirs ~f:(fun dir ->
|
2017-02-25 02:02:11 +00:00
|
|
|
let dir = Path.(relative root) dir in
|
2017-02-23 13:17:25 +00:00
|
|
|
Alias.file (Alias.runtest ~dir))
|
|
|
|
in
|
2017-02-23 14:58:18 +00:00
|
|
|
Build_system.do_build_exn setup.build_system targets) in
|
2017-02-23 13:17:25 +00:00
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-02-24 15:41:52 +00:00
|
|
|
$ Arg.(value & pos_all string ["."] name_))
|
2017-02-23 13:17:25 +00:00
|
|
|
, Term.info "runtest" ~doc ~man:help_secs)
|
|
|
|
|
2017-02-25 01:45:41 +00:00
|
|
|
let opam_installer () =
|
|
|
|
match Bin.which "opam-installer" with
|
2017-02-24 15:41:52 +00:00
|
|
|
| None ->
|
|
|
|
die "\
|
|
|
|
Sorry, you need the opam-installer tool to be able to install or
|
|
|
|
uninstall packages.
|
|
|
|
|
|
|
|
I couldn't find the opam-installer binary :-("
|
|
|
|
| Some fn -> fn
|
|
|
|
|
2017-02-25 01:45:41 +00:00
|
|
|
let get_prefix context ~from_command_line =
|
2017-02-24 15:41:52 +00:00
|
|
|
match from_command_line with
|
|
|
|
| Some p -> Future.return (Path.of_string p)
|
2017-02-25 01:45:41 +00:00
|
|
|
| None -> Context.install_prefix context
|
2017-02-24 15:41:52 +00:00
|
|
|
|
|
|
|
let install_uninstall ~what =
|
2017-02-26 21:30:28 +00:00
|
|
|
let doc =
|
|
|
|
sprintf "%s packages using opam-installer." (String.capitalize_ascii what)
|
|
|
|
in
|
2017-02-24 15:41:52 +00:00
|
|
|
let name_ = Arg.info [] ~docv:"PACKAGE" in
|
|
|
|
let go common prefix pkgs =
|
|
|
|
set_common common;
|
2017-02-25 01:45:41 +00:00
|
|
|
let opam_installer = opam_installer () in
|
2017-02-24 15:41:52 +00:00
|
|
|
Future.Scheduler.go ~log:(create_log ())
|
2017-02-27 15:04:49 +00:00
|
|
|
(Main.setup common >>= fun setup ->
|
2017-02-25 01:45:41 +00:00
|
|
|
let pkgs =
|
|
|
|
match pkgs with
|
|
|
|
| [] -> String_map.keys setup.packages
|
|
|
|
| l -> l
|
|
|
|
in
|
2017-02-24 15:41:52 +00:00
|
|
|
let install_files, missing_install_files =
|
2017-02-25 14:15:52 +00:00
|
|
|
List.concat_map pkgs ~f:(fun pkg ->
|
2017-02-24 15:41:52 +00:00
|
|
|
let fn = resolve_package_install setup pkg in
|
2017-02-25 14:15:52 +00:00
|
|
|
List.map setup.contexts ~f:(fun ctx ->
|
|
|
|
let fn = Path.append ctx.Context.build_dir fn in
|
|
|
|
if Path.exists fn then
|
|
|
|
Inl (ctx, fn)
|
|
|
|
else
|
|
|
|
Inr fn))
|
|
|
|
|> List.partition_map ~f:(fun x -> x)
|
2017-02-24 15:41:52 +00:00
|
|
|
in
|
|
|
|
if missing_install_files <> [] then begin
|
2017-02-25 14:15:52 +00:00
|
|
|
die "The following <package>.install are missing:\n\
|
2017-02-24 15:41:52 +00:00
|
|
|
%s\n\
|
2017-02-25 14:15:52 +00:00
|
|
|
You need to run: jbuilder build @install"
|
2017-02-24 15:41:52 +00:00
|
|
|
(String.concat ~sep:"\n"
|
2017-02-25 14:15:52 +00:00
|
|
|
(List.map missing_install_files
|
|
|
|
~f:(fun p -> sprintf "- %s" (Path.to_string p))))
|
2017-02-24 15:41:52 +00:00
|
|
|
end;
|
2017-02-25 02:38:41 +00:00
|
|
|
(match setup.contexts, prefix with
|
2017-02-25 01:45:41 +00:00
|
|
|
| _ :: _ :: _, Some _ ->
|
|
|
|
die "Cannot specify --prefix when installing into multiple contexts!"
|
|
|
|
| _ -> ());
|
2017-02-25 14:15:52 +00:00
|
|
|
let module CMap = Map.Make(Context) in
|
|
|
|
let install_files_by_context = CMap.of_alist_multi install_files |> CMap.bindings in
|
2017-02-24 15:41:52 +00:00
|
|
|
Future.all_unit
|
2017-02-25 14:15:52 +00:00
|
|
|
(List.map install_files_by_context ~f:(fun (context, install_files) ->
|
2017-02-25 01:45:41 +00:00
|
|
|
get_prefix context ~from_command_line:prefix >>= fun prefix ->
|
|
|
|
Future.all_unit
|
|
|
|
(List.map install_files ~f:(fun path ->
|
2017-02-27 11:37:28 +00:00
|
|
|
Future.run Strict (Path.to_string opam_installer)
|
2017-02-25 01:45:41 +00:00
|
|
|
[ sprintf "-%c" what.[0]
|
|
|
|
; "--prefix"
|
|
|
|
; Path.to_string prefix
|
|
|
|
; Path.to_string path
|
|
|
|
])))))
|
2017-02-24 15:41:52 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
|
|
|
$ Arg.(value & opt (some dir) None & info ["prefix"])
|
|
|
|
$ Arg.(value & pos_all string [] name_))
|
|
|
|
, Term.info what ~doc ~man:help_secs)
|
|
|
|
|
|
|
|
let install = install_uninstall ~what:"install"
|
|
|
|
let uninstall = install_uninstall ~what:"uninstall"
|
|
|
|
|
2017-02-21 15:09:58 +00:00
|
|
|
let all =
|
2017-02-24 16:29:08 +00:00
|
|
|
[ installed_libraries
|
2017-02-23 13:17:25 +00:00
|
|
|
; build_package
|
|
|
|
; external_lib_deps
|
2017-02-24 15:47:09 +00:00
|
|
|
; build_targets
|
2017-02-23 13:17:25 +00:00
|
|
|
; runtest
|
2017-02-24 15:41:52 +00:00
|
|
|
; install
|
|
|
|
; uninstall
|
2017-02-23 13:17:25 +00:00
|
|
|
]
|
2017-02-21 15:09:58 +00:00
|
|
|
|
2017-02-24 15:47:09 +00:00
|
|
|
let default =
|
|
|
|
let doc = "fast, portable and opinionated build system for OCaml" in
|
|
|
|
( Term.(ret @@ const @@ `Help (`Pager, None))
|
|
|
|
, Term.info "jbuilder" ~doc)
|
|
|
|
|
2017-02-21 15:09:58 +00:00
|
|
|
let () =
|
2017-02-24 11:28:30 +00:00
|
|
|
Ansi_color.setup_err_formatter_colors ();
|
2017-02-21 15:09:58 +00:00
|
|
|
try
|
2017-02-24 15:47:09 +00:00
|
|
|
match Term.eval_choice default all ~catch:false with
|
2017-02-21 15:09:58 +00:00
|
|
|
| `Error _ -> exit 1
|
|
|
|
| _ -> exit 0
|
|
|
|
with exn ->
|
|
|
|
Format.eprintf "%a@?" (Main.report_error ?map_fname:None) exn;
|
|
|
|
exit 1
|