Capture missing i18n

okTurtles · Apr 19, 2020 · 7a4155c · 7a4155c
1 parent ebc26f2
commit 7a4155c
Show file tree

Hide file tree

Showing 4 changed files with 91 additions and 73 deletions.
diff --git a/src/cli/strings.ml b/src/cli/strings.ml
@@ -20,7 +20,7 @@ let write_flags = Unix.[O_WRONLY; O_NONBLOCK; O_TRUNC; O_CREAT]
 let process_file ~root (strings, count) filename =
   Lwt_pool.use pool (fun () ->
     incr count;
-    let%lwt parsed = Lwt_io.with_file ~mode:Input ~flags:read_flags filename (Vue.parse filename) in
+    let%lwt parsed = Lwt_io.with_file ~mode:Input ~flags:read_flags filename (Vue.parse ~filename ~f:Vue.extract_strings) in
     Queue.iter parsed ~f:(fun string ->
       let data = String.chop_prefix filename ~prefix:root |> Option.value ~default:filename in
       String.Table.update strings string ~f:(function
@@ -137,63 +137,68 @@ let directory_exists path =
 
 let main args =
   let t0 = Time_now.nanoseconds_since_unix_epoch () in
-  let%lwt directories = begin match args with
+  begin match args with
   | _::"-v"::[] | _::"--version"::[] ->
     let%lwt () = Lwt_io.write_line Lwt_io.stdout (sprintf "Version %s" version) in
     exit 0
+  | _::"debug"::"pug"::filename::[] ->
+    let%lwt () = Lwt_io.printlf "Debugging %s" filename in
+    Lwt_io.with_file ~flags:read_flags ~mode:Input filename (fun ic ->
+      Vue.parse ~filename ic ~f:Vue.debug_pug
+    )
   | _::[] -> failwith "At least one argument is required"
-  | _::x -> Lwt.return x
-  | _ -> failwith "Expected Unix calling convention"
-  end
-  in
-  (* Check current directory *)
-  let%lwt strings_dir_files =
-    let git_dir_p = directory_exists ".git" in
-    let strings_dir_p = directory_exists "strings" in
-    let%lwt git_dir = git_dir_p in
-    let%lwt strings_dir = strings_dir_p in
-    if not (git_dir || strings_dir) then failwith "This program must be run from the root of your project";
-    begin match strings_dir with
-    | true -> Lwt_unix.files_of_directory "strings" |> Lwt_stream.to_list
-    | false ->
-      let%lwt () = Lwt_unix.mkdir "strings" 0o751 in
-      Lwt.return_nil
-    end
-  in
-  (* English *)
-  let%lwt english =
-    let english_list = String.Table.create () in
-    let count = ref 0 in
-    let%lwt () = Lwt_list.iter_p (fun directory ->
-        let root = (String.chop_suffix ~suffix:"/" directory |> Option.value ~default:directory) in
-        traverse ~root:(sprintf "%s/" root) (english_list, count) root
-      ) directories
+  | _::directories ->
+    (* Check current directory *)
+    let%lwt strings_dir_files =
+      let git_dir_p = directory_exists ".git" in
+      let strings_dir_p = directory_exists "strings" in
+      let%lwt git_dir = git_dir_p in
+      let%lwt strings_dir = strings_dir_p in
+      if not (git_dir || strings_dir) then failwith "This program must be run from the root of your project";
+      begin match strings_dir with
+      | true -> Lwt_unix.files_of_directory "strings" |> Lwt_stream.to_list
+      | false ->
+        let%lwt () = Lwt_unix.mkdir "strings" 0o751 in
+        Lwt.return_nil
+      end
     in
-    let english = String.Table.map english_list ~f:(fun set ->
-        String.Set.to_array set |> String.concat_array ~sep:", "
-      )
+    (* English *)
+    let%lwt english =
+      let english_list = String.Table.create () in
+      let count = ref 0 in
+      let%lwt () = Lwt_list.iter_p (fun directory ->
+          let root = (String.chop_suffix ~suffix:"/" directory |> Option.value ~default:directory) in
+          traverse ~root:(sprintf "%s/" root) (english_list, count) root
+        ) directories
+      in
+      let english = String.Table.map english_list ~f:(fun set ->
+          String.Set.to_array set |> String.concat_array ~sep:", "
+        )
+      in
+      let%lwt () = write_english english !count in
+      Lwt.return english
     in
-    let%lwt () = write_english english !count in
-    Lwt.return english
-  in
-  (* Other languages *)
-  let%lwt () = Lwt_list.iter_p (fun filename ->
-      begin match String.chop_suffix ~suffix:".strings" filename with
-      | Some "english" -> Lwt.return_unit
-      | Some language ->
-        let path = sprintf "strings/%s" filename in
-        begin match%lwt Lwt_unix.stat path with
-        | { st_kind = S_REG; _ } ->
-          let%lwt other = Lwt_io.with_file ~mode:Input ~flags:read_flags path Parsing.Strings.parse in
-          write_other ~language english other
-        | _ -> Lwt.return_unit
+    (* Other languages *)
+    let%lwt () = Lwt_list.iter_p (fun filename ->
+        begin match String.chop_suffix ~suffix:".strings" filename with
+        | Some "english" -> Lwt.return_unit
+        | Some language ->
+          let path = sprintf "strings/%s" filename in
+          begin match%lwt Lwt_unix.stat path with
+          | { st_kind = S_REG; _ } ->
+            let%lwt other = Lwt_io.with_file ~mode:Input ~flags:read_flags path Parsing.Strings.parse in
+            write_other ~language english other
+          | _ -> Lwt.return_unit
+          end
+        | None -> Lwt.return_unit
         end
-      | None -> Lwt.return_unit
-      end
-    ) strings_dir_files
-  in
-  let t1 = Time_now.nanoseconds_since_unix_epoch () in
-  Lwt_io.write_line Lwt_io.stdout (sprintf "Completed. (%sms)" Int63.(to_string ((t1 - t0) / (of_int 1_000_000))))
+      ) strings_dir_files
+    in
+    let t1 = Time_now.nanoseconds_since_unix_epoch () in
+    Lwt_io.write_line Lwt_io.stdout (sprintf "Completed. (%sms)" Int63.(to_string ((t1 - t0) / (of_int 1_000_000))))
+
+  | _ -> failwith "Expected Unix calling convention"
+  end
 
 let () =
   Lwt_main.run (

diff --git a/src/cli/vue.ml b/src/cli/vue.ml
@@ -10,10 +10,12 @@ type language =
 
 type languages = language list [@@deriving sexp, yojson]
 
-let rec loop_pug queue Pug.{ parts; arguments; text; children } =
-  begin match text, parts with
-  | (Some s), [Element { name = "i18n" }] -> Queue.enqueue queue s
-  | Some _, _
+let rec loop_pug queue Pug.{ selector; arguments; text; children } =
+  begin match text, selector with
+  | Some s, (Element { parts = "i18n"::_ }) -> Queue.enqueue queue s
+  | Some s, _ ->
+    begin try Js_ast.strings queue s
+    with _exn -> () end
   | None, _ -> ()
   end;
   List.iter arguments ~f:(fun { contents; _ } -> Option.iter contents ~f:(fun source ->
@@ -22,7 +24,28 @@ let rec loop_pug queue Pug.{ parts; arguments; text; children } =
     ));
   Array.iter children ~f:(loop_pug queue)
 
-let parse filename ic =
+let extract_strings ~filename parsed =
+  let strings = Queue.create () in
+  List.iter parsed ~f:(function
+  | Pug nodes -> Array.iter nodes ~f:(loop_pug strings)
+  | Js source ->
+    begin try Js_ast.strings strings source
+    with _exn -> failwithf "JS Syntax Error in %s" filename () end
+  | Css -> ()
+  );
+  Lwt.return strings
+
+let debug_pug ~filename parsed =
+  Lwt_list.iter_s (function
+  | Js _
+  | Css -> Lwt.return_unit
+  | (Pug nodes as lang) ->
+    let%lwt () = Lwt_io.printl (Pug.sexp_of_nodes nodes |> Sexp.to_string_hum) in
+    let%lwt strings = extract_strings ~filename [lang] in
+    Lwt_io.printl (Queue.to_array strings |> String.concat_array ~sep:"\n")
+  ) parsed
+
+let parse ~filename ic ~f =
   let open Angstrom in
   let open Basic in
 
@@ -36,17 +59,7 @@ let parse filename ic =
 
   let%lwt _unconsumed, result = Angstrom_lwt_unix.parse parser ic in
   begin match result with
-  | Ok (parsed, "") ->
-    let strings = Queue.create () in
-    List.iter parsed ~f:(function
-    | Pug nodes -> Array.iter nodes ~f:(loop_pug strings)
-    | Js source ->
-      begin try Js_ast.strings strings source
-      with _exn -> failwithf "JS Syntax Error in %s" filename () end
-    | Css -> ()
-    );
-    Lwt.return strings
-
+  | Ok (parsed, "") -> f ~filename parsed
   | Ok (_, unparsed) ->
     failwithf "Could not process data starting at:\n%s"
       (Yojson.Basic.to_string (`String (String.slice unparsed 0 Int.(min 20 (String.length unparsed))))) ()

diff --git a/src/parsing/compile_js.ml b/src/parsing/compile_js.ml
diff --git a/src/parsing/pug.ml b/src/parsing/pug.ml
@@ -1,10 +1,10 @@
 open Core_kernel
 
 type identifier = {
-  name: string;
+  parts: string list;
 } [@@deriving yojson, sexp]
 
-type selector_part =
+type selector =
 | Element of identifier
 | Class of identifier
 | Id of identifier
@@ -17,7 +17,7 @@ type argument = {
 } [@@deriving yojson, sexp]
 
 type node = {
-  parts: selector_part list;
+  selector: selector;
   arguments: argument list;
   text: string option;
   children: node array;
@@ -87,7 +87,7 @@ let parser =
 
   let word = take_while1 alphanum in
   let identifier =
-    lift2 (fun s ll -> { name = String.concat (s::ll) })
+    lift2 (fun s ll -> { parts = s::ll })
       word
       (many (lift2 (sprintf "%s%s")
             (symbols ["."; "-"; ":"; "#"])
@@ -108,8 +108,8 @@ let parser =
   let text_wrap = string "|" *> maybe (char ' ') *> take_remaining in
   let comment_start = symbols ["//-"; "//"] *> take_remaining in
   let node = (
-    (lift3 (fun parts arguments text -> { parts; arguments; text; children = [||] })
-          (many1 (choice [class_selector; id_selector; element_selector]))
+    (lift3 (fun selector arguments text -> { selector; arguments; text; children = [||] })
+          (choice [class_selector; id_selector; element_selector])
           (maybe (char '(' *> mlblank *> (sep_by mlblank1 argument) <* mlblank <* char ')') >>| (Option.value ~default:[]))
           (maybe (blank *> take_remaining)
             >>| function