1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
(* Example from the documentation, this code is in public domain. *)
(* 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 copts_sect = "COMMON OPTIONS"
let help_secs = [
`S copts_sect;
`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) help patterns' for help on patch matching."; `Noblank;
`P "Use `$(mname) help environment' for help on environment variables.";
`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 = copts_sect 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.(pure copts $ debug $ verb $ prehook)
(* Commands *)
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 "DESCRIPTION";
`P "Turns the current directory into a Darcs repository. Any
existing files and subdirectories become ..."] @ help_secs
in
Term.(pure initialize $ copts_t $ repodir),
Term.info "initialize" ~sdocs:copts_sect ~doc ~man
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 "DESCRIPTION";
`P "Creates a patch from changes in the working tree. If you specify
a set of files ..."] @ help_secs
in
Term.(pure record $ copts_t $ pname $ author $ all $ ask_deps $ files),
Term.info "record" ~doc ~sdocs:copts_sect ~man
let help_cmd =
let topic =
let doc = "The topic to get help on. `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 "DESCRIPTION";
`P "Prints help about darcs commands and other subjects..."] @ help_secs
in
Term.(ret (pure help $ copts_t $ Term.man_format $ Term.choice_names $topic)),
Term.info "help" ~doc ~man
let default_cmd =
let doc = "a revision control system" in
let man = help_secs in
Term.(ret (pure (fun _ -> `Help (`Pager, None)) $ copts_t)),
Term.info "darcs" ~version:"1.6.1" ~sdocs:copts_sect ~doc ~man
let cmds = [initialize_cmd; record_cmd; help_cmd]
let () = match Term.eval_choice default_cmd cmds with
| `Error _ -> exit 1 | _ -> exit 0
|
