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
open! Import
module Markup = struct
type t =
[ `P of string
| `Pre of string
]
let to_troff_string = function
| `P paragraph -> paragraph
| `Pre pre -> sprintf ".nf\n%s\n.fi" pre
;;
let troff_block heading ts =
sprintf ".SH %s" heading :: List.map ts ~f:to_troff_string
|> String.concat ~sep:"\n\n"
;;
end
module Prose = struct
type t =
{ description : Markup.t list option
; environment : Markup.t list option
; files : Markup.t list option
; examples : Markup.t list option
; authors : Markup.t list option
; extra : (string * Markup.t list) list
}
let empty =
{ description = None
; environment = None
; files = None
; examples = None
; authors = None
; extra = []
}
;;
let create ?description ?environment ?files ?examples ?authors ?( = []) () =
{ description; environment; files; examples; authors; extra }
;;
end
type t =
{ prose : Prose.t
; spec : Command_doc_spec.t
; version : string option
}
let ~(spec : Command_doc_spec.t) ~version =
let command_name = String.concat ~sep:"-" (spec.program_name :: spec.subcommand) in
sprintf
{|
.TH "%s" 1 "" "%s" "%s Manual"
|}
(String.uppercase_ascii command_name)
(sprintf
"%s %s"
(String.capitalize_ascii spec.program_name)
(Option.value version ~default:""))
(String.capitalize_ascii spec.program_name)
;;
let name ~(spec : Command_doc_spec.t) =
let command_name = String.concat ~sep:"-" (spec.program_name :: spec.subcommand) in
sprintf
{|
.SH NAME
%s%s
|}
command_name
(Option.map spec.doc ~f:(sprintf " - %s") |> Option.value ~default:"")
;;
let commands (subcommands : Command_doc_spec.Subcommands.t) =
".SH COMMANDS\n"
:: List.concat_map
subcommands
~f:(fun { Command_doc_spec.Subcommand.name; aliases; doc; args } ->
Command_doc_spec.Args.pp_usage_args
~format_positional_args:(fun name -> sprintf "\\fI%s\\fR" name)
Format.str_formatter
args;
let usage_args = Format.flush_str_formatter () in
let aliases =
match aliases with
| [] -> None
| aliases ->
Some
(sprintf
"\nAliases: %s"
(List.map ~f:Name.to_string aliases |> String.concat ~sep:", "))
in
[ Some (sprintf ".TP\n\\fB%s\\fR%s" (Name.to_string name) usage_args)
; doc
; aliases
]
|> List.filter_opt)
|> String.concat ~sep:"\n"
;;
let named_arg_string (arg : Command_doc_spec.Named_arg.t) =
let names =
List.map (Nonempty_list.to_list arg.names) ~f:(fun name ->
let string_name = Name.to_string_with_dashes name in
match arg.value with
| Some value ->
let sep = if Name.is_short name then " " else "=" in
sprintf "%s%s%s" string_name sep value.name
| None -> string_name)
|> String.concat ~sep:", "
in
match arg.default_string with
| Some default_string -> sprintf "%s (default=%s)" names default_string
| None -> names
;;
let options (args : Command_doc_spec.Named_args.t) =
".SH OPTIONS\n"
:: List.concat_map args ~f:(fun args ->
[ Some (sprintf ".TP\n%s" (named_arg_string args))
; Option.map args.doc ~f:(fun doc -> sprintf "%s" doc)
]
|> List.filter_opt)
|> String.concat ~sep:"\n"
;;
let to_troff_string { prose; spec; version } =
let parts =
([ Some (header ~spec ~version)
; Some (name ~spec)
; Option.map prose.description ~f:(Markup.troff_block "DESCRIPTION")
; (match spec.subcommands with
| [] -> None
| subcommands -> Some (commands subcommands))
; (match spec.args.named with
| [] -> None
| subcommands -> Some (options subcommands))
; Option.map prose.environment ~f:(Markup.troff_block "ENVIRONMENT")
; Option.map prose.files ~f:(Markup.troff_block "FILES")
; Option.map prose.examples ~f:(Markup.troff_block "EXAMPLES")
; Option.map prose.authors ~f:(Markup.troff_block "AUTHORS")
]
|> List.filter_opt)
@ List.map prose.extra ~f:(fun (heading, markup) -> Markup.troff_block heading markup)
in
String.concat ~sep:"\n" parts
;;