mirror of
https://github.com/c-cube/linol.git
synced 2025-12-06 03:05:31 -05:00
337 lines
19 KiB
HTML
337 lines
19 KiB
HTML
<!DOCTYPE html>
|
||
<html xmlns="http://www.w3.org/1999/xhtml"><head><title>examples (cmdliner.examples)</title><meta charset="utf-8"/><link rel="stylesheet" href="../_odoc-theme/odoc.css"/><meta name="generator" content="odoc 2.4.2"/><meta name="viewport" content="width=device-width,initial-scale=1.0"/><script src="../highlight.pack.js"></script><script>hljs.initHighlightingOnLoad();</script></head><body class="odoc"><nav class="odoc-nav"><a href="index.html">Up</a> – <a href="index.html">cmdliner</a> » examples</nav><header class="odoc-preamble"><h1 id="examples"><a href="#examples" class="anchor"></a>Examples</h1><p>The examples are self-contained, cut and paste them in a file to play with them.</p></header><nav class="odoc-toc"><ul><li><a href="#exrm">A <code>rm</code> command</a></li><li><a href="#excp">A <code>cp</code> command</a></li><li><a href="#extail">A <code>tail</code> command</a></li><li><a href="#exdarcs">A <code>darcs</code> command</a></li></ul></nav><div class="odoc-content"><h2 id="exrm"><a href="#exrm" class="anchor"></a>A <code>rm</code> command</h2><p>We define the command line interface of an <code>rm</code> command with the synopsis:</p><pre>rm [OPTION]… FILE…</pre><p>The <code>-f</code>, <code>-i</code> and <code>-I</code> flags define the prompt behaviour of <code>rm</code>. It is represented in our program by the <code>prompt</code> type. If more than one of these flags is present on the command line the last one takes precedence.</p><p>To implement this behaviour we map the presence of these flags to values of the <code>prompt</code> type by using <a href="Cmdliner/Arg/index.html#val-vflag_all"><code>Cmdliner.Arg.vflag_all</code></a>.</p><p>This argument will contain all occurrences of the flag on the command line and we just take the <a href="Cmdliner/Arg/index.html#val-last"><code>Cmdliner.Arg.last</code></a> one to define our term value. If there is no occurrence the last value of the default list <code>[Always]</code> is taken. This means the default prompt behaviour is <code>Always</code>.</p><pre class="language-ocaml"><code>(* Implementation of the command, we just print the args. *)
|
||
|
||
type prompt = Always | Once | Never
|
||
let prompt_str = function
|
||
| Always -> "always" | Once -> "once" | Never -> "never"
|
||
|
||
let rm prompt recurse files =
|
||
Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n"
|
||
(prompt_str prompt) recurse (String.concat ", " files)
|
||
|
||
(* Command line interface *)
|
||
|
||
open Cmdliner
|
||
|
||
let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE")
|
||
let prompt =
|
||
let always =
|
||
let doc = "Prompt before every removal." in
|
||
Always, Arg.info ["i"] ~doc
|
||
in
|
||
let never =
|
||
let doc = "Ignore nonexistent files and never prompt." in
|
||
Never, Arg.info ["f"; "force"] ~doc
|
||
in
|
||
let once =
|
||
let doc = "Prompt once before removing more than three files, or when
|
||
removing recursively. Less intrusive than $(b,-i), while
|
||
still giving protection against most mistakes."
|
||
in
|
||
Once, Arg.info ["I"] ~doc
|
||
in
|
||
Arg.(last & vflag_all [Always] [always; never; once])
|
||
|
||
let recursive =
|
||
let doc = "Remove directories and their contents recursively." in
|
||
Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc)
|
||
|
||
let cmd =
|
||
let doc = "Remove files or directories" in
|
||
let man = [
|
||
`S Manpage.s_description;
|
||
`P "$(tname) removes each specified $(i,FILE). By default it does not
|
||
remove directories, to also remove them and their contents, use the
|
||
option $(b,--recursive) ($(b,-r) or $(b,-R)).";
|
||
`P "To remove a file whose name starts with a $(b,-), for example
|
||
$(b,-foo), use one of these commands:";
|
||
`Pre "$(mname) $(b,-- -foo)"; `Noblank;
|
||
`Pre "$(mname) $(b,./-foo)";
|
||
`P "$(tname) removes symbolic links, not the files referenced by the
|
||
links.";
|
||
`S Manpage.s_bugs; `P "Report bugs to <bugs@example.org>.";
|
||
`S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ]
|
||
in
|
||
let info = Cmd.info "rm" ~version:"v1.3.0" ~doc ~man in
|
||
Cmd.v info Term.(const rm $ prompt $ recursive $ files)
|
||
|
||
let main () = exit (Cmd.eval cmd)
|
||
let () = main ()</code></pre><h2 id="excp"><a href="#excp" class="anchor"></a>A <code>cp</code> command</h2><p>We define the command line interface of a <code>cp</code> command with the synopsis:</p><pre>cp [OPTION]… SOURCE… DEST</pre><p>The <code>DEST</code> argument must be a directory if there is more than one <code>SOURCE</code>. This constraint is too complex to be expressed by the combinators of <a href="Cmdliner/Arg/index.html"><code>Cmdliner.Arg</code></a>.</p><p>Hence we just give <code>DEST</code> the <a href="Cmdliner/Arg/index.html#val-string"><code>Cmdliner.Arg.string</code></a> type and verify the constraint at the beginning of the implementation of <code>cp</code>. If the constraint is unsatisfied we return an <code>`Error</code> result. By using <a href="Cmdliner/Term/index.html#val-ret"><code>Cmdliner.Term.ret</code></a> on the lifted result <code>cp_t</code> of <code>cp</code>, <code>Cmdliner</code> handles the error reporting.</p><pre class="language-ocaml"><code>(* Implementation, we check the dest argument and print the args *)
|
||
|
||
let cp verbose recurse force srcs dest =
|
||
let many = List.length srcs > 1 in
|
||
if many && (not (Sys.file_exists dest) || not (Sys.is_directory dest))
|
||
then `Error (false, dest ^ ": not a directory") else
|
||
`Ok (Printf.printf
|
||
"verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n"
|
||
verbose recurse force (String.concat ", " srcs) dest)
|
||
|
||
(* Command line interface *)
|
||
|
||
open Cmdliner
|
||
|
||
let verbose =
|
||
let doc = "Print file names as they are copied." in
|
||
Arg.(value & flag & info ["v"; "verbose"] ~doc)
|
||
|
||
let recurse =
|
||
let doc = "Copy directories recursively." in
|
||
Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc)
|
||
|
||
let force =
|
||
let doc = "If a destination file cannot be opened, remove it and try again."in
|
||
Arg.(value & flag & info ["f"; "force"] ~doc)
|
||
|
||
let srcs =
|
||
let doc = "Source file(s) to copy." in
|
||
Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc)
|
||
|
||
let dest =
|
||
let doc = "Destination of the copy. Must be a directory if there is more \
|
||
than one $(i,SOURCE)." in
|
||
let docv = "DEST" in
|
||
Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv ~doc)
|
||
|
||
let cmd =
|
||
let doc = "Copy files" in
|
||
let man_xrefs =
|
||
[ `Tool "mv"; `Tool "scp"; `Page ("umask", 2); `Page ("symlink", 7) ]
|
||
in
|
||
let man =
|
||
[ `S Manpage.s_bugs;
|
||
`P "Email them to <bugs@example.org>."; ]
|
||
in
|
||
let info = Cmd.info "cp" ~version:"v1.3.0" ~doc ~man ~man_xrefs in
|
||
Cmd.v info Term.(ret (const cp $ verbose $ recurse $ force $ srcs $ dest))
|
||
|
||
|
||
let main () = exit (Cmd.eval cmd)
|
||
let () = main ()</code></pre><h2 id="extail"><a href="#extail" class="anchor"></a>A <code>tail</code> command</h2><p>We define the command line interface of a <code>tail</code> command with the synopsis:</p><pre>tail [OPTION]… [FILE]…</pre><p>The <code>--lines</code> option whose value specifies the number of last lines to print has a special syntax where a <code>+</code> prefix indicates to start printing from that line number. In the program this is represented by the <code>loc</code> type. We define a custom <code>loc_arg</code> <a href="Cmdliner/Arg/index.html#type-conv" title="Cmdliner.Arg.conv">argument converter</a> for this option.</p><p>The <code>--follow</code> option has an optional enumerated value. The argument converter <code>follow</code>, created with <a href="Cmdliner/Arg/index.html#val-enum"><code>Cmdliner.Arg.enum</code></a> parses the option value into the enumeration. By using <a href="Cmdliner/Arg/index.html#val-some"><code>Cmdliner.Arg.some</code></a> and the <code>~vopt</code> argument of <a href="Cmdliner/Arg/index.html#val-opt"><code>Cmdliner.Arg.opt</code></a>, the term corresponding to the option <code>--follow</code> evaluates to <code>None</code> if <code>--follow</code> is absent from the command line, to <code>Some Descriptor</code> if present but without a value and to <code>Some v</code> if present with a value <code>v</code> specified.</p><pre class="language-ocaml"><code>(* Implementation of the command, we just print the args. *)
|
||
|
||
type loc = bool * int
|
||
type verb = Verbose | Quiet
|
||
type follow = Name | Descriptor
|
||
|
||
let str = Printf.sprintf
|
||
let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v)
|
||
let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k
|
||
let follow_str = function Name -> "name" | Descriptor -> "descriptor"
|
||
let verb_str = function Verbose -> "verbose" | Quiet -> "quiet"
|
||
|
||
let tail lines follow verb pid files =
|
||
Printf.printf
|
||
"lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n"
|
||
(loc_str lines) (opt_str follow_str follow) (verb_str verb)
|
||
(opt_str string_of_int pid) (String.concat ", " files)
|
||
|
||
(* Command line interface *)
|
||
|
||
open Cmdliner
|
||
|
||
let loc_arg =
|
||
let parse s =
|
||
try
|
||
if s <> "" && s.[0] <> '+'
|
||
then Ok (true, int_of_string s)
|
||
else Ok (false, int_of_string (String.sub s 1 (String.length s - 1)))
|
||
with Failure _ -> Error (`Msg "unable to parse integer")
|
||
in
|
||
let print ppf p = Format.fprintf ppf "%s" (loc_str p) in
|
||
Arg.conv ~docv:"N" (parse, print)
|
||
|
||
let lines =
|
||
let doc = "Output the last $(docv) lines or use $(i,+)$(docv) to start \
|
||
output after the $(i,N)-1th line."
|
||
in
|
||
Arg.(value & opt loc_arg (true, 10) & info ["n"; "lines"] ~docv:"N" ~doc)
|
||
|
||
let follow =
|
||
let doc = "Output appended data as the file grows. $(docv) specifies how \
|
||
the file should be tracked, by its $(b,name) or by its \
|
||
$(b,descriptor)."
|
||
in
|
||
let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in
|
||
Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None &
|
||
info ["f"; "follow"] ~docv:"ID" ~doc)
|
||
|
||
let verb =
|
||
let quiet =
|
||
let doc = "Never output headers giving file names." in
|
||
Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc
|
||
in
|
||
let verbose =
|
||
let doc = "Always output headers giving file names." in
|
||
Verbose, Arg.info ["v"; "verbose"] ~doc
|
||
in
|
||
Arg.(last & vflag_all [Quiet] [quiet; verbose])
|
||
|
||
let pid =
|
||
let doc = "With -f, terminate after process $(docv) dies." in
|
||
Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc)
|
||
|
||
let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE")
|
||
|
||
let cmd =
|
||
let doc = "Display the last part of a file" in
|
||
let man = [
|
||
`S Manpage.s_description;
|
||
`P "$(tname) prints the last lines of each $(i,FILE) to standard output. If
|
||
no file is specified reads standard input. The number of printed
|
||
lines can be specified with the $(b,-n) option.";
|
||
`S Manpage.s_bugs;
|
||
`P "Report them to <bugs@example.org>.";
|
||
`S Manpage.s_see_also;
|
||
`P "$(b,cat)(1), $(b,head)(1)" ]
|
||
in
|
||
let info = Cmd.info "tail" ~version:"v1.3.0" ~doc ~man in
|
||
Cmd.v info Term.(const tail $ lines $ follow $ verb $ pid $ files)
|
||
|
||
|
||
let main () = exit (Cmd.eval cmd)
|
||
let () = main ()</code></pre><h2 id="exdarcs"><a href="#exdarcs" class="anchor"></a>A <code>darcs</code> command</h2><p>We define the command line interface of a <code>darcs</code> command with the synopsis:</p><pre>darcs [COMMAND] …</pre><p>The <code>--debug</code>, <code>-q</code>, <code>-v</code> and <code>--prehook</code> options are available in each command. To avoid having to pass them individually to each command we gather them in a record of type <code>copts</code>. By lifting the record constructor <code>copts</code> into the term <code>copts_t</code> we now have a term that we can pass to the commands to stand for an argument of type <code>copts</code>. These options are documented in a section called <code>COMMON
|
||
OPTIONS</code>, since we also want to put <code>--help</code> and <code>--version</code> in this section, the term information of commands makes a judicious use of the <code>sdocs</code> parameter of <a href="Cmdliner/Term/index.html#val-info"><code>Cmdliner.Term.info</code></a>.</p><p>The <code>help</code> command shows help about commands or other topics. The help shown for commands is generated by <code>Cmdliner</code> by making an appropriate use of <a href="Cmdliner/Term/index.html#val-ret"><code>Cmdliner.Term.ret</code></a> on the lifted <code>help</code> function.</p><p>If the program is invoked without a command we just want to show the help of the program as printed by <code>Cmdliner</code> with <code>--help</code>. This is done by the <code>default_cmd</code> term.</p><pre class="language-ocaml"><code>(* Implementations, just print the args. *)
|
||
|
||
type verb = Normal | Quiet | Verbose
|
||
type copts = { debug : bool; verb : verb; prehook : string option }
|
||
|
||
let str = Printf.sprintf
|
||
let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v)
|
||
let opt_str_str = opt_str (fun s -> s)
|
||
let verb_str = function
|
||
| Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose"
|
||
|
||
let pr_copts oc copts = Printf.fprintf oc
|
||
"debug = %B\nverbosity = %s\nprehook = %s\n"
|
||
copts.debug (verb_str copts.verb) (opt_str_str copts.prehook)
|
||
|
||
let initialize copts repodir = Printf.printf
|
||
"%arepodir = %s\n" pr_copts copts repodir
|
||
|
||
let record copts name email all ask_deps files = Printf.printf
|
||
"%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n"
|
||
pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps
|
||
(String.concat ", " files)
|
||
|
||
let help copts man_format cmds topic = match topic with
|
||
| None -> `Help (`Pager, None) (* help about the program. *)
|
||
| Some topic ->
|
||
let topics = "topics" :: "patterns" :: "environment" :: cmds in
|
||
let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in
|
||
match conv topic with
|
||
| `Error e -> `Error (false, e)
|
||
| `Ok t when t = "topics" -> List.iter print_endline topics; `Ok ()
|
||
| `Ok t when List.mem t cmds -> `Help (man_format, Some t)
|
||
| `Ok t ->
|
||
let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in
|
||
`Ok (Cmdliner.Manpage.print man_format Format.std_formatter page)
|
||
|
||
open Cmdliner
|
||
|
||
(* Help sections common to all commands *)
|
||
|
||
let help_secs = [
|
||
`S Manpage.s_common_options;
|
||
`P "These options are common to all commands.";
|
||
`S "MORE HELP";
|
||
`P "Use $(mname) $(i,COMMAND) --help for help on a single command.";`Noblank;
|
||
`P "Use $(mname) $(b,help patterns) for help on patch matching."; `Noblank;
|
||
`P "Use $(mname) $(b,help environment) for help on environment variables.";
|
||
`S Manpage.s_bugs; `P "Check bug reports at http://bugs.example.org.";]
|
||
|
||
(* Options common to all commands *)
|
||
|
||
let copts debug verb prehook = { debug; verb; prehook }
|
||
let copts_t =
|
||
let docs = Manpage.s_common_options in
|
||
let debug =
|
||
let doc = "Give only debug output." in
|
||
Arg.(value & flag & info ["debug"] ~docs ~doc)
|
||
in
|
||
let verb =
|
||
let doc = "Suppress informational output." in
|
||
let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in
|
||
let doc = "Give verbose output." in
|
||
let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in
|
||
Arg.(last & vflag_all [Normal] [quiet; verbose])
|
||
in
|
||
let prehook =
|
||
let doc = "Specify command to run before this $(mname) command." in
|
||
Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc)
|
||
in
|
||
Term.(const copts $ debug $ verb $ prehook)
|
||
|
||
(* Commands *)
|
||
|
||
let sdocs = Manpage.s_common_options
|
||
|
||
let initialize_cmd =
|
||
let repodir =
|
||
let doc = "Run the program in repository directory $(docv)." in
|
||
Arg.(value & opt file Filename.current_dir_name & info ["repodir"]
|
||
~docv:"DIR" ~doc)
|
||
in
|
||
let doc = "make the current directory a repository" in
|
||
let man = [
|
||
`S Manpage.s_description;
|
||
`P "Turns the current directory into a Darcs repository. Any
|
||
existing files and subdirectories become …";
|
||
`Blocks help_secs; ]
|
||
in
|
||
let info = Cmd.info "initialize" ~doc ~sdocs ~man in
|
||
Cmd.v info Term.(const initialize $ copts_t $ repodir)
|
||
|
||
let record_cmd =
|
||
let pname =
|
||
let doc = "Name of the patch." in
|
||
Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME"
|
||
~doc)
|
||
in
|
||
let author =
|
||
let doc = "Specifies the author's identity." in
|
||
Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL"
|
||
~doc)
|
||
in
|
||
let all =
|
||
let doc = "Answer yes to all patches." in
|
||
Arg.(value & flag & info ["a"; "all"] ~doc)
|
||
in
|
||
let ask_deps =
|
||
let doc = "Ask for extra dependencies." in
|
||
Arg.(value & flag & info ["ask-deps"] ~doc)
|
||
in
|
||
let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in
|
||
let doc = "create a patch from unrecorded changes" in
|
||
let man =
|
||
[`S Manpage.s_description;
|
||
`P "Creates a patch from changes in the working tree. If you specify
|
||
a set of files …";
|
||
`Blocks help_secs; ]
|
||
in
|
||
let info = Cmd.info "record" ~doc ~sdocs ~man in
|
||
Cmd.v info
|
||
Term.(const record $ copts_t $ pname $ author $ all $ ask_deps $ files)
|
||
|
||
let help_cmd =
|
||
let topic =
|
||
let doc = "The topic to get help on. $(b,topics) lists the topics." in
|
||
Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc)
|
||
in
|
||
let doc = "display help about darcs and darcs commands" in
|
||
let man =
|
||
[`S Manpage.s_description;
|
||
`P "Prints help about darcs commands and other subjects…";
|
||
`Blocks help_secs; ]
|
||
in
|
||
let info = Cmd.info "help" ~doc ~man in
|
||
Cmd.v info
|
||
Term.(ret (const help $ copts_t $ Arg.man_format $ Term.choice_names $
|
||
topic))
|
||
|
||
let main_cmd =
|
||
let doc = "a revision control system" in
|
||
let man = help_secs in
|
||
let info = Cmd.info "darcs" ~version:"v1.3.0" ~doc ~sdocs ~man in
|
||
let default = Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)) in
|
||
Cmd.group info ~default [initialize_cmd; record_cmd; help_cmd]
|
||
|
||
let () = exit (Cmd.eval main_cmd)</code></pre></div></body></html>
|