mirror of
https://gitlab.com/scemama/QCaml.git
synced 2024-08-28 23:42:00 +02:00
351 lines
9.8 KiB
Org Mode
351 lines
9.8 KiB
Org Mode
#+begin_src elisp tangle: no :results none :exports none
|
|
(setq pwd (file-name-directory buffer-file-name))
|
|
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
|
(setq lib (concat pwd "lib/"))
|
|
(setq testdir (concat pwd "test/"))
|
|
(setq mli (concat lib name ".mli"))
|
|
(setq ml (concat lib name ".ml"))
|
|
(setq test-ml (concat testdir name ".ml"))
|
|
(org-babel-tangle)
|
|
#+end_src
|
|
|
|
* Command line
|
|
:PROPERTIES:
|
|
:header-args: :noweb yes :comments both
|
|
:END:
|
|
|
|
This module is a wrapper around the ~Getopt~ library and helps to
|
|
define command-line arguments.
|
|
|
|
Here is an example of how to use this module.
|
|
First, define the specification:
|
|
#+begin_src ocaml :tangle no
|
|
let open Command_line in
|
|
begin
|
|
set_header_doc (Sys.argv.(0) ^ " - One-line description");
|
|
set_description_doc "Long description of the command.";
|
|
set_specs
|
|
[ { short='c'; long="check"; opt=Optional;
|
|
doc="Checks the input data";
|
|
arg=Without_arg; };
|
|
|
|
{ short='b' ; long="basis" ; opt=Mandatory;
|
|
arg=With_arg "<string>";
|
|
doc="Name of the file containing the basis set"; } ;
|
|
|
|
{ short='m' ; long="multiplicity" ; opt=Optional;
|
|
arg=With_arg "<int>";
|
|
doc="Spin multiplicity (2S+1). Default is singlet"; } ;
|
|
]
|
|
end;
|
|
#+end_src
|
|
|
|
Then, define what to do with the arguments:
|
|
#+begin_src ocaml :tangle no
|
|
let c =
|
|
Command_line.get_bool "check"
|
|
in
|
|
|
|
let basis =
|
|
match Command_line.get "basis" with
|
|
| Some x -> x
|
|
| None -> assert false
|
|
in
|
|
|
|
let multiplicity =
|
|
match Command_line.get "multiplicity" with
|
|
| None -> 1
|
|
| Some n -> int_of_string n
|
|
in
|
|
#+end_src
|
|
|
|
** Type
|
|
|
|
#+NAME:type
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
type short_opt = char
|
|
type long_opt = string
|
|
type optional = Mandatory | Optional
|
|
type documentation = string
|
|
type argument = With_arg of string | Without_arg | With_opt_arg of string
|
|
|
|
type description = {
|
|
short: short_opt ;
|
|
long : long_opt ;
|
|
opt : optional ;
|
|
doc : documentation ;
|
|
arg : argument ;
|
|
}
|
|
|
|
#+end_src
|
|
|
|
- Short option: in the command line, a dash with a single character
|
|
(ex: =ls -l=)
|
|
- Long option: in the command line, two dashes with a word
|
|
(ex: =ls --directory=)
|
|
- Command-line options can be ~Mandatory~ or ~Optional~
|
|
- Documentation of the option is used in the help function
|
|
- Some options require an argument (~ls --ignore="*.ml"~ ), some
|
|
don't (~ls -l~) and for some arguments the argument is optional
|
|
(~git --log[=<n>]~)
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
<<type>>
|
|
#+end_src
|
|
|
|
** Mutable attributes
|
|
|
|
All the options are stored in the hash table ~dict~ where the key
|
|
is the long option and the value is a value of type ~description~.
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let header_doc = ref ""
|
|
let description_doc = ref ""
|
|
let footer_doc = ref ""
|
|
let anon_args_ref = ref []
|
|
let specs = ref []
|
|
let dict = Hashtbl.create 67
|
|
#+end_src
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val set_header_doc : string -> unit
|
|
val set_description_doc : string -> unit
|
|
val set_footer_doc : string -> unit
|
|
#+end_src
|
|
|
|
Functions to set the header, footer and main description of the
|
|
documentation provided by the ~help~ function:
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let set_header_doc s = header_doc := s
|
|
let set_description_doc s = description_doc := s
|
|
let set_footer_doc s = footer_doc := s
|
|
#+end_src
|
|
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val anonymous : long_opt -> optional -> documentation -> description
|
|
#+end_src
|
|
|
|
Function to create an anonymous argument.
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let anonymous name opt doc =
|
|
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
|
|
#+end_src
|
|
|
|
** Text formatting functions :noexport:
|
|
|
|
Function to print some text such that it fits on the screen
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let output_text t =
|
|
Format.printf "@[<v 0>";
|
|
begin
|
|
match Str.split (Str.regexp "\n") t with
|
|
| x :: [] ->
|
|
Format.printf "@[<hov 0>";
|
|
Str.split (Str.regexp " ") x
|
|
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
|
Format.printf "@]"
|
|
| t ->
|
|
List.iter (fun x ->
|
|
Format.printf "@[<hov 0>";
|
|
Str.split (Str.regexp " ") x
|
|
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
|
Format.printf "@]@;"
|
|
) t
|
|
end;
|
|
Format.printf "@]"
|
|
#+end_src
|
|
|
|
|
|
Function to build the short description of the command-line
|
|
arguments, such as
|
|
|
|
#+begin_example
|
|
my_program -b <string> [-h] [-u <float>] -x <string> [--]
|
|
#+end_example
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let output_short x =
|
|
match x.short, x.opt, x.arg with
|
|
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
|
|
| ' ', Optional , _ -> Format.printf "@[[%s]@]" x.long
|
|
| _ , Mandatory, Without_arg -> Format.printf "@[-%c@]" x.short
|
|
| _ , Optional , Without_arg -> Format.printf "@[[-%c]@]" x.short
|
|
| _ , Mandatory, With_arg arg -> Format.printf "@[-%c %s@]" x.short arg
|
|
| _ , Optional , With_arg arg -> Format.printf "@[[-%c %s]@]" x.short arg
|
|
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
|
|
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
|
|
#+end_src
|
|
|
|
|
|
Function to build the long description of the command-line
|
|
arguments, such as
|
|
|
|
#+begin_example
|
|
-x --xyz=<string> Name of the file containing the nuclear
|
|
coordinates in xyz format
|
|
#+end_example
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let output_long max_width x =
|
|
let arg =
|
|
match x.short, x.arg with
|
|
| ' ' , _ -> x.long
|
|
| _ , Without_arg -> x.long
|
|
| _ , With_arg arg -> Printf.sprintf "%s=%s" x.long arg
|
|
| _ , With_opt_arg arg -> Printf.sprintf "%s[=%s]" x.long arg
|
|
in
|
|
let long =
|
|
let l = String.length arg in
|
|
arg^(String.make (max_width-l) ' ')
|
|
in
|
|
Format.printf "@[<v 0>";
|
|
begin
|
|
match x.short with
|
|
| ' ' -> Format.printf "@[%s @]" long
|
|
| short -> Format.printf "@[-%c --%s @]" short long
|
|
end;
|
|
Format.printf "@]";
|
|
output_text x.doc
|
|
#+end_src
|
|
|
|
** Query functions
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val get : long_opt -> string option
|
|
val get_bool : long_opt -> bool
|
|
val anon_args : unit -> string list
|
|
#+end_src
|
|
|
|
| ~get~ | Returns the argument associated with a long option |
|
|
| ~get_bool~ | True if the ~Optional~ argument is present in the command-line |
|
|
| ~anon_args~ | Returns the list of anonymous arguments |
|
|
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let anon_args () = !anon_args_ref
|
|
|
|
let help () =
|
|
|
|
(* Print the header *)
|
|
output_text !header_doc;
|
|
Format.printf "@.@.";
|
|
|
|
(* Find the anonymous arguments *)
|
|
let anon =
|
|
List.filter (fun x -> x.short = ' ') !specs
|
|
in
|
|
|
|
(* Find the options *)
|
|
let options =
|
|
List.filter (fun x -> x.short <> ' ') !specs
|
|
|> List.sort (fun x y -> Char.compare x.short y.short)
|
|
in
|
|
|
|
(* Find column lengths *)
|
|
let max_width =
|
|
List.map (fun x ->
|
|
( match x.arg with
|
|
| Without_arg -> String.length x.long
|
|
| With_arg arg -> String.length x.long + String.length arg
|
|
| With_opt_arg arg -> String.length x.long + String.length arg + 2
|
|
)
|
|
+ ( if x.opt = Optional then 2 else 0)
|
|
) !specs
|
|
|> List.fold_left max 0
|
|
in
|
|
|
|
|
|
(* Print usage *)
|
|
Format.printf "@[<v>@[<v 2>Usage:@,@,@[<hov 4>@[%s@]" Sys.argv.(0);
|
|
List.iter (fun x -> Format.printf "@ "; output_short x) options;
|
|
Format.printf "@ @[[--]@]";
|
|
List.iter (fun x -> Format.printf "@ "; output_short x;) anon;
|
|
Format.printf "@]@,@]@,";
|
|
|
|
|
|
(* Print arguments and doc *)
|
|
Format.printf "@[<v 2>Arguments:@,";
|
|
Format.printf "@[<v 0>" ;
|
|
List.iter (fun x -> Format.printf "@ "; output_long max_width x) anon;
|
|
Format.printf "@]@,@]@,";
|
|
|
|
|
|
(* Print options and doc *)
|
|
Format.printf "@[<v 2>Options:@,";
|
|
|
|
Format.printf "@[<v 0>" ;
|
|
List.iter (fun x -> Format.printf "@ "; output_long max_width x) options;
|
|
Format.printf "@]@,@]@,";
|
|
|
|
|
|
(* Print footer *)
|
|
if !description_doc <> "" then
|
|
begin
|
|
Format.printf "@[<v 2>Description:@,@,";
|
|
output_text !description_doc;
|
|
Format.printf "@,"
|
|
end;
|
|
|
|
(* Print footer *)
|
|
output_text !footer_doc;
|
|
Format.printf "@."
|
|
|
|
|
|
let get x =
|
|
try Some (Hashtbl.find dict x)
|
|
with Not_found -> None
|
|
|
|
|
|
let get_bool x = Hashtbl.mem dict x
|
|
#+end_src
|
|
|
|
** Specification
|
|
|
|
#+begin_src ocaml :tangle (eval mli)
|
|
val set_specs : description list -> unit
|
|
#+end_src
|
|
|
|
Sets the specifications of the current program from a list of ~descrption~ variables.
|
|
|
|
#+begin_src ocaml :tangle (eval ml) :exports none
|
|
let set_specs specs_in =
|
|
specs := { short = 'h' ;
|
|
long = "help" ;
|
|
doc = "Prints the help message." ;
|
|
arg = Without_arg ;
|
|
opt = Optional ;
|
|
} :: specs_in;
|
|
|
|
let cmd_specs =
|
|
List.filter (fun x -> x.short != ' ') !specs
|
|
|> List.map (fun { short ; long ; arg ; _ } ->
|
|
match arg with
|
|
| With_arg _ ->
|
|
(short, long, None, Some (fun x -> Hashtbl.replace dict long x) )
|
|
| Without_arg ->
|
|
(short, long, Some (fun () -> Hashtbl.replace dict long ""), None)
|
|
| With_opt_arg _ ->
|
|
(short, long, Some (fun () -> Hashtbl.replace dict long ""),
|
|
Some (fun x -> Hashtbl.replace dict long x) )
|
|
)
|
|
in
|
|
|
|
Getopt.parse_cmdline cmd_specs (fun x -> anon_args_ref := !anon_args_ref @ [x]);
|
|
|
|
if (get_bool "help") then
|
|
(help () ; exit 0);
|
|
|
|
(* Check that all mandatory arguments are set *)
|
|
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
|
|> List.iter (fun x ->
|
|
match get x.long with
|
|
| Some _ -> ()
|
|
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
|
)
|
|
#+end_src
|