Allow passing configuration options to the bench command

bot-components/utils/String_utils.ml

@@ -48,6 +48,113 @@ let first_line_of_string s =
 let remove_between s i j =
   String.sub ~pos:0 ~len:i s ^ String.sub s ~pos:j ~len:(String.length s - j)
 
+type quote = Single | Double
+
+let split_shell_words ~preserve_syntax input =
+  let is_whitespace = function
+    | ' ' | '\t' | '\n' | '\r' | '\011' | '\012' ->
+        true
+    | _ ->
+        false
+  in
+  let buffer = Buffer.create (String.length input) in
+  let add_syntax char = if preserve_syntax then Buffer.add_char buffer char in
+  let finish_token token_started tokens =
+    if token_started then Buffer.contents buffer :: tokens else tokens
+  in
+  let length = String.length input in
+  let rec split index quote token_started tokens =
+    if index = length then
+      match quote with
+      | Some delimiter ->
+          Error
+            (Printf.sprintf "unterminated %c quote"
+               (match delimiter with Single -> '\'' | Double -> '"') )
+      | None ->
+          Ok (List.rev (finish_token token_started tokens))
+    else
+      let char = input.[index] in
+      match quote with
+      | None when is_whitespace char ->
+          let tokens = finish_token token_started tokens in
+          Buffer.clear buffer ;
+          split (index + 1) None false tokens
+      | None when Char.equal char '\\' ->
+          if index + 1 = length then Error "trailing escape character"
+          else
+            let escaped = input.[index + 1] in
+            if Char.equal escaped '\n' then
+              split (index + 2) None token_started tokens
+            else (
+              add_syntax char ;
+              Buffer.add_char buffer escaped ;
+              split (index + 2) None true tokens )
+      | None when Char.equal char '\'' ->
+          add_syntax char ;
+          split (index + 1) (Some Single) true tokens
+      | None when Char.equal char '"' ->
+          add_syntax char ;
+          split (index + 1) (Some Double) true tokens
+      | None ->
+          Buffer.add_char buffer char ;
+          split (index + 1) None true tokens
+      | Some Single when Char.equal char '\'' ->
+          add_syntax char ;
+          split (index + 1) None true tokens
+      | Some Single ->
+          Buffer.add_char buffer char ;
+          split (index + 1) quote true tokens
+      | Some Double when Char.equal char '"' ->
+          add_syntax char ;
+          split (index + 1) None true tokens
+      | Some Double when Char.equal char '\\' ->
+          if index + 1 = length then Error "unterminated \" quote"
+          else
+            let escaped = input.[index + 1] in
+            if Char.equal escaped '\n' then split (index + 2) quote true tokens
+            else if List.mem ['"'; '\\'; '$'; '`'] escaped ~equal:Char.equal
+            then (
+              add_syntax char ;
+              Buffer.add_char buffer escaped ;
+              split (index + 2) quote true tokens )
+            else (
+              Buffer.add_char buffer char ;
+              split (index + 1) quote true tokens )
+      | Some Double ->
+          Buffer.add_char buffer char ;
+          split (index + 1) quote true tokens
+  in
+  split 0 None false []
+
+let split_on_unquoted_whitespace input =
+  split_shell_words ~preserve_syntax:true input
+
+let parse_key_value_arguments input =
+  match split_shell_words ~preserve_syntax:false input with
+  | Error _ as error ->
+      error
+  | Ok arguments ->
+      let rec parse parsed = function
+        | [] ->
+            Ok (List.rev parsed)
+        | argument :: arguments -> (
+          match Stdlib.String.index_opt argument '=' with
+          | None when String.is_empty argument ->
+              Error (Printf.sprintf "argument %S has an empty key" argument)
+          | None ->
+              parse ((argument, None) :: parsed) arguments
+          | Some 0 ->
+              Error (Printf.sprintf "argument %S has an empty key" argument)
+          | Some separator ->
+              let key = String.sub argument ~pos:0 ~len:separator in
+              let value =
+                String.sub argument ~pos:(separator + 1)
+                  ~len:(String.length argument - separator - 1)
+              in
+              parse ((key, Some value) :: parsed) arguments )
+      in
+      parse [] arguments
+
 (******************************************************************************)
 (* Formatting Functions                                                       *)
 (******************************************************************************)

bot-components/utils/String_utils.mli

@@ -23,6 +23,22 @@ val first_line_of_string : string -> string
 
 val remove_between : string -> int -> int -> string
 
+val split_on_unquoted_whitespace : string -> (string list, string) Result.t
+(** [split_on_unquoted_whitespace input] splits [input] at ASCII whitespace
+    outside single or double quotes. Shell quote and escape syntax is recognized
+    and preserved in the returned tokens.
+
+    Returns an error for an unterminated quote or a trailing backslash. *)
+
+val parse_key_value_arguments :
+  string -> ((string * string option) list, string) Result.t
+(** [parse_key_value_arguments input] parses shell-style [key=value] words.
+    Quote and escape syntax is consumed. A missing equal sign produces a [None]
+    value; an equal sign produces [Some value], including [Some ""] for an
+    explicitly empty value. Values may contain additional equal signs.
+
+    Returns an error if quoting is malformed or an argument has an empty key. *)
+
 (* ========================================================================== *)
 (* Formatting Functions *)
 (* ========================================================================== *)

src/utils/bench.ml

@@ -7,6 +7,26 @@ open HTTP_utils
 open String_utils
 open Lwt.Infix
 
+type args = (string * string option) list
+
+let parse ~github_bot_name body =
+  if
+    string_match
+      ~regexp:
+        ( f "@%s:? [Bb]ench\\( *$\\| +\\(.*\\(\n.+\\)*\\)\\(\n\n\\|$\\)\\)"
+        @@ Str.quote github_bot_name )
+      body
+  then
+    match Str.matched_group 2 body with
+    | exception _ ->
+        Some (Result.Ok [])
+    | args ->
+        Some
+          (Result.map_error (parse_key_value_arguments args) ~f:(fun error ->
+               f "bench command could not parse key-value arguments: %s" error )
+          )
+  else None
+
 let parse_quantity table table_name =
   let regexp = {|.*TOP \([0-9]*\)|} in
   if string_match ~regexp table then

src/utils/bench.mli

@@ -1,5 +1,9 @@
 open Base
 
+type args = (string * string option) list
+
+val parse : github_bot_name:string -> string -> (args, string) Result.t option
+
 module BenchResults : sig
   type t =
     { summary_table: string