Add Command line option parser for habc-linker

I add Command line option parser module for habc-linker. The module name is CmdOpt.

Offcourse I add unit test for it.

diff --git a/link/.gitignore b/link/.gitignore
new file mode 100644 (file)
index 0000000..5069c92
--- /dev/null
+++ b/link/.gitignore
@@ -0,0 +1 @@
+habc-link
\ No newline at end of file

diff --git a/link/OMakefile b/link/OMakefile
index 7e391a1..6e32ec7 100644 (file)
--- a/link/OMakefile
+++ b/link/OMakefile
@@ -6,9 +6,10 @@ OCAMLPACKS[] =
        extlib
        oUnit
 
-UseCamlp4(pa_oo)
+UseCamlp4(pa_oo pa_field)
 
 FILES[] =
+       cmdOpt
        $(ROOT)/swflib
        $(ROOT)/config
 
@@ -24,6 +25,7 @@ OCamlProgram($(PROGRAM), main $(FILES))
 # ------------------------------
 # Test
 # ------------------------------
+OUnitTest(cmdOpt, cmdOpt $(ROOT)/config)
 
 # ------------------------------
 # PHONY target

diff --git a/link/cmdOpt.ml b/link/cmdOpt.ml
new file mode 100644 (file)
index 0000000..a23c544
--- /dev/null
+++ b/link/cmdOpt.ml
@@ -0,0 +1,87 @@
+open Base
+open OptParse
+
+type t = {
+  size       : int * int;
+  color      : int * int * int;
+  main_class : string
+}
+
+let opt_parser =
+  OptParser.make
+    ~version:Config.version
+    ~usage:"habc-link [options] <file>" ()
+
+let str_option ~default ~metavar ?short_name ?long_name ~help () =
+  let store =
+    StdOpt.str_option ~default ~metavar () in
+  let _ =
+    OptParser.add opt_parser
+      ?short_name
+      ?long_name ~help store in
+    store
+
+let int_option ~default ~metavar ?short_name ?long_name ~help () =
+  let store =
+    StdOpt.int_option ~default ~metavar () in
+  let _ =
+    OptParser.add opt_parser
+      ?short_name ?long_name ~help store in
+    store
+
+let width =
+  int_option
+    ~default:(20 * 800)
+    ~metavar:"<width>"
+    ~short_name:'W'
+    ~long_name:"width"
+    ~help:"Set stage width by twips" ()
+
+let height =
+  int_option
+    ~default:600
+    ~metavar:"<height>"
+    ~short_name:'H'
+    ~long_name:"height"
+    ~help:"Set stage height by pixel" ()
+
+let main_class =
+  str_option
+    ~default:"boot.Main"
+    ~metavar:"<main_class>"
+    ~short_name:'m'
+    ~long_name:"main"
+    ~help:"Set main class" ()
+
+let red =
+  int_option
+    ~default:134
+    ~metavar:"<red>"
+    ~long_name:"red"
+    ~help:"stage background color(red)" ()
+
+let green =
+  int_option
+    ~default:156
+    ~metavar:"<green>"
+    ~long_name:"green"
+    ~help:"stage background color(green)" ()
+
+let blue =
+  int_option
+    ~default:167
+    ~metavar:"<blue>"
+    ~long_name:"blue"
+    ~help:"stage background color(blue)" ()
+
+let parse argv =
+  let inputs =
+    OptParser.parse opt_parser argv in
+    inputs,{
+      color      = (Opt.get red, Opt.get green, Opt.get blue);
+      main_class = Opt.get main_class;
+      size       = (Opt.get width, Opt.get height)
+    }
+
+let parse_argv () =
+  parse Sys.argv

diff --git a/link/cmdOpt.mli b/link/cmdOpt.mli
new file mode 100644 (file)
index 0000000..c9675f7
--- /dev/null
+++ b/link/cmdOpt.mli
@@ -0,0 +1,7 @@
+type t = {
+  size       : int * int;
+  color      : int * int * int;
+  main_class : string
+}
+val parse : string array -> string list * t
+val parse_argv : unit -> string list * t

diff --git a/link/cmdOptTest.ml b/link/cmdOptTest.ml
new file mode 100644 (file)
index 0000000..ff05b71
--- /dev/null
+++ b/link/cmdOptTest.ml
@@ -0,0 +1,25 @@
+open Base
+open OUnit
+open CmdOpt
+open ExtString
+
+let ok x f y =
+  assert_equal x @@ f @@ snd @@ parse @@ Array.of_list @@ String.nsplit y " "
+
+let _ = begin "cmdOpt.ml" >::: [
+  "filename" >:: begin fun () ->
+    assert_equal ["foo"]        @@ fst @@ parse [| "foo" |];
+    assert_equal ["foo"; "bar"] @@ fst @@ parse [| "foo"; "bar" |]
+  end;
+  "size" >:: begin fun () ->
+    ok (100,200) (fun {size} -> size) "-W 100 -H 200";
+    ok (100,200) (fun {size} -> size) "--width=100 --height=200";
+  end;
+  "color" >:: begin fun () ->
+    ok (1,2,3) (fun {color}-> color) "--red=1 --green=2 --blue=3"
+  end;
+  "main class" >:: begin fun () ->
+    ok "foo" (fun {main_class}->main_class) "-m foo";
+    ok "foo" (fun {main_class}->main_class) "--main=foo"
+  end
+] end +> run_test_tt_main

diff --git a/link/main.ml b/link/main.ml
index f7c8195..b2fa0cb 100644 (file)
--- a/link/main.ml
+++ b/link/main.ml
@@ -1,2 +1,4 @@
+open Base
+
 let _ =
   print_endline "hello"