Restore styled-ppx.generate CLI for static CSS extraction

Author: davesnx

packages/generate/dune

@@ -0,0 +1,7 @@
+(executable
+ (name generate)
+ (public_name styled-ppx.generate)
+ (modules generate)
+ (libraries styled-ppx ppxlib ppxlib.astlib)
+ (preprocess
+  (pps ppxlib.metaquot)))

packages/generate/generate.ml

@@ -0,0 +1,91 @@
+module String_map = Map.Make (String)
+
+let of_structure ~verbose ~filename structure stylesheet =
+  let get_string (e : Ppxlib.expression) =
+    match e.pexp_desc with
+    | Pexp_constant (Pconst_string (v, _, None)) -> Some v
+    | _ -> None
+  in
+  List.fold_left
+    (fun stylesheet item ->
+      match item with
+      | [%stri [@@@css [%e? value]]] ->
+        (match get_string value with
+        | Some v ->
+          if verbose then (
+            Format.eprintf "Adding %a\n" Ppxlib.Pprintast.expression value;
+            Printf.eprintf "Adding %s\n" v);
+          String_map.add filename v stylesheet
+        | None -> stylesheet)
+      | _ -> stylesheet)
+    stylesheet structure
+
+let of_pp_ml ~verbose ~filename stylesheet =
+  match Ppxlib.Ast_io.read_binary filename with
+  | Error msg ->
+    if verbose then Printf.eprintf "Error reading file %s: %s\n" filename msg;
+    stylesheet
+  | Ok t ->
+    (match Ppxlib.Ast_io.get_ast t with
+    | Impl structure -> of_structure ~verbose ~filename structure stylesheet
+    | Intf _ -> stylesheet)
+
+let of_ml ~verbose ~filename stylesheet =
+  try
+    let ic = open_in filename in
+    let len = in_channel_length ic in
+    let content = really_input_string ic len in
+    close_in ic;
+    let lexbuf = Lexing.from_string content in
+    lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename };
+    let structure = Ppxlib.Parse.implementation lexbuf in
+    of_structure ~verbose ~filename structure stylesheet
+  with
+  | Sys_error msg ->
+    if verbose then Printf.eprintf "Error reading file %s: %s\n" filename msg;
+    stylesheet
+  | exn ->
+    if verbose then
+      Printf.eprintf "Error parsing file %s: %s\n" filename
+        (Printexc.to_string exn);
+    stylesheet
+
+let extract_stylesheet ~verbose input_files =
+  List.fold_left
+    (fun stylesheet filename ->
+      if verbose then Printf.eprintf "Processing %s...\n" filename;
+      if String.ends_with filename ~suffix:".css" then
+        failwith "Extracting from .css files is not supported yet"
+      else if String.ends_with filename ~suffix:".pp.ml" then
+        of_pp_ml ~verbose ~filename stylesheet
+      else if String.ends_with filename ~suffix:".ml" then
+        of_ml ~verbose ~filename stylesheet
+      else failwith "Expected .css, .ml or .pp.ml file")
+    String_map.empty input_files
+
+let parse_args args =
+  let rec parse acc output_file verbose = function
+    | "-o" :: file :: rest
+    | "-output" :: file :: rest
+    | "--output" :: file :: rest ->
+      parse acc (Some file) verbose rest
+    | "-v" :: rest | "-verbose" :: rest | "--verbose" :: rest ->
+      parse acc output_file true rest
+    | arg :: rest -> parse (arg :: acc) output_file verbose rest
+    | [] -> List.rev acc, output_file, verbose
+  in
+  parse [] None false (Array.to_list args |> List.tl)
+
+let () =
+  let input_files, output_file, verbose = parse_args Sys.argv in
+  if verbose then (
+    Printf.eprintf "Extracting stylesheets...\n";
+    Printf.eprintf "Input files: %i\n" (List.length input_files));
+  let stylesheet = extract_stylesheet ~verbose input_files in
+  let out_channel =
+    match output_file with Some file -> open_out file | None -> Stdlib.stdout
+  in
+  Stdlib.output_string out_channel
+    "/* This file is generated by styled-ppx, do not edit manually */\n";
+  String_map.iter (fun _ v -> Stdlib.output_string out_channel v) stylesheet;
+  match output_file with Some _ -> close_out out_channel | None -> ()