Source file res_tailwindcss.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
module Expansion_context = Ppxlib.Expansion_context
module Ast_builder = Ppxlib.Ast_builder
module Ast_pattern = Ppxlib.Ast_pattern
module Extension = Ppxlib.Extension
open Lexing
open Core
open Util
open Spelling_corrector

module Parser = struct
  let print_position outx lexbuf =
    let pos = lexbuf.lex_curr_p in
    fprintf outx "%s:%d:%d" pos.pos_fname pos.pos_lnum
      (pos.pos_cnum - pos.pos_bol + 1)

  let parse_with_error lexbuf =
    try Parser.prog Lexer.read lexbuf with
    | Lexer.SyntaxError msg ->
        fprintf stderr "%a: %s\n" print_position lexbuf msg;
        exit (-1)
    | Parser.Error ->
        fprintf stderr "%a: syntax error\n" print_position lexbuf;
        exit (-1)

  let rec run lexbuf tailwindcss =
    match parse_with_error lexbuf with
    | Some (Class value) ->
        make_words tailwindcss value;
        run lexbuf tailwindcss
    | None -> tailwindcss
end

let loop filename classnames ~loc =
  let inx = In_channel.create filename in
  let lexbuf = Lexing.from_channel inx in
  set_filename lexbuf filename;

  let init_words = init_words ~size:1000 in
  let tailwind_classnames = Parser.run lexbuf init_words in

  let is_valid =
    classnames |> List.for_all ~f:(Hashtbl.mem tailwind_classnames)
  in
  if is_valid then In_channel.close inx
  else
    let not_found =
      classnames
      |> List.find_exn ~f:(fun c -> not (Hashtbl.mem tailwind_classnames c))
    in
    let corrected =
      Spelling_corrector.correction tailwind_classnames not_found
    in
    let _ =
      (* if corrected is same to not found classname, this means we can not find the suggestion *)
      if String.equal not_found corrected then
        Location.raise_errorf ~loc "Class name not found: %s" not_found
      else
        Location.raise_errorf ~loc "Class name not found: %s, do you mean %s?"
          not_found corrected
    in
    In_channel.close inx

let expand ~ctxt label =
  let loc = Expansion_context.Extension.extension_point_loc ctxt in
  let stripped_label = String.strip label in
  (* if label is emtpy string then pass it *)
  if String.length stripped_label = 0 then
    Ast_builder.Default.estring ~loc label
  else
    let classnames = stripped_label |> Str.split (Str.regexp "[ \t]+") in
    let project_root = find_project_root @@ Sys.getcwd () in
    match project_root with
    | Ok project_root' ->
        let tailwindcss_path =
          Filename.concat project_root' !(Configs.get_tailwindcss_path ())
        in
        loop tailwindcss_path classnames ~loc;
        Ast_builder.Default.estring ~loc label
    | Error msg ->
        fprintf stderr "%s\n" msg;
        exit (-1)

let extension =
  Extension.V3.declare "twc" Extension.Context.expression
    Ast_pattern.(single_expr_payload (estring __))
    expand

let rule = Ppxlib.Context_free.Rule.extension extension

(** Add command line arg "--path" to get a path of tailwindcss file *)
let _ =
  Ppxlib.Driver.add_arg "--path"
    (Caml.Arg.String
       (fun tailwind_path -> Configs.set_tailwindcss_path tailwind_path))
    ~doc:""

let () = Ppxlib.Driver.register_transformation ~rules:[ rule ] "res_tailwindcss"