diff --git a/bootstrap b/bootstrap index 9c75978..e372ee3 100755 --- a/bootstrap +++ b/bootstrap @@ -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 diff --git a/src/app_utils.ml b/src/app_utils.ml new file mode 100644 index 0000000..2081591 --- /dev/null +++ b/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 diff --git a/src/cmd.ml b/src/cmd.ml new file mode 100644 index 0000000..86758f6 --- /dev/null +++ b/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 [] diff --git a/src/cmd_build.ml b/src/cmd_build.ml new file mode 100644 index 0000000..6e8e8cf --- /dev/null +++ b/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 diff --git a/src/cmd_clean.ml b/src/cmd_clean.ml new file mode 100644 index 0000000..8a7b1c2 --- /dev/null +++ b/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 diff --git a/src/cmd_configure.ml b/src/cmd_configure.ml new file mode 100644 index 0000000..d09d49f --- /dev/null +++ b/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 diff --git a/src/cmd_doc.ml b/src/cmd_doc.ml new file mode 100644 index 0000000..23b18eb --- /dev/null +++ b/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 diff --git a/src/cmd_get.ml b/src/cmd_get.ml new file mode 100644 index 0000000..1e5b2db --- /dev/null +++ b/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 diff --git a/src/cmd_help.ml b/src/cmd_help.ml new file mode 100644 index 0000000..2e285e1 --- /dev/null +++ b/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 diff --git a/src/cmd_infer.ml b/src/cmd_infer.ml new file mode 100644 index 0000000..5c9839f --- /dev/null +++ b/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 diff --git a/src/cmd_init.ml b/src/cmd_init.ml new file mode 100644 index 0000000..c925e67 --- /dev/null +++ b/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 diff --git a/src/cmd_install.ml b/src/cmd_install.ml new file mode 100644 index 0000000..7ced446 --- /dev/null +++ b/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 diff --git a/src/cmd_sdist.ml b/src/cmd_sdist.ml new file mode 100644 index 0000000..2e57664 --- /dev/null +++ b/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 diff --git a/src/cmd_test.ml b/src/cmd_test.ml new file mode 100644 index 0000000..dbb2aeb --- /dev/null +++ b/src/cmd_test.ml @@ -0,0 +1,67 @@ +open Printf +open Ext.Filepath +open Ext +open Obuild.Types +open Obuild.Helper +open Obuild + +let showTest = ref false + +let args = [ + ("--output", Arg.Set showTest, " show test outputs"); +] + +let mainTest argv = + let setup = App_utils.read_setup () in + let proj_file = App_utils.project_read () in + let _ = Configure.check proj_file false setup in + if not (Gconf.get_target_option "build-tests") then ( + eprintf "error: building tests are disabled, re-configure with --enable-tests\n"; + exit 1 + ); + let testTargets = List.map Project.Test.to_target proj_file.Project.tests in + if testTargets <> [] + then ( + let results = + List.map (fun test -> + let testTarget = Project.Test.to_target test in + let outputName = Utils.to_exe_name Normal Native (Target.get_target_dest_name testTarget) in + let dir = Dist.get_build_exn (Dist.Target testTarget.Target.target_name) in + let exePath = dir outputName in + if not (Filesystem.exists exePath) then ( + eprintf "error: %s doesn't appears built, make sure 'obuild build' is run first\n" (Target.get_target_name testTarget); + exit 1 + ); + (match Process.run [ fp_to_string exePath ] with + | Process.Success (out,_,_) -> + if !showTest then print_warnings out; + (test.Project.Test.name, true) + | Process.Failure err -> + print_warnings err; + (test.Project.Test.name, false) + ) + ) proj_file.Project.tests + in + (* this is just a mockup. expect results displayed in javascript and 3d at some point *) + let failed = List.filter (fun (_,x) -> false = x) results in + let successes = List.filter (fun (_,x) -> true = x) results in + let total = List.length failed + List.length successes in + printf "%sSUCCESS%s: %d/%d\n" (color_green()) (color_white()) (List.length successes) total; + printf "%sFAILED%s : %d/%d\n" (color_red()) (color_white()) (List.length failed) total; + List.iter (fun (n,_) -> printf " %s\n" n) failed; + if failed <> [] then exit 1 + + ) else + printf "warning: no tests defined: not doing anything.\n" + +let () = + let cmd = { + Cmd.name = "test"; + args = args; + fn = mainTest; + short_desc = "Run the tests"; + long_desc = "\ +XXX +"; + } in + Cmd.register_cmd cmd diff --git a/src/help.ml b/src/help.ml deleted file mode 100644 index 66a9cee..0000000 --- a/src/help.ml +++ /dev/null @@ -1,39 +0,0 @@ - -let helpConfigure = - [ "Configure --- Prepare to build the package" - ; "" - ; "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" - ] - -let helpClean = - [ "Clean --- Cleanup after obuild" - ; "" - ; "Remove all by-product of compilation (.cmx, .cmi, .cmo, etc)" - ; "and remove the dist directory." - ] - -let helpBuild = - [ "Build --- Build every buildable bits" - ; "" - ; "Build all your different targets (library, executable," - ; "tests, benchmarks, example) that are marked as buildable." - ] - -let helpSdist = - [ "Sdist --- Create a source distribution file (.tar.gz)" - ; "" - ; "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" - ] - -let helpMessages = - [ "clean", helpClean - ; "configure", helpConfigure - ; "build", helpBuild - ; "sdist", helpSdist - ] diff --git a/src/main.ml b/src/main.ml index 173299d..1b95a40 100644 --- a/src/main.ml +++ b/src/main.ml @@ -1,353 +1,84 @@ open Printf -open Ext.Fugue -open Ext.Filepath -open Ext -open Obuild.Types -open Obuild.Helper open Obuild.Gconf open Obuild -let programName = "obuild" -let usageStr cmd = "\nusage: " ^ programName ^ " " ^ cmd ^ " \n\noptions:\n" - -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 configure argv = - let user_flags = ref [] in - let user_opts = ref [] in - 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, "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 - Arg.parse_argv (Array.of_list argv) ( - 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 - ) (fun s -> failwith ("unknown option: " ^ s)) (usageStr "configure"); - - 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 mainBuild argv = - let anon = ref [] in - let build_options = [ - ("-j", Arg.Int (fun i -> gconf.parallel_jobs <- i), "maximum number of jobs in parallel"); - ("--jobs", Arg.Int (fun i -> gconf.parallel_jobs <- i), "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") - ] in - Arg.parse_argv (Array.of_list argv) build_options (fun s -> anon := s :: !anon) (usageStr "build"); - - Dist.exist (); - let setup = read_setup () in - let proj_file = 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 !anon with - | [] -> project.Analyze.project_targets_dag - | _ -> - let targets = List.map Target.Name.of_string !anon in - Dag.subset project.Analyze.project_targets_dag targets - in - Build.build_dag bstate proj_file dag - -let mainClean _ = - if Filesystem.exists (Dist.get_path ()) - then begin - Filesystem.removeDir (Dist.get_path ()); - Dist.remove_dead_links () - end - -let mainSdist argv = - let isSnapshot = ref false in - Arg.parse_argv (Array.of_list argv) - [ ("--snapshot", Arg.Set isSnapshot, "build a snapshot of the project") - ] (fun s -> failwith ("unknown option: " ^ s)) - (usageStr "sdist"); - Dist.check_exn (fun () -> ()); - - let proj_file = project_read () in - Sdist.run proj_file !isSnapshot; - () - -let unimplemented () = - eprintf "sorry, you've reached an unimplemented part ! please be patient or send a patch.\n"; - exit 1 - -let mainDoc argv = - Arg.parse_argv (Array.of_list argv) - [ - ] (fun s -> failwith ("unknown option: " ^ s)) - (usageStr "doc"); - - let proj_file = project_read () in - Doc.run proj_file; - unimplemented () - -let mainInfer argv = - let anon = ref [] in - Arg.parse_argv (Array.of_list argv) - [ - ] (fun s -> anon := s :: !anon) - (usageStr "infer"); - - if !anon = [] - then (printf "no modules to infer\n"; exit 0); - - unimplemented () - -let mainInstall argv = - let dest_dir = ref "" in - let opam_install = ref false in - Arg.parse_argv (Array.of_list argv) [ - ("--destdir", Arg.Set_string dest_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)") - ] (fun s -> failwith ("unknown option: " ^ s)) - (usageStr "install"); - - Dist.exist (); - let setup = read_setup () in - let proj_file = 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 mainTest argv = - let showTest = ref false in - Arg.parse_argv (Array.of_list argv) - [ ("--output", Arg.Set showTest, "show test outputs") - ] (fun s -> failwith ("unknown option: " ^ s)) - (usageStr "test"); - - let setup = read_setup () in - let proj_file = project_read () in - let _ = Configure.check proj_file false setup in - if not (Gconf.get_target_option "build-tests") then ( - eprintf "error: building tests are disabled, re-configure with --enable-tests\n"; - exit 1 - ); - let testTargets = List.map Project.Test.to_target proj_file.Project.tests in - if testTargets <> [] - then ( - let results = - List.map (fun test -> - let testTarget = Project.Test.to_target test in - let outputName = Utils.to_exe_name Normal Native (Target.get_target_dest_name testTarget) in - let dir = Dist.get_build_exn (Dist.Target testTarget.Target.target_name) in - let exePath = dir outputName in - if not (Filesystem.exists exePath) then ( - eprintf "error: %s doesn't appears built, make sure 'obuild build' is run first\n" (Target.get_target_name testTarget); - exit 1 - ); - (match Process.run [ fp_to_string exePath ] with - | Process.Success (out,_,_) -> - if !showTest then print_warnings out; - (test.Project.Test.name, true) - | Process.Failure err -> - print_warnings err; - (test.Project.Test.name, false) - ) - ) proj_file.Project.tests - in - (* this is just a mockup. expect results displayed in javascript and 3d at some point *) - let failed = List.filter (fun (_,x) -> false = x) results in - let successes = List.filter (fun (_,x) -> true = x) results in - let total = List.length failed + List.length successes in - printf "%sSUCCESS%s: %d/%d\n" (color_green()) (color_white()) (List.length successes) total; - printf "%sFAILED%s : %d/%d\n" (color_red()) (color_white()) (List.length failed) total; - List.iter (fun (n,_) -> printf " %s\n" n) failed; - if failed <> [] then exit 1 - - ) else - printf "warning: no tests defined: not doing anything.\n" - -let mainGet argv = - let argv = List.tl argv in - let proj_file = 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 - * *) - match argv with - | [] -> eprintf "usage: obuild get \n\n"; exit 1 - | [field] -> (match field with - | "name" -> printf "%s\n" proj_file.Project.name; - | "version" -> printf "%s\n" proj_file.Project.version; - | "license" -> printf "%s\n" proj_file.Project.license; - | _ -> eprintf "error: unknown field %s\n" field; exit 1 - ) - | _ -> eprintf "usage: obuild get \n"; exit 1 - -let mainInit _ = - let project = Init.run () in - let name = fn (project.Project.name) <.> "obuild" in - Project.write (in_current_dir name) project - -let usageCommands = String.concat "\n" - [ "Commands:" - ; "" - ; " configure Prepare to build the package." - ; " build Make this package ready for installation." - ; " clean Clean up after a build." - ; " sdist Generate a source distribution file (.tar.gz)." - ; " doc Generate documentation." - ; " install Install this package." - ; " test Run the tests" - ; " help Help about commands" - ] - -let mainHelp argv = - match argv with - | [] -> eprintf "usage: obuild help \n\n"; - | command::_ -> - try - let msgs = List.assoc command Help.helpMessages in - List.iter (eprintf "%s\n") msgs - with Not_found -> - eprintf "no helpful documentation for %s\n" command - -(* parse the global args up the first non option - * -opt1 -opt2 <...> - * *) -let parseGlobalArgs () = - let printVersion () = printf "obuild %s\n" Path_generated.project_version; exit 0 - in - let printHelp () = printf "a rescue team has been dispatched\n"; - exit 0 - in - let expect_param1 optName l f = - match l with - | [] -> failwith (optName ^ " expect a parameter") - | x::xs -> f x; xs - in - let rec processGlobalArgs l = - match l with - | x::xs -> if String.length x > 0 && x.[0] = '-' - then ( - let retXs = - match x with - | "--help" -> printHelp () - | "--version" -> printVersion () - | "-v" - | "--verbose" -> gconf.verbosity <- Verbose; xs - | "--color" -> gconf.color <- true; xs - | "-vv" - | "--debug" -> gconf.verbosity <- Debug; xs - | "-vvv" - | "--debug+" - | "--debug-with-cmd" -> gconf.verbosity <- DebugPlus; xs - | "-q" (* for quiet *) - | "--silent" -> gconf.verbosity <- Silent; xs - | "--strict" -> gconf.strict <- true; xs - | "--findlib-conf" -> expect_param1 x xs (fun p -> Gconf.set_env "findlib-path" p) - | "--ocamlopt" -> expect_param1 x xs (fun p -> Gconf.set_env "ocamlopt" p) - | "--ocamldep" -> expect_param1 x xs (fun p -> Gconf.set_env "ocamldep" p) - | "--ocamlc" -> expect_param1 x xs (fun p -> Gconf.set_env "ocamlc" p) - | "--cc" -> expect_param1 x xs (fun p -> Gconf.set_env "cc" p) - | "--ar" -> expect_param1 x xs (fun p -> Gconf.set_env "ar" p) - | "--pkg-config"-> expect_param1 x xs (fun p -> Gconf.set_env "pkgconfig" p) - | "--ranlib" -> expect_param1 x xs (fun p -> Gconf.set_env "ranlib" p) - | _ -> failwith ("unknown global option: " ^ x) - in - processGlobalArgs retXs - ) else - l - | [] -> [] - in - - processGlobalArgs (List.tl (Array.to_list Sys.argv)) - -let knownCommands = - [ ("configure", configure) - ; ("build", mainBuild) - ; ("clean", mainClean) - ; ("sdist", mainSdist) - ; ("install", mainInstall) - ; ("init", mainInit) - ; ("infer", mainInfer) - ; ("test", mainTest) - ; ("get", mainGet) - ; ("doc", mainDoc) - ; ("help", mainHelp) - ] +(* create no-op aliases for all the modules with commands, so they can + * register themselves (see the Cmd module). + *) +module Cmd_build = Cmd_build +module Cmd_clean = Cmd_clean +module Cmd_configure = Cmd_configure +module Cmd_doc = Cmd_doc +module Cmd_get = Cmd_get +module Cmd_help = Cmd_help +module Cmd_infer = Cmd_infer +module Cmd_init = Cmd_init +module Cmd_install = Cmd_install +module Cmd_sdist = Cmd_sdist +module Cmd_test = Cmd_test + +let printVersion () = + printf "obuild %s\n" Path_generated.project_version; + exit 0 + +let global_args = Arg.align [ + ("--version", Arg.Unit printVersion, " Show the version and exit"); + ("--color", Arg.Unit (fun () -> gconf.color <- true), " enable colors"); + ("-v", Arg.Unit (fun () -> gconf.verbosity <- Verbose), " XXX"); + ("--verbose", Arg.Unit (fun () -> gconf.verbosity <- Verbose), " XXX"); + ("-vv", Arg.Unit (fun () -> gconf.verbosity <- Debug), " XXX"); + ("--debug", Arg.Unit (fun () -> gconf.verbosity <- Debug), " XXX"); + ("-vvv", Arg.Unit (fun () -> gconf.verbosity <- DebugPlus), " XXX"); + ("--debug+", Arg.Unit (fun () -> gconf.verbosity <- DebugPlus), " XXX"); + ("--debug-with-cmd", Arg.Unit (fun () -> gconf.verbosity <- DebugPlus), " XXX"); + ("-q", Arg.Unit (fun () -> gconf.verbosity <- Silent), " XXX"); + ("--silent", Arg.Unit (fun () -> gconf.verbosity <- Silent), " XXX"); + ("--strict", Arg.Unit (fun () -> gconf.strict <- true), " XXX"); + ("--findlib-conf", Arg.String (Gconf.set_env "findlib-path"), " XXX"); + ("--ocamlopt", Arg.String (Gconf.set_env "ocamlopt"), " XXX"); + ("--ocamldep", Arg.String (Gconf.set_env "ocamldep"), " XXX"); + ("--ocamlc", Arg.String (Gconf.set_env "ocamlc"), " XXX"); + ("--cc", Arg.String (Gconf.set_env "cc"), " XXX"); + ("--ar", Arg.String (Gconf.set_env "ar"), " XXX"); + ("--pkg-config", Arg.String (Gconf.set_env "pkgconfig"), " XXX"); + ("--ranlib", Arg.String (Gconf.set_env "ranlib"), " XXX"); +] let defaultMain () = - let args = parseGlobalArgs () in - - if List.length args = 0 - then ( - eprintf "usage: %s [options]\n\n%s\n" Sys.argv.(0) usageCommands; - exit 1 - ); - - let cmd = List.hd args in - try - let mainF = List.assoc cmd knownCommands in - mainF args - with Not_found -> - eprintf "error: unknown command: %s\n\n known commands:\n" cmd; - List.iter (eprintf " %s\n") (List.map fst knownCommands); - exit 1 + let args = ref global_args in + let argv = ref [] in + let cmd = ref None in + let anon_fun arg = + match !cmd with + | None -> + (* got a command, so switch the args to the command ones *) + let new_cmd = Cmd.require_cmd arg in + cmd := Some new_cmd; + args := Arg.align new_cmd.Cmd.args; + | Some _ -> + (* pile up the arguments for the command *) + argv := arg :: !argv + in + let usage_msg = sprintf "See `%s --help'." Cmd.programName in + Arg.parse_dynamic args anon_fun usage_msg; + + let cmd = + match !cmd with + | None -> + (* no command specified, so show an help *) + eprintf "Usage: %s [options]\n\nCommands:\n" Cmd.programName; + let cmds = List.sort compare (Cmd.cmds_list ()) in + List.iter ( + fun cmd_name -> + let cmd = Cmd.find_cmd cmd_name in + eprintf " %-12s %s\n" cmd_name cmd.Cmd.short_desc + ) cmds; + exit 1 + | Some cmd -> cmd in + + (* prepare the arguments for the command, and run it *) + let argv = List.rev !argv in + cmd.Cmd.fn argv let () = try defaultMain ()