mirror of
https://github.com/c-cube/linol.git
synced 2025-12-06 03:05:31 -05:00
346 lines
20 KiB
HTML
346 lines
20 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 3.1.0"/><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">Index</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. See also the suggested <a href="cookbook.html#tip_src_structure" title="tip_src_structure">source code structure</a> and program <a href="cookbook.html#blueprints" title="blueprints">blueprints</a>.</p></header><div class="odoc-tocs"><nav class="odoc-toc odoc-local-toc"><ul><li><a href="#example_rm">A <code>rm</code> command</a></li><li><a href="#example_cp">A <code>cp</code> command</a></li><li><a href="#example_tail">A <code>tail</code> command</a></li><li><a href="#example_darcs">A <code>darcs</code> command</a></li></ul></nav></div><div class="odoc-content"><h2 id="example_rm"><a href="#example_rm" 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
|
||
open Cmdliner.Term.Syntax
|
||
|
||
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 rm_cmd =
|
||
let doc = "Remove files or directories" in
|
||
let man = [
|
||
`S Manpage.s_description;
|
||
`P "$(cmd) 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 "$(cmd) $(b,-- -foo)"; `Noblank;
|
||
`Pre "$(cmd) $(b,./-foo)";
|
||
`P "$(cmd.name) 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
|
||
Cmd.make (Cmd.info "rm" ~version:"v2.0.0" ~doc ~man) @@
|
||
let+ prompt and+ recursive and+ files in
|
||
rm ~prompt ~recurse:recursive files
|
||
|
||
let main () = Cmd.eval rm_cmd
|
||
let () = if !Sys.interactive then () else exit (main ())</code></pre><h2 id="example_cp"><a href="#example_cp" 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 command's term for <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
|
||
open Cmdliner.Term.Syntax
|
||
|
||
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 cp_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
|
||
Cmd.make (Cmd.info "cp" ~version:"v2.0.0" ~doc ~man ~man_xrefs) @@
|
||
Term.ret @@
|
||
let+ verbose and+ recurse and+ force and+ srcs and+ dest in
|
||
cp ~verbose ~recurse ~force srcs dest
|
||
|
||
let main () = Cmd.eval cp_cmd
|
||
let () = if !Sys.interactive then () else exit (main ())</code></pre><h2 id="example_tail"><a href="#example_tail" 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
|
||
open Cmdliner.Term.Syntax
|
||
|
||
let loc_arg =
|
||
let parser 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 "unable to parse integer"
|
||
in
|
||
let pp ppf p = Format.fprintf ppf "%s" (loc_str p) in
|
||
Arg.Conv.make ~docv:"N" ~parser ~pp ()
|
||
|
||
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 tail_cmd =
|
||
let doc = "Display the last part of a file" in
|
||
let man = [
|
||
`S Manpage.s_description;
|
||
`P "$(cmd) 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
|
||
Cmd.make (Cmd.info "tail" ~version:"v2.0.0" ~doc ~man) @@
|
||
let+ lines and+ follow and+ verb and+ pid and+ files in
|
||
tail ~lines ~follow ~verb ~pid files
|
||
|
||
let main () = Cmd.eval tail_cmd
|
||
let () = if !Sys.interactive then () else exit (main ())</code></pre><h2 id="example_darcs"><a href="#example_darcs" 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 the section <a href="Cmdliner/Manpage/index.html#val-s_common_options"><code>Cmdliner.Manpage.s_common_options</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</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
|
||
let parse = Cmdliner.Arg.Conv.parser conv in
|
||
match parse 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
|
||
open Cmdliner.Term.Syntax
|
||
|
||
(* 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 $(tool) $(i,COMMAND) --help for help on a single command.";`Noblank;
|
||
`P "Use $(tool) $(b,help patterns) for help on patch matching."; `Noblank;
|
||
`P "Use $(tool) $(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 $(tool) 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
|
||
Cmd.make (Cmd.info "initialize" ~doc ~sdocs ~man) @@
|
||
let+ copts_t and+ repodir in
|
||
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
|
||
Cmd.make (Cmd.info "record" ~doc ~sdocs ~man) @@
|
||
let+ copts_t and+ pname and+ author and+ all and+ ask_deps and+ files in
|
||
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
|
||
Cmd.make (Cmd.info "help" ~doc ~man) @@
|
||
Term.ret @@
|
||
let+ copts_t and+ man_format = Arg.man_format
|
||
and+ choice_names = Term.choice_names and+ topic in
|
||
help copts_t man_format choice_names topic
|
||
|
||
let main_cmd =
|
||
let doc = "a revision control system" in
|
||
let man = help_secs in
|
||
let info = Cmd.info "darcs" ~version:"v2.0.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 main () = Cmd.eval main_cmd
|
||
let () = if !Sys.interactive then () else exit (main ())</code></pre></div></body></html>
|