feat: support @mel.as without @mel.{string,int} in external polyv…

…ars (#722)

* feat: support `@mel.as` without `@mel.{string,int}` in external polyvars

* chore: remove now outdated tests

* changelog entry

* test: add a test case for `@mel.int`

Changes.md

@@ -61,6 +61,10 @@ Unreleased
   JavaScript with `@mel.as`
   ([#714](https://github.com/melange-re/melange/pull/714), fixes
   [#713](https://github.com/melange-re/melange/pull/713)).
+- [melange]: Allow using `@mel.as` in external declarations without explicitly
+  annotating `@mel.{string,int}`
+  ([#722](https://github.com/melange-re/melange/pull/714), fixes
+  [#578](https://github.com/melange-re/melange/pull/713)).
 
 1.0.0 2023-05-31
 ---------------

ppx/ast_attributes.mli

@@ -63,4 +63,5 @@ type as_const_payload = Int of int | Str of string | Js_literal_str of string
 
 val iter_process_bs_string_or_int_as : t -> as_const_payload option
 val unboxable_type_in_prim_decl : attr
+val is_mel_as : attr -> bool
 val has_mel_as_payload : t -> attr option

ppx/ast_external_process.ml

@@ -82,6 +82,39 @@ let spec_of_ptyp (nolabel : bool) (ptyp : Parsetree.core_type) :
       match ptyp_desc with
       | Ptyp_constr ({ txt = Lident "unit"; _ }, []) ->
           if nolabel then Extern_unit else Nothing
+      | Ptyp_variant (row_fields, Closed, None) -> (
+          (* No `@mel.string` / `@mel.int` present. Try to infer `@mel.as`, if
+             present, in polyvariants.
+
+             https://github.com/melange-re/melange/issues/578 *)
+          let mel_as_type =
+            List.fold_left
+              (fun mel_as_type { prf_attributes; prf_loc; _ } ->
+                match List.filter Ast_attributes.is_mel_as prf_attributes with
+                | [] -> mel_as_type
+                | [ { attr_payload; attr_loc = loc; _ } ] -> (
+                    match
+                      ( mel_as_type,
+                        Ast_payload.is_single_string attr_payload,
+                        Ast_payload.is_single_int attr_payload )
+                    with
+                    | (`Nothing | `String), Some _, None -> `String
+                    | (`Nothing | `Int), None, Some _ -> `Int
+                    | (`Nothing | `String | `Int), None, None -> `Nothing
+                    | `String, None, Some _ ->
+                        Error.err ~loc Expect_string_literal
+                    | `Int, Some _, None -> Error.err ~loc Expect_int_literal
+                    | _, Some _, Some _ -> assert false)
+                | _ :: _ -> Error.err ~loc:prf_loc Duplicated_mel_as)
+              `Nothing row_fields
+          in
+          match mel_as_type with
+          | `Nothing -> Nothing
+          | `String ->
+              Ast_polyvar.map_row_fields_into_strings ptyp.ptyp_loc row_fields
+          | `Int ->
+              Int
+                (Ast_polyvar.map_row_fields_into_ints ptyp.ptyp_loc row_fields))
       | _ -> Nothing)
 
 (* is_optional = false

test/blackbox-tests/as-without-mel-string.t

@@ -0,0 +1,78 @@
+Test `@mel.as` without `@mel.string` / `@mel.int` in external polyvars
+
+  $ . ./setup.sh
+  $ cat > x.ml <<EOF
+  > type t = unit
+  > external transition_timing_function :
+  >   t ->
+  >   [ \`ease
+  >   | \`easeIn [@mel.as "ease-in"]
+  >   ] ->
+  >   unit = "transitionTimingFunction"
+  > let () = transition_timing_function () \`easeIn
+  > EOF
+  $ melc -ppx melppx x.ml
+  // Generated by Melange
+  'use strict';
+  
+  
+  transitionTimingFunction(undefined, "ease-in");
+  
+  /*  Not a pure module */
+
+  $ cat > x.ml <<EOF
+  > type t = unit
+  > external transition_timing_function :
+  >   t ->
+  >   [ \`ease
+  >   | \`easeIn [@mel.as 1]
+  >   | \`easeOut [@mel.as 2]
+  >   ] ->
+  >   unit = "transitionTimingFunction"
+  > let () = transition_timing_function () \`easeIn
+  > EOF
+  $ melc -ppx melppx x.ml
+  // Generated by Melange
+  'use strict';
+  
+  
+  transitionTimingFunction(undefined, 1);
+  
+  /*  Not a pure module */
+
+  $ cat > x.ml <<EOF
+  > type t = unit
+  > external transition_timing_function :
+  >   t ->
+  >   [ \`ease
+  >   | \`easeIn [@mel.as "ease-in"]
+  >   | \`easeOut [@mel.as 1]
+  >   ] ->
+  >   unit = "transitionTimingFunction"
+  > let () = transition_timing_function () \`easeIn
+  > EOF
+  $ melc -ppx melppx x.ml
+  File "x.ml", line 6, characters 13-24:
+  6 |   | `easeOut [@mel.as 1]
+                   ^^^^^^^^^^^
+  Error: expect string literal
+  [2]
+
+  $ cat > x.ml <<EOF
+  > type t = unit
+  > external transition_timing_function :
+  >   t ->
+  >   [ \`ease
+  >   | \`easeIn [@mel.as 1] [@mel.as "ease-in"]
+  >   | \`easeOut
+  >   ] ->
+  >   unit = "transitionTimingFunction"
+  > let () = transition_timing_function () \`easeIn
+  > EOF
+  $ melc -ppx melppx x.ml
+  File "x.ml", line 5, characters 4-43:
+  5 |   | `easeIn [@mel.as 1] [@mel.as "ease-in"]
+          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Error: duplicate @as
+  [2]
+

test/blackbox-tests/mel-as-in-external.t

@@ -32,43 +32,6 @@ Test the attribute @mel.as in external with @mel.set
   >  (preprocess (pps melange.ppx)))
   > EOF
 
-When `mel.string` is not used, the compiler complains
-
-  $ dune build @melange
-  File "x.ml", line 8, characters 14-20:
-  8 |   | `easeIn [@mel.as "ease-in"]
-                    ^^^^^^
-  Alert unused: Unused attribute [@mel.as]
-  This means such annotation is not annotated properly.
-  For example, some annotations are only meaningful in externals
-  
-  
-  File "x.ml", line 9, characters 15-21:
-  9 |   | `easeOut [@mel.as "ease-out"]
-                     ^^^^^^
-  Alert unused: Unused attribute [@mel.as]
-  This means such annotation is not annotated properly.
-  For example, some annotations are only meaningful in externals
-  
-  
-  File "x.ml", line 10, characters 17-23:
-  10 |   | `easeInOut [@mel.as "ease-in-out"]
-                        ^^^^^^
-  Alert unused: Unused attribute [@mel.as]
-  This means such annotation is not annotated properly.
-  For example, some annotations are only meaningful in externals
-  
-The `mel.as` attribute has no effect in the output
-
-  $ cat ./_build/default/out/x.js
-  // Generated by Melange
-  'use strict';
-  
-  
-  document.transitionTimingFunction = "easeIn";
-  
-  /*  Not a pure module */
-
   $ cat > x.ml <<\EOF
   > type document
   >