feat(melange): support (select ...) in melange.emit (ocaml#7239)

* feat(melange): support `(select ...)` in `melange.emit`

Signed-off-by: Antonio Nuno Monteiro <[email protected]>

src/dune_rules/cinaps.ml

@@ -32,7 +32,7 @@ let decode =
        field "files" Predicate_lang.Glob.decode ~default:Predicate_lang.any
      and+ preprocess, preprocessor_deps = Stanza_common.preprocess_fields
      and+ libraries =
-       field "libraries" (Dune_file.Lib_deps.decode Executable) ~default:[]
+       field "libraries" (Lib_dep.L.decode ~allow_re_export:false) ~default:[]
      and+ runtime_deps =
        field ~default:[] "runtime_deps"
          (Dune_lang.Syntax.since syntax (1, 1) >>> repeat Dep_conf.decode)

src/dune_rules/dir_contents.ml

@@ -132,6 +132,14 @@ end = struct
 
   (* As a side-effect, setup user rules and copy_files rules. *)
   let load_text_files sctx st_dir stanzas ~dir ~src_dir =
+    let select_deps_files libraries =
+      (* Manually add files generated by the (select ...)
+         dependencies *)
+      List.filter_map libraries ~f:(fun dep ->
+          match (dep : Lib_dep.t) with
+          | Re_export _ | Direct _ -> None
+          | Select s -> Some s.result_fn)
+    in
     (* Interpret a few stanzas in order to determine the list of files generated
        by the user. *)
     let* expander =
@@ -163,21 +171,17 @@ end = struct
             let+ res = Generate_sites_module_rules.setup_rules sctx ~dir def in
             [ res ]
           | Library { buildable; _ } | Executables { buildable; _ } ->
-            let select_deps_files =
-              (* Manually add files generated by the (select ...)
-                 dependencies *)
-              List.filter_map buildable.libraries ~f:(fun dep ->
-                  match (dep : Lib_dep.t) with
-                  | Re_export _ | Direct _ -> None
-                  | Select s -> Some s.result_fn)
-            in
+            let select_deps_files = select_deps_files buildable.libraries in
             let ctypes_files =
               (* Also manually add files generated by ctypes rules. *)
               match buildable.ctypes with
               | None -> []
               | Some ctypes -> Ctypes_field.generated_ml_and_c_files ctypes
             in
             Memo.return (select_deps_files @ ctypes_files)
+          | Melange_stanzas.Emit.T { libraries; _ } ->
+            let select_deps_files = select_deps_files libraries in
+            Memo.return select_deps_files
           | _ -> Memo.return [])
       >>| fun l -> String.Set.of_list (List.concat l)
     in

src/dune_rules/dune_file.ml

@@ -29,66 +29,6 @@ type for_ =
   | Executable
   | Library of Wrapped.t option
 
-module Lib_deps = struct
-  type t = Lib_dep.t list
-
-  type kind =
-    | Required
-    | Optional
-    | Forbidden
-
-  let decode for_ =
-    let+ loc = loc
-    and+ t =
-      let allow_re_export =
-        match for_ with
-        | Library _ -> true
-        | Executable -> false
-      in
-      repeat (Lib_dep.decode ~allow_re_export)
-    in
-    let add kind name acc =
-      match Lib_name.Map.find acc name with
-      | None -> Lib_name.Map.set acc name kind
-      | Some kind' -> (
-        match (kind, kind') with
-        | Required, Required ->
-          User_error.raise ~loc
-            [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ]
-        | (Optional | Forbidden), (Optional | Forbidden) -> acc
-        | Optional, Required | Required, Optional ->
-          User_error.raise ~loc
-            [ Pp.textf
-                "library %S is present both as an optional and required \
-                 dependency"
-                (Lib_name.to_string name)
-            ]
-        | Forbidden, Required | Required, Forbidden ->
-          User_error.raise ~loc
-            [ Pp.textf
-                "library %S is present both as a forbidden and required \
-                 dependency"
-                (Lib_name.to_string name)
-            ])
-    in
-    ignore
-      (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x ->
-           match x with
-           | Lib_dep.Re_export (_, s) | Lib_dep.Direct (_, s) ->
-             add Required s acc
-           | Select { choices; _ } ->
-             List.fold_left choices ~init:acc
-               ~f:(fun acc (c : Lib_dep.Select.Choice.t) ->
-                 let acc =
-                   Lib_name.Set.fold c.required ~init:acc ~f:(add Optional)
-                 in
-                 Lib_name.Set.fold c.forbidden ~init:acc ~f:(add Forbidden)))
-        : kind Lib_name.Map.t);
-    t
-
-  let of_pps pps = List.map pps ~f:(fun pp -> Lib_dep.direct (Loc.none, pp))
-end
-
 module Buildable = struct
   type t =
     { loc : Loc.t
@@ -165,7 +105,13 @@ module Buildable = struct
               (Dune_lang.Syntax.deleted_in Stanza.syntax (2, 0)
                  ~extra_info:"Use the (foreign_archives ...) field instead."
               >>> enter (maybe string))))
-    and+ libraries = field "libraries" (Lib_deps.decode for_) ~default:[]
+    and+ libraries =
+      let allow_re_export =
+        match for_ with
+        | Library _ -> true
+        | Executable -> false
+      in
+      field "libraries" (Lib_dep.L.decode ~allow_re_export) ~default:[]
     and+ flags = Ocaml_flags.Spec.decode
     and+ js_of_ocaml =
       field "js_of_ocaml" Js_of_ocaml.In_buildable.decode

src/dune_rules/dune_file.mli

@@ -12,14 +12,6 @@ type for_ =
   | Executable
   | Library of Wrapped.t option
 
-module Lib_deps : sig
-  type nonrec t = Lib_dep.t list
-
-  val of_pps : Lib_name.t list -> t
-
-  val decode : for_ -> t Dune_lang.Decoder.t
-end
-
 module Buildable : sig
   type t =
     { loc : Loc.t

src/dune_rules/lib_dep.ml

@@ -143,7 +143,58 @@ let encode =
       [ ("select", Select.to_dyn select) ]
 
 module L = struct
+  type kind =
+    | Required
+    | Optional
+    | Forbidden
+
+  type nonrec t = t list
+
   let field_encode t ~name =
     let open Dune_lang.Encoder in
     field_l name encode t
+
+  let decode ~allow_re_export =
+    let open Dune_lang.Decoder in
+    let+ loc = loc
+    and+ t = repeat (decode ~allow_re_export) in
+    let add kind name acc =
+      match Lib_name.Map.find acc name with
+      | None -> Lib_name.Map.set acc name kind
+      | Some kind' -> (
+        match (kind, kind') with
+        | Required, Required ->
+          User_error.raise ~loc
+            [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ]
+        | (Optional | Forbidden), (Optional | Forbidden) -> acc
+        | Optional, Required | Required, Optional ->
+          User_error.raise ~loc
+            [ Pp.textf
+                "library %S is present both as an optional and required \
+                 dependency"
+                (Lib_name.to_string name)
+            ]
+        | Forbidden, Required | Required, Forbidden ->
+          User_error.raise ~loc
+            [ Pp.textf
+                "library %S is present both as a forbidden and required \
+                 dependency"
+                (Lib_name.to_string name)
+            ])
+    in
+    ignore
+      (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x ->
+           match x with
+           | Re_export (_, s) | Direct (_, s) -> add Required s acc
+           | Select { choices; _ } ->
+             List.fold_left choices ~init:acc
+               ~f:(fun acc (c : Select.Choice.t) ->
+                 let acc =
+                   Lib_name.Set.fold c.required ~init:acc ~f:(add Optional)
+                 in
+                 Lib_name.Set.fold c.forbidden ~init:acc ~f:(add Forbidden)))
+        : _ Lib_name.Map.t);
+    t
+
+  let of_pps pps = List.map pps ~f:(fun pp -> direct (Loc.none, pp))
 end

src/dune_rules/lib_dep.mli

@@ -34,5 +34,13 @@ val re_export : Loc.t * Lib_name.t -> t
 val decode : allow_re_export:bool -> t Dune_lang.Decoder.t
 
 module L : sig
-  val field_encode : t list -> name:string -> Dune_lang.Encoder.field
+  type nonrec t = t list
+
+  val field_encode : t -> name:string -> Dune_lang.Encoder.field
+
+  val decode :
+       allow_re_export:bool
+    -> (t, Dune_lang.Decoder.values) Dune_lang.Decoder.parser
+
+  val of_pps : Lib_name.t list -> t
 end

src/dune_rules/mdx.ml

@@ -215,7 +215,7 @@ let decode =
      and+ libraries =
        field "libraries" ~default:[]
          (Dune_lang.Syntax.since syntax (0, 2)
-         >>> Dune_file.Lib_deps.decode Executable)
+         >>> Lib_dep.L.decode ~allow_re_export:false)
      and+ locks =
        Locks.field ~check:(Dune_lang.Syntax.since syntax (0, 3)) ()
      in

src/dune_rules/melange/melange_rules.ml

@@ -203,7 +203,7 @@ let setup_emit_cmj_rules ~sctx ~dir ~scope ~expander ~dir_contents
         ~opaque:Inherit_from_settings ~package:mel.package
         ~modes:
           { ocaml = { byte = None; native = None }
-          ; melange = Some (Requested Loc.none)
+          ; melange = Some (Requested mel.loc)
           }
     in
     let* () = Module_compilation.build_all cctx in
@@ -245,6 +245,7 @@ let setup_emit_cmj_rules ~sctx ~dir ~scope ~expander ~dir_contents
         ~dialects:(Dune_project.dialects (Scope.project scope))
         ~modes:`Melange_emit )
   in
+  let* () = Buildable_rules.gen_select_rules sctx compile_info ~dir in
   Buildable_rules.with_lib_deps ctx compile_info ~dir ~f
 
 module Runtime_deps = struct

src/dune_rules/melange/melange_stanzas.ml

@@ -20,36 +20,6 @@ module Emit = struct
 
   type Stanza.t += T of t
 
-  let decode_lib =
-    let+ loc = loc
-    and+ t =
-      let allow_re_export = false in
-      repeat (Lib_dep.decode ~allow_re_export)
-    in
-    let add kind name acc =
-      match Lib_name.Map.find acc name with
-      | None -> Lib_name.Map.set acc name kind
-      | Some _present ->
-        User_error.raise ~loc
-          [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ]
-    in
-    ignore
-      (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x ->
-           match x with
-           | Lib_dep.Direct (_, s) -> add true s acc
-           | Lib_dep.Re_export (_, name) ->
-             User_error.raise ~loc
-               [ Pp.textf
-                   "library %S is using re_export, which is not supported for \
-                    melange libraries"
-                   (Lib_name.to_string name)
-               ]
-           | Select _ ->
-             User_error.raise ~loc
-               [ Pp.textf "select is not supported for melange libraries" ])
-        : bool Lib_name.Map.t);
-    t
-
   let decode =
     let extension_field =
       let+ loc, extension = located string in
@@ -126,7 +96,8 @@ module Emit = struct
        and+ module_systems =
          field "module_systems" module_systems
            ~default:[ Melange.Module_system.default ]
-       and+ libraries = field "libraries" decode_lib ~default:[]
+       and+ libraries =
+         field "libraries" (Lib_dep.L.decode ~allow_re_export:false) ~default:[]
        and+ package = field_o "package" Stanza_common.Pkg.decode
        and+ runtime_deps =
          field "runtime_deps" (repeat Dep_conf.decode) ~default:[]

test/blackbox-tests/test-cases/melange/emit-select.t

@@ -0,0 +1,40 @@
+using `(select ...)` in melange.emit
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.7)
+  > (using melange 0.1)
+  > EOF
+  $ cat >bar.melange.ml <<EOF
+  > let message = "hello from melange"
+  > EOF
+  $ cat >bar.native.ml <<EOF
+  > let message = print_endline "hello from native"
+  > EOF
+  $ cat >foo.fake.ml <<EOF
+  > let message = "foo has fake " ^^ Fakefoobar.fake
+  > EOF
+  $ cat >foo.no_fake.ml <<EOF
+  > let message = "foo has no fake"
+  > EOF
+  $ cat >main.ml <<EOF
+  > let () = Js.log Bar.message
+  > let () = Js.log Foo.message
+  > EOF
+  $ cat >dune <<EOF
+  > (melange.emit
+  >  (target output)
+  >  (alias melange)
+  >  (libraries
+  >   (select bar.ml from
+  >    (melange -> bar.melange.ml)
+  >    (!melange -> bar.native.ml))
+  >   (select foo.ml from
+  >    (fakefoobar -> foo.fake.ml)
+  >    (!fakefoobar -> foo.no_fake.ml))))
+  > EOF
+
+  $ dune build @melange
+  $ node ./_build/default/output/main.js
+  hello from melange
+  foo has no fake
+