Expose UTF-16/WTF-8 conversion functions

src/c/helpers.c

@@ -645,6 +645,22 @@ int luv_os_uname(char *buffer)
 
 
 
+// String conversion functions.
+
+size_t luv_utf16_length_as_wtf8(const char *utf16, ssize_t utf16_len)
+{
+    return uv_utf16_length_as_wtf8((const uint16_t*)utf16, utf16_len);
+}
+
+int luv_utf16_to_wtf8(
+    const char *utf16, ssize_t utf16_len, char **wtf8_ptr,
+    size_t *wtf8_len_ptr)
+{
+    uv_utf16_to_wtf8((const uint16_t*)utf16, utf16_len, wtf8_ptr, wtf8_len_ptr);
+}
+
+
+
 // Other helpers.
 
 char* luv_version_suffix()

src/c/helpers.h

@@ -188,6 +188,20 @@ int luv_os_uname(char *buffer);
 
 
 
+// String conversion functions. These are wrapped because it is convenient to
+// use Ctypes to pass OCaml strings directly to C code, but the Ctypes type
+// combinator for that purpose only compiles against C arguments of types such
+// as char*, and not uint16_t*. So these helpers add the necessary casts to
+// satisfy Ctypes.
+
+size_t luv_utf16_length_as_wtf8(const char *utf16, ssize_t utf16_len);
+
+int luv_utf16_to_wtf8(
+    const char *utf16, ssize_t utf16_len, char **wtf8_ptr,
+    size_t *wtf8_len_ptr);
+
+
+
 // Miscellaneous helpers - other things that are easiest to do in C.
 
 // Ctypes.constant can't bind a char*, so we return it instead.

src/c/luv_c_function_descriptions.ml

@@ -1913,4 +1913,31 @@ struct
       foreign "uv_metrics_info"
         (ptr Types.Loop.t @-> ptr Types.Metrics.t @-> returning int)
   end
+
+  module String_ =
+  struct
+    let utf16_length_as_wtf8 =
+      foreign "luv_utf16_length_as_wtf8"
+        (string @-> PosixTypes.ssize_t @-> returning size_t)
+
+    let utf16_to_wtf8 =
+      foreign "luv_utf16_to_wtf8"
+        (string @->
+         PosixTypes.ssize_t @->
+         ptr (ptr char) @->
+         ptr size_t @->
+          returning error_code)
+
+    let wtf8_length_as_utf16 =
+      foreign "uv_wtf8_length_as_utf16"
+        (string @-> returning PosixTypes.ssize_t)
+
+    let wtf8_to_utf16 =
+      foreign "uv_wtf8_to_utf16"
+        (string @-> ptr uint16_t @-> size_t @-> returning void)
+
+    let free =
+      foreign "free"
+        (ptr void @-> returning void)
+  end
 end

src/c/shims.h

@@ -746,3 +746,27 @@
 
     #define UV_EUNATCH 0x7242424
 #endif
+
+#if UV_VERSION_MAJOR == 1 && UV_VERSION_MINOR < 47
+    size_t uv_utf16_length_as_wtf8(const uint16_t *utf16, ssize_t utf16_len)
+    {
+        return ENOSYS;
+    }
+
+    int uv_utf16_to_wtf8(
+        const uint16_t *utf16, ssize_t utf16_len, char **wtf8_ptr,
+        size_t *wtf8_len_ptr)
+    {
+        return ENOSYS;
+    }
+
+    ssize_t uv_wtf8_length_as_utf16(const char *wtf8)
+    {
+        return ENOSYS;
+    }
+
+    void uv_wtf8_to_utf16(const char *utf8, uint16_t *utf16, size_t utf16_len)
+    {
+        abort();
+    }
+#endif

src/feature/detect_features.ml

@@ -303,6 +303,7 @@ let () =
   needs 37 "udp_recvmmsg" "See {!Luv.UDP.init}.";
   needs 32 "udp_set_source_membership" "See {!Luv.UDP.set_source_membership}.";
   needs 39 "udp_using_recvmmsg" "See {!Luv.UDP.using_recvmmsg}.";
+  needs 47 "utf_16" "See {!Luv.String}.";
 
   let mli_channel = open_out mli in
   Buffer.contents mli_buffer |> output_string mli_channel;

src/index.mld

@@ -92,5 +92,6 @@ presented in the user guide.
 - {!Luv.Prepare} — pre-I/O callbacks
 - {!Luv.Check} — post-I/O callbacks
 - {!Luv.Idle} — per-iteration callbacks
+- {!Luv.String} — UTF-16 manipulation for Windows
 - {!Luv.Version} — libuv version
 - {!Luv.Require} — feature checks

src/luv.ml

@@ -64,5 +64,6 @@ module Env = Env
 module Time = Time
 module Random = Random
 module Metrics = Metrics
+module String = String_
 module Require = Require
 module Unix = Luv_unix

src/string_.ml

@@ -0,0 +1,57 @@
+(* This file is part of Luv, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *)
+
+
+
+let utf16_length_as_wtf8 s =
+  let result =
+    C.Functions.String_.utf16_length_as_wtf8
+      s
+      (PosixTypes.Ssize.of_int (String.length s / 2))
+    |> Unsigned.Size_t.to_int
+   in
+   if result < 0 then
+     Printf.ksprintf
+       failwith "Luv internal error: utf16_length_as_wtf8 error code %i;%s"
+       result "\nCheck your libuv version; 1.47.0 or higher required.";
+   result
+
+let utf16_to_wtf8 s =
+  let wtf8 = Ctypes.(allocate (ptr char) (coerce (ptr void) (ptr char) null)) in
+  let wtf8_length = Ctypes.(allocate size_t) Unsigned.Size_t.zero in
+  let error_code =
+   C.Functions.String_.utf16_to_wtf8
+      s
+      (PosixTypes.Ssize.of_int (String.length s / 2))
+      wtf8
+      wtf8_length
+  in
+  if error_code <> 0 then
+    Printf.ksprintf
+      failwith "Luv internal error: utf16_to_wtf8 error code %i;%s" error_code
+      "\nCheck your libuv version; 1.47.0 or higher required.";
+  let wtf8 = Ctypes.(!@ wtf8) in
+  let wtf8_length = Ctypes.(!@ wtf8_length) |> Unsigned.Size_t.to_int in
+  let s = Ctypes.string_from_ptr wtf8 ~length:wtf8_length in
+  C.Functions.String_.free Ctypes.(coerce (ptr char) (ptr void) wtf8);
+  s
+
+let wtf8_length_as_utf16 s =
+  let result =
+    C.Functions.String_.wtf8_length_as_utf16 s
+    |> PosixTypes.Ssize.to_int
+   in
+   if result < 0 then
+     Printf.ksprintf
+       failwith "Luv internal error: wtf8_length_as_utf16 error code %i;%s"
+       result "\nCheck your libuv version; 1.47.0 or higher required.";
+   result
+
+let wtf8_to_utf16 s =
+  let utf16_length = wtf8_length_as_utf16 s in
+  let utf16 = Ctypes.(allocate_n uint16_t) ~count:utf16_length in
+  C.Functions.String_.wtf8_to_utf16
+    s utf16 (Unsigned.Size_t.of_int utf16_length);
+  utf16
+  |> Ctypes.(coerce (ptr uint16_t) (ptr char))
+  |> Ctypes.string_from_ptr ~length:((utf16_length - 1) * 2)

src/string_.mli

@@ -0,0 +1,36 @@
+(* This file is part of Luv, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *)
+
+
+
+val utf16_length_as_wtf8 : string -> int
+(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_utf16_length_as_wtf8}
+    [uv_utf16_length_as_wtf8]}.
+
+    Requires Luv 0.5.13 and libuv 1.47.0.
+
+    {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *)
+
+val utf16_to_wtf8 : string -> string
+(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_utf16_to_wtf8}
+    [uv_utf16_to_wtf8]}.
+
+    Requires Luv 0.5.13 and libuv 1.47.0.
+
+    {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *)
+
+val wtf8_length_as_utf16 : string -> int
+(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_wtf8_length_as_utf16}
+    [uv_wtf8_length_as_utf16]}.
+
+    Requires Luv 0.5.13 and libuv 1.47.0.
+
+    {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *)
+
+val wtf8_to_utf16 : string -> string
+(** Binds {{:https://docs.libuv.org/en/v1.x/misc.html#c.uv_wtf8_to_utf16}
+    [uv_wtf8_to_utf16]}.
+
+    Requires Luv 0.5.13 and libuv 1.47.0.
+
+    {{!Luv.Require} Feature check}: [Luv.Require.(has utf_16)] *)

test/string_.ml

@@ -0,0 +1,28 @@
+(* This file is part of Luv, released under the MIT license. See LICENSE.md for
+   details, or visit https://github.com/aantron/luv/blob/master/LICENSE.md. *)
+
+
+
+let tests = [
+  "string", [
+    "utf16_length_as_wtf8", `Quick, begin fun () ->
+      Luv.String.utf16_length_as_wtf8 "f\x00\xBB\x03"
+      |> Alcotest.(check int) "length" 3
+    end;
+
+    "utf16_to_wtf8", `Quick, begin fun () ->
+      Luv.String.utf16_to_wtf8 "f\x00\xBB\x03"
+      |> Alcotest.(check string) "value" "fλ"
+    end;
+
+    "wtf8_length_as_utf16", `Quick, begin fun () ->
+      Luv.String.wtf8_length_as_utf16 "fλ"
+      |> Alcotest.(check int) "length" 3
+    end;
+
+    "wtf8_to_utf16", `Quick, begin fun () ->
+      Luv.String.wtf8_to_utf16 "fλ"
+      |> Alcotest.(check string) "value" "f\x00\xBB\x03"
+    end;
+  ]
+]

test/tester.ml

@@ -24,4 +24,5 @@ let () =
     DNS.tests;
     Thread_.tests;
     Misc.tests;
+    String_.tests;
   ])