Cleanups

okTurtles · Sep 11, 2022 · 04021e7 · 04021e7
1 parent 73014a4
commit 04021e7
Show file tree

Hide file tree

Showing 14 changed files with 82 additions and 51 deletions.
diff --git a/src/cli/strings.ml b/src/cli/strings.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 open Lwt.Infix
 open Lwt.Syntax
 
@@ -79,14 +79,11 @@ let rec traverse ~root counts strings js_file_errors template_script directory =
               Queue.iter parsed)
         | { st_kind = S_REG; _ }, _, _ when String.is_suffix filename ~suffix:".html" ->
           process_file ~root strings counts.html path ~f:(fun ic ->
-              let* nodes =
+              let* top =
                 Parsing.Basic.exec_parser_lwt Parsing.Html.parser ~filename ~language_name:"HTML" ic
               in
               let parsed = Queue.create () in
-              let+ () =
-                Parsing.Html.finalize ~filename nodes
-                |> Option.value_map ~default:Lwt.return_unit ~f:(Vue.collect_html parsed template_script)
-              in
+              let+ () = Vue.collect_html parsed template_script top in
               Queue.iter parsed)
         | { st_kind = S_DIR; _ }, _, _ ->
           traverse ~root counts strings js_file_errors template_script path
@@ -233,7 +230,6 @@ let main { targets; template_script } = function
           | Html, _ when String.is_suffix filename ~suffix:".html" ->
             let* top =
               Parsing.Basic.exec_parser_lwt Parsing.Html.parser ~filename ~language_name:"Pug" ic
-              >|= Parsing.Html.finalize ~filename
             in
             Vue.debug_template ~filename [ Html { top; length = None } ] template_script lang
           | _ -> Lwt_io.printlf "Nothing to do for file [%s]" filename))

diff --git a/src/cli/vue.ml b/src/cli/vue.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 open Lwt.Syntax
 open Lwt.Infix
 open Parsing
@@ -15,7 +15,7 @@ module Language = struct
     | Js   of string
     | Ts   of string
     | Html of {
-        top: SZXX.Xml.DOM.element option;
+        top: SZXX.Xml.DOM.element;
         length: int option;
       }
     | Pug  of {
@@ -26,10 +26,7 @@ module Language = struct
 
   let of_source ~filename : Source.t -> t = function
   | Template (Template.HTML source) ->
-    let top =
-      Parsing.Basic.exec_parser Parsing.Html.parser ~filename ~language_name:"HTML" source
-      |> Parsing.Html.finalize ~filename
-    in
+    let top = Parsing.Basic.exec_parser Parsing.Html.parser ~filename ~language_name:"HTML" source in
     Html { top; length = Some (String.length source) }
   | Template (Template.PUG source) ->
     let nodes = Basic.exec_parser Pug.parser ~filename ~language_name:"Pug" source in
@@ -106,8 +103,7 @@ let extract_strings ~filename js_file_errors template_script languages =
   let+ () =
     Lwt_list.iter_p
       (function
-        | Language.Html { top = None; length = _ } -> Lwt.return_unit
-        | Html { top = Some node; length = _ } -> collect_html strings template_script node
+        | Language.Html { top; length = _ } -> collect_html strings template_script top
         | Pug { nodes; length = _ } -> collect_pug strings template_script nodes
         | Js source -> Js_ast.strings_from_js ~filename strings js_file_errors source
         | Ts source -> extract_ts strings source
@@ -133,11 +129,11 @@ let debug_template ~filename languages template_script target =
         | Ts source, _ -> Lwt_io.printlf "<TS Code - %d bytes>" (String.length source)
         | Css length, _ -> Lwt_io.printlf "<CSS Code - %d bytes>" length
         | Html { top; length = _ }, Html ->
-          let* () = Lwt_io.printlf !"%{sexp#hum: SZXX.Xml.DOM.element option}" top in
+          let* () = Lwt_io.printlf !"%{sexp#hum: SZXX.Xml.DOM.element}" top in
           let* iter = extract_strings ~filename js_file_errors template_script [ lang ] in
           print_iter iter
         | (Pug { nodes; length = _ } as lang), Pug ->
-          let* () = Lwt_io.printlf !"%{sexp#hum: Pug.nodes}" nodes in
+          let* () = Lwt_io.printlf !"%{sexp#hum: Pug.t}" nodes in
           let* iter = extract_strings ~filename js_file_errors template_script [ lang ] in
           print_iter iter
         | Html { length = Some len; _ }, Pug -> Lwt_io.printlf "<HTML code - %d bytes>" len
@@ -147,7 +143,7 @@ let debug_template ~filename languages template_script target =
       languages
   in
   Lwt_io.printl
-    (Queue.to_array js_file_errors |> Array.map ~f:Failed.to_string |> String.concat_array ~sep:"\n")
+    (Queue.to_array js_file_errors |> Array.map ~f:Utils.Failed.to_string |> String.concat_array ~sep:"\n")
 
 let parse ~filename ic =
   let open Angstrom in

diff --git a/src/parsing/basic.ml b/src/parsing/basic.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 open Angstrom
 
 let lowercase = function

diff --git a/src/parsing/dune b/src/parsing/dune
@@ -6,6 +6,7 @@
     lwt
     SZXX
 
+    utils
     flow_parser
   )
   (preprocess (pps

diff --git a/src/parsing/failed.ml b/src/parsing/failed.ml
diff --git a/src/parsing/html.ml b/src/parsing/html.ml
@@ -1,13 +1,18 @@
 open! Core
 open SZXX
 
-let parser =
-  Angstrom.many
-    Xml.(make_parser { accept_html_boolean_attributes = true; accept_unquoted_attributes = true })
-
-let finalize ~filename ll =
+let finalize ll =
   List.fold_result ll ~init:Xml.SAX.To_DOM.init ~f:(fun acc x ->
       Xml.SAX.To_DOM.folder ~strict:false (Ok acc) x)
   |> function
-  | Error err -> failwithf "Syntax error in %s: %s" filename err ()
-  | Ok Xml.SAX.To_DOM.{ top; _ } -> top
+  | Error _ as err -> err
+  | Ok Xml.SAX.To_DOM.{ top = None; _ } -> Error "No root HTML element"
+  | Ok Xml.SAX.To_DOM.{ top = Some x; _ } -> Ok x
+
+let parser =
+  let open Angstrom in
+  many Xml.(make_parser { accept_html_boolean_attributes = true; accept_unquoted_attributes = true })
+  >>= fun ll ->
+  match finalize ll with
+  | Ok x -> return x
+  | Error msg -> fail msg
diff --git a/src/parsing/js_ast.ml b/src/parsing/js_ast.ml
@@ -1,5 +1,6 @@
-open Core
+open! Core
 open Flow_ast
+open Utils
 
 let extract strings stmts =
   let rec extract_expr_or_spread = function

diff --git a/src/parsing/pug.ml b/src/parsing/pug.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 
 type identifier = { parts: string list } [@@deriving yojson, sexp]
 
@@ -31,7 +31,7 @@ type line =
 
 type lines = (int * line) list [@@deriving yojson, sexp]
 
-type nodes = node array [@@deriving yojson, sexp]
+type t = node array [@@deriving yojson, sexp]
 
 let rollup (lines : lines) =
   let rec loop lvl acc_nodes acc_text = function

diff --git a/src/parsing/pug.mli b/src/parsing/pug.mli
@@ -0,0 +1,28 @@
+open! Core
+
+type identifier = { parts: string list } [@@deriving yojson, sexp]
+
+type selector =
+  | Element of identifier
+  | Class   of identifier
+  | Id      of identifier
+[@@deriving yojson, sexp]
+
+type argument = {
+  prefix: string option;
+  identifier: identifier;
+  contents: string option;
+}
+[@@deriving yojson, sexp]
+
+type node = {
+  selector: selector;
+  arguments: argument list;
+  text: string option;
+  children: node array;
+}
+[@@deriving yojson, sexp]
+
+type t = node array [@@deriving yojson, sexp]
+
+val parser : node array Angstrom.t
diff --git a/src/parsing/script.ml b/src/parsing/script.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 
 type raw =
   | JS of string

diff --git a/src/parsing/strings.ml b/src/parsing/strings.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 
 type line =
   | Translation of (string * string)

diff --git a/src/parsing/template.ml b/src/parsing/template.ml
@@ -1,4 +1,4 @@
-open Core
+open! Core
 
 type raw =
   | HTML of string

diff --git a/src/quickjs/quickjs.ml b/src/quickjs/quickjs.ml
@@ -1,23 +1,18 @@
-open Core
+open! Core
 open Lwt.Infix
 open Lwt.Syntax
 
-type pug_response = {
-  strings: string array;
-  possible_js: string array;
-}
-
 type _ kind =
   | Typescript : string array kind
-  | Pug : pug_response kind
+  | Pug : Utils.Parsed.t kind
 
 let fn_name_of_kind (type a) : a kind -> string = function
 | Typescript -> "extractFromTypeScript"
 | Pug -> "extractFromPug"
 
 external stub_init_contexts : int -> (unit, string) Result.t = "stub_init_contexts"
 
-external stub_extract : int -> string -> fn_name:string -> (string array * string array, string) Result.t
+external stub_extract : int -> string -> fn_name:string -> (Utils.Parsed.t, string) Result.t
   = "stub_extract"
 
 let num_threads = 4
@@ -47,8 +42,8 @@ let extract (type a) code (kind : a kind) : a Lwt.t =
   Lwt_pool.use js_contexts (fun id -> Lwt_preemptive.detach (fun () -> stub_extract id code ~fn_name) ())
   >|= function
   | Error msg -> failwith msg
-  | Ok (strings, possible_js) ->
+  | Ok { strings; possible_scripts } ->
     (match kind with
      | Typescript -> strings
-     | Pug -> { strings; possible_js }
+     | Pug -> { strings; possible_scripts }
       : a)
diff --git a/src/utils/utils.ml b/src/utils/utils.ml
@@ -1,4 +1,21 @@
-open Core
+open! Core
+
+module Failed = struct
+  type t = {
+    filename: string;
+    message: string;
+  }
+
+  let to_string { filename; message } = sprintf "Parsing error in %s:\n%s" filename message
+end
+
+module Parsed = struct
+  type t = {
+    strings: string array;
+    possible_scripts: string array;
+  }
+  [@@deriving sexp]
+end
 
 module Exception = struct
   let human = function
-Original file line number
+Diff line change
@@ Expand Up / @@ -6,6 +6,7 @@ @@
         lwt
         SZXX
+        utils
         flow_parser
       )
       (preprocess (pps
@@ Expand Down @@