Finish converting types/regexp.

src/core/harbor/harbor.ml

@@ -804,26 +804,18 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
     let handler, _ = find_handler port in
     let f (verb, rex, handler) =
       if (verb :> verb) = hmethod && Lang.Regexp.test ~rex base_uri then (
-        let subs = Lang.Regexp.exec ~rex base_uri in
-        let matches =
-          Array.(
-            to_list
-              (map
-                 (fun name ->
-                   (name, Lang.Regexp.get_named_substring rex name subs))
-                 (Lang.Regexp.names rex)))
-        in
+        let { Lang.Regexp.groups } = Lang.Regexp.exec ~rex base_uri in
         log#info "Found handler '%s %s' on port %d%s." smethod
           (Lang.descr_of_regexp rex) port
-          (match matches with
+          (match groups with
             | [] -> ""
-            | matches ->
+            | groups ->
                 Printf.sprintf " with matches: %s"
                   (String.concat ", "
                      (List.map
                         (fun (lbl, v) -> [%string "%{lbl}: %{v}"])
-                        matches)));
-        raise (Handled (verb, matches, handler)))
+                        groups)));
+        raise (Handled (verb, groups, handler)))
       else ()
     in
     try
@@ -839,16 +831,15 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct
         | s when is_admin s -> ans_400 "unrecognised command"
         | _ -> ans_404 ()
     with
-      | Handled (meth, matches, handler) ->
+      | Handled (meth, groups, handler) ->
           let protocol =
             match hprotocol with
               | `Http_10 -> "1.0"
               | `Http_11 -> "1.1"
               | _ -> assert false
           in
           let query =
-            matches
-            @ Hashtbl.fold (fun lbl k query -> (lbl, k) :: query) args []
+            groups @ Hashtbl.fold (fun lbl k query -> (lbl, k) :: query) args []
           in
           Duppy.Monad.Io.exec ~priority:`Maybe_blocking h
             (handler ~protocol ~meth ~data ~headers

src/core/hooks_implementations.ml

@@ -15,7 +15,11 @@ module Regexp = struct
   open Liquidsoap_lang.Regexp
 
   type t += Regexp of Pcre.regexp
-  type sub += Sub of Pcre.substrings
+
+  type sub = Lang.Regexp.sub = {
+    matches : string option list;
+    groups : (string * string) list;
+  }
 
   let cflags_of_flags (flags : flag list) =
     List.fold_left
@@ -37,17 +41,26 @@ module Regexp = struct
     Regexp (Pcre.regexp_or ~iflags l)
 
   let get_rex = Option.map (function Regexp r -> r | _ -> assert false)
-  let get_sub = function Sub s -> s | _ -> assert false
   let split ?pat ?rex s = Pcre.split ?pat ?rex:(get_rex rex) s
-  let exec ?pat ?rex s = Sub (Pcre.exec ?pat ?rex:(get_rex rex) s)
-  let names = function Regexp r -> Pcre.names r | _ -> assert false
-  let test ?pat ?rex s = Pcre.pmatch ?pat ?rex:(get_rex rex) s
-  let num_of_subs sub = Pcre.num_of_subs (get_sub sub)
-  let get_substring sub pos = Pcre.get_substring (get_sub sub) pos
 
-  let get_named_substring = function
-    | Regexp r -> fun name sub -> Pcre.get_named_substring r name (get_sub sub)
-    | _ -> assert false
+  let exec ?pat ?rex s =
+    let rex = get_rex rex in
+    let sub = Pcre.exec ?pat ?rex s in
+    let matches = Array.to_list (Pcre.get_opt_substrings sub) in
+    let groups =
+      match rex with
+        | None -> []
+        | Some rex ->
+            List.fold_left
+              (fun groups name ->
+                try (name, Pcre.get_named_substring rex name sub) :: groups
+                with _ -> groups)
+              []
+              (Array.to_list (Pcre.names rex))
+    in
+    { Lang.Regexp.matches; groups }
+
+  let test ?pat ?rex s = Pcre.pmatch ?pat ?rex:(get_rex rex) s
 
   let substitute ?pat ?rex ~subst s =
     Pcre.substitute ?pat ?rex:(get_rex rex) ~subst s

src/core/lang.mli

@@ -287,4 +287,11 @@ val descr_of_regexp : regexp -> string
 (** Return a string description of a regexp value i.e. r/^foo\/bla$/g *)
 val string_of_regexp : regexp -> string
 
-module Regexp : Liquidsoap_lang.Regexp.T with type t := regexp
+module Regexp : sig
+  include Liquidsoap_lang.Regexp.T with type t := regexp
+
+  type sub = Liquidsoap_lang.Regexp.sub = {
+    matches : string option list;
+    groups : (string * string) list;
+  }
+end

src/js/regexp_js.ml

@@ -2,10 +2,13 @@ open Js_of_ocaml
 open Liquidsoap_lang.Regexp
 
 type t += Regexp of Js.regExp Js.t
-type sub += Sub of Js.match_result Js.t
+
+type sub = Liquidsoap_lang.Regexp.sub = {
+  matches : string option list;
+  groups : (string * string) list;
+}
 
 let get_regexp = function Regexp r -> r | _ -> assert false
-let get_sub = function Sub s -> s | _ -> assert false
 let string_of_flag = function `i -> "i" | `g -> "g" | `s -> "s" | `m -> "m"
 
 let flags_of_flags flags =
@@ -28,24 +31,41 @@ let split ?pat ?rex s =
   let split = Js.str_array split in
   Array.to_list (Array.map Js.to_string (Js.to_array split))
 
+class type match_result =
+  object
+    inherit Js.match_result
+    method groups : Js.Unsafe.any Js.optdef Js.readonly_prop
+  end
+
 let exec ?pat ?rex s =
   let rex = pat_of_rex rex pat in
   let s = Js.string s in
   let ret =
     Js.Opt.case (rex##exec s) (fun () -> raise Not_found) (fun x -> x)
   in
-  Sub (Js.match_result ret)
+  let sub : match_result Js.t = Js.Unsafe.coerce (Js.match_result ret) in
+  let matches =
+    List.init sub##.length (fun pos ->
+        Option.map Js.to_string (Js.Optdef.to_option (Js.array_get sub pos)))
+  in
+  let groups =
+    Js.Optdef.case sub##.groups
+      (fun () -> [])
+      (fun groups ->
+        let names = Js.to_array (Js.object_keys groups) in
+        Array.fold_left
+          (fun cur key ->
+            Js.Optdef.case (Js.Unsafe.get groups key)
+              (fun () -> cur)
+              (fun value -> (Js.to_string key, Js.to_string value) :: cur))
+          [] names)
+  in
+  { matches; groups }
 
 let test ?pat ?rex s =
   let rex = pat_of_rex rex pat in
   Js.to_bool (rex##test (Js.string s))
 
-let num_of_subs sub = (get_sub sub)##.length
-
-let get_substring sub pos =
-  Js.to_string
-    (Option.get (Js.Optdef.to_option (Js.array_get (get_sub sub) pos)))
-
 let substitute ?pat ?rex ~subst s =
   let rex = pat_of_rex rex pat in
   let subst a = Js.string (subst (Js.to_string a)) in

src/lang/builtins_regexp.ml

@@ -99,42 +99,48 @@ let split_fun ~flags:_ rex =
       Lang_core.list (List.map Lang_core.string (Regexp.split ~rex string)))
 
 let exec_t =
+  let matches_t =
+    Lang_core.list_t (Lang_core.product_t Lang_core.int_t Lang_core.string_t)
+  in
   Lang_core.fun_t
     [(false, "", Lang_core.string_t)]
-    (Lang_core.list_t (Lang_core.product_t Lang_core.int_t Lang_core.string_t))
+    (Lang_core.method_t matches_t
+       [
+         ( "groups",
+           ( [],
+             Lang_core.list_t
+               (Lang_core.product_t Lang_core.string_t Lang_core.string_t) ),
+           "Named captures" );
+       ])
 
 let exec_fun ~flags:_ regexp =
   Lang_core.val_fun [("", "", None)] (fun p ->
       let string = Lang_core.to_string (List.assoc "" p) in
       try
-        let sub = Regexp.exec ~rex:regexp string in
-        let names = Regexp.names regexp in
-        let n = Regexp.num_of_subs sub in
-        let rec extract acc i =
-          if i < n then (
-            try
-              extract
-                ((string_of_int i, Regexp.get_substring sub i) :: acc)
-                (i + 1)
-            with Not_found -> extract acc (i + 1))
-          else List.rev acc
-        in
-        let l = extract [] 1 in
-        let rec extract_named acc = function
-          | [] -> acc
-          | name :: names -> (
-              try
-                extract_named
-                  ((name, Regexp.get_named_substring regexp name sub) :: acc)
-                  names
-              with Not_found -> extract_named acc names)
+        let { Regexp.matches; groups } = Regexp.exec ~rex:regexp string in
+        let matches =
+          Lang_core.list
+            (List.fold_left
+               (fun matches (pos, value) ->
+                 match value with
+                   | None -> matches
+                   | Some value ->
+                       Lang_core.product (Lang_core.int pos)
+                         (Lang_core.string value)
+                       :: matches)
+               []
+               (List.mapi (fun pos v -> (pos, v)) matches))
         in
-        let l = extract_named l (Array.to_list names) in
-        Lang_core.list
-          (List.map
-             (fun (x, y) ->
-               Lang_core.product (Lang_core.string x) (Lang_core.string y))
-             l)
+        Lang_core.meth matches
+          [
+            ( "groups",
+              Lang_core.list
+                (List.map
+                   (fun (name, value) ->
+                     Lang_core.product (Lang_core.string name)
+                       (Lang_core.string value))
+                   groups) );
+          ]
       with Not_found -> Lang_core.list [])
 
 let replace_t =

src/lang/lang.mli

@@ -208,4 +208,11 @@ val descr_of_regexp : regexp -> string
 (** Return a string description of a regexp value i.e. r/^foo\/bla$/g *)
 val string_of_regexp : regexp -> string
 
-module Regexp : Regexp.T with type t := regexp
+module Regexp : sig
+  include Regexp.T with type t := regexp
+
+  type sub = Regexp.sub = {
+    matches : string option list;
+    groups : (string * string) list;
+  }
+end

src/lang/lang_regexp.ml

@@ -7,6 +7,11 @@ let descr_of_regexp { Builtins_regexp.descr; _ } = descr
 let string_of_regexp = Builtins_regexp.string_of_regexp
 
 module Regexp = struct
+  type sub = Regexp.sub = {
+    matches : string option list;
+    groups : (string * string) list;
+  }
+
   let get_rex = Option.map (fun { Builtins_regexp.regexp } -> regexp)
 
   let regexp ?(flags = []) s =
@@ -22,13 +27,6 @@ module Regexp = struct
   let split ?pat ?rex = Regexp.split ?pat ?rex:(get_rex rex)
   let exec ?pat ?rex = Regexp.exec ?pat ?rex:(get_rex rex)
   let test ?pat ?rex = Regexp.test ?pat ?rex:(get_rex rex)
-  let names { Builtins_regexp.regexp } = Regexp.names regexp
-  let num_of_subs = Regexp.num_of_subs
-  let get_substring = Regexp.get_substring
-
-  let get_named_substring { Builtins_regexp.regexp } name sub =
-    Regexp.get_named_substring regexp name sub
-
   let substitute ?pat ?rex = Regexp.substitute ?pat ?rex:(get_rex rex)
 
   let substitute_first ?pat ?rex =

src/lang/lang_string.ml

@@ -327,8 +327,8 @@ module Version = struct
   let of_string s : t =
     let rex = Regexp.regexp "([\\.\\d]+)([^\\.]+)?" in
     let sub = Regexp.exec ~rex s in
-    let num = Regexp.get_substring sub 1 in
-    let str = try Regexp.get_substring sub 2 with Not_found -> "" in
+    let num = Option.get (List.nth sub.Regexp.matches 1) in
+    let str = Option.value ~default:"" (List.nth sub.Regexp.matches 2) in
     let num = String.split_on_char '.' num |> List.map int_of_string in
     (num, str)
 

src/lang/lexer.ml

@@ -50,9 +50,9 @@ end
 
 let parse_time t =
   let g sub n =
-    let s = Regexp.get_substring sub n in
-    if s = "" then None
-    else Some (int_of_string (String.sub s 0 (String.length s - 1)))
+    Option.map
+      (fun s -> int_of_string (String.sub s 0 (String.length s - 1)))
+      (List.nth sub.Regexp.matches n)
   in
   try
     let pat = "^((?:\\d+w)?)((?:\\d+h)?)((?:\\d+m)?)((?:\\d+s)?)$" in
@@ -63,7 +63,12 @@ let parse_time t =
     let pat = "^((?:\\d+w)?)(\\d+h)(\\d+)$" in
     let sub = Regexp.exec ~pat t in
     let g = g sub in
-    [g 1; g 2; Some (int_of_string (Regexp.get_substring sub 3)); None]
+    [
+      g 1;
+      g 2;
+      Some (int_of_string (Option.get (List.nth sub.Regexp.matches 3)));
+      None;
+    ]
 
 let skipped = [%sedlex.regexp? Sub (white_space, '\n') | '\r' | '\t']
 let decimal_digit = [%sedlex.regexp? '0' .. '9']

src/lang/preprocessor.ml

@@ -250,8 +250,8 @@ let parse_comments tokenizer =
                 ~pat:"^\\s*@(category|docof|flag|param|method|argsof)\\s*(.*)$"
                 line
             in
-            let s = Regexp.get_substring sub 2 in
-            match Regexp.get_substring sub 1 with
+            let s = Option.get (List.nth sub.Regexp.matches 2) in
+            match Option.get (List.nth sub.Regexp.matches 1) with
               | "docof" ->
                   let doc = Environment.builtins#get_subsection s in
                   let main_doc = doc#get_doc in
@@ -280,13 +280,13 @@ let parse_comments tokenizer =
                       let sub =
                         Regexp.exec ~pat:"^\\s*([^\\[]+)\\[([^\\]]+)\\]\\s*$" s
                       in
-                      let s = Regexp.get_substring sub 1 in
+                      let s = Option.get (List.nth sub.Regexp.matches 1) in
                       let args =
                         List.filter
                           (fun s -> s <> "")
                           (List.map String.trim
                              (String.split_on_char ','
-                                (Regexp.get_substring sub 2)))
+                                (Option.get (List.nth sub.Regexp.matches 2))))
                       in
                       let only, except =
                         List.fold_left
@@ -322,8 +322,8 @@ let parse_comments tokenizer =
                   parse_doc (main, `Flag s :: special, params, methods) lines
               | "param" ->
                   let sub = Regexp.exec ~pat:"^(~?[a-zA-Z0-9_.]+)\\s*(.*)$" s in
-                  let label = Regexp.get_substring sub 1 in
-                  let descr = Regexp.get_substring sub 2 in
+                  let label = Option.get (List.nth sub.Regexp.matches 1) in
+                  let descr = Option.get (List.nth sub.Regexp.matches 2) in
                   let label =
                     if label.[0] = '~' then
                       String.sub label 1 (String.length label - 1)
@@ -352,8 +352,8 @@ let parse_comments tokenizer =
                     lines
               | "method" ->
                   let sub = Regexp.exec ~pat:"^(~?[a-zA-Z0-9_.]+)\\s*(.*)$" s in
-                  let label = Regexp.get_substring sub 1 in
-                  let descr = Regexp.get_substring sub 2 in
+                  let label = Option.get (List.nth sub.Regexp.matches 1) in
+                  let descr = Option.get (List.nth sub.Regexp.matches 2) in
                   parse_doc
                     (main, special, params, (label, descr) :: methods)
                     lines