From 5e15341857e57671a3c617579e3d5dcc89040936 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Fri, 10 Jan 2025 22:06:06 +0100
Subject: Print the float numbers using the user locale

---
 lib/configuration/dune          |  1 +
 lib/configuration/importConf.ml | 12 +++++++++-
 lib/configuration/locale.c      | 12 ++++++++++
 lib/configuration/of_json.ml    |  1 +
 lib/configuration/read_conf.ml  |  9 ++++----
 lib/configuration/syntax.ml     |  1 +
 lib/csv/dataType.ml             |  4 +++-
 lib/csv/dune                    |  1 +
 lib/csv/format.c                | 49 +++++++++++++++++++++++++++++++++++++++++
 9 files changed, 84 insertions(+), 6 deletions(-)
 create mode 100644 lib/configuration/locale.c
 create mode 100644 lib/csv/format.c

(limited to 'lib')

diff --git a/lib/configuration/dune b/lib/configuration/dune
index 27d31a6..b08e9bd 100755
--- a/lib/configuration/dune
+++ b/lib/configuration/dune
@@ -12,6 +12,7 @@
    importExpression
    importErrors
  )
+ (foreign_stubs (language c) (names locale))
 
 (preprocess (pps ppx_yojson_conv ppx_deriving.ord))
 )
diff --git a/lib/configuration/importConf.ml b/lib/configuration/importConf.ml
index 3406a11..aa0e2f3 100644
--- a/lib/configuration/importConf.ml
+++ b/lib/configuration/importConf.ml
@@ -5,6 +5,8 @@ module Path = ImportDataTypes.Path
 module T = Read_conf
 module Expression = ImportExpression.T
 
+external set_locale : string -> unit = "set_locale"
+
 let current_syntax = 1
 
 let t_of_yojson : Yojson.Safe.t -> Syntax.t =
@@ -39,7 +41,14 @@ let t_of_toml : Otoml.t -> (Syntax.t, string) result =
       [ "version" ]
   in
   match version with
-  | n when n = latest_version -> TomlReader.read toml
+  | n when n = latest_version ->
+      let conf = TomlReader.read toml in
+      let () =
+        Result.iter
+          (fun conf -> set_locale (Option.value ~default:"" conf.Syntax.locale))
+          conf
+      in
+      conf
   | _ ->
       Printf.eprintf "Unsuported version : %d\n" version;
       exit 1
@@ -49,6 +58,7 @@ let dummy_conf =
     {
       source = { file = ""; tab = 0; name = "" };
       version = 1;
+      locale = Some "C";
       externals = [];
       columns = [];
       filters = [];
diff --git a/lib/configuration/locale.c b/lib/configuration/locale.c
new file mode 100644
index 0000000..eeafd26
--- /dev/null
+++ b/lib/configuration/locale.c
@@ -0,0 +1,12 @@
+#include <stdio.h>
+#include <locale.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+
+CAMLprim value set_locale( value param )
+{
+    const char *s;
+    s = String_val(param);
+    setlocale(LC_NUMERIC, s);
+    return Val_unit;
+}
diff --git a/lib/configuration/of_json.ml b/lib/configuration/of_json.ml
index e6ee7a4..6ac59a2 100644
--- a/lib/configuration/of_json.ml
+++ b/lib/configuration/of_json.ml
@@ -123,6 +123,7 @@ let yojson_of_predicate () = `Null
 
 type t = Syntax.t = {
   version : int; [@default current_syntax]
+  locale : string option;
   source : table;
   externals : syntax_v1_extern list; [@default []]
   columns : path expression list;
diff --git a/lib/configuration/read_conf.ml b/lib/configuration/read_conf.ml
index 952c43c..df1a728 100644
--- a/lib/configuration/read_conf.ml
+++ b/lib/configuration/read_conf.ml
@@ -184,17 +184,18 @@ module Make (S : Decoders.Decode.S) = struct
           S.field_opt_or ~default:[] "uniq"
           @@ S.list (self#parse_expression ExpressionParser.path)
         in
-        S.succeed @@ fun version source externals ->
-        Syntax.{ version; source; externals; columns; filters; sort; uniq }
+        S.succeed @@ fun version source externals locale ->
+        Syntax.
+          { version; source; externals; columns; filters; sort; uniq; locale }
 
       method conf =
         let* source = S.field "source" self#source
         and* externals =
           S.field_opt_or ~default:[] "externals"
             (S.key_value_pairs_seq self#external_)
-        in
+        and* locale = S.field_opt "locale" S.string in
         let* sheet =
-          S.field "sheet" self#sheet >|= fun v -> v 1 source externals
+          S.field "sheet" self#sheet >|= fun v -> v 1 source externals locale
         in
 
         S.succeed sheet
diff --git a/lib/configuration/syntax.ml b/lib/configuration/syntax.ml
index 1eb3c70..253720e 100644
--- a/lib/configuration/syntax.ml
+++ b/lib/configuration/syntax.ml
@@ -54,6 +54,7 @@ end
 
 type t = {
   version : int;
+  locale : string option;
   source : Table.t;
   externals : Extern.t list;
   columns : Path.t E.t list;
diff --git a/lib/csv/dataType.ml b/lib/csv/dataType.ml
index c582b9c..1d2c7f9 100644
--- a/lib/csv/dataType.ml
+++ b/lib/csv/dataType.ml
@@ -1,3 +1,5 @@
+external show_float : float -> string = "show_float"
+
 let match_date = Re.Str.regexp {|[0-9]+/[0-9]+/[0-9]+|}
 
 type t =
@@ -11,7 +13,7 @@ let to_string = function
   | Null -> ""
   | Error s -> s
   | Integer i -> string_of_int i
-  | Float f -> string_of_float f
+  | Float f -> show_float f
   | Content c -> (
       match String.starts_with ~prefix:"0" c with
       | false -> c
diff --git a/lib/csv/dune b/lib/csv/dune
index b0f4a72..2cdc868 100755
--- a/lib/csv/dune
+++ b/lib/csv/dune
@@ -3,4 +3,5 @@
  (libraries 
    re
  )
+ (foreign_stubs (language c) (names format))
 )
diff --git a/lib/csv/format.c b/lib/csv/format.c
new file mode 100644
index 0000000..31e4bbe
--- /dev/null
+++ b/lib/csv/format.c
@@ -0,0 +1,49 @@
+#include <stdio.h>
+#include <locale.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+
+#ifndef _vscprintf
+/* For some reason, MSVC fails to honour this #ifndef. */
+/* Hence function renamed to _vscprintf_so(). */
+int _vscprintf_so(const char * format, va_list pargs) {
+    int retval;
+    va_list argcopy;
+    va_copy(argcopy, pargs);
+    retval = vsnprintf(NULL, 0, format, argcopy);
+    va_end(argcopy);
+    return retval;}
+#endif // _vscprintf
+
+#ifndef vasprintf
+int vasprintf(char **strp, const char *fmt, va_list ap) {
+    int len = _vscprintf_so(fmt, ap);
+    if (len == -1) return -1;
+    char *str = malloc((size_t) len + 1);
+    if (!str) return -1;
+    int r = vsnprintf(str, len + 1, fmt, ap); /* "secure" version of vsprintf */
+    if (r == -1) return free(str), -1;
+    *strp = str;
+    return r;}
+#endif // vasprintf
+
+#ifndef asprintf
+int asprintf(char *strp[], const char *fmt, ...) {
+    va_list ap;
+    va_start(ap, fmt);
+    int r = vasprintf(strp, fmt, ap);
+    va_end(ap);
+    return r;}
+#endif // asprintf
+
+CAMLprim value show_float( value float_param )
+{
+    CAMLparam1( float_param );
+    CAMLlocal1( ml_data );
+    double f = Double_val(float_param);
+    char* raw_data;
+    int data_len = asprintf(&raw_data, "%f", f);
+    ml_data = caml_copy_string( raw_data );
+    free(raw_data);
+    CAMLreturn( ml_data );
+}
-- 
cgit v1.2.3