Better error messages

lib/Bindings/Chalk.fs

@@ -0,0 +1,153 @@
+module Chalk
+
+#nowarn "3390" // disable warnings for invalid XML comments
+
+open System
+open Fable.Core
+open Fable.Core.JS
+
+type ColorSupportLevel =
+    | L0 = 0
+    | L1 = 1
+    | L2 = 2
+    | L3 = 3
+
+type ColorInfo = U2<ColorSupportLevel, bool>
+
+type [<AllowNullLiteral>] ChalkInstance =
+    [<Emit("$0($1...)")>] abstract draw: [<ParamArray>] text: obj[] -> string
+    [<Emit("$0($1...)")>] abstract Item: [<ParamArray>] text: obj[] -> string
+    /// <summary>
+    /// The color support for Chalk.
+    ///
+    /// By default, color support is automatically detected based on the environment.
+    ///
+    /// Levels:
+    /// - <c>0</c> - All colors disabled.
+    /// - <c>1</c> - Basic 16 colors support.
+    /// - <c>2</c> - ANSI 256 colors support.
+    /// - <c>3</c> - Truecolor 16 million colors support.
+    /// </summary>
+    abstract level: ColorSupportLevel with get, set
+    /// <summary>Use RGB values to set text color.</summary>
+    /// <example>
+    /// <code>
+    /// import chalk from 'chalk';
+    /// chalk.rgb(222, 173, 237);
+    /// </code>
+    /// </example>
+    abstract rgb: float * float * float -> ChalkInstance
+    /// <summary>Use HEX value to set text color.</summary>
+    /// <param name="color">Hexadecimal value representing the desired color.</param>
+    /// <example>
+    /// <code>
+    /// import chalk from 'chalk';
+    /// chalk.hex('#DEADED');
+    /// </code>
+    /// </example>
+    abstract hex: string -> ChalkInstance
+    /// <summary>Use an <see href="https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit">8-bit unsigned number</see> to set text color.</summary>
+    /// <example>
+    /// <code>
+    /// import chalk from 'chalk';
+    /// chalk.ansi256(201);
+    /// </code>
+    /// </example>
+    abstract ansi256: float -> ChalkInstance
+    /// <summary>Use RGB values to set background color.</summary>
+    /// <example>
+    /// <code>
+    /// import chalk from 'chalk';
+    /// chalk.bgRgb(222, 173, 237);
+    /// </code>
+    /// </example>
+    abstract bgRgb: float * float * float -> ChalkInstance
+    /// <summary>Use HEX value to set background color.</summary>
+    /// <param name="color">Hexadecimal value representing the desired color.</param>
+    /// <example>
+    /// <code>
+    /// import chalk from 'chalk';
+    /// chalk.bgHex('#DEADED');
+    /// </code>
+    /// </example>
+    abstract bgHex: string -> ChalkInstance
+    /// <summary>Use a <see href="https://en.wikipedia.org/wiki/ANSI_escape_code#8-bit">8-bit unsigned number</see> to set background color.</summary>
+    /// <example>
+    /// <code>
+    /// import chalk from 'chalk';
+    /// chalk.bgAnsi256(201);
+    /// </code>
+    /// </example>
+    abstract bgAnsi256: float -> ChalkInstance
+    /// Modifier: Reset the current style.
+    abstract reset: ChalkInstance
+    /// Modifier: Make the text bold.
+    abstract bold: ChalkInstance
+    /// Modifier: Make the text have lower opacity.
+    abstract dim: ChalkInstance
+    /// Modifier: Make the text italic. *(Not widely supported)*
+    abstract italic: ChalkInstance
+    /// Modifier: Put a horizontal line below the text. *(Not widely supported)*
+    abstract underline: ChalkInstance
+    /// Modifier: Put a horizontal line above the text. *(Not widely supported)*
+    abstract overline: ChalkInstance
+    /// Modifier: Invert background and foreground colors.
+    abstract inverse: ChalkInstance
+    /// Modifier: Print the text but make it invisible.
+    abstract hidden: ChalkInstance
+    /// Modifier: Puts a horizontal line through the center of the text. *(Not widely supported)*
+    abstract strikethrough: ChalkInstance
+    /// Modifier: Print the text only when Chalk has a color level above zero.
+    ///
+    /// Can be useful for things that are purely cosmetic.
+    abstract visible: ChalkInstance
+    abstract black: ChalkInstance
+    abstract red: ChalkInstance
+    abstract green: ChalkInstance
+    abstract yellow: ChalkInstance
+    abstract blue: ChalkInstance
+    abstract magenta: ChalkInstance
+    abstract cyan: ChalkInstance
+    abstract white: ChalkInstance
+    abstract gray: ChalkInstance
+    abstract grey: ChalkInstance
+    abstract blackBright: ChalkInstance
+    abstract redBright: ChalkInstance
+    abstract greenBright: ChalkInstance
+    abstract yellowBright: ChalkInstance
+    abstract blueBright: ChalkInstance
+    abstract magentaBright: ChalkInstance
+    abstract cyanBright: ChalkInstance
+    abstract whiteBright: ChalkInstance
+    abstract bgBlack: ChalkInstance
+    abstract bgRed: ChalkInstance
+    abstract bgGreen: ChalkInstance
+    abstract bgYellow: ChalkInstance
+    abstract bgBlue: ChalkInstance
+    abstract bgMagenta: ChalkInstance
+    abstract bgCyan: ChalkInstance
+    abstract bgWhite: ChalkInstance
+    abstract bgGray: ChalkInstance
+    abstract bgGrey: ChalkInstance
+    abstract bgBlackBright: ChalkInstance
+    abstract bgRedBright: ChalkInstance
+    abstract bgGreenBright: ChalkInstance
+    abstract bgYellowBright: ChalkInstance
+    abstract bgBlueBright: ChalkInstance
+    abstract bgMagentaBright: ChalkInstance
+    abstract bgCyanBright: ChalkInstance
+    abstract bgWhiteBright: ChalkInstance
+
+/// <summary>
+/// Main Chalk object that allows to chain styles together.
+///
+/// Call the last one as a method with a string argument.
+///
+/// Order doesn't matter, and later styles take precedent in case of a conflict.
+///
+/// This simply means that <c>chalk.red.yellow.green</c> is equivalent to <c>chalk.green</c>.
+/// </summary>
+let [<ImportDefault("chalk")>] chalk: ChalkInstance = jsNative
+let [<Import("chalkStderr","chalk")>] chalkStderr: ChalkInstance = jsNative
+let [<Import("supportsColor","chalk")>] supportsColor: ColorInfo = jsNative
+let [<Import("supportsColorStderr","chalk")>] supportsColorStderr: ColorInfo = jsNative

lib/Bindings/Codeframe.fs

@@ -0,0 +1,68 @@
+module Codeframe
+
+#nowarn "3390" // disable warnings for invalid XML comments
+
+open System
+open Fable.Core
+open Fable.Core.JS
+
+type Position = {| line: int; column: int option |}
+
+type [<AllowNullLiteral>] SourceLocation =
+    abstract start: Position with get, set
+    abstract ``end``: Position option with get, set
+
+type [<AllowNullLiteral>] BabelCodeFrameOptions =
+    /// Syntax highlight the code as JavaScript for terminals. default: false
+    abstract highlightCode: bool option with get, set
+    /// The number of lines to show above the error. default: 2
+    abstract linesAbove: int option with get, set
+    /// The number of lines to show below the error. default: 3
+    abstract linesBelow: int option with get, set
+    /// Forcibly syntax highlight the code as JavaScript (for non-terminals);
+    /// overrides highlightCode.
+    /// default: false
+    abstract forceColor: bool option with get, set
+    /// Pass in a string to be displayed inline (if possible) next to the
+    /// highlighted location in the code. If it can't be positioned inline,
+    /// it will be placed above the code frame.
+    /// default: nothing
+    abstract message: string option with get, set
+
+type [<AllowNullLiteral>] ICodeframe =
+    [<Emit("$0($1...)")>]
+    abstract Invoke: rawLines: string * lineNumber: int * colNumber: int * ?options: BabelCodeFrameOptions -> string
+
+type [<AllowNullLiteral>] ICodeframeColumns =
+    [<Emit("$0($1...)")>]
+    abstract Invoke: rawLines: string * location: SourceLocation * ?options: BabelCodeFrameOptions -> string
+
+let [<ImportDefault("@babel/code-frame")>] codeFrame: ICodeframe = jsNative
+
+let [<Import("codeFrameColumns", "@babel/code-frame")>] codeFrameColumns: ICodeframeColumns = jsNative
+
+type Codeframe =
+    static member CreateColumns(rawLines, startLine, ?startCol, ?endLine, ?endCol, ?highlightCode, ?linesAbove, ?linesBelow, ?forceColor, ?message) =
+        let options : BabelCodeFrameOptions = JsInterop.createEmpty
+        options.highlightCode <- highlightCode
+        options.linesAbove <- linesAbove
+        options.linesBelow <- linesBelow
+        options.forceColor <- forceColor
+        options.message <- message
+        let startPos = {| line = startLine; column = startCol |}
+        let endPos =
+            match endLine with
+            | Some x -> Some {| line = x; column = endCol |}
+            | None -> None
+        let loc : SourceLocation = JsInterop.createEmpty
+        loc.start <- startPos
+        loc.``end`` <- endPos
+        codeFrameColumns.Invoke(rawLines, loc, options)
+    static member Create(rawLines, line, col, ?highlightCode, ?linesAbove, ?linesBelow, ?forceColor, ?message) =
+        let options : BabelCodeFrameOptions = JsInterop.createEmpty
+        options.highlightCode <- highlightCode
+        options.linesAbove <- linesAbove
+        options.linesBelow <- linesBelow
+        options.forceColor <- forceColor
+        options.message <- message
+        codeFrame.Invoke(rawLines, line, col, options)

lib/Extensions.fs

@@ -220,6 +220,11 @@ module Path =
     if Node.path.isAbsolute(path) then path |> normalizeSlashes
     else Node.path.resolve(path) |> normalizeSlashes
 
+  let relativeToCwd (path: string) =
+    if Node.path.isAbsolute(path) then
+      Node.path.relative(Node.``process``.cwd(), path) |> normalizeSlashes
+    else path |> normalizeSlashes
+
   let diff (fromPath: Absolute) (toPath: Absolute) : string =
     let fromPath =
       if Node.fs.lstatSync(!^fromPath).isDirectory() then fromPath

lib/Parser.fs

@@ -32,16 +32,21 @@ module private ParserImpl =
     let ppLocation (n: Node) =
       let src = n.getSourceFile()
       let pos = src.getLineAndCharacterOfPosition (n.getStart())
-      sprintf "line %i, col %i of %s" (int pos.line + 1) (int pos.character + 1) src.fileName
+      sprintf "line %i, col %i of %s" (int pos.line + 1) (int pos.character + 1) (Path.relativeToCwd src.fileName)
 
     let ppLine (n: Node) =
       let src = n.getSourceFile()
-      let pos = src.getLineAndCharacterOfPosition (n.getStart())
-      let startPos = int <| src.getPositionOfLineAndCharacter(pos.line, 0.)
-      let endPos = int <| src.getLineEndOfPosition(n.getEnd())
-      let lines =
-        src.text.Substring(startPos, endPos - startPos) |> String.toLines
-      lines |> Array.map (sprintf "> %s") |> String.concat System.Environment.NewLine
+      let startPos = src.getLineAndCharacterOfPosition(n.getStart())
+      let endPos = src.getLineAndCharacterOfPosition(n.getEnd())
+      let text = src.text
+      Codeframe.Codeframe.CreateColumns(
+        text,
+        int startPos.line + 1,
+        int startPos.character + 1,
+        int endPos.line + 1,
+        int endPos.character + 1,
+        linesAbove=0, linesBelow=0
+      )
 
   let nodeWarn (ctx: ParserContext) (node: Node) format =
     Printf.kprintf (fun s ->
@@ -1114,12 +1119,12 @@ let createDependencyGraph (sourceFiles: Ts.SourceFile[]) =
   for source in sourceFiles do goSourceFile source
   graph
 
-let assertFileExistsAndHasCorrectExtension (fileName: string) =
+let assertFileExistsAndHasCorrectExtension (ctx: #IContext<#IOptions>) (fileName: string) =
   assertNode ()
   if not <| Node.fs.existsSync(!^fileName) then
-    failwithf "file '%s' does not exist" fileName
-  if fileName.EndsWith(".d.ts") |> not then
-    failwithf "file '%s' is not a TypeScript declaration file" fileName
+    ctx.logger.errorf "file '%s' does not exist" fileName
+  if fileName.EndsWith(".ts") |> not then
+    ctx.logger.errorf "file '%s' is not a TypeScript file" fileName
   fileName
 
 let createContextFromFiles (ctx: #IContext<#IOptions>) compilerOptions (fileNames: string[]) : ParserContext =
@@ -1129,11 +1134,11 @@ let createContextFromFiles (ctx: #IContext<#IOptions>) compilerOptions (fileName
       if not ctx.options.followRelativeReferences then
         fileNames
         |> Array.map Path.absolute
-        |> Array.map assertFileExistsAndHasCorrectExtension
+        |> Array.map (assertFileExistsAndHasCorrectExtension ctx)
       else
         fileNames
         |> Array.map Path.absolute
-        |> Array.map assertFileExistsAndHasCorrectExtension
+        |> Array.map (assertFileExistsAndHasCorrectExtension ctx)
         |> Array.map (fun a -> a, Node.fs.readFileSync(a, "utf-8"))
         |> Array.map (fun (a, i) ->
           ts.createSourceFile (a, i, !^Ts.ScriptTarget.Latest, setParentNodes=true, scriptKind=Ts.ScriptKind.TS))

lib/Syntax.fs

@@ -45,12 +45,12 @@ with
       sprintf "line %i, col %i of %s"
         (int pos.line + 1)
         (int pos.character + 1)
-        src.fileName
+        (Path.relativeToCwd src.fileName)
     | Location l ->
       sprintf "line %i, col %i of %s"
         (int l.line + 1)
         (int l.character + 1)
-        l.src.fileName
+        (Path.relativeToCwd l.src.fileName)
     | MultipleLocation l ->
       l |> List.map (fun x -> x.AsString) |> String.concat " and "
     | UnknownLocation -> "<unknown>"

lib/Typer.fs

@@ -136,7 +136,7 @@ type TyperContext<'Options, 'State when 'Options :> IOptions> = private {
     member this.logger = this.logger
 
 let inline private warn (ctx: IContext<_>) (loc: Location) fmt =
-  Printf.kprintf (fun s -> ctx.logger.warnf "%s at %s" s loc.AsString) fmt
+  Printf.kprintf (fun s -> ctx.logger.warnf "%s at %s" s (Path.relativeToCwd loc.AsString)) fmt
 
 module TyperContext =
   type private Anonoymous<'Options, 'State when 'Options :> IOptions> = {|

lib/ts2ml.fsproj

@@ -5,6 +5,8 @@
   <ItemGroup>
     <Compile Include="Bindings/TypeScript.fs" />
     <Compile Include="Bindings/BrowserOrNode.fs" />
+    <Compile Include="Bindings/Chalk.fs" />
+    <Compile Include="Bindings/Codeframe.fs" />
     <Compile Include="Extensions.fs" />
     <Compile Include="DataTypes/Text.fs" />
     <Compile Include="DataTypes/Trie.fs" />

package.json

@@ -27,13 +27,16 @@
     "ts2ocaml": "./dist/ts2ocaml.js"
   },
   "dependencies": {
+    "@babel/code-frame": "^7.18.6",
     "browser-or-node": "^2.0.0",
+    "chalk": "^5.0.1",
     "typescript": "4.7",
     "yargs": "17.5.1"
   },
   "devDependencies": {
     "@angular/common": "^13.0.3",
     "@babel/core": "7.18.2",
+    "@types/babel__code-frame": "^7.0.3",
     "@types/react-modal": "3.13.1",
     "@types/semver": "7.3.9",
     "@types/vscode": "^1.63.1",

src/Common.fs

@@ -45,15 +45,22 @@ module Log =
   let warnf (opt: 'Options) fmt : _ when 'Options :> GlobalOptions =
     Printf.ksprintf (fun str ->
       if not opt.nowarn then
-        eprintfn "warn: %s" str
+        eprintfn "%s %s" (Chalk.chalk.yellow["warn:"]) str
+    ) fmt
+
+  let errorf fmt =
+    Printf.ksprintf (fun str ->
+      eprintfn "%s %s" (Chalk.chalk.red["error:"]) str
+      Node.Api.``process``.exit -1
+      failwith str
     ) fmt
 
 let createBaseContext (opts: #GlobalOptions) : IContext<_> =
   let logger =
     { new ILogger with
         member _.tracef fmt = Log.tracef opts fmt
         member _.warnf  fmt = Log.warnf opts fmt
-        member _.errorf fmt = failwithf fmt
+        member _.errorf fmt = Log.errorf fmt
     }
   { new IContext<_> with
       member _.options = opts

src/Targets/JsOfOCaml/Target.fs

@@ -22,7 +22,7 @@ let private run (input: Input) (ctx: IContext<Options>) =
         if Node.Api.path.isAbsolute dir then dir
         else Node.Api.path.join [|curdir; dir|]
       let fail () =
-        failwithf "The output directory '%s' does not exist." path
+        ctx.logger.errorf "The output directory '%s' does not exist." path
       try
         if Node.Api.fs.lstatSync(!^path).isDirectory() then path
         else fail ()
@@ -60,7 +60,7 @@ let private run (input: Input) (ctx: IContext<Options>) =
                     .Split([|Node.Api.os.EOL|], System.StringSplitOptions.RemoveEmptyEntries)
         |> Set.ofArray
       else
-        failwithf "The path '%s' is not a file." stubFile
+        ctx.logger.errorf "The path '%s' is not a file." stubFile
     let stubLines = Set.union existingStubLines newStubLines
     if stubLines <> existingStubLines then
       ctx.logger.tracef "* writing the stub file to '%s'..." stubFile