Merge pull request rescript-lang#55 from reason-association/playground-ui-improvements

Playground UI improvements

Author: ryyppy

bindings/Bs_platform_api.re

@@ -6,6 +6,8 @@
 // has been loaded, so we'd prefer to protect this
 // API with the playground compiler manager state
 
+[@bs.val] [@bs.scope "performance"] external now: unit => float = "now";
+
 module Lang = {
   type t =
     | Reason
@@ -109,6 +111,32 @@ module LocMsg = {
 
     {j|[$prefix] Line $row, $column: $shortMsg|j};
   };
+
+  // Creates a somewhat unique id based on the rows / cols of the locMsg
+  let makeId = t => {
+    Belt.Int.(
+      toString(t.row)
+      ++ "-"
+      ++ toString(t.endRow)
+      ++ "-"
+      ++ toString(t.column)
+      ++ "-"
+      ++ toString(t.endColumn)
+    );
+  };
+
+  let dedupe = (arr: array(t)) => {
+    let result = Js.Dict.empty();
+
+    for (i in 0 to Js.Array.length(arr) - 1) {
+      let locMsg = Js.Array2.unsafe_get(arr, i);
+      let id = makeId(locMsg);
+
+      // The last element with the same id wins
+      result->Js.Dict.set(id, locMsg);
+    };
+    Js.Dict.values(result);
+  };
 };
 
 module Warning = {
@@ -173,12 +201,14 @@ module CompileSuccess = {
   type t = {
     js_code: string,
     warnings: array(Warning.t),
+    time: float // total compilation time
   };
 
-  let decode = (json): t => {
+  let decode = (~time: float, json): t => {
     Json.Decode.{
       js_code: field("js_code", string, json),
       warnings: field("warnings", array(Warning.decode), json),
+      time,
     };
   };
 };
@@ -213,7 +243,9 @@ module CompileFail = {
     switch (field("type", string, json)) {
     | "syntax_error" =>
       let locMsgs = field("errors", array(LocMsg.decode), json);
-      SyntaxErr(locMsgs);
+      // TODO: There seems to be a bug in the ReScript bundle that reports
+      //       back multiple LocMsgs of the same value
+      locMsgs->LocMsg.dedupe->SyntaxErr;
     | "type_error" =>
       let locMsgs = field("errors", array(LocMsg.decode), json);
       TypecheckErr(locMsgs);
@@ -241,12 +273,12 @@ module CompilationResult = {
     | Unknown(string, Js.Json.t);
 
   // TODO: We might change this specific api completely before launching
-  let decode = (json: Js.Json.t): t => {
+  let decode = (~time: float, json: Js.Json.t): t => {
     open! Json.Decode;
 
     try(
       switch (field("type", string, json)) {
-      | "success" => Success(CompileSuccess.decode(json))
+      | "success" => Success(CompileSuccess.decode(~time, json))
       | "unexpected_error" => UnexpectedError(field("msg", string, json))
       | _ => Fail(CompileFail.decode(json))
       }
@@ -288,7 +320,6 @@ module Config = {
   type t = {
     module_system: string,
     warn_flags: string,
-    warn_error_flags: string,
   };
 };
 
@@ -299,8 +330,6 @@ module Compiler = {
   [@bs.val] [@bs.scope "bs_platform"] external make: unit => t = "make";
 
   [@bs.get] external version: t => string = "version";
-  [@bs.get]
-  external version_git_commit: t => option(string) = "version_git_commit";
 
   /*
       Res compiler actions
@@ -311,7 +340,11 @@ module Compiler = {
   external resCompile: (t, string) => Js.Json.t = "compile";
 
   let resCompile = (t, code): CompilationResult.t => {
-    resCompile(t, code)->CompilationResult.decode;
+    let startTime = now();
+    let json = resCompile(t, code);
+    let stopTime = now();
+
+    CompilationResult.decode(~time=stopTime -. startTime, json);
   };
 
   [@bs.send] [@bs.scope "napkin"]
@@ -331,7 +364,11 @@ module Compiler = {
   [@bs.send] [@bs.scope "reason"]
   external reasonCompile: (t, string) => Js.Json.t = "compile";
   let reasonCompile = (t, code): CompilationResult.t => {
-    reasonCompile(t, code)->CompilationResult.decode;
+    let startTime = now();
+    let json = reasonCompile(t, code);
+    let stopTime = now();
+
+    CompilationResult.decode(~time=stopTime -. startTime, json);
   };
 
   [@bs.send] [@bs.scope "reason"]
@@ -351,7 +388,11 @@ module Compiler = {
   external ocamlCompile: (t, string) => Js.Json.t = "compile";
 
   let ocamlCompile = (t, code): CompilationResult.t => {
-    ocamlCompile(t, code)->CompilationResult.decode;
+    let startTime = now();
+    let json = ocamlCompile(t, code);
+    let stopTime = now();
+
+    CompilationResult.decode(~time=stopTime -. startTime, json);
   };
 
   /*
@@ -367,9 +408,6 @@ module Compiler = {
 
   [@bs.send] external setWarnFlags: (t, string) => bool = "setWarnFlags";
 
-  [@bs.send]
-  external setWarnErrorFlags: (t, string) => bool = "setWarnErrorFlags";
-
   let setConfig = (t: t, config: Config.t): unit => {
     let moduleSystem =
       switch (config.module_system) {
@@ -383,7 +421,6 @@ module Compiler = {
     );
 
     t->setWarnFlags(config.warn_flags)->ignore;
-    t->setWarnErrorFlags(config.warn_error_flags)->ignore;
   };
 
   [@bs.send]

common/HighlightJs.re

@@ -4,3 +4,48 @@ type highlightResult = {value: string};
 [@bs.module "highlight.js/lib/highlight"]
 external highlight: (~lang: string, ~value: string) => highlightResult =
   "highlight";
+
+let renderHLJS =
+    (
+      ~highlightedLines=[||],
+      ~darkmode=false,
+      ~code: string,
+      ~lang: string,
+      (),
+    ) => {
+  // If the language couldn't be parsed, we will fall back to text
+  let (lang, highlighted) =
+    try((lang, highlight(~lang, ~value=code)->valueGet)) {
+    | Js.Exn.Error(_) => ("text", code)
+    };
+
+  // Add line highlighting as well
+  let highlighted =
+    if (Belt.Array.length(highlightedLines) > 0) {
+      Js.String2.split(highlighted, "\n")
+      ->Belt.Array.mapWithIndex((i, line) =>
+          if (Js.Array2.find(highlightedLines, lnum => lnum === i + 1) !== None) {
+            "<span class=\"hljs-line-highlight\">" ++ line ++ "</span>";
+          } else {
+            line;
+          }
+        )
+      ->Js.Array2.joinWith("\n");
+    } else {
+      highlighted;
+    };
+
+  let dark = darkmode ? "dark" : "";
+
+  ReactDOMRe.createElementVariadic(
+    "code",
+    ~props=
+      ReactDOMRe.objToDOMProps({
+        "className": "hljs lang-" ++ lang ++ " " ++ dark,
+        "dangerouslySetInnerHTML": {
+          "__html": highlighted,
+        },
+      }),
+    [||],
+  );
+};

components/CodeExample.re

@@ -1,41 +1,5 @@
 open Util.ReactStuff;
 
-let renderHLJS = (~highlightedLines=[||], ~code: string, ~lang: string, ()) => {
-  // If the language couldn't be parsed, we will fall back to text
-  let (lang, highlighted) =
-    try((lang, HighlightJs.(highlight(~lang, ~value=code)->valueGet))) {
-    | Js.Exn.Error(_) => ("text", code)
-    };
-
-  // Add line highlighting as well
-  let highlighted =
-    if (Belt.Array.length(highlightedLines) > 0) {
-      Js.String2.split(highlighted, "\n")
-      ->Belt.Array.mapWithIndex((i, line) =>
-          if (Js.Array2.find(highlightedLines, lnum => lnum === i + 1) !== None) {
-            "<span class=\"hljs-line-highlight\">" ++ line ++ "</span>";
-          } else {
-            line;
-          }
-        )
-      ->Js.Array2.joinWith("\n");
-    } else {
-      highlighted;
-    };
-
-  ReactDOMRe.createElementVariadic(
-    "code",
-    ~props=
-      ReactDOMRe.objToDOMProps({
-        "className": "wrap hljs lang-" ++ lang,
-        "dangerouslySetInnerHTML": {
-          "__html": highlighted,
-        },
-      }),
-    [||],
-  );
-};
-
 let langShortname = (lang: string) => {
   switch (lang) {
   | "ocaml" => "ml"
@@ -49,7 +13,7 @@ let langShortname = (lang: string) => {
 
 [@react.component]
 let make = (~highlightedLines=[||], ~code: string, ~showLabel=true, ~lang="text") => {
-  let children = renderHLJS(~highlightedLines, ~code, ~lang, ());
+  let children = HighlightJs.renderHLJS(~highlightedLines, ~code, ~lang, ());
 
   let label = if(showLabel) {
     let label = langShortname(lang);
@@ -136,7 +100,7 @@ module Toggle = {
         Belt.Array.get(multiple, selected)
         ->Belt.Option.map(tab => {
             let lang = Belt.Option.getWithDefault(tab.lang, "text");
-            renderHLJS(
+            HighlightJs.renderHLJS(
               ~highlightedLines=?tab.highlightedLines,
               ~code=tab.code,
               ~lang,