Add parallelism

src/angstrom_eio/angstrom_eio.ml

@@ -50,12 +50,12 @@ let parse ?(pushback = default_pushback) parser src =
   let buf = Cstruct.create default_buffer_size in
   let rec loop = function
     | (Done _ as state)
-    | (Fail _ as state) ->
+     |(Fail _ as state) ->
       handle_parse_result state
     | Partial feed as state -> (
       match src#read_into buf with
       | 0
-      | (exception End_of_file) ->
+       |(exception End_of_file) ->
         finalize state |> handle_parse_result
       | len ->
         let next = feed (`Bigstring (Bigstringaf.sub buf.buffer ~off:0 ~len)) in
@@ -70,7 +70,7 @@ let rec buffered_state_loop pushback state src (buf : Cstruct.t) =
     let next =
       match src#read_into buf with
       | 0
-      | (exception End_of_file) ->
+       |(exception End_of_file) ->
         k `Eof
       | len -> k (`Bigstring (Bigstringaf.sub buf.buffer ~off:0 ~len))
     in
@@ -80,9 +80,9 @@ let rec buffered_state_loop pushback state src (buf : Cstruct.t) =
 
 let with_buffered_parse_state ?(pushback = default_pushback) state src =
   let buf = Cstruct.create default_buffer_size in
-  ( match state with
+  (match state with
   | Partial _ -> buffered_state_loop pushback state src buf
-  | _ -> state )
+  | _ -> state)
   |> handle_parse_result
 
 let async_many e k = Angstrom.(skip_many (e <* commit >>| k) <?> "async_many")

src/cli/generate.ml

@@ -0,0 +1,123 @@
+open! Core
+open Eio.Std
+
+let header ~version = sprintf "/* Generated by okTurtles/strings v%s */\n\n" version
+
+let fmt s = Yojson.Basic.to_string (`String s)
+
+let json_pair left right first =
+  sprintf "%s\n  %s: %s"
+    ( if !first
+      then (
+        first := false;
+        "" )
+      else "," )
+    left right
+
+let write_english env ~version ~outdir english =
+  let time = Utils.Timing.start () in
+  let path_strings = Filename.concat outdir "english.strings" in
+  let path_json = Filename.concat outdir "english.json" in
+  let first = ref true in
+  Switch.run (fun sw ->
+    let file_strings =
+      Eio.Path.open_out ~sw ~create:Utils.Io.flags Eio.Path.(env#fs / outdir / "english.strings")
+    in
+    let file_json =
+      Eio.Path.open_out ~sw ~create:Utils.Io.flags Eio.Path.(env#fs / outdir / "english.json")
+    in
+    let module W = Eio.Buf_write in
+    W.with_flow file_strings @@ fun w_strings ->
+    W.with_flow file_json @@ fun w_json ->
+    (* Write headers of both *)
+    W.string w_strings (header ~version);
+    W.char w_json '{';
+    (* Switch to a map to preserve order as much as possible and therefore reduce merge conflicts *)
+    let map =
+      String.Table.fold english ~init:String.Map.empty ~f:(fun ~key ~data acc ->
+        String.Map.set acc ~key ~data )
+    in
+    String.Map.iteri map ~f:(fun ~key ~data ->
+      let fmt_key = fmt key in
+      W.string w_strings (sprintf "/* %s */\n%s = %s;\n\n" data fmt_key fmt_key);
+      W.string w_json (json_pair fmt_key fmt_key first) );
+    W.string w_json "\n}\n" );
+
+  Eio.Flow.copy_string
+    (sprintf
+       !"✅ [%{Int63}ms] Generated '%s' and '%s' with:\n- %d unique strings\n\n"
+       (time `Stop) path_strings path_json (String.Table.length english) )
+    env#stdout
+
+let write_other env ~version ~outdir ~language english other =
+  let time = Utils.Timing.start () in
+  let path_strings = Filename.concat outdir (sprintf "%s.strings" language) in
+  let path_json = Filename.concat outdir (sprintf "%s.json" language) in
+  let n_left, n_right, n_both =
+    Switch.run @@ fun sw ->
+    let file_strings =
+      Eio.Path.open_out ~sw ~create:Utils.Io.flags
+        Eio.Path.(env#fs / outdir / sprintf "%s.strings" language)
+    in
+    let file_json =
+      Eio.Path.open_out ~sw ~create:Utils.Io.flags Eio.Path.(env#fs / outdir / sprintf "%s.json" language)
+    in
+    let module W = Eio.Buf_write in
+    W.with_flow file_strings @@ fun w_strings ->
+    W.with_flow file_json @@ fun w_json ->
+    let english_only = ref String.Map.empty in
+    let other_only = ref String.Map.empty in
+    let both = ref String.Map.empty in
+    let add_entry map_ref ~line_strings ~line_json =
+      map_ref := String.Map.set !map_ref ~key:line_strings ~data:line_json;
+      None
+    in
+    let missing_translation key x =
+      let fmt_key = fmt key in
+      let line_strings = sprintf "/* MISSING TRANSLATION - %s */\n%s = %s;\n\n" x fmt_key fmt_key in
+      add_entry english_only ~line_strings ~line_json:(fmt_key, fmt_key)
+    in
+    let _table =
+      String.Table.merge english other ~f:(fun ~key -> function
+        | `Left x -> missing_translation key x
+        | `Both (x, y) when String.(key = y) -> missing_translation key x
+        | `Both (x, y) ->
+          let fmt_key = fmt key in
+          let fmt_y = fmt y in
+          let line_strings = sprintf "/* %s */\n%s = %s;\n\n" x fmt_key fmt_y in
+          add_entry both ~line_strings ~line_json:(fmt_key, fmt_y)
+        | `Right y when String.(key = y) -> None
+        | `Right y ->
+          (* No need to write "deprecated translations" to JSON *)
+          let line_strings = sprintf "/* Not currently used */\n%s = %s;\n\n" (fmt key) (fmt y) in
+          add_entry other_only ~line_strings ~line_json:() )
+    in
+    let first = ref true in
+    (* Write headers *)
+    W.string w_strings (header ~version);
+    W.char w_json '{';
+    let write_pairs map =
+      String.Map.fold map ~init:0 ~f:(fun ~key:line_strings ~data:(x, y) acc ->
+        W.string w_strings line_strings;
+        W.string w_json (json_pair x y first);
+        acc + 1 )
+    in
+    let n_left = write_pairs !english_only in
+    let n_both = write_pairs !both in
+    let n_right =
+      String.Map.fold !other_only ~init:0 ~f:(fun ~key:line_strings ~data:() acc ->
+        W.string w_strings line_strings;
+        acc + 1 )
+    in
+    W.string w_json "\n}\n";
+    n_left, n_right, n_both
+  in
+
+  Eio.Flow.copy_string
+    (sprintf
+       !"✅ [%{Int63}ms] Generated '%s' and '%s' with:\n\
+         - %d new strings\n\
+         - %d existing strings\n\
+         - %d unused strings\n\n"
+       (time `Stop) path_strings path_json n_left n_both n_right )
+    env#stdout