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.(>>=)
|
2017-08-04 07:59:35 +00:00
|
|
|
let (>>|) = Future.(>>|)
|
2017-02-21 15:09:58 +00:00
|
|
|
|
|
|
|
type common =
|
2017-05-29 13:17:59 +00:00
|
|
|
{ concurrency : int
|
|
|
|
; debug_dep_path : bool
|
|
|
|
; debug_findlib : bool
|
|
|
|
; debug_backtraces : bool
|
|
|
|
; dev_mode : bool
|
|
|
|
; verbose : bool
|
|
|
|
; workspace_file : string option
|
|
|
|
; root : string
|
|
|
|
; target_prefix : string
|
|
|
|
; only_packages : String_set.t option
|
|
|
|
; capture_outputs : bool
|
2017-12-21 11:54:00 +00:00
|
|
|
; x : string option
|
2018-01-15 13:24:25 +00:00
|
|
|
; diff_command : string option
|
|
|
|
; promote_mode : Clflags.Promote_mode.t
|
2017-05-19 13:16:00 +00:00
|
|
|
; (* Original arguments for the external-lib-deps hint *)
|
2017-05-29 13:17:59 +00:00
|
|
|
orig_args : string list
|
2017-02-21 15:09:58 +00:00
|
|
|
}
|
|
|
|
|
2017-02-28 07:32:15 +00:00
|
|
|
let prefix_target common s = common.target_prefix ^ s
|
|
|
|
|
2017-05-19 13:16:00 +00:00
|
|
|
let set_common c ~targets =
|
2017-02-21 15:09:58 +00:00
|
|
|
Clflags.concurrency := c.concurrency;
|
|
|
|
Clflags.debug_dep_path := c.debug_dep_path;
|
2017-02-24 12:19:02 +00:00
|
|
|
Clflags.debug_findlib := c.debug_findlib;
|
2017-05-29 13:17:59 +00:00
|
|
|
Clflags.debug_backtraces := c.debug_backtraces;
|
2017-02-28 07:32:15 +00:00
|
|
|
Clflags.dev_mode := c.dev_mode;
|
2017-03-30 16:36:58 +00:00
|
|
|
Clflags.verbose := c.verbose;
|
2017-05-29 09:57:04 +00:00
|
|
|
Clflags.capture_outputs := c.capture_outputs;
|
2017-02-28 07:32:15 +00:00
|
|
|
if c.root <> Filename.current_dir_name then
|
2017-05-19 13:16:00 +00:00
|
|
|
Sys.chdir c.root;
|
2017-09-29 13:01:54 +00:00
|
|
|
Clflags.workspace_root := Sys.getcwd ();
|
2018-01-15 13:24:25 +00:00
|
|
|
Clflags.diff_command := c.diff_command;
|
|
|
|
Clflags.promote_mode := c.promote_mode;
|
2017-05-19 13:16:00 +00:00
|
|
|
Clflags.external_lib_deps_hint :=
|
|
|
|
List.concat
|
|
|
|
[ ["jbuilder"; "external-lib-deps"; "--missing"]
|
|
|
|
; c.orig_args
|
|
|
|
; targets
|
|
|
|
]
|
2017-02-21 15:09:58 +00:00
|
|
|
|
2017-11-12 19:55:49 +00:00
|
|
|
let restore_cwd_and_execve common prog argv env =
|
|
|
|
let prog =
|
|
|
|
if Filename.is_relative prog then
|
|
|
|
Filename.concat common.root prog
|
|
|
|
else
|
|
|
|
prog
|
|
|
|
in
|
|
|
|
Sys.chdir initial_cwd;
|
2017-08-04 07:59:35 +00:00
|
|
|
if Sys.win32 then
|
2017-11-12 19:55:49 +00:00
|
|
|
let pid = Unix.create_process_env prog argv env
|
|
|
|
Unix.stdin Unix.stdout Unix.stderr
|
|
|
|
in
|
|
|
|
match snd (Unix.waitpid [] pid) with
|
|
|
|
| WEXITED 0 -> ()
|
|
|
|
| WEXITED n -> exit n
|
|
|
|
| WSIGNALED _ -> exit 255
|
|
|
|
| WSTOPPED _ -> assert false
|
2017-08-04 07:59:35 +00:00
|
|
|
else
|
2017-11-12 19:55:49 +00:00
|
|
|
Unix.execve prog argv env
|
2017-08-04 07:59:35 +00:00
|
|
|
|
2017-02-27 15:04:49 +00:00
|
|
|
module Main = struct
|
|
|
|
include Jbuilder.Main
|
|
|
|
|
2017-11-28 11:03:22 +00:00
|
|
|
let setup ~log ?unlink_aliases ?filter_out_optional_stanzas_with_missing_deps common =
|
2017-03-02 18:21:19 +00:00
|
|
|
setup
|
2017-03-10 12:32:27 +00:00
|
|
|
~log
|
2017-11-28 11:03:22 +00:00
|
|
|
?unlink_aliases
|
2017-03-02 18:21:19 +00:00
|
|
|
?workspace_file:common.workspace_file
|
|
|
|
?only_packages:common.only_packages
|
2017-12-21 11:54:00 +00:00
|
|
|
?filter_out_optional_stanzas_with_missing_deps
|
|
|
|
?x:common.x
|
|
|
|
()
|
2017-02-27 15:04:49 +00:00
|
|
|
end
|
|
|
|
|
2017-09-29 15:06:29 +00:00
|
|
|
type target =
|
|
|
|
| File of Path.t
|
|
|
|
| Alias_rec of Alias.t
|
|
|
|
|
|
|
|
let request_of_targets (setup : Main.setup) targets =
|
|
|
|
let open Build.O in
|
|
|
|
List.fold_left targets ~init:(Build.return ()) ~f:(fun acc target ->
|
|
|
|
acc >>>
|
|
|
|
match target with
|
|
|
|
| File path -> Build.path path
|
|
|
|
| Alias_rec alias ->
|
|
|
|
Alias.dep_rec ~loc:(Loc.in_file "<command-line>")
|
|
|
|
~file_tree:setup.file_tree alias)
|
|
|
|
|
2017-03-01 19:19:43 +00:00
|
|
|
let do_build (setup : Main.setup) targets =
|
2017-09-29 15:06:29 +00:00
|
|
|
Build_system.do_build_exn setup.build_system
|
|
|
|
~request:(request_of_targets setup targets)
|
2017-03-01 19:19:43 +00:00
|
|
|
|
2017-02-28 07:32:15 +00:00
|
|
|
let find_root () =
|
|
|
|
let cwd = Sys.getcwd () in
|
|
|
|
let rec loop counter ~candidates ~to_cwd dir =
|
|
|
|
let files = Sys.readdir dir |> Array.to_list |> String_set.of_list in
|
|
|
|
if String_set.mem "jbuild-workspace" files then
|
|
|
|
cont counter ~candidates:((0, dir, to_cwd) :: candidates) dir ~to_cwd
|
|
|
|
else if String_set.exists files ~f:(fun fn ->
|
2017-03-10 10:41:34 +00:00
|
|
|
String.is_prefix fn ~prefix:"jbuild-workspace") then
|
2017-02-28 07:32:15 +00:00
|
|
|
cont counter ~candidates:((1, dir, to_cwd) :: candidates) dir ~to_cwd
|
|
|
|
else
|
|
|
|
cont counter ~candidates dir ~to_cwd
|
|
|
|
and cont counter ~candidates ~to_cwd dir =
|
|
|
|
if counter > String.length cwd then
|
|
|
|
candidates
|
|
|
|
else
|
|
|
|
let parent = Filename.dirname dir in
|
|
|
|
if parent = dir then
|
|
|
|
candidates
|
|
|
|
else
|
|
|
|
let base = Filename.basename dir in
|
|
|
|
loop (counter + 1) parent ~candidates ~to_cwd:(base :: to_cwd)
|
|
|
|
in
|
|
|
|
match loop 0 ~candidates:[] ~to_cwd:[] cwd with
|
|
|
|
| [] -> (cwd, [])
|
|
|
|
| l ->
|
|
|
|
let lowest_priority =
|
|
|
|
List.fold_left l ~init:max_int ~f:(fun acc (prio, _, _) ->
|
|
|
|
min acc prio)
|
|
|
|
in
|
|
|
|
match List.find l ~f:(fun (prio, _, _) -> prio = lowest_priority) with
|
|
|
|
| None -> assert false
|
|
|
|
| Some (_, dir, to_cwd) -> (dir, to_cwd)
|
|
|
|
|
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-05-19 13:16:00 +00:00
|
|
|
let dump_opt name value =
|
|
|
|
match value with
|
|
|
|
| None -> []
|
|
|
|
| Some s -> [name; s]
|
|
|
|
in
|
2017-03-02 18:21:19 +00:00
|
|
|
let make
|
|
|
|
concurrency
|
|
|
|
debug_dep_path
|
|
|
|
debug_findlib
|
2017-05-29 13:17:59 +00:00
|
|
|
debug_backtraces
|
2017-03-02 18:21:19 +00:00
|
|
|
dev_mode
|
2017-03-30 16:36:58 +00:00
|
|
|
verbose
|
2017-05-29 09:57:04 +00:00
|
|
|
no_buffer
|
2017-03-02 18:21:19 +00:00
|
|
|
workspace_file
|
2018-01-15 13:24:25 +00:00
|
|
|
diff_command
|
|
|
|
(root, only_packages, promote_mode, orig)
|
2017-12-21 11:54:00 +00:00
|
|
|
x
|
2017-03-02 18:21:19 +00:00
|
|
|
=
|
2017-02-28 07:32:15 +00:00
|
|
|
let root, to_cwd =
|
|
|
|
match root with
|
|
|
|
| Some dn -> (dn, [])
|
|
|
|
| None -> find_root ()
|
|
|
|
in
|
2017-05-19 13:16:00 +00:00
|
|
|
let orig_args =
|
|
|
|
List.concat
|
|
|
|
[ if dev_mode then ["--dev"] else []
|
|
|
|
; dump_opt "--workspace" workspace_file
|
|
|
|
; orig
|
|
|
|
]
|
|
|
|
in
|
2017-02-24 12:19:02 +00:00
|
|
|
{ concurrency
|
|
|
|
; debug_dep_path
|
|
|
|
; debug_findlib
|
2017-05-29 13:17:59 +00:00
|
|
|
; debug_backtraces
|
2017-02-24 12:19:02 +00:00
|
|
|
; dev_mode
|
2017-03-30 16:36:58 +00:00
|
|
|
; verbose
|
2017-05-29 09:57:04 +00:00
|
|
|
; capture_outputs = not no_buffer
|
2017-02-27 15:04:49 +00:00
|
|
|
; workspace_file
|
2017-02-28 07:32:15 +00:00
|
|
|
; root
|
2017-05-19 13:16:00 +00:00
|
|
|
; orig_args
|
2017-02-28 07:32:15 +00:00
|
|
|
; target_prefix = String.concat ~sep:"" (List.map to_cwd ~f:(sprintf "%s/"))
|
2018-01-15 13:24:25 +00:00
|
|
|
; diff_command
|
|
|
|
; promote_mode
|
2017-03-02 18:21:19 +00:00
|
|
|
; only_packages =
|
|
|
|
Option.map only_packages
|
|
|
|
~f:(fun s -> String_set.of_list (String.split s ~on:','))
|
2017-12-21 11:54:00 +00:00
|
|
|
; x
|
2017-02-24 12:19:02 +00:00
|
|
|
}
|
|
|
|
in
|
2017-02-21 15:09:58 +00:00
|
|
|
let docs = copts_sect in
|
|
|
|
let concurrency =
|
2017-02-28 19:05:04 +00:00
|
|
|
Arg.(value
|
|
|
|
& opt int !Clflags.concurrency
|
|
|
|
& info ["j"] ~docs ~docv:"JOBS"
|
|
|
|
~doc:{|Run no more than $(i,JOBS) commands simultaneously.|}
|
|
|
|
)
|
|
|
|
in
|
2017-03-02 18:21:19 +00:00
|
|
|
let only_packages =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some string) None
|
|
|
|
& info ["only-packages"] ~docs ~docv:"PACKAGES"
|
|
|
|
~doc:{|Ignore stanzas referring to a package that is not in $(b,PACKAGES).
|
2017-06-02 09:51:32 +00:00
|
|
|
$(b,PACKAGES) is a comma-separated list of package names.
|
2017-05-26 11:33:55 +00:00
|
|
|
Note that this has the same effect as deleting the relevant stanzas
|
|
|
|
from jbuild files. It is mostly meant for releases.
|
|
|
|
During development, it is likely that what you want instead is to
|
|
|
|
build a particular $(b,<package>.install) target.|}
|
2017-03-02 18:21:19 +00:00
|
|
|
)
|
|
|
|
in
|
2017-02-28 19:05:04 +00:00
|
|
|
let ddep_path =
|
|
|
|
Arg.(value
|
|
|
|
& flag
|
2017-03-01 19:28:44 +00:00
|
|
|
& info ["debug-dependency-path"] ~docs
|
2017-02-28 19:05:04 +00:00
|
|
|
~doc:{|In case of error, print the dependency path from
|
|
|
|
the targets on the command line to the rule that failed.
|
|
|
|
|})
|
|
|
|
in
|
|
|
|
let dfindlib =
|
|
|
|
Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["debug-findlib"] ~docs
|
|
|
|
~doc:{|Debug the findlib sub-system.|})
|
|
|
|
in
|
2017-05-29 13:17:59 +00:00
|
|
|
let dbacktraces =
|
|
|
|
Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["debug-backtraces"] ~docs
|
|
|
|
~doc:{|Always print exception backtraces.|})
|
|
|
|
in
|
2017-02-28 19:05:04 +00:00
|
|
|
let dev =
|
|
|
|
Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["dev"] ~docs
|
|
|
|
~doc:{|Use stricter compilation flags by default.|})
|
|
|
|
in
|
2017-03-30 16:36:58 +00:00
|
|
|
let verbose =
|
|
|
|
Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["verbose"] ~docs
|
|
|
|
~doc:"Print detailed information about commands being run")
|
|
|
|
in
|
2017-05-29 09:57:04 +00:00
|
|
|
let no_buffer =
|
|
|
|
Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["no-buffer"] ~docs ~docv:"DIR"
|
|
|
|
~doc:{|Do not buffer the output of commands executed by jbuilder.
|
|
|
|
By default jbuilder buffers the output of subcommands, in order
|
|
|
|
to prevent interleaving when multiple commands are executed
|
|
|
|
in parallel. However, this can be an issue when debugging
|
|
|
|
long running tests. With $(b,--no-buffer), commands have direct
|
|
|
|
access to the terminal. Note that as a result their output won't
|
|
|
|
be captured in the log file.
|
|
|
|
|
|
|
|
You should use this option in conjunction with $(b,-j 1),
|
|
|
|
to avoid interleaving. Additionally you should use
|
|
|
|
$(b,--verbose) as well, to make sure that commands are printed
|
|
|
|
before they are being executed.|})
|
|
|
|
in
|
2017-02-27 15:04:49 +00:00
|
|
|
let workspace_file =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some file) None
|
2017-02-28 19:05:04 +00:00
|
|
|
& info ["workspace"] ~docs ~docv:"FILE"
|
2017-02-28 07:32:15 +00:00
|
|
|
~doc:"Use this specific workspace file instead of looking it up.")
|
|
|
|
in
|
|
|
|
let root =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some dir) None
|
2017-02-28 19:05:04 +00:00
|
|
|
& info ["root"] ~docs ~docv:"DIR"
|
|
|
|
~doc:{|Use this directory as workspace root instead of guessing it.
|
2017-04-04 15:56:14 +00:00
|
|
|
Note that this option doesn't change the interpretation of
|
|
|
|
targets given on the command line. It is only intended
|
2017-02-28 19:05:04 +00:00
|
|
|
for scripts.|})
|
2017-02-27 15:04:49 +00:00
|
|
|
in
|
2018-01-15 13:24:25 +00:00
|
|
|
let promote =
|
|
|
|
let mode =
|
|
|
|
Arg.(conv
|
|
|
|
(Arg.parser_of_kind_of_string ~kind:"promotion mode"
|
|
|
|
Clflags.Promote_mode.of_string,
|
|
|
|
fun ppf mode ->
|
|
|
|
Format.pp_print_string ppf
|
|
|
|
(Clflags.Promote_mode.to_string mode)))
|
|
|
|
in
|
|
|
|
Arg.(value
|
|
|
|
& opt (some mode) None
|
|
|
|
& info ["promote"] ~docs
|
2018-01-15 14:55:17 +00:00
|
|
|
~doc:"How to interpret promote actions. $(b,copy) means to print
|
|
|
|
a diff and copy the generated files to the source tree when
|
|
|
|
they differ. $(b,copy) is the default. $(b,check) means to
|
|
|
|
only print a diff without copying files. $(b,ignore) means
|
|
|
|
to ignore promote action altogether.")
|
2018-01-15 13:24:25 +00:00
|
|
|
in
|
2017-04-04 15:56:14 +00:00
|
|
|
let for_release = "for-release-of-packages" in
|
|
|
|
let frop =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some string) None
|
|
|
|
& info ["p"; for_release] ~docs ~docv:"PACKAGES"
|
2018-01-15 13:24:25 +00:00
|
|
|
~doc:{|Shorthand for $(b,--root . --only-packages PACKAGE --promote ignore).
|
|
|
|
You must use this option in your $(i,<package>.opam) files, in order
|
|
|
|
to build only what's necessary when your project contains multiple
|
|
|
|
packages as well as getting reproducible builds.|})
|
2017-04-04 15:56:14 +00:00
|
|
|
in
|
|
|
|
let root_and_only_packages =
|
2018-01-15 13:24:25 +00:00
|
|
|
let merge root only_packages promote release =
|
|
|
|
let fail opt =
|
2017-04-04 15:56:14 +00:00
|
|
|
`Error (true,
|
|
|
|
sprintf
|
2018-01-15 13:24:25 +00:00
|
|
|
"Cannot use -p/--%s and %s simultaneously"
|
|
|
|
for_release opt)
|
|
|
|
in
|
|
|
|
match release, root, only_packages, promote with
|
|
|
|
| Some _, Some _, _, _ -> fail "--root"
|
|
|
|
| Some _, _, Some _, _ -> fail "--only-packages"
|
|
|
|
| Some _, _, _, Some _ -> fail "--promote"
|
|
|
|
| Some pkgs, None, None, None ->
|
|
|
|
`Ok (Some ".",
|
|
|
|
Some pkgs,
|
|
|
|
Clflags.Promote_mode.Ignore,
|
|
|
|
["-p"; pkgs]
|
|
|
|
)
|
|
|
|
| None, _, _, _ ->
|
|
|
|
`Ok (root,
|
|
|
|
only_packages,
|
2018-01-15 14:55:17 +00:00
|
|
|
Option.value promote ~default:Clflags.Promote_mode.Copy,
|
2017-05-19 13:16:00 +00:00
|
|
|
List.concat
|
|
|
|
[ dump_opt "--root" root
|
|
|
|
; dump_opt "--only-packages" only_packages
|
2018-01-15 13:24:25 +00:00
|
|
|
; dump_opt "--promote"
|
|
|
|
(Option.map promote ~f:Clflags.Promote_mode.to_string)
|
2017-05-19 13:16:00 +00:00
|
|
|
])
|
2017-04-04 15:56:14 +00:00
|
|
|
in
|
|
|
|
Term.(ret (const merge
|
|
|
|
$ root
|
|
|
|
$ only_packages
|
2018-01-15 13:24:25 +00:00
|
|
|
$ promote
|
2017-04-04 15:56:14 +00:00
|
|
|
$ frop))
|
|
|
|
in
|
2017-12-21 11:54:00 +00:00
|
|
|
let x =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some string) None
|
|
|
|
& info ["x"] ~docs
|
|
|
|
~doc:{|Cross-compile using this toolchain.|})
|
|
|
|
in
|
2018-01-15 13:24:25 +00:00
|
|
|
let diff_command =
|
|
|
|
Arg.(value
|
|
|
|
& opt (some string) None
|
|
|
|
& info ["diff-command"] ~docs
|
|
|
|
~doc:"Shell command to use to diff files")
|
|
|
|
in
|
2017-02-27 15:04:49 +00:00
|
|
|
Term.(const make
|
|
|
|
$ concurrency
|
|
|
|
$ ddep_path
|
|
|
|
$ dfindlib
|
2017-05-29 13:17:59 +00:00
|
|
|
$ dbacktraces
|
2017-02-27 15:04:49 +00:00
|
|
|
$ dev
|
2017-03-30 16:36:58 +00:00
|
|
|
$ verbose
|
2017-05-29 09:57:04 +00:00
|
|
|
$ no_buffer
|
2017-02-27 15:04:49 +00:00
|
|
|
$ workspace_file
|
2018-01-15 13:24:25 +00:00
|
|
|
$ diff_command
|
2017-04-04 15:56:14 +00:00
|
|
|
$ root_and_only_packages
|
2017-12-21 11:54:00 +00:00
|
|
|
$ x
|
2017-02-27 15:04:49 +00:00
|
|
|
)
|
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
|
2017-05-17 13:54:50 +00:00
|
|
|
let go common na =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets:[];
|
2017-03-10 12:32:27 +00:00
|
|
|
Future.Scheduler.go ~log:(Log.create ())
|
2017-12-21 11:54:00 +00:00
|
|
|
(Context.create (Default [Native]) >>= fun ctxs ->
|
|
|
|
let ctx = List.hd ctxs in
|
2017-02-28 06:01:27 +00:00
|
|
|
let findlib = ctx.findlib in
|
2017-05-17 13:54:50 +00:00
|
|
|
if na then begin
|
|
|
|
let pkgs = Findlib.all_unavailable_packages findlib in
|
|
|
|
let longest = List.longest_map pkgs ~f:(fun na -> na.package) in
|
|
|
|
let ppf = Format.std_formatter in
|
|
|
|
List.iter pkgs ~f:(fun (na : Findlib.Package_not_available.t) ->
|
|
|
|
Format.fprintf ppf "%-*s -> %a@\n" longest na.package
|
|
|
|
Findlib.Package_not_available.explain na.reason);
|
|
|
|
Format.pp_print_flush ppf ();
|
|
|
|
Future.return ()
|
|
|
|
end else begin
|
|
|
|
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 ()
|
|
|
|
end)
|
2017-02-24 16:29:08 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
2017-05-17 13:54:50 +00:00
|
|
|
$ common
|
|
|
|
$ Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["na"; "not-available"]
|
|
|
|
~doc:"List libraries that are not available and explain why"))
|
2017-02-24 16:29:08 +00:00
|
|
|
, 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-04-25 15:22:17 +00:00
|
|
|
let target_hint (setup : Main.setup) path =
|
|
|
|
assert (Path.is_local path);
|
|
|
|
let sub_dir = Path.parent path in
|
|
|
|
let candidates = Build_system.all_targets setup.build_system in
|
|
|
|
let candidates =
|
|
|
|
if Path.is_in_build_dir path then
|
|
|
|
candidates
|
|
|
|
else
|
|
|
|
List.map candidates ~f:(fun path ->
|
|
|
|
match Path.extract_build_context path with
|
|
|
|
| None -> path
|
|
|
|
| Some (_, path) -> path)
|
|
|
|
in
|
|
|
|
let candidates =
|
|
|
|
(* Only suggest hints for the basename, otherwise it's slow when there are lots of
|
|
|
|
files *)
|
|
|
|
List.filter_map candidates ~f:(fun path ->
|
|
|
|
if Path.parent path = sub_dir then
|
|
|
|
Some (Path.to_string path)
|
|
|
|
else
|
|
|
|
None)
|
|
|
|
in
|
|
|
|
let candidates = String_set.of_list candidates |> String_set.elements in
|
|
|
|
hint (Path.to_string path) candidates
|
|
|
|
|
2017-03-30 16:36:58 +00:00
|
|
|
let resolve_targets ~log common (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-12-11 10:23:07 +00:00
|
|
|
List.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
|
2017-02-28 07:32:15 +00:00
|
|
|
let path = Path.relative Path.root (prefix_target common s) in
|
2017-02-24 12:31:01 +00:00
|
|
|
if Path.is_root path then
|
2017-03-27 22:16:16 +00:00
|
|
|
die "@@ on the command line must be followed by a valid alias name"
|
2017-02-24 12:31:01 +00:00
|
|
|
else
|
2017-12-11 10:23:07 +00:00
|
|
|
Ok [Alias_rec (Alias.of_path path)]
|
2017-02-23 10:03:35 +00:00
|
|
|
else
|
2017-02-28 07:32:15 +00:00
|
|
|
let path = Path.relative Path.root (prefix_target common s) in
|
2017-02-25 14:01:08 +00:00
|
|
|
let can't_build path =
|
2017-12-11 10:23:07 +00:00
|
|
|
Error (path, target_hint setup path);
|
2017-02-25 14:01:08 +00:00
|
|
|
in
|
|
|
|
if not (Path.is_local path) then
|
2017-12-11 10:23:07 +00:00
|
|
|
Ok [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
|
2017-12-11 10:23:07 +00:00
|
|
|
Ok [File path]
|
2017-02-25 14:01:08 +00:00
|
|
|
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-12-11 10:23:07 +00:00
|
|
|
| l -> Ok l
|
2017-02-25 02:14:32 +00:00
|
|
|
)
|
2017-02-23 10:03:35 +00:00
|
|
|
in
|
2017-03-30 16:36:58 +00:00
|
|
|
if !Clflags.verbose then begin
|
|
|
|
Log.info log "Actual targets:";
|
2017-12-11 10:23:07 +00:00
|
|
|
let targets =
|
|
|
|
List.concat_map targets ~f:(function
|
|
|
|
| Ok targets -> targets
|
|
|
|
| Error _ -> []) in
|
2017-03-30 16:36:58 +00:00
|
|
|
List.iter targets ~f:(function
|
|
|
|
| File path ->
|
|
|
|
Log.info log @@ "- " ^ (Path.to_string path)
|
2017-09-29 15:06:29 +00:00
|
|
|
| Alias_rec alias ->
|
|
|
|
let path = Alias.fully_qualified_name alias in
|
|
|
|
Log.info log @@ "- recursive alias " ^
|
|
|
|
(Path.to_string_maybe_quoted path));
|
2017-03-30 16:36:58 +00:00
|
|
|
flush stdout;
|
|
|
|
end;
|
2017-09-29 15:06:29 +00:00
|
|
|
targets
|
2017-02-23 10:03:35 +00:00
|
|
|
|
2017-12-11 10:23:07 +00:00
|
|
|
let resolve_targets_exn ~log common setup user_targets =
|
|
|
|
resolve_targets ~log common setup user_targets
|
|
|
|
|> List.concat_map ~f:(function
|
|
|
|
| Error (path, hint) ->
|
|
|
|
die "Don't know how to build %a%s" Path.pp path hint
|
|
|
|
| Ok targets ->
|
|
|
|
targets)
|
|
|
|
|
2017-02-24 15:47:09 +00:00
|
|
|
let build_targets =
|
2017-03-30 16:43:36 +00:00
|
|
|
let doc = "Build the given targets, or all installable targets if none are given." in
|
2017-02-28 19:05:04 +00:00
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
|
|
|
; `P {|Targets starting with a $(b,@) are interpreted as aliases.|}
|
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
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 =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets;
|
2017-03-10 12:32:27 +00:00
|
|
|
let log = Log.create () in
|
|
|
|
Future.Scheduler.go ~log
|
|
|
|
(Main.setup ~log common >>= fun setup ->
|
2017-12-11 10:23:07 +00:00
|
|
|
let targets = resolve_targets_exn ~log common setup targets in
|
2017-03-01 19:19:43 +00:00
|
|
|
do_build setup targets) in
|
2017-02-21 15:09:58 +00:00
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-03-30 16:43:36 +00:00
|
|
|
$ Arg.(value & pos_all string ["@install"] name_))
|
2017-02-28 19:05:04 +00:00
|
|
|
, Term.info "build" ~doc ~man)
|
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-28 19:05:04 +00:00
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
|
|
|
; `P {|This is a short-hand for calling:|}
|
|
|
|
; `Pre {| jbuilder build @runtest|}
|
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
in
|
2017-02-23 13:17:25 +00:00
|
|
|
let name_ = Arg.info [] ~docv:"DIR" in
|
2017-11-28 11:03:22 +00:00
|
|
|
let go common force dirs =
|
|
|
|
let unlink_aliases = if force then Some ["runtest"] else None in
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common
|
|
|
|
~targets:(List.map dirs ~f:(function
|
|
|
|
| "" | "." -> "@runtest"
|
|
|
|
| dir when dir.[String.length dir - 1] = '/' -> sprintf "@%sruntest" dir
|
|
|
|
| dir -> sprintf "@%s/runtest" dir));
|
2017-03-10 12:32:27 +00:00
|
|
|
let log = Log.create () in
|
|
|
|
Future.Scheduler.go ~log
|
2017-11-28 11:03:22 +00:00
|
|
|
(Main.setup ?unlink_aliases ~log common >>= fun setup ->
|
2017-02-23 13:17:25 +00:00
|
|
|
let targets =
|
|
|
|
List.map dirs ~f:(fun dir ->
|
2017-02-28 07:32:15 +00:00
|
|
|
let dir = Path.(relative root) (prefix_target common dir) in
|
2017-09-29 15:06:29 +00:00
|
|
|
Alias_rec (Alias.runtest ~dir))
|
2017-02-23 13:17:25 +00:00
|
|
|
in
|
2017-03-01 19:19:43 +00:00
|
|
|
do_build setup targets) in
|
2017-02-23 13:17:25 +00:00
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-11-28 11:03:22 +00:00
|
|
|
$ Arg.(value & flag & info ["force"; "f"])
|
2017-02-24 15:41:52 +00:00
|
|
|
$ Arg.(value & pos_all string ["."] name_))
|
2017-02-28 19:05:04 +00:00
|
|
|
, Term.info "runtest" ~doc ~man)
|
2017-02-23 13:17:25 +00:00
|
|
|
|
2017-05-26 10:32:32 +00:00
|
|
|
let clean =
|
|
|
|
let doc = "Clean the project." in
|
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
|
|
|
; `P {|Removes files added by jbuilder such as _build, <package>.install, and .merlin|}
|
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
in
|
|
|
|
let go common =
|
|
|
|
begin
|
|
|
|
set_common common ~targets:[];
|
|
|
|
Build_system.all_targets_ever_built () |> List.iter ~f:Path.unlink_no_err;
|
|
|
|
Path.(rm_rf (append root (of_string "_build")))
|
|
|
|
end
|
|
|
|
in
|
|
|
|
( Term.(const go $ common)
|
|
|
|
, Term.info "clean" ~doc ~man)
|
|
|
|
|
2017-03-10 16:35:02 +00:00
|
|
|
let format_external_libs libs =
|
|
|
|
String_map.bindings libs
|
|
|
|
|> List.map ~f:(fun (name, kind) ->
|
|
|
|
match (kind : Build.lib_dep_kind) with
|
|
|
|
| Optional -> sprintf "- %s (optional)" name
|
|
|
|
| Required -> sprintf "- %s" name)
|
|
|
|
|> String.concat ~sep:"\n"
|
|
|
|
|
2017-03-01 19:19:43 +00:00
|
|
|
let external_lib_deps =
|
|
|
|
let doc = "Print out external libraries needed to build the given targets." in
|
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
|
|
|
; `P {|Print out the external libraries needed to build the given targets.|}
|
|
|
|
; `P {|The output of $(b,jbuild external-lib-deps @install) should be included
|
|
|
|
in what is written in your $(i,<package>.opam) file.|}
|
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
in
|
|
|
|
let go common only_missing targets =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets:[];
|
2017-03-10 12:32:27 +00:00
|
|
|
let log = Log.create () in
|
|
|
|
Future.Scheduler.go ~log
|
|
|
|
(Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
|
2017-03-02 16:57:28 +00:00
|
|
|
>>= fun setup ->
|
2017-12-11 10:23:07 +00:00
|
|
|
let targets = resolve_targets_exn ~log common setup targets in
|
2017-09-29 15:06:29 +00:00
|
|
|
let request = request_of_targets setup targets in
|
2017-03-01 19:19:43 +00:00
|
|
|
let failure =
|
|
|
|
String_map.fold ~init:false
|
2017-09-29 15:06:29 +00:00
|
|
|
(Build_system.all_lib_deps_by_context setup.build_system ~request)
|
2017-03-01 19:19:43 +00:00
|
|
|
~f:(fun ~key:context_name ~data:lib_deps acc ->
|
|
|
|
let internals =
|
2017-06-02 13:32:05 +00:00
|
|
|
Jbuild.Stanzas.lib_names
|
2017-03-01 19:19:43 +00:00
|
|
|
(match String_map.find context_name setup.Main.stanzas with
|
|
|
|
| None -> assert false
|
|
|
|
| Some x -> x)
|
|
|
|
in
|
|
|
|
let externals =
|
|
|
|
String_map.filter lib_deps ~f:(fun name _ ->
|
|
|
|
not (String_set.mem name internals))
|
|
|
|
in
|
|
|
|
if only_missing then begin
|
|
|
|
let context =
|
|
|
|
match List.find setup.contexts ~f:(fun c -> c.name = context_name) with
|
|
|
|
| None -> assert false
|
|
|
|
| Some c -> c
|
|
|
|
in
|
|
|
|
let missing =
|
|
|
|
String_map.filter externals ~f:(fun name _ ->
|
2017-03-15 12:07:20 +00:00
|
|
|
not (Findlib.available context.findlib name ~required_by:[]))
|
2017-03-01 19:19:43 +00:00
|
|
|
in
|
|
|
|
if String_map.is_empty missing then
|
|
|
|
acc
|
2017-06-09 14:18:27 +00:00
|
|
|
else if String_map.for_all missing ~f:(fun _ kind -> kind = Build.Optional)
|
|
|
|
then begin
|
2017-03-01 19:19:43 +00:00
|
|
|
Format.eprintf
|
2017-06-09 13:49:08 +00:00
|
|
|
"@{<error>Error@}: The following libraries are missing \
|
|
|
|
in the %s context:\n\
|
|
|
|
%s@."
|
|
|
|
context_name
|
|
|
|
(format_external_libs missing);
|
|
|
|
false
|
|
|
|
end else begin
|
|
|
|
Format.eprintf
|
|
|
|
"@{<error>Error@}: The following libraries are missing \
|
2017-03-01 19:19:43 +00:00
|
|
|
in the %s context:\n\
|
2017-05-18 13:31:31 +00:00
|
|
|
%s\n\
|
|
|
|
Hint: try: opam install %s@."
|
2017-03-01 19:19:43 +00:00
|
|
|
context_name
|
2017-05-18 13:31:31 +00:00
|
|
|
(format_external_libs missing)
|
|
|
|
(String_map.bindings missing
|
|
|
|
|> List.filter_map ~f:(fun (name, kind) ->
|
|
|
|
match (kind : Build.lib_dep_kind) with
|
|
|
|
| Optional -> None
|
|
|
|
| Required -> Some (Findlib.root_package_name name))
|
|
|
|
|> String_set.of_list
|
|
|
|
|> String_set.elements
|
|
|
|
|> String.concat ~sep:" ");
|
2017-03-01 19:19:43 +00:00
|
|
|
true
|
|
|
|
end
|
|
|
|
end else begin
|
|
|
|
Printf.printf
|
|
|
|
"These are the external library dependencies in the %s context:\n\
|
|
|
|
%s\n%!"
|
|
|
|
context_name
|
2017-03-10 16:35:02 +00:00
|
|
|
(format_external_libs externals);
|
2017-03-01 19:19:43 +00:00
|
|
|
acc
|
|
|
|
end)
|
|
|
|
in
|
|
|
|
if failure then die "";
|
|
|
|
Future.return ())
|
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
|
|
|
$ Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["missing"]
|
|
|
|
~doc:{|Only print out missing dependencies|})
|
|
|
|
$ Arg.(non_empty
|
|
|
|
& pos_all string []
|
|
|
|
& Arg.info [] ~docv:"TARGET"))
|
|
|
|
, Term.info "external-lib-deps" ~doc ~man)
|
|
|
|
|
2017-05-18 23:16:48 +00:00
|
|
|
let rules =
|
|
|
|
let doc = "Dump internal rules." in
|
2017-05-18 18:05:01 +00:00
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
2017-05-18 23:16:48 +00:00
|
|
|
; `P {|Dump Jbuilder internal rules for the given targets.
|
|
|
|
If no targets are given, dump all the internal rules.|}
|
|
|
|
; `P {|By default the output is a list of S-expressions,
|
|
|
|
one S-expression per rule. Each S-expression is of the form:|}
|
|
|
|
; `Pre " ((deps (<dependencies>))\n\
|
|
|
|
\ (targets (<targets>))\n\
|
|
|
|
\ (context <context-name>)\n\
|
|
|
|
\ (action <action>))"
|
|
|
|
; `P {|$(b,<context-name>) is the context is which the action is executed.
|
|
|
|
It is omitted if the action is independant from the context.|}
|
|
|
|
; `P {|$(b,<action>) is the action following the same syntax as user actions,
|
|
|
|
as described in the manual.|}
|
2017-05-18 18:05:01 +00:00
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
in
|
2017-05-18 23:16:48 +00:00
|
|
|
let go common out recursive makefile_syntax targets =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets;
|
2017-05-18 18:05:01 +00:00
|
|
|
let log = Log.create () in
|
|
|
|
Future.Scheduler.go ~log
|
|
|
|
(Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
|
|
|
|
>>= fun setup ->
|
2017-09-29 15:06:29 +00:00
|
|
|
let request =
|
2017-05-18 18:05:01 +00:00
|
|
|
match targets with
|
2017-09-29 15:06:29 +00:00
|
|
|
| [] -> Build.paths (Build_system.all_targets setup.build_system)
|
2017-12-11 10:23:07 +00:00
|
|
|
| _ -> resolve_targets_exn ~log common setup targets |> request_of_targets setup
|
2017-05-18 18:05:01 +00:00
|
|
|
in
|
2017-09-29 15:06:29 +00:00
|
|
|
Build_system.build_rules setup.build_system ~request ~recursive >>= fun rules ->
|
2017-05-18 23:16:48 +00:00
|
|
|
let print oc =
|
2017-05-18 18:05:01 +00:00
|
|
|
let ppf = Format.formatter_of_out_channel oc in
|
2017-05-19 00:42:41 +00:00
|
|
|
Sexp.prepare_formatter ppf;
|
|
|
|
Format.pp_open_vbox ppf 0;
|
2017-05-18 23:16:48 +00:00
|
|
|
if makefile_syntax then begin
|
|
|
|
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
2017-05-19 01:12:51 +00:00
|
|
|
Format.fprintf ppf "@[<hov 2>@{<makefile-stuff>%a:%t@}@]@,@<0>\t@{<makefile-action>%a@}@,@,"
|
|
|
|
(Format.pp_print_list ~pp_sep:Format.pp_print_space (fun ppf p ->
|
|
|
|
Format.pp_print_string ppf (Path.to_string p)))
|
|
|
|
(Path.Set.elements rule.targets)
|
|
|
|
(fun ppf ->
|
|
|
|
Path.Set.iter rule.deps ~f:(fun dep ->
|
|
|
|
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
2017-05-27 23:48:48 +00:00
|
|
|
Sexp.pp_split_strings (Action.sexp_of_t rule.action))
|
2017-05-18 23:16:48 +00:00
|
|
|
end else begin
|
|
|
|
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
|
|
|
let sexp =
|
|
|
|
let paths ps = Sexp.To_sexp.list Path.sexp_of_t (Path.Set.elements ps) in
|
|
|
|
Sexp.To_sexp.record (
|
|
|
|
List.concat
|
|
|
|
[ [ "deps" , paths rule.deps
|
|
|
|
; "targets", paths rule.targets ]
|
2017-05-27 23:48:48 +00:00
|
|
|
; (match rule.context with
|
2017-05-18 23:16:48 +00:00
|
|
|
| None -> []
|
|
|
|
| Some c -> ["context", Atom c.name])
|
2017-05-27 23:48:48 +00:00
|
|
|
; [ "action" , Action.sexp_of_t rule.action ]
|
2017-05-18 23:16:48 +00:00
|
|
|
])
|
|
|
|
in
|
2017-05-19 00:42:41 +00:00
|
|
|
Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
|
2017-05-18 23:16:48 +00:00
|
|
|
end;
|
|
|
|
Format.pp_print_flush ppf ();
|
|
|
|
Future.return ()
|
|
|
|
in
|
|
|
|
match out with
|
|
|
|
| None -> print stdout
|
|
|
|
| Some fn -> Io.with_file_out fn ~f:print)
|
2017-05-18 18:05:01 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-05-18 23:16:48 +00:00
|
|
|
$ Arg.(value
|
2017-05-18 18:05:01 +00:00
|
|
|
& opt (some string) None
|
|
|
|
& info ["o"] ~docv:"FILE"
|
2017-05-18 23:16:48 +00:00
|
|
|
~doc:"Output to a file instead of stdout.")
|
|
|
|
$ Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["r"; "recursive"]
|
|
|
|
~doc:"Print all rules needed to build the transitive dependencies of the given targets.")
|
|
|
|
$ Arg.(value
|
|
|
|
& flag
|
|
|
|
& info ["m"; "makefile"]
|
|
|
|
~doc:"Output the rules in Makefile syntax.")
|
2017-05-18 18:05:01 +00:00
|
|
|
$ Arg.(value
|
|
|
|
& pos_all string []
|
|
|
|
& Arg.info [] ~docv:"TARGET"))
|
2017-05-18 23:16:48 +00:00
|
|
|
, Term.info "rules" ~doc ~man)
|
2017-05-18 18:05:01 +00:00
|
|
|
|
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
|
|
|
|
2017-07-25 16:07:24 +00:00
|
|
|
let get_libdir context ~libdir_from_command_line =
|
2017-07-05 13:10:41 +00:00
|
|
|
match libdir_from_command_line with
|
2017-07-25 16:07:24 +00:00
|
|
|
| Some p -> Future.return (Some (Path.of_string p))
|
|
|
|
| None -> Context.install_ocaml_libdir context
|
2017-07-05 13:10:41 +00:00
|
|
|
|
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
|
2017-07-05 13:10:41 +00:00
|
|
|
let go common prefix_from_command_line libdir_from_command_line pkgs =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets:[];
|
2017-02-25 01:45:41 +00:00
|
|
|
let opam_installer = opam_installer () in
|
2017-03-10 12:32:27 +00:00
|
|
|
let log = Log.create () in
|
|
|
|
Future.Scheduler.go ~log
|
|
|
|
(Main.setup ~log 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-07-05 13:10:41 +00:00
|
|
|
(match setup.contexts, prefix_from_command_line, libdir_from_command_line with
|
|
|
|
| _ :: _ :: _, Some _, _ | _ :: _ :: _, _, Some _ ->
|
2017-07-25 16:07:24 +00:00
|
|
|
die "Cannot specify --prefix or --libdir when installing \
|
|
|
|
into multiple contexts!"
|
2017-02-25 01:45:41 +00:00
|
|
|
| _ -> ());
|
2017-02-25 14:15:52 +00:00
|
|
|
let module CMap = Map.Make(Context) in
|
2017-07-25 16:07:24 +00:00
|
|
|
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-07-25 16:07:24 +00:00
|
|
|
get_prefix context ~from_command_line:prefix_from_command_line
|
|
|
|
>>= fun prefix ->
|
|
|
|
get_libdir context ~libdir_from_command_line
|
|
|
|
>>= fun libdir ->
|
2017-02-25 01:45:41 +00:00
|
|
|
Future.all_unit
|
|
|
|
(List.map install_files ~f:(fun path ->
|
2017-07-25 16:07:24 +00:00
|
|
|
let purpose = Future.Build_job install_files in
|
|
|
|
Future.run ~purpose Strict (Path.to_string opam_installer)
|
|
|
|
([ sprintf "-%c" what.[0]
|
|
|
|
; Path.to_string path
|
|
|
|
; "--prefix"
|
|
|
|
; Path.to_string prefix
|
|
|
|
] @
|
|
|
|
match libdir with
|
|
|
|
| None -> []
|
|
|
|
| Some p -> [ "--libdir"; Path.to_string p ]
|
|
|
|
))))))
|
2017-02-24 15:41:52 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-07-27 11:06:06 +00:00
|
|
|
$ Arg.(value
|
|
|
|
& opt (some dir) None
|
|
|
|
& info ["destdir"; "prefix"]
|
|
|
|
~docv:"PREFIX"
|
|
|
|
~doc:"Directory where files are copied. For instance binaries \
|
|
|
|
are copied into $(i,\\$prefix/bin), library files into \
|
2017-07-27 11:08:19 +00:00
|
|
|
$(i,\\$prefix/lib), etc... It defaults to the current opam \
|
2017-07-27 11:06:06 +00:00
|
|
|
prefix if opam is available and configured, otherwise it uses \
|
|
|
|
the same prefix as the ocaml compiler.")
|
|
|
|
$ Arg.(value
|
|
|
|
& opt (some dir) None
|
|
|
|
& info ["libdir"]
|
|
|
|
~docv:"PATH"
|
|
|
|
~doc:"Directory where library files are copied, relative to \
|
|
|
|
$(b,prefix) or absolute. If $(b,--prefix) \
|
|
|
|
is specified the default is $(i,\\$prefix/lib), otherwise \
|
|
|
|
it is the output of $(b,ocamlfind printconf destdir)"
|
|
|
|
)
|
2017-02-24 15:41:52 +00:00
|
|
|
$ 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-08-04 07:59:35 +00:00
|
|
|
let context_arg ~doc =
|
|
|
|
Arg.(value
|
|
|
|
& opt string "default"
|
|
|
|
& info ["context"] ~docv:"CONTEXT" ~doc)
|
|
|
|
|
2017-03-01 12:09:57 +00:00
|
|
|
let exec =
|
|
|
|
let doc =
|
|
|
|
"Execute a command in a similar environment as if installation was performed."
|
|
|
|
in
|
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
2017-11-07 13:41:09 +00:00
|
|
|
; `P {|$(b,jbuilder exec -- COMMAND) should behave in the same way as if you
|
|
|
|
do:|}
|
2017-03-01 12:09:57 +00:00
|
|
|
; `Pre " \\$ jbuilder install\n\
|
|
|
|
\ \\$ COMMAND"
|
2017-11-07 13:41:09 +00:00
|
|
|
; `P {|In particular if you run $(b,jbuilder exec ocaml), you will have
|
|
|
|
access to the libraries defined in the workspace using your usual
|
|
|
|
directives ($(b,#require) for instance)|}
|
|
|
|
; `P {|When a leading / is present in the command (absolute path), then the
|
|
|
|
path is interpreted as an absolute path|}
|
|
|
|
; `P {|When a / is present at any other position (relative path), then the
|
|
|
|
path is interpreted as relative to the build context + current
|
|
|
|
working directory (or the value of $(b,--root) when ran outside of
|
|
|
|
the project root)|}
|
2017-03-01 12:09:57 +00:00
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
in
|
2017-12-11 10:23:07 +00:00
|
|
|
let go common context prog no_rebuild args =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets:[];
|
2017-03-10 12:32:27 +00:00
|
|
|
let log = Log.create () in
|
2017-05-31 13:40:58 +00:00
|
|
|
let setup = Future.Scheduler.go ~log (Main.setup ~log common) in
|
2017-08-04 07:59:35 +00:00
|
|
|
let context = Main.find_context_exn setup ~name:context in
|
2017-12-11 10:23:07 +00:00
|
|
|
let prog_where =
|
|
|
|
match Filename.analyze_program_name prog with
|
|
|
|
| Absolute ->
|
|
|
|
`This_abs (Path.of_string prog)
|
|
|
|
| In_path ->
|
|
|
|
`Search prog
|
|
|
|
| Relative_to_current_dir ->
|
|
|
|
let prog = prefix_target common prog in
|
|
|
|
`This_rel (Path.relative context.build_dir prog) in
|
|
|
|
let targets = lazy (
|
|
|
|
(match prog_where with
|
|
|
|
| `Search p ->
|
|
|
|
[Path.relative (Config.local_install_bin_dir ~context:context.name) p]
|
|
|
|
| `This_rel p when Sys.win32 ->
|
|
|
|
[p; Path.extend_basename p ~suffix:Bin.exe]
|
|
|
|
| `This_rel p ->
|
|
|
|
[p]
|
|
|
|
| `This_abs p when Path.is_in_build_dir p ->
|
|
|
|
[p]
|
|
|
|
| `This_abs _ ->
|
|
|
|
[])
|
|
|
|
|> List.map ~f:Path.to_string
|
|
|
|
|> resolve_targets ~log common setup
|
|
|
|
|> List.concat_map ~f:(function
|
|
|
|
| Ok targets -> targets
|
|
|
|
| Error _ -> [])
|
|
|
|
) in
|
2017-11-14 07:19:58 +00:00
|
|
|
let real_prog =
|
2017-12-11 10:23:07 +00:00
|
|
|
if not no_rebuild then begin
|
|
|
|
match Lazy.force targets with
|
|
|
|
| [] -> ()
|
|
|
|
| targets ->
|
|
|
|
Future.Scheduler.go ~log (do_build setup targets);
|
|
|
|
Build_system.dump_trace setup.build_system
|
|
|
|
end;
|
|
|
|
match prog_where with
|
2017-11-14 07:19:58 +00:00
|
|
|
| `Search prog ->
|
|
|
|
let path = Config.local_install_bin_dir ~context:context.name :: context.path in
|
|
|
|
Bin.which prog ~path
|
2017-12-11 10:23:07 +00:00
|
|
|
| `This_rel prog
|
|
|
|
| `This_abs prog ->
|
2017-11-14 07:19:58 +00:00
|
|
|
if Path.exists prog then
|
|
|
|
Some prog
|
|
|
|
else if not Sys.win32 then
|
|
|
|
None
|
|
|
|
else
|
|
|
|
let prog = Path.extend_basename prog ~suffix:Bin.exe in
|
|
|
|
Option.some_if (Path.exists prog) prog
|
|
|
|
in
|
2017-12-11 10:23:07 +00:00
|
|
|
match real_prog, no_rebuild with
|
|
|
|
| None, true ->
|
|
|
|
begin match Lazy.force targets with
|
|
|
|
| [] ->
|
|
|
|
Format.eprintf "@{<Error>Error@}: Program %S not found!@." prog;
|
|
|
|
die ""
|
|
|
|
| _::_ ->
|
|
|
|
Format.eprintf "@{<Error>Error@}: Program %S isn't built yet \
|
|
|
|
you need to buid it first or remove the \
|
|
|
|
--no-build option.@." prog;
|
|
|
|
die ""
|
|
|
|
end
|
|
|
|
| None, false ->
|
2017-05-31 13:40:58 +00:00
|
|
|
Format.eprintf "@{<Error>Error@}: Program %S not found!@." prog;
|
|
|
|
die ""
|
2017-12-11 10:23:07 +00:00
|
|
|
| Some real_prog, _ ->
|
2017-05-31 13:40:58 +00:00
|
|
|
let real_prog = Path.to_string real_prog in
|
|
|
|
let env = Context.env_for_exec context in
|
|
|
|
let argv = Array.of_list (prog :: args) in
|
2017-11-12 19:55:49 +00:00
|
|
|
restore_cwd_and_execve common real_prog argv env
|
2017-03-01 12:09:57 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-08-04 07:59:35 +00:00
|
|
|
$ context_arg ~doc:{|Run the command in this build context.|}
|
2017-03-01 12:09:57 +00:00
|
|
|
$ Arg.(required
|
|
|
|
& pos 0 (some string) None (Arg.info [] ~docv:"PROG"))
|
2017-12-11 10:23:07 +00:00
|
|
|
$ Arg.(value & flag
|
|
|
|
& info ["no-build"]
|
|
|
|
~doc:"don't rebuild target before executing")
|
2017-03-01 12:09:57 +00:00
|
|
|
$ Arg.(value
|
|
|
|
& pos_right 0 string [] (Arg.info [] ~docv:"ARGS"))
|
|
|
|
)
|
|
|
|
, Term.info "exec" ~doc ~man)
|
|
|
|
|
2017-05-07 19:42:22 +00:00
|
|
|
let subst =
|
|
|
|
let doc =
|
|
|
|
"Substitute watermarks in source files."
|
|
|
|
in
|
|
|
|
let man =
|
2017-06-01 15:34:04 +00:00
|
|
|
let var name desc =
|
|
|
|
`Blocks [`Noblank; `P ("- $(b,%%" ^ name ^ "%%), " ^ desc) ]
|
|
|
|
in
|
|
|
|
let opam field =
|
|
|
|
var ("PKG_" ^ String.uppercase_ascii field)
|
|
|
|
("contents of the $(b," ^ field ^ ":) field from the opam file")
|
|
|
|
in
|
2017-05-07 19:42:22 +00:00
|
|
|
[ `S "DESCRIPTION"
|
2017-06-01 15:34:04 +00:00
|
|
|
; `P {|Substitute $(b,%%ID%%) strings in source files, in a similar fashion to
|
2017-05-07 19:42:22 +00:00
|
|
|
what topkg does in the default configuration.|}
|
2017-06-01 15:34:04 +00:00
|
|
|
; `P {|This command is only meant to be called when a user pins a package to
|
|
|
|
its development version. Especially it replaces $(b,%%VERSION%%) strings
|
|
|
|
by the version obtained from the vcs. Currently only git is supported and
|
|
|
|
the version is obtained from the output of:|}
|
|
|
|
; `Pre {| \$ git describe --always --dirty|}
|
|
|
|
; `P {|$(b,jbuilder subst) substitutes the variables that topkg substitutes with
|
|
|
|
the defatult configuration:|}
|
|
|
|
; var "NAME" "the name of the package"
|
|
|
|
; var "VERSION" "output of $(b,git describe --always --dirty)"
|
|
|
|
; var "VERSION_NUM" "same as $(b,%%VERSION%%) but with a potential leading \
|
|
|
|
'v' or 'V' dropped"
|
|
|
|
; var "VCS_COMMIT_ID" "commit hash from the vcs"
|
|
|
|
; opam "maintainer"
|
|
|
|
; opam "authors"
|
|
|
|
; opam "homepage"
|
|
|
|
; opam "issues"
|
|
|
|
; opam "doc"
|
|
|
|
; opam "license"
|
|
|
|
; opam "repo"
|
|
|
|
; `P {|It is not possible to customize this list. If you wish to do so you need to
|
|
|
|
configure topkg instead and use it to perform the substitution.|}
|
|
|
|
; `P {|Note that the expansion of $(b,%%NAME%%) is guessed using the following
|
|
|
|
heuristic: if all the $(b,<package>.opam) files in the current directory are
|
|
|
|
prefixed by the shortest package name, this prefix is used. Otherwise you must
|
|
|
|
specify a name with the $(b,-n) command line option.|}
|
|
|
|
; `P {|In order to call $(b,jbuilder subst) when your package is pinned, add this line
|
|
|
|
to the $(b,build:) field of your opam file:|}
|
|
|
|
; `Pre {| ["jbuilder" "subst"] {pinned}|}
|
2017-05-07 19:42:22 +00:00
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
in
|
2017-05-08 15:53:12 +00:00
|
|
|
let go common name =
|
2017-05-19 13:16:00 +00:00
|
|
|
set_common common ~targets:[];
|
2017-05-08 15:53:12 +00:00
|
|
|
Future.Scheduler.go (Watermarks.subst ?name ())
|
2017-05-07 19:42:22 +00:00
|
|
|
in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
2017-05-08 15:53:12 +00:00
|
|
|
$ Arg.(value
|
|
|
|
& opt (some string) None
|
|
|
|
& info ["n"; "name"] ~docv:"NAME"
|
|
|
|
~doc:"Use this package name instead of detecting it.")
|
2017-05-07 19:42:22 +00:00
|
|
|
)
|
|
|
|
, Term.info "subst" ~doc ~man)
|
2017-03-01 12:09:57 +00:00
|
|
|
|
2017-08-04 07:59:35 +00:00
|
|
|
let utop =
|
|
|
|
let doc = "Load library in utop" in
|
|
|
|
let man =
|
|
|
|
[ `S "DESCRIPTION"
|
|
|
|
; `P {|$(b,jbuilder utop DIR) build and run utop toplevel with libraries defined in DIR|}
|
|
|
|
; `Blocks help_secs
|
|
|
|
] in
|
|
|
|
let go common dir ctx_name args =
|
|
|
|
let utop_target = dir |> Path.of_string |> Utop.utop_exe |> Path.to_string in
|
|
|
|
set_common common ~targets:[utop_target];
|
|
|
|
let log = Log.create () in
|
|
|
|
let (build_system, context, utop_path) =
|
|
|
|
(Main.setup ~log common >>= fun setup ->
|
|
|
|
let context = Main.find_context_exn setup ~name:ctx_name in
|
|
|
|
let setup = { setup with contexts = [context] } in
|
|
|
|
let target =
|
2017-12-11 10:23:07 +00:00
|
|
|
match resolve_targets_exn ~log common setup [utop_target] with
|
2017-08-04 07:59:35 +00:00
|
|
|
| [] -> die "no libraries defined in %s" dir
|
2017-09-29 15:06:29 +00:00
|
|
|
| [File target] -> target
|
|
|
|
| [Alias_rec _] | _::_::_ -> assert false
|
2017-08-04 07:59:35 +00:00
|
|
|
in
|
2017-09-29 15:06:29 +00:00
|
|
|
do_build setup [File target] >>| fun () ->
|
2017-08-04 07:59:35 +00:00
|
|
|
(setup.build_system, context, Path.to_string target)
|
|
|
|
) |> Future.Scheduler.go ~log in
|
|
|
|
Build_system.dump_trace build_system;
|
2017-11-12 19:55:49 +00:00
|
|
|
restore_cwd_and_execve common utop_path (Array.of_list (utop_path :: args))
|
2017-08-04 07:59:35 +00:00
|
|
|
(Context.env_for_exec context)
|
|
|
|
in
|
|
|
|
let name_ = Arg.info [] ~docv:"PATH" in
|
|
|
|
( Term.(const go
|
|
|
|
$ common
|
|
|
|
$ Arg.(value & pos 0 dir "" name_)
|
|
|
|
$ context_arg ~doc:{|Select context where to build/run utop.|}
|
|
|
|
$ Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")))
|
|
|
|
, Term.info "utop" ~doc ~man )
|
|
|
|
|
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
|
|
|
; external_lib_deps
|
2017-02-24 15:47:09 +00:00
|
|
|
; build_targets
|
2017-02-23 13:17:25 +00:00
|
|
|
; runtest
|
2017-05-26 10:32:32 +00:00
|
|
|
; clean
|
2017-02-24 15:41:52 +00:00
|
|
|
; install
|
|
|
|
; uninstall
|
2017-03-01 12:09:57 +00:00
|
|
|
; exec
|
2017-05-07 19:42:22 +00:00
|
|
|
; subst
|
2017-05-18 23:16:48 +00:00
|
|
|
; rules
|
2017-08-04 07:59:35 +00:00
|
|
|
; utop
|
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 =
|
2017-02-28 19:05:04 +00:00
|
|
|
let doc = "composable build system for OCaml" in
|
|
|
|
( Term.(ret (const (fun _ -> `Help (`Pager, None)) $ common))
|
2017-05-08 16:19:27 +00:00
|
|
|
, Term.info "jbuilder" ~doc ~version:"%%VERSION%%"
|
2017-02-28 19:05:04 +00:00
|
|
|
~man:
|
|
|
|
[ `S "DESCRIPTION"
|
|
|
|
; `P {|Jbuilder is a build system designed for OCaml projects only. It
|
|
|
|
focuses on providing the user with a consistent experience and takes
|
|
|
|
care of most of the low-level details of OCaml compilation. All you
|
|
|
|
have to do is provide a description of your project and Jbuilder will
|
|
|
|
do the rest.
|
|
|
|
|}
|
|
|
|
; `P {|The scheme it implements is inspired from the one used inside Jane
|
|
|
|
Street and adapted to the open source world. It has matured over a
|
2017-08-06 09:39:42 +00:00
|
|
|
long time and is used daily by hundreds of developers, which means
|
2017-02-28 19:05:04 +00:00
|
|
|
that it is highly tested and productive.
|
|
|
|
|}
|
|
|
|
; `Blocks help_secs
|
|
|
|
]
|
|
|
|
)
|
2017-02-24 15:47:09 +00:00
|
|
|
|
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
|