refactor: make stanzas private (#9362)

This requires going through a functor to construct all stanzas. The capability will be useful to eliminate physical equality for stanzas. Signed-off-by: Rudi Grinberg <[email protected]>
ocaml · Dec 3, 2023 · 53499cd · 53499cd
1 parent a97b394
commit 53499cd
Show file tree

Hide file tree

Showing 31 changed files with 224 additions and 128 deletions.
diff --git a/bin/describe/describe_external_lib_deps.ml b/bin/describe/describe_external_lib_deps.ml
@@ -149,7 +149,7 @@ let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system)
     Memo.parallel_map dune_file.stanzas ~f:(fun stanza ->
       let dir = dune_file.dir in
       match stanza with
-      | Dune_rules.Dune_file.Executables exes ->
+      | Dune_rules.Dune_file.Executables.T exes ->
         let* ocaml = Context.ocaml context in
         resolve_libs
           db
@@ -161,7 +161,7 @@ let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system)
           Item.Kind.Executables
           (exes_extensions ocaml.lib_config exes.modes)
         >>| List.singleton
-      | Dune_rules.Dune_file.Library lib ->
+      | Dune_rules.Dune_file.Library.T lib ->
         resolve_libs
           db
           dir
@@ -172,7 +172,7 @@ let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system)
           Item.Kind.Library
           []
         >>| List.singleton
-      | Dune_rules.Dune_file.Tests tests ->
+      | Dune_rules.Dune_file.Tests.T tests ->
         let* ocaml = Context.ocaml context in
         resolve_libs
           db

diff --git a/bin/describe/describe_pp.ml b/bin/describe/describe_pp.ml
@@ -62,7 +62,7 @@ let get_pped_file super_context file =
            dune_file.stanzas
            |> List.fold_left ~init:None ~f:(fun acc stanza ->
              match stanza with
-             | Dune_rules.Dune_file.Library lib ->
+             | Dune_rules.Dune_file.Library.T lib ->
                let preprocess =
                  Dune_rules.Preprocess.Per_module.(
                    lib.buildable.preprocess |> single_preprocess)

diff --git a/bin/describe/describe_workspace.ml b/bin/describe/describe_workspace.ml
@@ -537,7 +537,7 @@ module Crawl = struct
         Memo.parallel_map dune_file.stanzas ~f:(fun stanza ->
           let dir = Path.Build.append_source (Context.build_dir context) dune_file.dir in
           match stanza with
-          | Dune_file.Executables exes ->
+          | Dune_file.Executables.T exes ->
             executables sctx ~options ~project:dune_file.project ~dir exes
           | _ -> Memo.return None)
         >>| List.filter_opt)

diff --git a/bin/dune_init.ml b/bin/dune_init.ml
@@ -54,9 +54,9 @@ module File = struct
     let stanzas_conflict (a : Stanza.t) (b : Stanza.t) =
       let open Dune_file in
       match a, b with
-      | Executables a, Executables b -> executables_conflict a b
-      | Library a, Library b -> libraries_conflict a b
-      | Tests a, Tests b -> tests_conflict a b
+      | Executables.T a, Executables.T b -> executables_conflict a b
+      | Library.T a, Library.T b -> libraries_conflict a b
+      | Tests.T a, Tests.T b -> tests_conflict a b
       (* NOTE No other stanza types currently supported *)
       | _ -> false
     ;;

diff --git a/src/dune_lang/stanza.ml b/src/dune_lang/stanza.ml
@@ -3,6 +3,13 @@ open Dune_sexp
 
 type t = ..
 
+module Make (S : sig
+    type t
+  end) =
+struct
+  type t += T of S.t
+end
+
 module Parser = struct
   type nonrec t = string * t list Decoder.t
 end

diff --git a/src/dune_lang/stanza.mli b/src/dune_lang/stanza.mli
@@ -3,7 +3,13 @@
 open! Stdune
 open Dune_sexp
 
-type t = ..
+type t = private ..
+
+module Make (S : sig
+    type t
+  end) : sig
+  type t += T of S.t
+end
 
 val latest_version : Syntax.Version.t
 

diff --git a/src/dune_rules/artifacts_db.ml b/src/dune_rules/artifacts_db.ml
@@ -67,9 +67,9 @@ let get_installed_binaries ~(context : Context.t) stanzas =
     in
     Memo.List.map d.stanzas ~f:(fun stanza ->
       match (stanza : Stanza.t) with
-      | Dune_file.Install { section = Section Bin; files; _ } ->
+      | Dune_file.Install_conf.T { section = Section Bin; files; _ } ->
         binaries_from_install files
-      | Dune_file.Executables
+      | Dune_file.Executables.T
           ({ install_conf = Some { section = Section Bin; files; _ }; _ } as exes) ->
         let* available =
           let* enabled_if =

diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml
@@ -15,7 +15,9 @@ type t =
 let name = "cinaps"
 let cinaps_alias = Alias.Name.of_string name
 
-type Stanza.t += T of t
+include Stanza.Make (struct
+    type nonrec t = t
+  end)
 
 let syntax =
   Dune_lang.Syntax.create

diff --git a/src/dune_rules/coq/coq_stanza.ml b/src/dune_rules/coq/coq_stanza.ml
@@ -44,7 +44,9 @@ module Coqpp = struct
        { modules; loc })
   ;;
 
-  type Stanza.t += T of t
+  include Stanza.Make (struct
+      type nonrec t = t
+    end)
 
   let p = "coq.pp", decode >>| fun x -> [ T x ]
 end
@@ -129,7 +131,9 @@ module Extraction = struct
        { prelude; extracted_modules; buildable })
   ;;
 
-  type Stanza.t += T of t
+  include Stanza.Make (struct
+      type nonrec t = t
+    end)
 
   let p = "coq.extraction", decode >>| fun x -> [ T x ]
 end
@@ -230,7 +234,9 @@ module Theory = struct
        })
   ;;
 
-  type Stanza.t += T of t
+  include Stanza.Make (struct
+      type nonrec t = t
+    end)
 
   let coqlib_warn x =
     User_warning.emit

diff --git a/src/dune_rules/cram/cram_stanza.ml b/src/dune_rules/cram/cram_stanza.ml
@@ -31,7 +31,9 @@ type t =
   ; runtest_alias : (Loc.t * bool) option
   }
 
-type Stanza.t += T of t
+include Stanza.Make (struct
+    type nonrec t = t
+  end)
 
 let decode =
   fields

diff --git a/src/dune_rules/ctypes/ctypes_field.ml b/src/dune_rules/ctypes/ctypes_field.ml
@@ -149,7 +149,9 @@ type t =
   ; version : Syntax.Version.t
   }
 
-type Stanza.t += T of t
+include Stanza.Make (struct
+    type nonrec t = t
+  end)
 
 let decode =
   let open Dune_lang.Decoder in

diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml
@@ -129,7 +129,7 @@ let build_mlds_map stanzas ~dir ~files =
       |> Memo.return)
   in
   Memo.parallel_map stanzas ~f:(function
-    | Documentation doc ->
+    | Documentation.T doc ->
       let+ mlds =
         let+ mlds = Memo.Lazy.force mlds in
         Ordered_set_lang.Unordered_string.eval
@@ -194,19 +194,19 @@ end = struct
           | Coq_stanza.Extraction.T s ->
             Memo.return (Coq_stanza.Extraction.ml_target_fnames s)
           | Menhir_stanza.T menhir -> Memo.return (Menhir_stanza.targets menhir)
-          | Rule rule ->
+          | Rule.T rule ->
             Simple_rules.user_rule sctx rule ~dir ~expander
             >>| (function
              | None -> []
              | Some targets ->
                (* CR-someday amokhov: Do not ignore directory targets. *)
                Path.Build.Set.to_list_map targets.files ~f:Path.Build.basename)
-          | Copy_files def ->
+          | Copy_files.T def ->
             Simple_rules.copy_files sctx def ~src_dir ~dir ~expander
             >>| Path.Set.to_list_map ~f:Path.basename
           | Generate_sites_module_stanza.T def ->
             Generate_sites_module_rules.setup_rules sctx ~dir def >>| List.singleton
-          | Library { buildable; _ } | Executables { buildable; _ } ->
+          | Library.T { buildable; _ } | Executables.T { buildable; _ } ->
             let select_deps_files = select_deps_files buildable.libraries in
             let ctypes_files =
               (* Also manually add files generated by ctypes rules. *)

diff --git a/src/dune_rules/dir_status.ml b/src/dune_rules/dir_status.ml
@@ -56,7 +56,7 @@ let current_group dir = function
 let get_include_subdirs stanzas =
   List.fold_left stanzas ~init:None ~f:(fun acc stanza ->
     match stanza with
-    | Include_subdirs (loc, x) ->
+    | Include_subdirs.T (loc, x) ->
       if Option.is_some acc
       then
         User_error.raise
@@ -70,9 +70,9 @@ let find_module_stanza stanzas =
   List.find_map stanzas ~f:(fun stanza ->
     match stanza with
     | Melange_stanzas.Emit.T { loc; _ }
-    | Library { buildable = { loc; _ }; _ }
-    | Executables { buildable = { loc; _ }; _ }
-    | Tests { exes = { buildable = { loc; _ }; _ }; _ } -> Some loc
+    | Library.T { buildable = { loc; _ }; _ }
+    | Executables.T { buildable = { loc; _ }; _ }
+    | Tests.T { exes = { buildable = { loc; _ }; _ }; _ } -> Some loc
     | _ -> None)
 ;;
 
@@ -92,7 +92,7 @@ let error_no_module_consumer ~loc (qualification : Include_subdirs.qualification
 let extract_directory_targets ~dir stanzas =
   Memo.List.fold_left stanzas ~init:Path.Build.Map.empty ~f:(fun acc stanza ->
     match stanza with
-    | Rule { targets = Static { targets = l; _ }; loc = rule_loc; _ } ->
+    | Rule.T { targets = Static { targets = l; _ }; loc = rule_loc; _ } ->
       List.fold_left l ~init:acc ~f:(fun acc (target, kind) ->
         let loc = String_with_vars.loc target in
         match (kind : Targets_spec.Kind.t) with

diff --git a/src/dune_rules/dune_env.ml b/src/dune_rules/dune_env.ml
@@ -322,4 +322,6 @@ let fire_hooks t ~profile =
       User_warning.emit ?loc paragraphs))
 ;;
 
-type Stanza.t += T of t
+include Stanza.Make (struct
+    type nonrec t = t
+  end)