QCaml/common/command_line.org

• Command line
  • Type
  • Mutable attributes
  • Text formatting functions
  • Query functions
    • anon_args
    • help
    • get
    • get_bool
  • Specification

(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)

Command line

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:

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;

Then, define what to do with the arguments:

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

Type

• 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>])

#+NAME:type

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 ;
}

<<type>>

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.

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

Functions to set the header, footer and main description of the documentation provided by the help function:

val set_header_doc : string -> unit
val set_description_doc : string -> unit
val set_footer_doc : string -> unit

let set_header_doc s = header_doc := s
let set_description_doc s = description_doc := s
let set_footer_doc s = footer_doc := s

Function to create an anonymous argument:

val anonymous : long_opt -> optional -> documentation -> description

let anonymous name opt doc =
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }

Text formatting functions

Function to print some text such that it fits on the screen

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 "@]"

Function to build the short description of the command-line arguments, such as

my_program -b <string> [-h] [-u <float>] -x <string> [--]

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

Function to build the long description of the command-line arguments, such as

-x  --xyz=<string>              Name of the file containing the nuclear
                               coordinates in xyz format

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

Query functions

anon_args

Returns the list of anonymous arguments

val anon_args : unit -> string list

let anon_args () = !anon_args_ref

help

Prints the documentation of the program.

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 "@."

get

Returns the argument associated with a long option.

val get : long_opt -> string option

let get x =
try Some (Hashtbl.find dict x)
with Not_found -> None

get_bool

True if the Optional argument is present in the command-line

val get_bool : long_opt -> bool

let get_bool x = Hashtbl.mem dict x

Specification

Gives the specifications of the current program as a list of descrption variables.

val set_specs : description list -> unit

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.")
)