Support HTML, TS in Pug, refactor CLI

okTurtles · Sep 3, 2022 · 176aafe · 176aafe
1 parent 37a82a8
commit 176aafe
Show file tree

Hide file tree

Showing 15 changed files with 369 additions and 198 deletions.
diff --git a/src/cli/dune b/src/cli/dune
@@ -8,6 +8,8 @@
     stdlib-shims
     angstrom-lwt-unix
     core
+    core_unix
+    core_unix.command_unix
     lwt
     lwt.unix
     ppx_deriving_yojson.runtime

diff --git a/src/cli/strings.ml b/src/cli/strings.ml
@@ -1,9 +1,8 @@
-module U = Unix
 open Core
 open Lwt.Infix
 open Lwt.Syntax
 
-let version = "2.0.0"
+let version = "2.1.0"
 
 let header = sprintf "/* Generated by okTurtles/strings v%s */\n\n" version
 
@@ -21,9 +20,9 @@ let plural i = if i = 1 then "" else "s"
 
 let pool = Lwt_pool.create 6 (fun () -> Lwt.return_unit)
 
-let read_flags = U.[ O_RDONLY; O_NONBLOCK ]
+let read_flags = Core_unix.[ O_RDONLY; O_NONBLOCK ]
 
-let write_flags = U.[ O_WRONLY; O_NONBLOCK; O_TRUNC; O_CREAT ]
+let write_flags = Core_unix.[ O_WRONLY; O_NONBLOCK; O_TRUNC; O_CREAT ]
 
 type counts = {
   vue: int ref;
@@ -53,8 +52,9 @@ let rec traverse ~root counts strings js_file_errors directory =
         let path = sprintf "%s/%s" directory filename in
         Lwt_unix.lstat path >>= function
         | { st_kind = S_REG; _ } when String.is_suffix ~suffix:".vue" filename ->
-          process_file ~root strings counts.vue path
-            ~f:(Vue.parse ~filename ~f:Vue.(extract_strings js_file_errors))
+          process_file ~root strings counts.vue path ~f:(fun ic ->
+              let* languages = Vue.parse ~filename ic in
+              Vue.extract_strings ~filename js_file_errors languages JS)
         | { st_kind = S_REG; _ } when String.is_suffix ~suffix:".js" filename ->
           process_file ~root strings counts.js path ~f:(fun ic ->
               let* source = Lwt_io.read ic in
@@ -174,103 +174,134 @@ let directory_exists path =
   | { st_kind = _; _ } -> failwithf "%s already exists, but is not a directory" path ()
   | exception _ -> false
 
-let main args =
+type common_options = {
+  targets: string list;
+  template_script: Vue.template_script;
+}
+
+let handle_system_failure = function
+| (Failure _ as ex)
+ |(Core_unix.Unix_error _ as ex)
+ |(Exn.Reraised _ as ex) ->
+  let message = Utils.Exception.human ex in
+  let* () = Lwt_io.write_line Lwt_io.stderr (sprintf "❌ An error occured:\n%s" message) in
+  exit 1
+| exn -> raise exn
+
+type action =
+  | Debug of Vue.Debug.t
+  | Run
+
+let main { targets; template_script } = function
+| Debug lang ->
+  Lwt_list.iter_s
+    (fun filename ->
+      let* () = Lwt_io.printlf "Debugging %s" filename in
+      Lwt_io.with_file ~flags:read_flags ~mode:Input filename (fun ic ->
+          let* languages = Vue.parse ~filename ic in
+          Vue.debug_template ~filename languages lang template_script))
+    targets
+| Run ->
   let overall_time = Utils.time () in
-  match args with
-  | [ _; "-v" ]
-   |[ _; "--version" ] ->
-    let* () = Lwt_io.write_line Lwt_io.stdout (sprintf "Version %s" version) in
-    exit 0
-  | [ _; "debug"; "pug"; filename ] ->
-    let* () = 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"
-  | _ :: directories ->
-    (* Check current directory *)
-    let* strings_dir_files =
-      let git_dir_p = directory_exists ".git" in
-      let strings_dir_p = directory_exists "strings" in
-      let* git_dir = git_dir_p in
-      let* 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";
-      match strings_dir with
-      | true -> Lwt_unix.files_of_directory "strings" |> Lwt_stream.to_list
-      | false ->
-        let+ () = Lwt_unix.mkdir "strings" 0o751 in
-        []
-    in
-    (* English *)
-    let js_file_errors = Queue.create () in
-    let* english =
-      let english_list = String.Table.create () in
-      let counts = { vue = ref 0; js = ref 0; ts = ref 0 } in
-      let time = Utils.time () in
-      let* () =
-        Lwt_list.iter_p
-          (fun directory ->
-            let root = String.chop_suffix ~suffix:"/" directory |> Option.value ~default:directory in
-            traverse ~root:(sprintf "%s/" root) counts english_list js_file_errors root)
-          directories
-      in
-      let english =
-        String.Table.map english_list ~f:(fun set ->
-            String.Set.to_array set |> String.concat_array ~sep:", ")
-      in
-      let* () =
-        let f ext i = sprintf "%d %s file%s" i ext (plural i) in
-        let time = Int63.(time () - !Quickjs.init_time) in
-        Lwt_io.printlf
-          !"✅ [%{Int63}ms] Processed %s, %s, and %s"
-          time (f ".vue" !(counts.vue)) (f ".js" !(counts.js)) (f ".ts" !(counts.ts))
-      in
-      let+ () = write_english english in
-      english
-    in
-    (* Other languages *)
+  (* Check current directory *)
+  let* strings_dir_files =
+    let git_dir_p = directory_exists ".git" in
+    let strings_dir_p = directory_exists "strings" in
+    let* git_dir = git_dir_p in
+    let* 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";
+    match strings_dir with
+    | true -> Lwt_unix.files_of_directory "strings" |> Lwt_stream.to_list
+    | false ->
+      let+ () = Lwt_unix.mkdir "strings" 0o751 in
+      []
+  in
+  (* English *)
+  let js_file_errors = Queue.create () in
+  let* english =
+    let english_list = String.Table.create () in
+    let counts = { vue = ref 0; js = ref 0; ts = ref 0 } in
+    let time = Utils.time () in
     let* () =
       Lwt_list.iter_p
-        (fun filename ->
-          match String.chop_suffix ~suffix:".strings" filename with
-          | Some "english" -> Lwt.return_unit
-          | Some language -> (
-            let path = sprintf "strings/%s" filename in
-            Lwt_unix.stat path >>= function
-            | { st_kind = S_REG; _ } ->
-              let* other =
-                Lwt_io.with_file ~mode:Input ~flags:read_flags path (Parsing.Strings.parse ~filename)
-              in
-              write_other ~language english other
-            | _ -> Lwt.return_unit)
-          | None -> Lwt.return_unit)
-        strings_dir_files
+        (fun directory ->
+          let root = String.chop_suffix ~suffix:"/" directory |> Option.value ~default:directory in
+          traverse ~root:(sprintf "%s/" root) counts english_list js_file_errors root)
+        targets
+    in
+    let english =
+      String.Table.map english_list ~f:(fun set ->
+          String.Set.to_array set |> String.concat_array ~sep:", ")
     in
-    (* JS parse errors *)
     let* () =
-      match Queue.length js_file_errors with
-      | 0 -> Lwt.return_unit
-      | len ->
-        let files =
-          Queue.to_array js_file_errors
-          |> Array.map ~f:(fun { filename; _ } -> sprintf "- %s" filename)
-          |> String.concat_array ~sep:"\n"
-        in
-        Lwt_io.printlf "❌ Encountered %d parsing error%s. File%s:\n%s\n" len (plural len) (plural len)
-          files
+      let f ext i = sprintf "%d %s file%s" i ext (plural i) in
+      let time = Int63.(time () - !Quickjs.init_time) in
+      Lwt_io.printlf
+        !"✅ [%{Int63}ms] Processed %s, %s, and %s"
+        time (f ".vue" !(counts.vue)) (f ".js" !(counts.js)) (f ".ts" !(counts.ts))
     in
-    Lwt_io.write_line Lwt_io.stdout (sprintf !"Completed. (%{Int63}ms)" (overall_time ()))
-  | _ -> failwith "Expected Unix calling convention"
+    let+ () = write_english english in
+    english
+  in
+  (* Other languages *)
+  let* () =
+    Lwt_list.iter_p
+      (fun filename ->
+        match String.chop_suffix ~suffix:".strings" filename with
+        | Some "english" -> Lwt.return_unit
+        | Some language -> (
+          let path = sprintf "strings/%s" filename in
+          Lwt_unix.stat path >>= function
+          | { st_kind = S_REG; _ } ->
+            let* other =
+              Lwt_io.with_file ~mode:Input ~flags:read_flags path (Parsing.Strings.parse ~filename)
+            in
+            write_other ~language english other
+          | _ -> Lwt.return_unit)
+        | None -> Lwt.return_unit)
+      strings_dir_files
+  in
+  (* JS parse errors *)
+  let* () =
+    match Queue.length js_file_errors with
+    | 0 -> Lwt.return_unit
+    | len ->
+      let files =
+        Queue.to_array js_file_errors
+        |> Array.map ~f:(fun { filename; _ } -> sprintf "- %s" filename)
+        |> String.concat_array ~sep:"\n"
+      in
+      Lwt_io.printlf "❌ Encountered %d parsing error%s. File%s:\n%s\n" len (plural len) (plural len) files
+  in
+  Lwt_io.write_line Lwt_io.stdout (sprintf !"Completed. (%{Int63}ms)" (overall_time ()))
 
 let () =
-  Lwt_main.run
-    (Lwt.catch
-       (fun () -> main (Sys.get_argv () |> Array.to_list))
-       (function
-         | (Failure _ as ex)
-          |(U.Unix_error _ as ex)
-          |(Exn.Reraised _ as ex) ->
-           let message = Utils.Exception.human ex in
-           let* () = Lwt_io.write_line Lwt_io.stderr (sprintf "❌ An error occured:\n%s" message) in
-           exit 1
-         | exn -> raise exn))
+  let open Command in
+  let open Command.Let_syntax in
+  let common =
+    let%map_open use_ts =
+      flag "--ts" ~full_flag_required:() no_arg ~doc:"Interpret Vue templates as TypeScript"
+    and targets = Param.("path" %: string |> sequence |> anon) in
+    { targets; template_script = (if use_ts then TS else JS) }
+  in
+  let action =
+    let open Param in
+    let debug_pug =
+      flag "--debug-pug" ~aliases:[ "--dp" ] ~full_flag_required:() no_arg
+        ~doc:"Debug pug templates in .vue files"
+      >>| Fn.flip Option.some_if (Debug Pug)
+    in
+    let debug_html =
+      flag "--debug-html" ~aliases:[ "--dh" ] ~full_flag_required:() no_arg
+        ~doc:"Debug html templates in .vue files"
+      >>| Fn.flip Option.some_if (Debug Html)
+    in
+    choose_one [ debug_pug; debug_html ] ~if_nothing_chosen:(Default_to Run)
+  in
+
+  Param.both common action
+  >>| (fun (common, action) () ->
+        let program () = main common action in
+        Lwt_main.run (Lwt.catch program handle_system_failure))
+  |> Command.basic ~summary:"Extract i18n strings - https://github.com/okTurtles/strings"
+  |> Command_unix.run ~version