Make the 'interface' field of a dialect optional

Signed-off-by: Guillaume Petiot <guillaume@tarides.com>

src/dune_rules/dialect.ml

@@ -45,7 +45,7 @@ end
 
 type t =
   { name : string
-  ; file_kinds : File_kind.t Ml_kind.Dict.t
+  ; file_kinds : File_kind.t option Ml_kind.Dict.t
   }
 
 let name t = t.name
@@ -54,15 +54,17 @@ let to_dyn { name; file_kinds } =
   let open Dyn in
   record
     [ ("name", string name)
-    ; ("file_kinds", Ml_kind.Dict.to_dyn File_kind.to_dyn file_kinds)
+    ; ( "file_kinds"
+      , Ml_kind.Dict.to_dyn (Dyn.option File_kind.to_dyn) file_kinds )
     ]
 
 let encode { name; file_kinds } =
   let open Dune_lang.Encoder in
+  let open Option.O in
   let file_kind_stanzas =
-    let open Ml_kind in
-    List.map ~f:File_kind.encode
-      [ Dict.get file_kinds Intf; Dict.get file_kinds Impl ]
+    List.filter_map Ml_kind.all ~f:(fun kind ->
+        let+ file_kind = Ml_kind.Dict.get file_kinds kind in
+        File_kind.encode file_kind)
   in
   let fields = record_fields [ field "name" string name ] @ file_kind_stanzas in
   list sexp (string "dialect" :: fields)
@@ -87,18 +89,35 @@ let decode =
   in
   fields
     (let+ name = field "name" string
-     and+ impl = field "implementation" (fields (kind Ml_kind.Impl))
-     and+ intf = field "interface" (fields (kind Ml_kind.Intf)) in
+     and+ impl_loc, impl =
+       located (field_o "implementation" (fields (kind Ml_kind.Impl)))
+     and+ intf_loc, intf =
+       located (field_o "interface" (fields (kind Ml_kind.Intf)))
+     and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in
+     let dialect_kind_optional_since = (3, 9) in
+     if version < dialect_kind_optional_since then (
+       if Option.is_none impl then
+         Syntax.Error.since impl_loc Stanza.syntax dialect_kind_optional_since
+           ~what:"omitting (implementation) in dialects";
+       if Option.is_none intf then
+         Syntax.Error.since intf_loc Stanza.syntax dialect_kind_optional_since
+           ~what:"omitting (interface) in dialects");
      { name; file_kinds = Ml_kind.Dict.make ~intf ~impl })
 
 let extension { file_kinds; _ } ml_kind =
-  (Ml_kind.Dict.get file_kinds ml_kind).extension
+  let open Option.O in
+  let+ x = Ml_kind.Dict.get file_kinds ml_kind in
+  x.extension
 
 let preprocess { file_kinds; _ } ml_kind =
-  (Ml_kind.Dict.get file_kinds ml_kind).preprocess
+  let open Option.O in
+  let* x = Ml_kind.Dict.get file_kinds ml_kind in
+  x.preprocess
 
 let format { file_kinds; _ } ml_kind =
-  (Ml_kind.Dict.get file_kinds ml_kind).format
+  let open Option.O in
+  let* x = Ml_kind.Dict.get file_kinds ml_kind in
+  x.format
 
 let ocaml =
   let format kind =
@@ -126,8 +145,8 @@ let ocaml =
           , [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ] )
     }
   in
-  let intf = file_kind Ml_kind.Intf ".mli" in
-  let impl = file_kind Ml_kind.Impl ".ml" in
+  let intf = Some (file_kind Ml_kind.Intf ".mli") in
+  let impl = Some (file_kind Ml_kind.Impl ".ml") in
   { name = "ocaml"; file_kinds = Ml_kind.Dict.make ~intf ~impl }
 
 let reason =
@@ -152,8 +171,8 @@ let reason =
     ; format = Some (Loc.none, format, [])
     }
   in
-  let intf = file_kind Ml_kind.Intf ".rei" in
-  let impl = file_kind Ml_kind.Impl ".re" in
+  let intf = Some (file_kind Ml_kind.Intf ".rei") in
+  let impl = Some (file_kind Ml_kind.Impl ".re") in
   { name = "reason"; file_kinds = Ml_kind.Dict.make ~intf ~impl }
 
 let rescript =
@@ -179,22 +198,23 @@ let rescript =
     ; format = Some (Loc.none, format, [])
     }
   in
-  let intf = file_kind Ml_kind.Intf ".resi" in
-  let impl = file_kind Ml_kind.Impl ".res" in
+  let intf = Some (file_kind Ml_kind.Intf ".resi") in
+  let impl = Some (file_kind Ml_kind.Impl ".res") in
   { name = "rescript"; file_kinds = Ml_kind.Dict.make ~intf ~impl }
 
-let ml_suffix { file_kinds = { Ml_kind.Dict.intf; impl }; _ } ml_kind =
-  match (ml_kind, intf.preprocess, impl.preprocess) with
-  | Ml_kind.Intf, None, _ | Impl, _, None -> None
-  | _ -> Some (extension ocaml ml_kind)
+let ml_suffix { file_kinds = { intf; impl }; _ } ml_kind =
+  match (ml_kind, intf, impl) with
+  | Ml_kind.Intf, (None | Some { preprocess = None; _ }), _
+  | Impl, _, (None | Some { preprocess = None; _ }) -> None
+  | _ -> extension ocaml ml_kind
 
 module DB = struct
   type dialect = t
 
   type t =
     { by_name : dialect String.Map.t
     ; by_extension : dialect String.Map.t
-    ; mutable extensions_for_merlin : string Ml_kind.Dict.t list option
+    ; mutable extensions_for_merlin : string option Ml_kind.Dict.t list option
     }
 
   let fold { by_name; _ } = String.Map.fold by_name
@@ -219,7 +239,8 @@ module DB = struct
                && intf = extension ocaml Ml_kind.Intf
           then s
           else { Ml_kind.Dict.impl; intf } :: s)
-      |> List.sort ~compare:(Ml_kind.Dict.compare String.compare)
+      |> List.sort
+           ~compare:(Ml_kind.Dict.compare (Option.compare String.compare))
     in
     t.extensions_for_merlin <- Some v;
     v
@@ -237,19 +258,21 @@ module DB = struct
         User_error.raise ~loc
           [ Pp.textf "dialect %S is already defined" dialect.name ]
     in
-    let add_ext map ext =
-      match String.Map.add map ext dialect with
-      | Ok map -> map
-      | Error dialect ->
-        User_error.raise ~loc
-          [ Pp.textf "extension %S is already registered by dialect %S"
-              (String.drop ext 1) dialect.name
-          ]
+    let add_ext map = function
+      | Some { File_kind.extension = ext; _ } -> (
+        match String.Map.add map ext dialect with
+        | Ok map -> map
+        | Error dialect ->
+          User_error.raise ~loc
+            [ Pp.textf "extension %S is already registered by dialect %S"
+                (String.drop ext 1) dialect.name
+            ])
+      | None -> map
     in
     let by_extension =
       add_ext
-        (add_ext by_extension dialect.file_kinds.intf.extension)
-        dialect.file_kinds.impl.extension
+        (add_ext by_extension dialect.file_kinds.intf)
+        dialect.file_kinds.impl
     in
     { by_name; by_extension; extensions_for_merlin = None }
 
@@ -262,8 +285,9 @@ module DB = struct
     Option.map
       ~f:(fun dialect ->
         let kind =
-          if dialect.file_kinds.intf.extension = extension then Ml_kind.Intf
-          else Ml_kind.Impl
+          match dialect.file_kinds.intf with
+          | Some intf when intf.extension = extension -> Ml_kind.Intf
+          | _ -> Ml_kind.Impl
         in
         (dialect, kind))
       (String.Map.find by_extension extension)

src/dune_rules/dialect.mli

@@ -29,7 +29,7 @@ val encode : t Dune_lang.Encoder.t
 
 val decode : t Dune_lang.Decoder.t
 
-val extension : t -> Ml_kind.t -> string
+val extension : t -> Ml_kind.t -> string option
 
 val preprocess : t -> Ml_kind.t -> (Loc.t * Dune_lang.Action.t) option
 
@@ -58,7 +58,7 @@ module DB : sig
 
   val fold : t -> init:'a -> f:(dialect -> 'a -> 'a) -> 'a
 
-  val extensions_for_merlin : t -> string Ml_kind.Dict.t list
+  val extensions_for_merlin : t -> string option Ml_kind.Dict.t list
 
   val to_dyn : t -> Dyn.t
 

src/dune_rules/merlin/merlin.ml

@@ -47,7 +47,7 @@ module Processed = struct
     ; obj_dirs : Path.Set.t
     ; src_dirs : Path.Set.t
     ; flags : string list
-    ; extensions : string Ml_kind.Dict.t list
+    ; extensions : string option Ml_kind.Dict.t list
     ; melc_flags : string list
     }
 
@@ -59,7 +59,7 @@ module Processed = struct
       ; ("obj_dirs", Path.Set.to_dyn obj_dirs)
       ; ("src_dirs", Path.Set.to_dyn src_dirs)
       ; ("flags", list string flags)
-      ; ("extensions", list (Ml_kind.Dict.to_dyn string) extensions)
+      ; ("extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions)
       ; ("melc_flags", list string melc_flags)
       ]
 
@@ -118,6 +118,13 @@ module Processed = struct
 
   let serialize_path = Path.to_absolute_filename
 
+  let get_ext { Ml_kind.Dict.impl; intf } =
+    match (impl, intf) with
+    | Some impl, Some intf -> Some (impl, intf)
+    | Some impl, None -> Some (impl, impl)
+    | None, Some intf -> Some (intf, intf)
+    | None, None -> None
+
   let to_sexp ~opens ~pp
       { stdlib_dir; obj_dirs; src_dirs; flags; extensions; melc_flags } =
     let make_directive tag value = Sexp.List [ Atom tag; value ] in
@@ -171,7 +178,9 @@ module Processed = struct
         :: flags
     in
     let suffixes =
-      List.map extensions ~f:(fun { Ml_kind.Dict.impl; intf } ->
+      List.filter_map extensions ~f:(fun x ->
+          let open Option.O in
+          let+ impl, intf = get_ext x in
           make_directive "SUFFIX" (Sexp.Atom (Printf.sprintf "%s %s" impl intf)))
     in
     Sexp.List
@@ -198,8 +207,9 @@ module Processed = struct
         printf "STDLIB %s\n" (serialize_path stdlib_dir));
     Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p));
     Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p));
-    List.iter extensions ~f:(fun { Ml_kind.Dict.impl; intf } ->
-        printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf));
+    List.iter extensions ~f:(fun x ->
+        Option.iter (get_ext x) ~f:(fun (impl, intf) ->
+            printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf)));
     (* We print all FLG directives as comments *)
     List.iter pp_configs
       ~f:
@@ -322,7 +332,7 @@ module Unprocessed = struct
     ; libname : Lib_name.Local.t option
     ; source_dirs : Path.Source.Set.t
     ; objs_dirs : Path.Set.t
-    ; extensions : string Ml_kind.Dict.t list
+    ; extensions : string option Ml_kind.Dict.t list
     ; mode : Lib_mode.t
     }
 

src/dune_rules/module.ml

@@ -374,13 +374,15 @@ let decode_old ~src_dir =
              ]
      in
      let file exists ml_kind =
+       let open Option.O in
        if exists then
          let module_basename n ~(ml_kind : Ml_kind.t) ~(dialect : Dialect.t) =
            let n = Module_name.to_string n in
-           String.lowercase n ^ Dialect.extension dialect ml_kind
+           let+ ext = Dialect.extension dialect ml_kind in
+           String.lowercase n ^ ext
          in
-         let basename = module_basename name ~ml_kind ~dialect:Dialect.ocaml in
-         Some (File.make Dialect.ocaml (Path.relative src_dir basename))
+         let+ basename = module_basename name ~ml_kind ~dialect:Dialect.ocaml in
+         File.make Dialect.ocaml (Path.relative src_dir basename)
        else None
      in
      let kind =

test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune

@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (public_name main)
+ (modules main))
+
+(executable
+ (name fmt)
+ (public_name fmt)
+ (modules fmt))

test/blackbox-tests/test-cases/dialects/no_intf_bad.t/dune-project

@@ -0,0 +1,7 @@
+(lang dune 3.8)
+
+(dialect
+ (name mlfi)
+ (implementation
+  (extension mf)
+  (format (run fmt %{input-file}))))

test/blackbox-tests/test-cases/dialects/no_intf_bad.t/fmt.ml

@@ -0,0 +1 @@
+prerr_endline ("Formatting " ^ Sys.argv.(1))

test/blackbox-tests/test-cases/dialects/no_intf_bad.t/run.t

@@ -0,0 +1,25 @@
+Test the (dialect ...) stanza inside the dune-project file.
+
+  $ dune exec ./main.exe
+  File "dune-project", line 3, characters 0-92:
+  3 | (dialect
+  4 |  (name mlfi)
+  5 |  (implementation
+  6 |   (extension mf)
+  7 |   (format (run fmt %{input-file}))))
+  Error: omitting (interface) in dialects is only available since version 3.9
+  of the dune language. Please update your dune-project file to have (lang dune
+  3.9).
+  [1]
+
+  $ dune build @fmt
+  File "dune-project", line 3, characters 0-92:
+  3 | (dialect
+  4 |  (name mlfi)
+  5 |  (implementation
+  6 |   (extension mf)
+  7 |   (format (run fmt %{input-file}))))
+  Error: omitting (interface) in dialects is only available since version 3.9
+  of the dune language. Please update your dune-project file to have (lang dune
+  3.9).
+  [1]

test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune

@@ -0,0 +1,9 @@
+(executable
+ (name main)
+ (public_name main)
+ (modules main))
+
+(executable
+ (name fmt)
+ (public_name fmt)
+ (modules fmt))

test/blackbox-tests/test-cases/dialects/no_intf_good.t/dune-project

@@ -0,0 +1,7 @@
+(lang dune 3.9)
+
+(dialect
+ (name mlfi)
+ (implementation
+  (extension mf)
+  (format (run fmt %{input-file}))))

test/blackbox-tests/test-cases/dialects/no_intf_good.t/fmt.ml

@@ -0,0 +1 @@
+prerr_endline ("Formatting " ^ Sys.argv.(1))

test/blackbox-tests/test-cases/dialects/no_intf_good.t/run.t

@@ -0,0 +1,6 @@
+Test the (dialect ...) stanza inside the dune-project file.
+
+  $ dune exec ./main.exe
+
+  $ dune build @fmt
+  Formatting main.mf