balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cli_entries: export formatter setup functions

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-12 15:57:49 +01:00
parent a830c29185
commit 2c2f0a1818
2 changed files with 249 additions and 196 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/lib_base/cli_entries.ml
View File

@ -731,14 +731,22 @@ let group_commands commands =
ref l ]))
let print_group print_command ppf ({ title ; _ }, commands) =
Format.fprintf ppf "@{<title>%s@}@,@{<section>%a@}"
Format.fprintf ppf "@{<title>%s@}@,@{<list>%a@}"
title
(Format.pp_print_list print_command) commands
let setup_ppf ppf format verbosity =
type formatter_state =
Format.formatter_out_functions *
Format.formatter_tag_functions *
bool
let setup_formatter ppf ~format ~verbosity =
let skip = ref false in
let orig_out_functions =
Format.pp_get_formatter_out_functions ppf () in
let orig_out_functions, _, _ as orig_state =
Format.pp_get_formatter_out_functions ppf (),
Format.pp_get_formatter_tag_functions ppf (),
Format.pp_get_print_tags ppf () in
begin
Format.pp_set_formatter_out_functions ppf
{ out_string =
(fun s b a ->
@ -796,7 +804,7 @@ let setup_ppf ppf format verbosity =
| "arg" -> Format.fprintf ppf "@<0>%a<" ansi_format (`Yellow, `Black, false, false)
| "kwd" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, false, true)
| "hilight" -> Format.fprintf ppf "@<0>%a" ansi_format (`Black, `Yellow, false, true)
| "section" -> Format.fprintf ppf " @[<v 0>"
| "list" -> Format.fprintf ppf " @[<v 0>"
| "command" -> Format.fprintf ppf "@[<v 0>"
| "full" -> push_level `Full
| "args" -> push_level `Args
@ -813,7 +821,7 @@ let setup_ppf ppf format verbosity =
| "arg" -> Format.fprintf ppf ">@<0>%s" "\027[0m"
| "kwd" -> Format.fprintf ppf "@<0>%s" "\027[0m"
| "hilight" -> Format.fprintf ppf "@<0>%s" "\027[0m"
| "command" | "section" -> Format.fprintf ppf "@]"
| "command" | "list" -> Format.fprintf ppf "@]"
| "full" -> pop_level `Full
| "args" -> pop_level `Args
| "short" -> pop_level `Short
@ -834,7 +842,7 @@ let setup_ppf ppf format verbosity =
| "arg" -> Format.fprintf ppf "<"
| "kwd" -> ()
| "hilight" -> ()
| "section" -> Format.fprintf ppf " @[<v 0>"
| "list" -> Format.fprintf ppf " @[<v 0>"
| "command" -> Format.fprintf ppf "@[<v 0>"
| "full" -> push_level `Full
| "args" -> push_level `Args
@ -851,7 +859,7 @@ let setup_ppf ppf format verbosity =
| "arg" -> Format.fprintf ppf ">"
| "kwd" -> ()
| "hilight" -> ()
| "command" | "section" -> Format.fprintf ppf "@]"
| "command" | "list" -> Format.fprintf ppf "@]"
| "full" -> pop_level `Full
| "args" -> pop_level `Args
| "short" -> pop_level `Short
@ -872,7 +880,7 @@ let setup_ppf ppf format verbosity =
| "arg" -> Format.fprintf ppf "\003span class='arg'\004"
| "kwd" -> Format.fprintf ppf "\003span class='kwd'\004"
| "hilight" -> ()
| "section" -> Format.fprintf ppf "\003ul\004@\n"
| "list" -> Format.fprintf ppf "\003ul\004@\n"
| "command" -> Format.fprintf ppf "\003li\004@\n"
| "full" -> push_level `Full
| "args" -> push_level `Args
@ -898,7 +906,7 @@ let setup_ppf ppf format verbosity =
| "arg" -> Format.fprintf ppf "\003/span\004"
| "kwd" -> Format.fprintf ppf "\003/span\004"
| "hilight" -> ()
| "section" -> Format.fprintf ppf "\003/ul\004@\n"
| "list" -> Format.fprintf ppf "\003/ul\004@\n"
| "command" -> Format.fprintf ppf "\003/li\004@\n"
| "full" -> pop_level `Full
| "args" -> pop_level `Args
@ -923,9 +931,17 @@ let setup_ppf ppf format verbosity =
let s' = Buffer.contents buf in
orig_out_functions.out_string s' 0 (String.length s'))} ;
Format.pp_set_print_tags ppf true
end ;
orig_state
let restore_formatter ppf (out_functions, tag_functions, tags) =
Format.pp_set_formatter_out_functions ppf out_functions ;
Format.pp_set_formatter_tag_functions ppf tag_functions ;
Format.pp_set_print_tags ppf tags
let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
setup_ppf ppf format verbosity ;
ignore (setup_formatter ppf ~format ~verbosity) ;
let usage ppf (by_group, options) =
let exe = Filename.basename Sys.executable_name in
let print_groups =
@ -940,7 +956,7 @@ let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
| Some (Argument { spec ; _ })->
Format.fprintf ppf
"@[<v>@{<title>Usage@}@,\
@{<section>\
@{<list>\
@{<command>@{<commandline>\
%s [@{<opt>global options@}] command @{<opt>[command options]@}@}@}@,\
@{<command>@{<commandline>\
@ -949,7 +965,7 @@ let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
%s [@{<opt>global options@}] command @{<opt>-help@} (for command options)@}@}\
@}@,@,\
@{<title>To browse the documentation@}@,\
@{<section>\
@{<list>\
@{<command>@{<commandline>\
%s [@{<opt>global options@}] man (for a list of commands)@}@}@,\
@{<command>@{<commandline>\
@ -968,7 +984,7 @@ let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
Format.fprintf ppf "@}"
let command_usage ppf commands format verbosity =
setup_ppf ppf format verbosity ;
ignore (setup_formatter ppf ~format ~verbosity) ;
let exe = Filename.basename Sys.executable_name in
let prefix ppf () =
Format.fprintf ppf "@{<kwd>%s@} @{<opt>[global options]@} " exe in
@ -1147,13 +1163,13 @@ let handle_cli_errors ~stdout ~stderr ~global_options = function
| Error [ e ] -> (* Should only be one error here *)
begin match e with
| Extra_arguments (_, cmd) ->
setup_ppf stderr (if Unix.isatty Unix.stderr then `Ansi else `Plain) `Terse ;
ignore (setup_formatter stderr ~format:(if Unix.isatty Unix.stderr then `Ansi else `Plain) ~verbosity:`Terse) ;
Format.fprintf stderr
"Extra arguments provided for command:@;<1 2>@[%a@]@."
(print_command ?prefix:None ~highlights:[]) cmd;
return 1
| Not_enough_args (_, cmds) ->
setup_ppf stderr (if Unix.isatty Unix.stderr then `Ansi else `Plain) `Terse ;
ignore (setup_formatter stderr ~format:(if Unix.isatty Unix.stderr then `Ansi else `Plain) ~verbosity:`Terse) ;
Format.fprintf stderr
"@[<v 2>Unterminated command, here are possible completions:@,%a@]@."
(Format.pp_print_list

41
src/lib_base/cli_entries.mli
View File

@ -252,7 +252,7 @@ val dispatch:
(** Parse the global options, and return their value, with the rest of
the command to be parsed. *)
val parse_global_options :
val parse_initial_options :
('a, 'ctx) options ->
'ctx ->
string list ->
@ -262,4 +262,41 @@ val map_command: ('a -> 'b) -> ('b, 'c) command -> ('a, 'c) command
(** {2 Output formatting} *)
val setup_ppf : Format.formatter -> [< `Plain ] -> [< `LOL ] -> unit
(** Used to restore the formatter state after [setup_formatter]. *)
type formatter_state
(** Updates the formatter's functions to interprete some semantic tags
used in manual production. Returns the previous state of the
formatter to restore it afterwards if needed.
Toplevel structure tags:
* [<document>]: a toplevel group
* [<title>]: a section title (just below a [<document])
* [<list>]: a list section (just below a [<document])
Structure tags used internally for generating the manual:
* [<command>]: wraps the full documentation bloc for a command
* [<commandline>]: wraps the command line in a [<command>]
* [<commanddoc>]: wraps everything but the command line in a [<command>]
Cosmetic tags for hilighting text:
* [<opt>]: optional arguments * [<arg>]: positional arguments
* [<kwd>]: positional keywords * [<hilight>]: search results
Verbosity levels, in order, and how they are used in the manual:
* [<terse>]: always displayed (titles commands lines)
* [<args>]: displayed if [verbosity >= `Args] (lists of arguments)
* [<short>]: displayed if [verbosity >= `Short] (single line descriptions)
* [<full>]: only displayed if [verbosity = `Full] (long descriptions) *)
val setup_formatter :
Format.formatter ->
format: [< `Ansi | `Html | `Plain ] ->
verbosity: [> `Terse | `Short | `Args | `Full ] ->
formatter_state
(** Restore the formatter state after [setup_formatter]. *)
val restore_formatter : Format.formatter -> formatter_state -> unit