package climate

  1. Overview
  2. Docs

Source file manpage.ml

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 ?(extra = []) () =
    { description; environment; files; examples; authors; extra }
  ;;
end

type t =
  { prose : Prose.t
  ; spec : Command_doc_spec.t
  ; version : string option
  }

let header ~(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
;;