Skip to content

Commit

Permalink
obuild: refactor handling of commands and options
Browse files Browse the repository at this point in the history
The current system mixes manual command line parsing for global options,
and the Arg module for command options, which is not optimal:
- no way to generate the list of global command line options, nor to
  document them
- the per-command options are used only when parsing, so showing them
  for help is not possible
- two different ways to parse options

Also, the handling of commands themselves is messy:
- all of them are implemented in the same module, overloading it with
  different tasks
- their help texts are structured in lists of lines, and with a separate
  list to maintain
- the names of the commands are hardcoded in a couple of places

To overcome this situation, create a small Cmd module to represent a
single command, with all the information stored there: name, options,
help texts, and the actual function for it.  Split all the commands in
own modules named Cmd_<command>, which contains only the command
declaration, its function, and all the helper stuff for it.
Consequently refactor the command line handling: use the dynamic parsing
feature of Arg, so the global command line options (which are now
converted to Arg) are parsed first, and then the command options are
parsed.

The results are various:
- each command is in its own modules, with its options clearly
  represented, and help texts side with them
- global command line options are parsed properly
- main.ml is very small, way more readable, and will almost require no
  changes for adding new commands (see drawback below)
- the 'help' command had to be basically rewritten due to the
  refactoring; OTOH, `obuild help <command>` works fine now
- `obuild --help` works fine now (fixes ocaml-obuild#136)

The only drawback is that, due to the way obuild is built using obuild,
the modules of the commands are not built if nothing references them.
As result, create no-op aliases for all of them in main.ml.
  • Loading branch information
ptoscano committed Sep 12, 2018
1 parent 55ed451 commit 9f258ad
Show file tree
Hide file tree
Showing 16 changed files with 514 additions and 384 deletions.
2 changes: 1 addition & 1 deletion bootstrap
Expand Up @@ -17,7 +17,7 @@ fi

extmodules="compat fugue filepath filesystem"
libmodules="types gconf filetype dag libname pp expr utils modname taskdep helper dagutils process findlibConf scheduler prog dependencies generators hier meta metacache target dist project analyze configure prepare buildprogs build exception"
mainmodules="sdist doc init help install path_generated main"
mainmodules="app_utils sdist doc init install path_generated cmd cmd_build cmd_clean cmd_configure cmd_doc cmd_get cmd_help cmd_infer cmd_init cmd_install cmd_sdist cmd_test main"

set -e

Expand Down
20 changes: 20 additions & 0 deletions src/app_utils.ml
@@ -0,0 +1,20 @@
open Printf
open Obuild.Helper
open Obuild.Gconf
open Obuild

let read_setup () =
FindlibConf.load ();
let setup = Dist.read_setup () in
(* all_options are restored from setup file *)
Configure.set_opts setup;
setup

let project_read () =
try Project.read gconf.strict
with exn -> verbose Verbose "exception during project read: %s\n" (Printexc.to_string exn);
raise exn

let unimplemented () =
eprintf "sorry, you've reached an unimplemented part ! please be patient or send a patch.\n";
exit 1
36 changes: 36 additions & 0 deletions src/cmd.ml
@@ -0,0 +1,36 @@
open Printf

type cmd = {
name : string;
args : (Arg.key * Arg.spec * Arg.doc) list;
fn : string list -> unit;
short_desc : string;
long_desc : string;
}

let (cmds : ((string, cmd) Hashtbl.t) ref) = ref (Hashtbl.create 13)

let programName = "obuild"

let register_cmd cmd =
try
ignore (Hashtbl.find !cmds cmd.name)
with Not_found ->
Hashtbl.add !cmds cmd.name cmd

let find_cmd name =
Hashtbl.find !cmds name

let require_cmd name =
try
Hashtbl.find !cmds name
with Not_found ->
eprintf "error: unknown command: %s. See `%s --help'.\n"
name programName;
exit 1

let cmds_list () =
Hashtbl.fold (
fun key _ acc ->
key :: acc
) !cmds []
37 changes: 37 additions & 0 deletions src/cmd_build.ml
@@ -0,0 +1,37 @@
open Obuild.Gconf
open Obuild

let args = [
("-j", Arg.Int (fun i -> gconf.parallel_jobs <- i), "N maximum number of jobs in parallel");
("--jobs", Arg.Int (fun i -> gconf.parallel_jobs <- i), "N maximum number of jobs in parallel");
("--dot", Arg.Unit (fun () -> gconf.dump_dot <- true), " dump dependencies dot files during build");
("--noocamlmklib", Arg.Unit (fun () -> gconf.ocamlmklib <- false), " do not use ocamlmklib when linking C code");
]

let mainBuild argv =
Dist.exist ();
let setup = App_utils.read_setup () in
let proj_file = App_utils.project_read () in
let flags = Configure.check proj_file true setup in
let project = Analyze.prepare proj_file flags in
let bstate = Prepare.init project in

let dag = match argv with
| [] -> project.Analyze.project_targets_dag
| _ ->
let targets = List.map Target.Name.of_string argv in
Dag.subset project.Analyze.project_targets_dag targets
in
Build.build_dag bstate proj_file dag

let () =
let cmd = {
Cmd.name = "build";
args = args;
fn = mainBuild;
short_desc = "Build every buildable bits";
long_desc = "\
Build all your different targets (library, executable,
tests, benchmarks, example) that are marked as buildable.";
} in
Cmd.register_cmd cmd
21 changes: 21 additions & 0 deletions src/cmd_clean.ml
@@ -0,0 +1,21 @@
open Ext
open Obuild

let mainClean _ =
if Filesystem.exists (Dist.get_path ())
then begin
Filesystem.removeDir (Dist.get_path ());
Dist.remove_dead_links ()
end

let () =
let cmd = {
Cmd.name = "clean";
args = [];
fn = mainClean;
short_desc = "Clean up after a build";
long_desc = "\
Remove all by-product of compilation (.cmx, .cmi, .cmo, etc)
and remove the dist directory.";
} in
Cmd.register_cmd cmd
71 changes: 71 additions & 0 deletions src/cmd_configure.ml
@@ -0,0 +1,71 @@
open Ext.Fugue
open Obuild.Helper
open Obuild.Gconf
open Obuild

let user_flags = ref []
let user_opts = ref []

let configure argv =
FindlibConf.load ();
let proj_file = Project.read gconf.strict in
verbose Report "Configuring %s-%s...\n" proj_file.Project.name proj_file.Project.version;
Configure.run proj_file !user_flags !user_opts;
(* check build deps of everything buildables *)
()

let () =
let user_set_flags s =
let tweak = if string_startswith "-" s then Configure.ClearFlag (string_drop 1 s) else Configure.SetFlag s
in
user_flags := tweak :: !user_flags
in
let set_target_options field value () =
let opt_name = if (List.mem field ["examples"; "benchs"; "tests"]) then ("build-" ^ field) else field in
user_opts := (opt_name,value) :: !user_opts
in
let enable_disable_opt opt_name doc = [
("--enable-" ^ opt_name, Arg.Unit (set_target_options opt_name true), " enable " ^ doc);
("--disable-" ^ opt_name, Arg.Unit (set_target_options opt_name false), " disable " ^ doc)
] in
let opts = [
("--flag", Arg.String user_set_flags, "FLAG enable or disable a project's flag");
("--executable-as-obj", Arg.Unit (set_target_options "executable-as-obj" true), " output executable as obj file");
("--annot", Arg.Unit (set_target_options "annot" true), " generate .annot files");
("-g", Arg.Unit (fun () ->
(set_target_options "library-debugging" true)();
(set_target_options "executable-debugging" true)();
), " compilation with debugging");
("-pg", Arg.Unit (fun () ->
(set_target_options "library-profiling" true)();
(set_target_options "executable-profiling" true)();
), " compilation with profiling")
] in
let args =
enable_disable_opt "library-bytecode" "library compilation as bytecode"
@ enable_disable_opt "library-native" "library compilation as native"
@ enable_disable_opt "library-plugin" "library compilation as native plugin"
@ enable_disable_opt "executable-bytecode" "executable compilation as bytecode"
@ enable_disable_opt "executable-native" "executable compilation as native"
@ enable_disable_opt "library-profiling" "library profiling"
@ enable_disable_opt "library-debugging" "library debugging"
@ enable_disable_opt "executable-profiling" "executable profiling"
@ enable_disable_opt "executable-debugging" "executable debugging"
@ enable_disable_opt "examples" "building examples"
@ enable_disable_opt "benchs" "building benchs"
@ enable_disable_opt "tests" "building tests"
@ opts in

let cmd = {
Cmd.name = "configure";
args = args;
fn = configure;
short_desc = "Prepare to build the package";
long_desc = "\
Configure verify that the environment is able to compile the project
and this is where the user can tell obuild options to build
System settings and user settings are cached, to provide faster
access for building task.";
} in
Cmd.register_cmd cmd
18 changes: 18 additions & 0 deletions src/cmd_doc.ml
@@ -0,0 +1,18 @@
open Printf

let mainDoc argv =
let proj_file = App_utils.project_read () in
Doc.run proj_file;
App_utils.unimplemented ()

let () =
let cmd = {
Cmd.name = "doc";
args = [];
fn = mainDoc;
short_desc = "Generate documentation";
long_desc = "\
XXX
";
} in
Cmd.register_cmd cmd
37 changes: 37 additions & 0 deletions src/cmd_get.ml
@@ -0,0 +1,37 @@
open Printf
open Obuild

let mainGet = function
| [] ->
eprintf "missing field for 'obuild get'\n";
exit 1
| [field] ->
let proj_file = App_utils.project_read () in

(* TODO: hardcoded just for now to get basic fields.
* - add option for quoting
* - optional formating options for multi values (one per line, csv)
* - access more complicated fields lib/sublib modules/dependencies, etc
* *)
let value =
match field with
| "name" -> proj_file.Project.name;
| "version" -> proj_file.Project.version;
| "license" -> proj_file.Project.license;
| f -> eprintf "error: unknown field %s\n" f; exit 1 in
printf "%s\n" value
| _ :: _ ->
eprintf "too many fields for 'obuild get', only one is supported\n";
exit 1

let () =
let cmd = {
Cmd.name = "get";
args = [];
fn = mainGet;
short_desc = "XXX";
long_desc = "\
XXX
";
} in
Cmd.register_cmd cmd
26 changes: 26 additions & 0 deletions src/cmd_help.ml
@@ -0,0 +1,26 @@
open Printf

let mainHelp = function
| [] ->
eprintf "missing command for 'obuild help'\n";
exit 1
| [command] ->
let cmd = Cmd.require_cmd command in
let usage_msg = sprintf "%s - %s\n\n%s\n\nOptions:"
command cmd.Cmd.short_desc cmd.Cmd.long_desc in
print_string (Arg.usage_string (Arg.align cmd.Cmd.args) usage_msg)
| _ :: _ ->
eprintf "too many commands for 'obuild help', only one is supported\n";
exit 1

let () =
let cmd = {
Cmd.name = "help";
args = [];
fn = mainHelp;
short_desc = "Help about commands";
long_desc = "\
XXX
";
} in
Cmd.register_cmd cmd
19 changes: 19 additions & 0 deletions src/cmd_infer.ml
@@ -0,0 +1,19 @@
open Printf

let mainInfer argv =
if argv = []
then (printf "no modules to infer\n"; exit 0);

App_utils.unimplemented ()

let () =
let cmd = {
Cmd.name = "infer";
args = [];
fn = mainInfer;
short_desc = "XXX";
long_desc = "\
XXX
";
} in
Cmd.register_cmd cmd
19 changes: 19 additions & 0 deletions src/cmd_init.ml
@@ -0,0 +1,19 @@
open Ext.Filepath
open Obuild

let mainInit _ =
let project = Init.run () in
let name = fn (project.Project.name) <.> "obuild" in
Project.write (in_current_dir name) project

let () =
let cmd = {
Cmd.name = "init";
args = [];
fn = mainInit;
short_desc = "XXX";
long_desc = "\
XXX
";
} in
Cmd.register_cmd cmd
40 changes: 40 additions & 0 deletions src/cmd_install.ml
@@ -0,0 +1,40 @@
open Ext.Filepath
open Obuild

let dest_dir = ref ""
let opam_install = ref false

let args = [
("--destdir", Arg.Set_string dest_dir, "DIR override destination where to install (default coming from findlib configuration)");
("--opam", Arg.Set opam_install, " only create the .install file for opam (do not copy the files)");
]

let mainInstall argv =
Dist.exist ();
let setup = App_utils.read_setup () in
let proj_file = App_utils.project_read () in
let flags = Configure.check proj_file false setup in
let dest_dir =
(if !dest_dir = ""
then (match FindlibConf.get_destdir () with
| None -> failwith "no destdir specified, and no findlib default found"
| Some p -> p
)
else fp !dest_dir)
in
(* install all the libs *)
Install.install_libs proj_file dest_dir !opam_install;
if !opam_install then
Install.opam_install_file proj_file flags

let () =
let cmd = {
Cmd.name = "install";
args = args;
fn = mainInstall;
short_desc = "Install this package";
long_desc = "\
XXX
";
} in
Cmd.register_cmd cmd
27 changes: 27 additions & 0 deletions src/cmd_sdist.ml
@@ -0,0 +1,27 @@
open Obuild

let isSnapshot = ref false

let args = [
("--snapshot", Arg.Set isSnapshot, " build a snapshot of the project");
]

let mainSdist argv =
Dist.check_exn (fun () -> ());

let proj_file = App_utils.project_read () in
Sdist.run proj_file !isSnapshot;
()

let () =
let cmd = {
Cmd.name = "sdist";
args = args;
fn = mainSdist;
short_desc = "Create a source distribution file (.tar.gz)";
long_desc = "\
Generate a source distribution file .tar.gz that contains
all the necessary bits to distribute to someone else
and being able to build and install the package.";
} in
Cmd.register_cmd cmd

0 comments on commit 9f258ad

Please sign in to comment.