test: give every dialect directive a case and a verdict

bin/main.ml

@@ -233,97 +233,14 @@ let print_stats ~quiet ~candidate_count ~known_count =
     Fmt.epr "Candidate tokens scanned: %d@." candidate_count;
     Fmt.epr "Successfully parsed: %d@." known_count)
 
-(* [prose] comes from @tailwindcss/typography, which Tailwind only applies when
-   the entrypoint asks for it. A project that styles [.prose] itself, as
-   tailwindcss.com does, gets the plugin's whole stylesheet on top otherwise. *)
-let declares_plugin css name =
-  match css with
-  | None -> false
-  | Some css -> Re.execp (Re.compile (Re.str ("@tailwindcss/" ^ name))) css
-
-let is_prose_class cls =
-  cls = "prose"
-  || String.starts_with ~prefix:"prose-" cls
-  ||
-  (* variants keep the utility at the end: [lg:prose-sm] *)
-  match String.rindex_opt cls ':' with
-  | Some i ->
-      let bare = String.sub cls (i + 1) (String.length cls - i - 1) in
-      bare = "prose" || String.starts_with ~prefix:"prose-" bare
-  | None -> false
-
-let parse_known_candidates ?(theme = Tw.Scheme.default) ?input_css candidates =
-  let typography = declares_plugin input_css "typography" in
-  List.filter_map
-    (fun cls ->
-      if (not typography) && is_prose_class cls then None
-      else
-        match Tw.of_string ~theme cls with
-        | Ok style -> (
-            (* A handler may accept a class at parse yet raise when it renders
-               an arbitrary value it cannot serialise, as the docs'
-               [prop-[<value>]] placeholders do. Such a class produces no rule,
-               so drop it rather than let it abort the whole sheet. *)
-            match Tw.to_css ~theme [ style ] with
-            | (_ : Css.t) -> Some (cls, style)
-            | exception
-                (Invalid_argument _ | Failure _ | Cascade.Error.Parse_error _)
-              ->
-                None)
-        | Error _ -> None)
-    candidates
-
 let scanned_classes paths =
   collect_files paths
   |> List.concat_map Tw_tools.Source_scan.candidates_from_file
   |> List.sort_uniq String.compare
 
-(* The whole sheet tw generates for a scanned project: the built-in utilities,
-   the classes the project's own [@utility] and [@custom-variant] declarations
-   route, and the entrypoint all of it is spliced into. A comparison against the
-   real Tailwind has to be made against this, not against the built-in utilities
-   alone: Tailwind reads the same entrypoint, so every declared utility would
-   otherwise read as a rule tw failed to emit. *)
 let native_stylesheet ~(opts : gen_opts) ~include_base all_classes =
-  let defs = Entrypoint.entry_variant_defs opts.input_css_path in
-  let udefs = Entrypoint.entry_utility_defs opts.input_css_path in
-  let routed, normal =
-    List.partition (Entrypoint.is_custom_routed ~defs ~udefs) all_classes
-  in
-  let known =
-    parse_known_candidates ~theme:opts.theme ?input_css:opts.input_css normal
-  in
-  let routed_count, routed_extra, routed_stmts =
-    Entrypoint.custom_routed_utilities ~theme:opts.theme ~defs ~udefs routed
-  in
-  (* Routed custom variants no longer pass through the typed modifier parser,
-     but the sorter still needs their exact names so a declaration such as
-     [not-dark] is not mistaken for the built-in [not-] compound slot. Dummy
-     selector values are sufficient here: routed candidates already carry the
-     expanded author CSS in [extra], and only the registered names are read. *)
-  let sort_theme =
-    let custom = Tw.Scheme.{ values = [ ("", "&") ]; template = "{}" } in
-    let custom_variants =
-      List.fold_left
-        (fun variants (name, _) ->
-          if List.mem_assoc name variants then variants
-          else (name, custom) :: variants)
-        opts.theme.custom_variants defs
-    in
-    { opts.theme with custom_variants }
-  in
-  let stylesheet =
-    Tw.to_css ~theme:sort_theme ~base:include_base ~extra:routed_extra
-      (List.map snd known)
-  in
-  let stylesheet = Entrypoint.place_routed routed_stmts stylesheet in
-  let stylesheet =
-    match opts.input_css_path with
-    | Some path ->
-        Entrypoint.splice_into_entrypoint ~theme:opts.theme ~path stylesheet
-    | None -> stylesheet
-  in
-  (List.length known + routed_count, stylesheet)
+  Tw_tools.Project.stylesheet ~theme:opts.theme ?entrypoint:opts.input_css_path
+    ~base:include_base all_classes
 
 let diff_files paths ~(opts : gen_opts) =
   try

lib/tools/project.ml

@@ -0,0 +1,81 @@
+(* [prose] comes from @tailwindcss/typography, which Tailwind only applies when
+   the entrypoint asks for it. A project that styles [.prose] itself, as
+   tailwindcss.com does, gets the plugin's whole stylesheet on top otherwise. *)
+let declares_plugin css name =
+  match css with
+  | None -> false
+  | Some css -> Re.execp (Re.compile (Re.str ("@tailwindcss/" ^ name))) css
+
+let is_prose_class cls =
+  cls = "prose"
+  || String.starts_with ~prefix:"prose-" cls
+  ||
+  (* variants keep the utility at the end: [lg:prose-sm] *)
+  match String.rindex_opt cls ':' with
+  | Some i ->
+      let bare = String.sub cls (i + 1) (String.length cls - i - 1) in
+      bare = "prose" || String.starts_with ~prefix:"prose-" bare
+  | None -> false
+
+let parse_known_candidates ~theme ?input_css candidates =
+  let typography = declares_plugin input_css "typography" in
+  List.filter_map
+    (fun cls ->
+      if (not typography) && is_prose_class cls then None
+      else
+        match Tw.of_string ~theme cls with
+        | Ok style -> (
+            (* A handler may accept a class at parse yet raise when it renders
+               an arbitrary value it cannot serialise, as the docs'
+               [prop-[<value>]] placeholders do. Such a class produces no rule,
+               so drop it rather than let it abort the whole sheet. *)
+            match Tw.to_css ~theme [ style ] with
+            | (_ : Cascade.Css.t) -> Some (cls, style)
+            | exception
+                (Invalid_argument _ | Failure _ | Cascade.Error.Parse_error _)
+              ->
+                None)
+        | Error _ -> None)
+    candidates
+
+(* A comparison against the real Tailwind has to be made against the whole of
+   this, not against the built-in utilities alone: Tailwind reads the same
+   entrypoint, so every declared utility would otherwise read as a rule tw
+   failed to emit. *)
+let stylesheet ~theme ?entrypoint ~base classes =
+  let input_css = Option.map Entrypoint.read_file entrypoint in
+  let defs = Entrypoint.entry_variant_defs entrypoint in
+  let udefs = Entrypoint.entry_utility_defs entrypoint in
+  let routed, normal =
+    List.partition (Entrypoint.is_custom_routed ~defs ~udefs) classes
+  in
+  let known = parse_known_candidates ~theme ?input_css normal in
+  let routed_count, routed_extra, routed_stmts =
+    Entrypoint.custom_routed_utilities ~theme ~defs ~udefs routed
+  in
+  (* Routed custom variants no longer pass through the typed modifier parser,
+     but the sorter still needs their exact names so a declaration such as
+     [not-dark] is not mistaken for the built-in [not-] compound slot. Dummy
+     selector values are sufficient here: routed candidates already carry the
+     expanded author CSS in [extra], and only the registered names are read. *)
+  let sort_theme =
+    let custom = Tw.Scheme.{ values = [ ("", "&") ]; template = "{}" } in
+    let custom_variants =
+      List.fold_left
+        (fun variants (name, _) ->
+          if List.mem_assoc name variants then variants
+          else (name, custom) :: variants)
+        theme.Tw.Scheme.custom_variants defs
+    in
+    { theme with custom_variants }
+  in
+  let sheet =
+    Tw.to_css ~theme:sort_theme ~base ~extra:routed_extra (List.map snd known)
+  in
+  let sheet = Entrypoint.place_routed routed_stmts sheet in
+  let sheet =
+    match entrypoint with
+    | Some path -> Entrypoint.splice_into_entrypoint ~theme ~path sheet
+    | None -> sheet
+  in
+  (List.length known + routed_count, sheet)

lib/tools/project.mli

@@ -0,0 +1,17 @@
+(** The stylesheet [tw] generates for a whole project.
+
+    One function, so the CLI and anything measuring the CLI against Tailwind
+    compile a project the same way rather than two ways that drift. *)
+
+val stylesheet :
+  theme:Tw.Scheme.t ->
+  ?entrypoint:string ->
+  base:bool ->
+  string list ->
+  int * Cascade.Css.t
+(** [stylesheet ~theme ?entrypoint ~base classes] is the sheet for a project
+    whose markup carries [classes], with how many of them produced a rule: the
+    built-in utilities, the classes the entrypoint's own [@utility] and
+    [@custom-variant] declarations route, and the entrypoint at path
+    [entrypoint] all of it is spliced into. The base layer is included when
+    [base]. A class no handler reads is left out rather than raising. *)