[melange]: remove dependency on rescript syntax (#411)

* [melange]: remove dependency on rescript syntax

* tweak dependency specification

Changes.md

@@ -14,6 +14,10 @@ Unreleased
 - [melange]: Remove dependency on `reason`. Reason syntax users should install`
   reason` from their preferred package manager instead, and Melange / Dune will
   find it in `$PATH` ([#409](https://github.com/melange-re/melange/pull/409))
+- [melange]: Remove dependency on `napkin` (the ReScript syntax parser). Users
+  that depend on libraries written in ReScript syntax should install the `mel`
+  package and Melange / Dune will find the `rescript_syntax` binary in `$PATH`
+  ([#411](https://github.com/melange-re/melange/pull/411))
 
 0.2.0 2022-10-24
 --------------

dune-project

@@ -40,8 +40,6 @@
    (>= "1.1.0"))
   (base64
    (>= "3.1.0"))
-  (ocaml-migrate-parsetree
-   (>= "2.3.0"))
   (cppo :build)
   (ounit :with-test)))
 
@@ -56,4 +54,6 @@
    (>= "1.1.0"))
   (luv
    (>= "0.5.11"))
+  (ocaml-migrate-parsetree
+   (>= "2.3.0"))
   (ounit :with-test)))

jscomp/common/js_config.cppo.ml

@@ -113,8 +113,6 @@ let no_stdlib = ref false
 
 let no_export = ref false
 
-let format = ref None
-
 let as_ppx = ref false
 
 

jscomp/common/js_config.mli

@@ -75,7 +75,6 @@ val js_stdout : bool ref
 val all_module_aliases : bool ref
 val no_stdlib : bool ref
 val no_export : bool ref
-val format : Ext_file_extensions.syntax_kind option ref
 val as_ppx : bool ref
 val customize_runtime : string option ref
 val as_pp : bool ref

jscomp/core/dune

@@ -13,9 +13,7 @@
   frontend
   melange-compiler-libs
   outcome_printer
-  js_parser
-  ppx_rescript_compat
-  napkin))
+  js_parser))
 
 (rule
  (targets js_fold.ml)

jscomp/core/js_implementation.ml

@@ -99,7 +99,7 @@ let after_parsing_sig ppf outputprefix ast =
         initial_env sg;
       process_with_gentype (outputprefix ^ ".cmti"))
 
-let interface ~parser ~lang:_ ppf fname =
+let interface ~parser ppf fname =
   Res_compmisc.init_path ();
   let sig_ = parser fname |> Ast_deriving_compat.signature in
   sig_
@@ -190,14 +190,10 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) =
         Lam_compile_main.lambda_as_module ~package_info js_program outputprefix);
     process_with_gentype (outputprefix ^ ".cmt")
 
-let implementation ~parser ~lang ppf fname =
+let implementation ~parser ppf fname =
   Res_compmisc.init_path ();
 
-  let str = parser fname |> Ast_deriving_compat.structure in
-  let str =
-    match lang with `rescript -> Ppx_rescript_compat.structure str | _ -> str
-  in
-  str
+  parser fname |> Ast_deriving_compat.structure
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name
        Ml
   |> Ppx_entry.rewrite_implementation

jscomp/core/js_implementation.mli

@@ -25,11 +25,7 @@
 (** High level compilation module *)
 
 val interface :
-  parser:(string -> Parsetree.signature) ->
-  lang:[ `ml | `rescript ] ->
-  Format.formatter ->
-  string ->
-  unit
+  parser:(string -> Parsetree.signature) -> Format.formatter -> string -> unit
 (** This module defines a function to compile the program directly into [js]
     given [filename] and [outputprefix],
     it will be useful if we don't care about bytecode output(generating js only).
@@ -48,11 +44,7 @@ val interface_mliast : Format.formatter -> string -> unit
 *)
 
 val implementation :
-  parser:(string -> Parsetree.structure) ->
-  lang:[ `ml | `rescript ] ->
-  Format.formatter ->
-  string ->
-  unit
+  parser:(string -> Parsetree.structure) -> Format.formatter -> string -> unit
 (** [implementation ppf sourcefile outprefix] compiles to JS directly *)
 
 val implementation_mlast : Format.formatter -> string -> unit

jscomp/ext/ext_file_extensions.ml

@@ -3,8 +3,6 @@ type syntax_kind = Ml | Res
 type valid_input =
   | Ml
   | Mli
-  | Res
-  | Resi
   | Intf_ast
   | Impl_ast
   | Mlmap
@@ -25,7 +23,5 @@ let classify_input ext =
   | _ when ext = Literals.suffix_iast -> Intf_ast
   | _ when ext = Literals.suffix_mlmap -> Mlmap
   | _ when ext = Literals.suffix_cmi -> Cmi
-  | _ when ext = Literals.suffix_res -> Res
-  | _ when ext = Literals.suffix_resi -> Resi
   | _ when ext = Literals.suffix_cmj -> Cmj
   | _ -> Unknown

jscomp/frontend/dune

@@ -12,4 +12,4 @@
   melange-compiler-libs
   outcome_printer
   js_parser
-  napkin))
+  reactjs_jsx_ppx_v3))

jscomp/frontend/ppx_entry.ml

@@ -29,7 +29,7 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
   Ast_config.iter_on_bs_config_sigi ast;
   let ast =
     match !Js_config.jsx_version with
-    | 3 -> Napkin.Reactjs_jsx_ppx_v3.rewrite_signature ast
+    | 3 -> Reactjs_jsx_ppx_v3.rewrite_signature ast
     | _ -> ast
     (* react-jsx ppx relies on built-in ones like `##` *)
   in
@@ -45,7 +45,7 @@ let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure =
   Ast_config.iter_on_bs_config_stru ast;
   let ast =
     match !Js_config.jsx_version with
-    | 3 -> Napkin.Reactjs_jsx_ppx_v3.rewrite_implementation ast
+    | 3 -> Reactjs_jsx_ppx_v3.rewrite_implementation ast
     | _ -> ast
   in
   if !Js_config.no_builtin_ppx then ast

jscomp/main/dune

@@ -11,7 +11,6 @@
   outcome_printer
   melange-compiler-libs
   core
-  napkin
   cmdliner)
  (modules melc melc_cli)
  (preprocessor_deps ../../package.json ../../bsconfig.json)

jscomp/main/melc.ml

@@ -46,25 +46,11 @@ let process_file sourcefile
     let sourcefile = set_abs_input_name  sourcefile in
     Js_implementation.implementation
       ~parser:Pparse_driver.parse_implementation
-      ~lang:`ml
       ppf sourcefile
   | Mli  ->
     let sourcefile = set_abs_input_name  sourcefile in
     Js_implementation.interface
       ~parser:Pparse_driver.parse_interface
-      ~lang:`ml
-      ppf sourcefile
-  | Res ->
-    let sourcefile = set_abs_input_name  sourcefile in
-    Js_implementation.implementation
-      ~parser:Napkin.Res_driver.parse_implementation
-      ~lang:`rescript
-      ppf sourcefile
-  | Resi ->
-    let sourcefile = set_abs_input_name  sourcefile in
-    Js_implementation.interface
-      ~parser:Napkin.Res_driver.parse_interface
-      ~lang:`rescript
       ppf sourcefile
   | Intf_ast
     ->
@@ -89,63 +75,6 @@ let process_file sourcefile
 
 let ppf = Format.err_formatter
 
-(* Error messages to standard error formatter *)
-open struct
-  let handle_res_parse_result (parse_result : _ Napkin.Res_driver.parseResult) =
-    if parse_result.invalid then begin
-        Napkin.Res_diagnostics.printReport parse_result.diagnostics parse_result.source;
-        exit 1
-    end
-end
-
-let print_res_interface ~comments ast =
-  Napkin.Res_printer.printInterface ~width:100 ~comments ast
-
-let print_res_implementation ~comments ast =
-  Napkin.Res_printer.printImplementation ~width:100 ~comments ast
-
-(* TODO: support printing from AST too. *)
-let format_file ~(kind: Ext_file_extensions.syntax_kind) input =
-  let ext = Ext_file_extensions.classify_input (Ext_filename.get_extension_maybe input) in
-  let impl_format_fn ~comments ast =
-    match kind, comments with
-    | Res, `Res comments ->
-      let ast = Napkin.Import.From_current.copy_structure ast in
-      output_string stdout (print_res_implementation ~comments ast)
-    | Res, `Re _ ->
-      let ast = Napkin.Import.From_current.copy_structure ast in
-      output_string stdout (print_res_implementation ~comments:[] ast)
-    | _ -> raise (Arg.Bad ("don't know what to do with " ^ input))
-  in
-  let intf_format_fn ~comments ast =
-    match kind, comments with
-    | Res, `Res comments ->
-      let ast = Napkin.Import.From_current.copy_signature ast in
-      output_string stdout (print_res_interface ~comments ast)
-    | Res, `Re _ ->
-      let ast = Napkin.Import.From_current.copy_signature ast in
-      output_string stdout (print_res_interface ~comments:[] ast)
-    | _ -> raise (Arg.Bad ("don't know what to do with " ^ input))
-  in
-  begin match ext with
-  | Res ->
-    let parse_result =
-      Napkin.Res_driver.parsingEngine.parseImplementation ~forPrinter:true ~filename:input
-    in
-    handle_res_parse_result parse_result;
-    impl_format_fn
-      ~comments:(`Res parse_result.comments)
-      parse_result.parsetree
-  | Resi ->
-    let parse_result =
-      Napkin.Res_driver.parsingEngine.parseInterface ~forPrinter:true ~filename:input
-    in
-    intf_format_fn
-      ~comments:(`Res parse_result.comments)
-       parse_result.parsetree
-  | _ -> (raise (Arg.Bad ("don't know what to do with " ^ input)))
-  end
-
 let anonymous ~(rev_args : string list) =
   if !Js_config.as_ppx then
     match rev_args with
@@ -169,11 +98,7 @@ let anonymous ~(rev_args : string list) =
           end else
 
       match rev_args with
-      | [filename] ->
-        begin match !Js_config.format with
-        | Some syntax_kind -> `Ok (format_file ~kind:syntax_kind filename)
-        | None -> `Ok (process_file filename ppf)
-        end
+      | [filename] -> `Ok (process_file filename ppf)
       | [] -> `Ok ()
       | _ ->
           `Error (false, "can not handle multiple files")
@@ -278,7 +203,6 @@ let main: Melc_cli.t -> _ Cmdliner.Term.ret
       bs_no_builtin_ppx;
       bs_cross_module_opt;
       bs_diagnose;
-      format;
       where;
       verbose;
       keep_locs;
@@ -395,7 +319,6 @@ let main: Melc_cli.t -> _ Cmdliner.Term.ret
 
     if bs_no_builtin_ppx then Js_config.no_builtin_ppx := bs_no_builtin_ppx;
     if bs_diagnose then Js_config.diagnose := bs_diagnose;
-    Ext_option.iter format (fun format -> Js_config.format := Some format);
     if where then print_standard_library ();
     if verbose then Clflags.verbose := verbose;
     Ext_option.iter keep_locs (fun keep_locs -> Clflags.keep_locs := keep_locs);

jscomp/main/melc_cli.ml

@@ -59,7 +59,6 @@ type t = {
   bs_no_builtin_ppx : bool;
   bs_cross_module_opt : bool option;
   bs_diagnose : bool;
-  format : Ext_file_extensions.syntax_kind option;
   where : bool;
   verbose : bool;
   keep_locs : bool option;
@@ -194,29 +193,6 @@ let bs_e =
   in
   Arg.(value & opt (some string) None & info [ "e" ] ~doc)
 
-let format =
-  let ext_conv =
-    let parse ext : (Ext_file_extensions.syntax_kind, _) result =
-      match Ext_string.trim ext with
-      | "res" -> Ok Res
-      | "ml" -> Ok Ml
-      | x ->
-          Error
-            (`Msg
-              (Format.asprintf
-                 "invalid option `%s` passed to -format, expected `re`, `res` \
-                  or `ml`"
-                 x))
-    in
-    let print fmt (ext : Ext_file_extensions.syntax_kind) =
-      let s = match ext with Ext_file_extensions.Res -> "res" | Ml -> "ml" in
-      Format.fprintf fmt "%s" s
-    in
-    Arg.conv ~docv:"ext" (parse, print)
-  in
-  let doc = "Format as Res syntax" in
-  Arg.(value & opt (some ext_conv) None & info [ "format" ] ~doc)
-
 let where =
   let doc = "Print location of standard library and exit" in
   Arg.(value & flag & info [ "where" ] ~doc)
@@ -510,8 +486,8 @@ let parse help include_dirs alerts warnings output_name bs_read_cmi ppx
     bs_g bs_package_name bs_ns as_ppx as_pp no_alias_deps bs_gentype
     unboxed_types bs_D bs_unsafe_empty_array nostdlib color bs_list_conditionals
     bs_eval bs_e bs_cmi_only bs_cmi bs_cmj bs_no_version_header
-    bs_no_builtin_ppx bs_cross_module_opt bs_diagnose format where verbose
-    keep_locs bs_no_check_div_by_zero bs_noassertfalse noassert bs_loc impl intf
+    bs_no_builtin_ppx bs_cross_module_opt bs_diagnose where verbose keep_locs
+    bs_no_check_div_by_zero bs_noassertfalse noassert bs_loc impl intf
     intf_suffix g opaque strict_sequence strict_formats dtypedtree dparsetree
     drawlambda dsource version pp absname bin_annot i nopervasives modules
     nolabels principal short_paths unsafe warn_help warn_error bs_stop_after_cmj
@@ -552,7 +528,6 @@ let parse help include_dirs alerts warnings output_name bs_read_cmi ppx
     bs_no_builtin_ppx;
     bs_cross_module_opt;
     bs_diagnose;
-    format;
     where;
     verbose;
     keep_locs;
@@ -600,16 +575,15 @@ let cmd =
     $ color $ bs_list_conditionals $ Internal.bs_eval $ bs_e
     $ Internal.bs_cmi_only $ Internal.bs_cmi $ Internal.bs_cmj
     $ Internal.bs_no_version_header $ Internal.bs_no_builtin_ppx
-    $ Internal.bs_cross_module_opt $ Internal.bs_diagnose $ format $ where
-    $ verbose $ keep_locs $ Internal.bs_no_check_div_by_zero
-    $ Internal.bs_noassertfalse $ Internal.noassert $ Internal.bs_loc
-    $ Internal.impl $ Internal.intf $ Internal.intf_suffix $ Internal.g
-    $ Internal.opaque $ Internal.strict_sequence $ Internal.strict_formats
-    $ Internal.dtypedtree $ Internal.dparsetree $ Internal.drawlambda
-    $ Internal.dsource $ version $ pp $ absname $ bin_annot $ i
-    $ Internal.nopervasives $ Internal.modules $ Internal.nolabels
-    $ Internal.principal $ Internal.short_paths $ unsafe $ warn_help
-    $ warn_error $ bs_stop_after_cmj $ Internal.runtime $ filenames
+    $ Internal.bs_cross_module_opt $ Internal.bs_diagnose $ where $ verbose
+    $ keep_locs $ Internal.bs_no_check_div_by_zero $ Internal.bs_noassertfalse
+    $ Internal.noassert $ Internal.bs_loc $ Internal.impl $ Internal.intf
+    $ Internal.intf_suffix $ Internal.g $ Internal.opaque
+    $ Internal.strict_sequence $ Internal.strict_formats $ Internal.dtypedtree
+    $ Internal.dparsetree $ Internal.drawlambda $ Internal.dsource $ version
+    $ pp $ absname $ bin_annot $ i $ Internal.nopervasives $ Internal.modules
+    $ Internal.nolabels $ Internal.principal $ Internal.short_paths $ unsafe
+    $ warn_help $ warn_error $ bs_stop_after_cmj $ Internal.runtime $ filenames
     $ Compat.bs_super_errors $ Compat.c)
 
 (* Different than Ext_cli_args because we need to normalize `-w -foo` to

jscomp/napkin/dune

@@ -1,5 +1,17 @@
+(include_subdirs unqualified)
+
 (library
  (name napkin)
  (flags
   (:standard -w -9))
- (libraries ocaml-migrate-parsetree compiler-libs.common))
+ (modules :standard \ res_cli)
+ (libraries frontend ocaml-migrate-parsetree compiler-libs.common))
+
+(executable
+ (name res_cli)
+ (public_name rescript_syntax)
+ (package mel)
+ (modules res_cli)
+ (flags
+  (-open Napkin))
+ (libraries napkin))

jscomp/napkin/res_driver.ml

@@ -46,7 +46,11 @@ let setup ~filename ~forPrinter () =
 let parsingEngine = {
   parseImplementation = begin fun ~forPrinter ~filename ->
     let engine = setup ~filename ~forPrinter () in
-    let structure = Res_core.parseImplementation engine |> To_current.copy_structure in
+    let structure =
+      Res_core.parseImplementation engine
+      |> To_current.copy_structure
+      |> Ppx_rescript_compat.structure
+    in
     let (invalid, diagnostics) = match engine.diagnostics with
     | [] as diagnostics -> (false, diagnostics)
     | _ as diagnostics -> (true, diagnostics)