rescript: use rescript-nodejs

src/Targets/ReScript/ReScriptHelper.fs

@@ -152,7 +152,7 @@ module Naming =
 
   let reservedModuleNames =
     Set.ofList [
-      "Export"; "Default"; "Types"
+      "Export"; "Default"; "Types"; "NodeJs"
     ] |> Set.union keywords
 
   let moduleNameReserved (name: string) =
@@ -588,3 +588,165 @@ module Binding =
     | Binding.Ext x -> yield Statement.external x.attrs x.name x.ty x.target
     | Binding.Unknown x -> match x.msg with Some msg -> yield comment msg | None -> ()
   ]
+
+module Import =
+  open Fable.Core.JsInterop
+  open JsHelper
+  type Node = NodeBuiltin
+
+  let isModule (ctx: Typer.TyperContext<_, _>) (name: string) (kind: Set<Kind> option) =
+    kind |> Option.map Kind.generatesReScriptModule
+            |> Option.defaultValue false
+    || ctx |> Typer.TyperContext.tryCurrentSourceInfo (fun i -> i.unknownIdentTypes |> Trie.containsKey [name])
+            |> Option.defaultValue false
+    || name |> Naming.isCase Naming.PascalCase
+
+  [<RequireQualifiedAccess>]
+  type Statement =
+    /// `module Name = Target`
+    | Alias of name:string * target:string
+    /// `open Name`
+    | Open of name:string
+    /// `module Name = { type t = typeName }`
+    | Type of name:string * typeName:string * typeArgs:string list
+    /// `module Name = Y.Make()`
+    | FunctorInstance of name:string * expr:string
+    | Comment of text
+
+  let alias name target = Statement.Alias (name, target)
+  let open_ name = Statement.Open name
+  let type_ name typeName typeArgs = Statement.Type (name, typeName, typeArgs)
+  let instance name expr = Statement.FunctorInstance (name, expr)
+  let comment text = Statement.Comment text
+
+  let private getDedicatedImportStatementForNodeBuiltin (ctx: Typer.TyperContext<_, _>) (c: ImportClause) =
+    option {
+      let! specifier = c.moduleSpecifier
+      let! builtin = getNodeBuiltin specifier
+      let moduleName =
+        match builtin.name with
+        | Node.Vm -> "VM"
+        | _ -> Naming.toCase Naming.PascalCase !!builtin.name
+      let importedName = c.importedName |? "" // this becomes None only when ES6WildcardImport is used
+
+      match builtin.name, builtin.subpath, c with
+      // special cases
+      | Node.ChildProcess, None, ES6Import x ->
+        match x.name with
+        | "ChildProcess" ->
+          return alias (Naming.moduleName importedName) "NodeJs.ChildProcess"
+        | name when name.StartsWith("ExecOptions") ->
+          return type_ (Naming.moduleName importedName) "NodeJs.ChildProcess.execOptions" []
+        | name when name.StartsWith("ExecFileOptions") ->
+          return type_ (Naming.moduleName importedName) "NodeJs.ChildProcess.execFileOptions" []
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.ChildProcess.{x.name}"
+      | Node.Console, None, ES6Import x when x.name = "ConsoleConstructorOptions" ->
+        return type_ (Naming.moduleName importedName) "NodeJs.Console.consoleOptions" []
+      | Node.Dns, None, ES6Import x when x.name.StartsWith("Lookup") && x.name.EndsWith("Options") ->
+        return type_ (Naming.moduleName importedName) "NodeJs.Dns.options" []
+      | Node.Events, None, ES6Import x when x.name = "EventEmitter" ->
+        return instance (Naming.moduleName importedName) "NodeJs.EventEmitter.Make()"
+      | Node.Fs, _, ES6Import x ->
+        match builtin.subpath, x.name with
+        | None, "ReadStreamOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Fs.createReadStreamOptions" []
+        | None, "WriteStreamOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Fs.createWriteStreamOptions" ["'t"]
+        | None, "WriteFileOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Fs.writeFileOptions" []
+        | _, _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.Fs.{x.name}"
+      | Node.Http, None, ES6Import x ->
+        match x.name with
+        | "IncomingHttpHeaders" | "OutgoingHttpHeaders" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Http.headersObject" []
+        | "ServerOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Http.createServerOptions" []
+        | "RequestOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Http.requestOptions" []
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.Http.{x.name}"
+      | Node.Http2, None, ES6Import x when x.name = "Settings" ->
+        return type_ (Naming.moduleName importedName) "NodeJs.Http2.settingsObject" []
+      | Node.Https, None, ES6Import x ->
+        match x.name with
+        | "Server" ->
+          return alias (Naming.moduleName importedName) "NodeJs.Https.HttpsServer"
+        | "Agent" ->
+          return alias (Naming.moduleName importedName) "NodeJs.Https.Agent"
+        // rescript-nodejs doesn't have these, but it has fallback types
+        | "ServerOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Http.createServerOptions" []
+        | "RequestOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Http.requestOptions" []
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.Https.{x.name}"
+      | Node.Net, None, ES6Import x when x.name = "AddressInfo" ->
+        return type_ (Naming.moduleName importedName) "NodeJs.Net.address" []
+      | Node.Os, None, ES6Import x when x.name = "CpuInfo" ->
+        return type_ (Naming.moduleName importedName) "NodeJs.Os.cpu" []
+      | Node.Os, None, ES6Import x when x.name = "ParsedPath" || x.name = "FormatInputPathObject" ->
+        return type_ (Naming.moduleName importedName) "NodeJs.Path.t" []
+      | Node.Tls, None, ES6Import x ->
+        match x.name with
+        | "TLSSocket" ->
+          return alias (Naming.moduleName importedName) "NodeJs.Tls.TlsSocket"
+        | "Server" ->
+          return alias (Naming.moduleName importedName) "NodeJs.Tls.TlsServer"
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.Tls.{x.name}"
+      | Node.Url, None, ES6Import x ->
+        match x.name with
+        | "UrlObject" | "Url" | "UrlWithParsedQuery" | "UrlWithStringQuery" | "URL" ->
+          return alias (Naming.moduleName importedName) "NodeJs.Url"
+        | "URLSearchParams" ->
+          return alias (Naming.moduleName importedName) "NodeJs.Url.SearchParams"
+        | "URLFormatOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Url.urlFormatOptions" []
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.Url.{x.name}"
+      | Node.Util, None, ES6Import x ->
+        match x.name with
+        | "InspectOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.Util.inspectOptions" []
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.Util.{x.name}"
+      | Node.V8, None, ES6Import x ->
+        match x.name with
+        | "HeapSpaceInfo" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.V8.heapSpaceStats" []
+        | "HeapInfo" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.V8.heapStats" []
+        | "HeapCodeStatistics" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.V8.heapCodeStats" []
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.V8.{x.name}"
+      | Node.Vm, None, ES6Import x ->
+        match x.name with
+        | "CreateContextOptions" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.VM.createContextOptions" []
+        | "Context" ->
+          return type_ (Naming.moduleName importedName) "NodeJs.VM.contextifiedObject" ["'t"]
+        | _ ->
+          return alias (Naming.moduleName importedName) $"NodeJs.VM.{x.name}"
+
+      // general cases
+      // 1. the `t` type right under the module
+      | (Node.Buffer | Node.ChildProcess | Node.Console | Node.Module | Node.Stream | Node.StringDecoder), None, ES6Import x when x.name = moduleName ->
+        return alias (Naming.moduleName importedName) $"NodeJs.{moduleName}"
+      // 2. the module contains submodules with their `t` type
+      | _, _, _ ->
+        match c with
+        | (NamespaceImport _ | ES6DefaultImport _) ->
+          return alias (Naming.moduleName importedName) $"NodeJs.{moduleName}"
+        | ES6Import x when isModule ctx x.name x.kind ->
+          return alias (Naming.moduleName importedName) $"NodeJs.{moduleName}.{x.name}"
+        | ES6WildcardImport _ ->
+          return open_ $"NodeJs.{moduleName}"
+        | _ -> ()
+    }
+
+  let getDedicatedImportStatement (ctx: Typer.TyperContext<_, _>) (c: ImportClause) =
+    getDedicatedImportStatementForNodeBuiltin ctx c
+    // TODO: add more dedicated imports?

src/Targets/ReScript/Writer.fs

@@ -525,9 +525,9 @@ and getLabelOfFullName flags overrideFunc (ctx: Context) (fullName: FullName) (t
   let inheritingType = InheritingType.KnownIdent {| fullName = fullName; tyargs = typeParams |> List.map (fun tp -> TypeVar tp.name) |}
   getLabelsFromInheritingTypes flags overrideFunc ctx (Set.singleton inheritingType) |> Choice1Of2
 
-type StructuredTextItemBase<'TypeDefText, 'Binding, 'EnumCaseText> =
+type StructuredTextItemBase<'ImportText, 'TypeDefText, 'Binding, 'EnumCaseText> =
   /// Will always be emitted at the top of the module.
-  | ImportText of text
+  | ImportText of 'ImportText
   /// Will always be emitted at the next top of the module.
   | TypeDefText of 'TypeDefText
   | TypeAliasText of text
@@ -538,6 +538,7 @@ type StructuredTextItemBase<'TypeDefText, 'Binding, 'EnumCaseText> =
   | EnumCaseText of 'EnumCaseText
 
 and StructuredTextItem = StructuredTextItemBase<
+  ImportItem,
   TypeDefText,
   (OverloadRenamer -> CurrentScope -> Binding),
   {| name: string; comments: Comment list |}
@@ -574,6 +575,8 @@ and [<RequireQualifiedAccess>] Scope =
   | Global
   | Ignore
 
+and [<RequireQualifiedAccess>] ImportItem = Import.Statement
+
 and [<RequireQualifiedAccess>] ExportItem =
   | Export of {| comments: Comment list; clauses: (ExportClause * Set<Kind>) list; loc: Location; origText: string |}
   | ReExport of {| comments: Comment list; clauses: (ReExportClause * Set<Kind>) list; loc: Location; specifier: string; origText: string |}
@@ -1466,6 +1469,7 @@ let emitImport (ctx: Context) (i: Import) : StructuredTextItem list =
       else
         match JsHelper.tryGetActualFileNameFromRelativeImportPath ctx.currentSourceFile ctx.state.fileNames specifier with
         | Some _ -> None // if the imported file is included in the input files, skip emitting it
+        | _ when ctx.options.merge -> None // if --merge is specified, skip emitting it
         | None ->
           JsHelper.resolveRelativeImportPath (ctx.state.info |> Result.toOption) ctx.currentSourceFile ctx.state.fileNames specifier
           |> JsHelper.InferenceResult.tryUnwrap
@@ -1488,21 +1492,21 @@ let emitImport (ctx: Context) (i: Import) : StructuredTextItem list =
         | Some kind -> kind |> Kind.generatesReScriptModule
         | None -> x.target |> Ident.getKind ctx |> Kind.generatesReScriptModule
       if shouldEmit then
-        [Statement.moduleAlias (Naming.moduleName x.name) (x.target.name |> Naming.structured Naming.moduleName) |> ImportText]
+        [Import.alias (Naming.moduleName x.name) (x.target.name |> Naming.structured Naming.moduleName) |> ImportText]
       else []
     | NamespaceImport x when isModule x.name x.kind ->
       getModuleName x.specifier
       |> Option.map (fun moduleName ->
-        [Statement.moduleAlias (Naming.moduleName x.name) (sprintf "%s.Export" moduleName) |> ImportText])
+        [Import.alias (Naming.moduleName x.name) (sprintf "%s.Export" moduleName) |> ImportText])
       |> Option.defaultValue []
     | ES6WildcardImport s ->
       getModuleName s
-      |> Option.map (fun moduleName -> [Statement.open_ (sprintf "%s.Export" moduleName) |> ImportText])
+      |> Option.map (fun moduleName -> [Import.open_ (sprintf "%s.Export" moduleName) |> ImportText])
       |> Option.defaultValue []
     | ES6DefaultImport x when isModule x.name x.kind ->
       getModuleName x.specifier
       |> Option.map (fun moduleName ->
-        [Statement.moduleAlias (Naming.moduleName x.name) (sprintf "%s.Export.Default" moduleName) |> ImportText])
+        [Import.alias (Naming.moduleName x.name) (sprintf "%s.Export.Default" moduleName) |> ImportText])
       |> Option.defaultValue []
     | ES6Import x when isModule x.name x.kind ->
       let name =
@@ -1511,14 +1515,16 @@ let emitImport (ctx: Context) (i: Import) : StructuredTextItem list =
         | None -> Naming.moduleName x.name
       getModuleName x.specifier
       |> Option.map (fun moduleName ->
-        [Statement.moduleAlias name (sprintf "%s.Export.%s" moduleName (Naming.moduleName x.name)) |> ImportText])
+        [Import.alias name (sprintf "%s.Export.%s" moduleName (Naming.moduleName x.name)) |> ImportText])
       |> Option.defaultValue []
     | NamespaceImport _ | ES6DefaultImport _ | ES6Import _ -> []
 
-  [ yield! emitComments true i.comments |> List.map ImportText
-    yield commentStr i.origText |> ImportText
+  [ yield! emitComments true i.comments |> List.map (Import.comment >> ImportText)
+    yield commentStr i.origText |> Import.comment |> ImportText
     for c in i.clauses do
-      yield! emitImportClause c]
+      match Import.getDedicatedImportStatement ctx c with
+      | Some stmt -> yield ImportText stmt
+      | None -> yield! emitImportClause c ]
 
 let createStructuredText (rootCtx: Context) (stmts: Statement list) : StructuredText =
   let emitTypeFlags = EmitTypeFlags.defaultValue
@@ -1743,7 +1749,7 @@ type EmitModuleFlags = {|
 |}
 
 type EmitModuleResult = {|
-  imports: text list
+  imports: {| types: text; impl: text; intf: text |} list
   /// The `Types` module
   types: text list
   /// The content of the `.res` file
@@ -1833,8 +1839,34 @@ let rec emitModule (dt: DependencyTrie<string>) flags (ctx: Context) st =
           | Some b, true -> attrs + tmp +@ " = " + b
         {| types = actual; intf = actual; impl = alias |}
 
+      let emitImportStatement (i: ImportItem) =
+        match i with
+        | ImportItem.Alias (name, target) ->
+          let txt = Statement.moduleAlias name target
+          {| types = txt; intf = txt; impl = txt |}
+        | ImportItem.Open name ->
+          let txt = Statement.open_ name
+          {| types = txt; intf = txt; impl = txt |}
+        | ImportItem.Type (name, tyName, tyArgs) ->
+          let typeArgs = tyArgs |> List.map str
+          let alias =
+            Statement.typeAlias false "t" typeArgs (Some (Type.appOpt (str tyName) typeArgs))
+          let resi =
+            tprintf "module %s : { " name  + alias +@ " }"
+          let res =
+            tprintf "module %s = { " name + alias +@ " }"
+          {| types = resi; intf = resi; impl = res |}
+        | ImportItem.FunctorInstance (name, expr) ->
+          let resi =
+            tprintf "module %s : module type of %s" name expr
+          let res =
+            tprintf "module %s = %s" name expr
+          {| types = resi; intf = resi; impl = res |}
+        | ImportItem.Comment c ->
+          {| types = c; intf = c; impl = c |}
+
       let rec f = function
-        | ImportText t -> ImportText t
+        | ImportText t -> ImportText (emitImportStatement t)
         | TypeAliasText t -> TypeAliasText t
         | TypeDefText d -> TypeDefText (emitTypeDefText d)
         | Binding b -> Binding (b renamer currentScope)
@@ -1855,7 +1887,7 @@ let rec emitModule (dt: DependencyTrie<string>) flags (ctx: Context) st =
         let children =
           children
           |> List.filter (fun (_, _, c) -> c.types |> List.isEmpty |> not)
-          |> List.map (fun (k, _, c) -> {| k with content = c.imports @ c.types; comments = [] |})
+          |> List.map (fun (k, _, c) -> {| k with content = (c.imports |> List.map (fun i -> i.types)) @ c.types; comments = [] |})
           |> Statement.moduleSCC dt Statement.moduleSigRec Statement.moduleSigNonRec ctx
         children @ items
 
@@ -1869,7 +1901,7 @@ let rec emitModule (dt: DependencyTrie<string>) flags (ctx: Context) st =
         children
         |> List.filter (fun (_, _, c) -> c.intf |> List.isEmpty |> not)
         |> List.map (fun (k, _, c) ->
-          let content = c.imports @ c.intf
+          let content = (c.imports |> List.map (fun i -> i.intf)) @ c.intf
           {| k with content = content; comments = c.comments |})
         |> Statement.moduleSigRec
       let typeDefs =
@@ -1907,11 +1939,12 @@ let rec emitModule (dt: DependencyTrie<string>) flags (ctx: Context) st =
         children
         |> List.filter (fun (_, _, c) -> c.impl |> List.isEmpty |> not)
         |> List.map (fun (k, openTypesModule, c) ->
+          let imports = c.imports |> List.map (fun i -> i.impl)
           let content =
             if not isLinear && openTypesModule then
-              Statement.open_ k.name :: c.imports @ c.impl
+              Statement.open_ k.name :: imports @ c.impl
             else
-              c.imports @ c.impl
+              imports @ c.impl
           {| k with content = content; comments = c.comments |})
         |> Statement.moduleSCC dt fixmeRecursiveModules Statement.moduleValMany ctx
       let typeDefs =
@@ -2114,7 +2147,7 @@ let private emitImpl (sources: SourceFile list) (info: PackageInfo option) (ctx:
       yield! header
       yield! m.comments
       yield! opens
-      yield! m.imports
+      yield! m.imports |> List.map (fun i -> i.impl)
       yield! emitTypes m.types
       yield! m.impl
     ]
@@ -2124,7 +2157,7 @@ let private emitImpl (sources: SourceFile list) (info: PackageInfo option) (ctx:
         yield! header
         yield! m.comments
         yield! opens
-        yield! m.imports
+        yield! m.imports |> List.map (fun i -> i.intf)
         yield! m.intf
       ] |> Some
     else None

test/res/package.json

@@ -16,6 +16,7 @@
   },
   "dependencies": {
     "@rescript/core": "^1.1.0",
-    "rescript": "11.0.1"
+    "rescript": "11.0.1",
+    "rescript-nodejs": "^16.1.0"
   }
 }

test/res/rescript.json

@@ -11,7 +11,8 @@
   },
   "suffix": ".bs.js",
   "bs-dependencies": [
-    "@rescript/core"
+    "@rescript/core",
+    "rescript-nodejs"
   ],
   "uncurried": true
 }