Multiple-lined documents are automatically aligned (#27)

Author: invrtd-h

CHANGES.md

@@ -1,5 +1,11 @@
 # Changelog
 
+## Unreleased
+
+### Added
+
+- Multiple-lined documents are automatically aligned (#27)
+
 ## 0.8.7
 
 ### Changed

examples/echo_ansi.ml

@@ -66,6 +66,7 @@ let () =
     ; arg_name = { ansi_style_plain with color = Some `Blue }
     ; arg_doc = { ansi_style_plain with color = Some `Cyan }
     ; error = { ansi_style_plain with color = Some `Red }
+    ; margin = None
     }
   in
   match

src/ansi_style.ml

@@ -68,7 +68,7 @@ let escape { bold; dim; underline; color } =
 ;;
 
 let pp_with_style t ppf ~f =
-  if not (is_default t) then Format.pp_print_string ppf (escape t);
+  if not (is_default t) then Format.pp_print_as ppf 0 (escape t);
   f ppf;
-  if not (is_default t) then Format.pp_print_string ppf reset
+  if not (is_default t) then Format.pp_print_as ppf 0 reset
 ;;

src/help.ml

@@ -9,6 +9,7 @@ module Style = struct
     ; arg_doc : Ansi_style.t
     ; section_heading : Ansi_style.t
     ; error : Ansi_style.t
+    ; margin : int option
     }
 
   let plain =
@@ -18,6 +19,7 @@ module Style = struct
     ; arg_doc = Ansi_style.default
     ; section_heading = Ansi_style.default
     ; error = Ansi_style.default
+    ; margin = None
     }
   ;;
 
@@ -49,6 +51,11 @@ let rec pp_print_spaces ppf = function
     pp_print_spaces ppf (n - 1)
 ;;
 
+let pp_print_string_as_seq ppf s =
+  let s = String.split_on_char ~sep:' ' s in
+  Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string ppf s
+;;
+
 module Print = struct
   module Names = struct
     (* An entry possibly has several names in the case of command aliases or
@@ -128,6 +135,7 @@ module Print = struct
       ~doc_left_padding
       t
       =
+      Format.pp_open_box ppf (doc_left_padding + 4);
       pp_print_spaces ppf indent;
       let names_value_string =
         names_value_padded_to_string ~at_least_one_left_name ~right_names_left_padding t
@@ -139,7 +147,7 @@ module Print = struct
         let padding = doc_left_padding - String.length names_value_string in
         pp_print_spaces ppf padding;
         Ansi_style.pp_with_style style.arg_doc ppf ~f:(fun ppf ->
-          Format.pp_print_string ppf doc));
+          pp_print_string_as_seq ppf doc));
       Format.pp_print_newline ppf ()
     ;;
   end
@@ -184,6 +192,7 @@ module Print = struct
         let doc_left_padding =
           max_name_length ~at_least_one_left_name ~right_names_left_padding t
         in
+        Format.pp_open_box ppf (doc_left_padding + 4);
         List.iter t.entries ~f:(fun entry ->
           Entry.pp_padded
             style
@@ -299,6 +308,8 @@ let pp_usage (style : Style.t) ppf (spec : Command_doc_spec.t) =
 ;;
 
 let pp (style : Style.t) ppf (spec : Command_doc_spec.t) =
+  let margin = Option.value ~default:1_000_000 style.margin in
+  Format.pp_set_margin Format.std_formatter margin;
   Option.iter spec.doc ~f:(fun spec ->
     Ansi_style.pp_with_style style.program_doc ppf ~f:(fun ppf ->
       Format.pp_print_string ppf spec);

src/help.mli

@@ -8,6 +8,7 @@ module Style : sig
     ; arg_doc : Ansi_style.t
     ; section_heading : Ansi_style.t
     ; error : Ansi_style.t
+    ; margin : int option
     }
 
   (** An opinionated default value with some colours and formatting *)

src/lib.ml

@@ -858,6 +858,7 @@ module For_test = struct
   ;;
 
   let print_help_spec spec = Help.pp Help_style.plain Format.std_formatter spec
+  let print_help_spec_with_style style spec = Help.pp style Format.std_formatter spec
 
   let print_manpage spec prose =
     let manpage = { Manpage.spec; prose; version = None } in

src/lib.mli

@@ -36,6 +36,7 @@ module Help_style : sig
     ; arg_doc : ansi_style
     ; section_heading : ansi_style
     ; error : ansi_style
+    ; margin : int option
     }
 
   (** An opinionated default value with some colours and formatting *)
@@ -213,5 +214,6 @@ module For_test : sig
     -> ('a, Non_ret.t) result
 
   val print_help_spec : Command_doc_spec.t -> unit
+  val print_help_spec_with_style : Help_style.t -> Command_doc_spec.t -> unit
   val print_manpage : Command_doc_spec.t -> Manpage.prose -> unit
 end

tests/usage_tests/help_messages.ml

@@ -1,11 +1,11 @@
 open Climate
 open Command
 
-let run command args =
+let run ?(style = Help_style.plain) command args =
   match For_test.eval_result ~program_name:"foo.exe" command args with
   | Ok () -> ()
   | Error (For_test.Non_ret.Help { command_doc_spec; _ }) ->
-    For_test.print_help_spec command_doc_spec
+    For_test.print_help_spec_with_style style command_doc_spec
   | Error (For_test.Non_ret.Manpage { prose; command_doc_spec }) ->
     For_test.print_manpage command_doc_spec prose
   | _ -> failwith "unexpected parser output"
@@ -470,3 +470,139 @@ let%expect_test "positional arguments" =
       -h, --help  Show this help message.
     |}]
 ;;
+
+let lorem_ipsum =
+  "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor \
+   incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud \
+   exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure \
+   dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla"
+;;
+
+let lorem_reversed =
+  lorem_ipsum |> String.to_seq |> List.of_seq |> List.rev |> List.to_seq |> String.of_seq
+;;
+
+let%expect_test "a long arg document" =
+  run
+    (singleton
+     @@
+     let open Arg_parser in
+     let+ _ = flag [ "lorem" ] ~doc:(String.sub lorem_ipsum 0 100)
+     and+ _ = flag [ "ipsum" ] ~doc:(String.sub lorem_reversed 0 100) in
+     ())
+    [ "--help" ];
+  [%expect
+    {|
+    Usage: foo.exe [OPTION]…
+
+    Options:
+          --lorem  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore
+          --ipsum  allun taiguf ue erolod mullic esse tilev etatpulov ni tiredneherper ni rolod eruri etua siuD .tauqes
+      -h, --help   Show this help message.
+    |}]
+;;
+
+let%expect_test "a long arg document with margin" =
+  let cmd =
+    singleton
+    @@
+    let open Arg_parser in
+    let+ _ = flag [ "lorem" ] ~doc:lorem_ipsum
+    and+ _ = flag [ "ipsum" ] ~doc:lorem_reversed in
+    ()
+  in
+  run ~style:{ Help_style.plain with margin = Some 80 } cmd [ "--help" ];
+  [%expect
+    {|
+    Usage: foo.exe [OPTION]…
+
+    Options:
+          --lorem  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do
+                   eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut
+                   enim ad minim veniam, quis nostrud exercitation ullamco laboris
+                   nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor
+                   in reprehenderit in voluptate velit esse cillum dolore eu fugiat
+                   nulla
+          --ipsum  allun taiguf ue erolod mullic esse tilev etatpulov ni
+                   tiredneherper ni rolod eruri etua siuD .tauqesnoc odommoc ae xe
+                   piuqila tu isin sirobal ocmallu noitaticrexe durtson siuq
+                   ,mainev minim da mine tU .auqila angam erolod te erobal tu
+                   tnudidicni ropmet domsuie od des ,tile gnicsipida rutetcesnoc
+                   ,tema tis rolod muspi meroL
+      -h, --help   Show this help message.
+    |}];
+  (* adding ansi escape sequences does not harm the shape *)
+  run
+    ~style:
+      { Help_style.plain with
+        margin = Some 80
+      ; arg_doc = { color = Some `Yellow; bold = true; dim = true; underline = true }
+      }
+    cmd
+    [ "--help" ];
+  [%expect
+    {|
+    Usage: foo.exe [OPTION]…
+
+    Options:
+          --lorem  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do
+                   eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut
+                   enim ad minim veniam, quis nostrud exercitation ullamco laboris
+                   nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor
+                   in reprehenderit in voluptate velit esse cillum dolore eu fugiat
+                   nulla
+          --ipsum  allun taiguf ue erolod mullic esse tilev etatpulov ni
+                   tiredneherper ni rolod eruri etua siuD .tauqesnoc odommoc ae xe
+                   piuqila tu isin sirobal ocmallu noitaticrexe durtson siuq
+                   ,mainev minim da mine tU .auqila angam erolod te erobal tu
+                   tnudidicni ropmet domsuie od des ,tile gnicsipida rutetcesnoc
+                   ,tema tis rolod muspi meroL
+      -h, --help   Show this help message.
+    |}]
+;;
+
+let%expect_test "a long command document" =
+  let lorem = unit_command ~doc:(String.sub lorem_ipsum 0 100) () in
+  let ipsum = unit_command ~doc:(String.sub lorem_reversed 0 100) () in
+  let cmd = group [ subcommand "lorem" lorem; subcommand "ipsum" ipsum ] in
+  run cmd [ "--help" ];
+  [%expect
+    {|
+    Usage: foo.exe [COMMAND]
+           foo.exe [OPTION]…
+
+    Options:
+      -h, --help  Show this help message.
+
+    Commands:
+      lorem  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore
+      ipsum  allun taiguf ue erolod mullic esse tilev etatpulov ni tiredneherper ni rolod eruri etua siuD .tauqes
+    |}]
+;;
+
+let%expect_test "a long command document with margin" =
+  let lorem = unit_command ~doc:lorem_ipsum () in
+  let ipsum = unit_command ~doc:lorem_reversed () in
+  let cmd = group [ subcommand "lorem" lorem; subcommand "ipsum" ipsum ] in
+  run ~style:{ Help_style.plain with margin = Some 80 } cmd [ "--help" ];
+  [%expect
+    {|
+    Usage: foo.exe [COMMAND]
+           foo.exe [OPTION]…
+
+    Options:
+      -h, --help  Show this help message.
+
+    Commands:
+      lorem  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do
+             eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad
+             minim veniam, quis nostrud exercitation ullamco laboris nisi ut
+             aliquip ex ea commodo consequat. Duis aute irure dolor in
+             reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla
+      ipsum  allun taiguf ue erolod mullic esse tilev etatpulov ni tiredneherper ni
+             rolod eruri etua siuD .tauqesnoc odommoc ae xe piuqila tu isin sirobal
+             ocmallu noitaticrexe durtson siuq ,mainev minim da mine tU .auqila
+             angam erolod te erobal tu tnudidicni ropmet domsuie od des ,tile
+             gnicsipida rutetcesnoc ,tema tis rolod muspi meroL
+    |}]
+;;