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
146
147
148
149
150
151
152
153
154
155
156
|
open Cmdliner
let named wrapper = Term.(app (const wrapper))
let non_deterministic =
let doc = "Run non-deterministic tests." in
let env = Cmd.Env.info ~doc "MDX_RUN_NON_DETERMINISTIC" in
named
(fun x -> `Non_deterministic x)
Arg.(value & flag & info [ "non-deterministic"; "n" ] ~env ~doc)
let syntax =
let parser s =
match Mdx.Syntax.of_string s with
| Some syntax -> Ok syntax
| None -> Error (`Msg (Format.sprintf "unrecognized syntax %S" s))
in
let syntax = Arg.conv (parser, Mdx.Syntax.pp) in
let doc =
"Which syntax to use. Either 'markdown' (also 'normal'), 'cram', or 'mli'."
in
named
(fun x -> `Syntax x)
Arg.(value & opt (some syntax) None & info [ "syntax" ] ~doc ~docv:"SYNTAX")
let file_docv = "FILE"
let file =
let doc = "The file to use." in
named
(fun x -> `File x)
Arg.(
required & pos 0 (some non_dir_file) None & info [] ~doc ~docv:file_docv)
let section =
let doc =
"Select file sub-sections. Will be interpreted as a Perl regular \
expression."
in
named
(fun x -> `Section x)
Arg.(
value & opt (some string) None & info [ "section"; "s" ] ~doc ~docv:"PAT")
let silent_eval =
let doc = "Do not show the result of evaluating toplevel phrases." in
named
(fun x -> `Silent_eval x)
Arg.(value & flag & info [ "silent-eval" ] ~doc)
let record_backtrace =
let doc = "Print backtraces when evaluating toplevel phrases." in
named
(fun x -> `Record_backtrace x)
Arg.(value & flag & info [ "record-backtrace" ] ~doc)
let silent =
let doc = "Do not show any (phrases and findlib directives) results." in
named (fun x -> `Silent x) Arg.(value & flag & info [ "silent" ] ~doc)
let verbose_findlib =
let doc =
"Show the result of evaluating findlib directives in toplevel fragments."
in
named
(fun x -> `Verbose_findlib x)
Arg.(value & flag & info [ "verbose-findlib" ] ~doc)
let prelude =
let parser s =
let env, filename = Mdx.Prelude.env_and_payload s in
let parse = Arg.conv_parser Arg.non_dir_file in
match parse filename with Ok _ -> Ok (env, filename) | Error _ as e -> e
in
let prelude = Arg.conv (parser, Mdx.Prelude.pp) in
let doc =
"A file to load as prelude. Can be prefixed with $(i,env:) to specify a \
specific environment to load the prelude in. Multiple prelude files can \
be provided: they will be evaluated in the order they are provided on the \
command-line."
in
named
(fun x -> `Prelude x)
Arg.(value & opt_all prelude [] & info [ "prelude" ] ~doc)
let prelude_str =
let doc =
"A string to load as prelude. Can be prefixed with $(i,env:) to specify a \
specific environment to load the prelude in (the environment name should \
not contain any spaces. Multiple prelude strings can be provided: they \
will be evaluated in the order they are provided on the command-line."
in
let parse s = Ok (Mdx.Prelude.env_and_payload s) in
let prelude = Arg.conv (parse, Mdx.Prelude.pp) in
named
(fun x -> `Prelude_str x)
Arg.(value & opt_all prelude [] & info [ "prelude-str" ] ~doc)
let directories =
let doc = "A list of directories to load for the #directory directive." in
named
(fun x -> `Directories x)
Arg.(value & opt_all string [] & info [ "directory" ] ~doc ~docv:"STR")
let root =
let doc = "The directory to run the tests from." in
named
(fun x -> `Root x)
Arg.(value & opt (some dir) None & info [ "root" ] ~doc ~docv:"DIR")
let force_output =
let doc = "Force generation of corrected file (even if there was no diff)" in
named
(fun x -> `Force_output x)
Arg.(value & flag & info [ "force-output" ] ~doc)
type output = File of string | Stdout
let output_conv =
let sparse, sprint = Arg.(conv_parser string, conv_printer string) in
let parse s =
match sparse s with
| Ok "-" -> Ok Stdout
| Ok s -> Ok (File s)
| Error msg -> Error msg
in
let print fmt = function
| Stdout -> sprint fmt "-"
| File s -> sprint fmt s
in
Arg.conv ~docv:"OUTPUT" (parse, print)
let output =
let docv = "OUTPUT" in
let doc =
Printf.sprintf
"Specify where to write the command output. $(docv) should be $(b,-) for \
stdout or a filename. Defaults to $(i,%s).corrected. Note that setting \
this option implies $(b,--force-output)."
file_docv
in
named
(fun x -> `Output x)
Arg.(
value & opt (some output_conv) None & info ~doc ~docv [ "o"; "output" ])
let setup_log style_renderer level =
Fmt_tty.setup_std_outputs ?style_renderer ();
Logs.set_level level;
Logs.set_reporter (Logs_fmt.reporter ());
()
let setup =
named
(fun x -> `Setup x)
Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
|
