content script now doesn't rewrite code as refmt errors

bsconfig.json

@@ -3,7 +3,7 @@
   "name" : "reason-tools",
   "version": "0.0.0",
   "reason" : {"react-jsx" : 2},
-  "bs-dependencies": ["reason-react"],
+  "bs-dependencies": ["reason-react", "bs-result"],
   "sources": {
     "dir": "src",
     "subdirs": [

package.json

@@ -38,6 +38,7 @@
   },
   "devDependencies": {
     "bs-platform": "^2.2.1",
+    "bs-result": "^1.1.0",
     "chrome-store-api": "^1.0.5",
     "file-loader": "^1.1.5",
     "generate-json-webpack-plugin": "^0.2.1",

src/extension/background.re

@@ -1,22 +1,19 @@
 open Core;
 
 module Refmt = {
-  let refmt = Refmt2.refmtJS;
+  let refmt = Refmt2.refmt;
   let parse =
     fun
-    | ("Failure", error) => Protocol.Error(error)
-    | (conversion, outText) =>
-      switch (conversion |> Js.String.split("to")) {
-      | [|inLang, outLang|] when Protocol.languageOfString(outLang) != RefmtShared.UnknownLang =>
-        Protocol.Ok(
+    | Result.Error(error) => Result.Error(error)
+    | Result.Ok((inLang, outLang, outText)) =>
+        Result.Ok(
           Protocol.Refmt.{
             outText,
-            inLang: Protocol.languageOfString(inLang),
-            outLang: Protocol.languageOfString(outLang)
+            inLang,
+            outLang
           }
         )
-      | _ => Protocol.Error(outText)
-      };
+        ;
 };
 
 Protocol.Refmt.listen(

src/extension/common/protocol.re

@@ -1,8 +1,5 @@
 open Common;
-
-type result('a, 'e) =
-  | Ok('a)
-  | Error('e);
+open Result;
 
 type language = RefmtShared.language;
 
@@ -30,58 +27,47 @@ module Refmt = {
     inType: codeType,
     outLang: language
   };
-  type payloadSerialized = {
-    outText: string,
-    inLang: string,
-    outLang: string
-  };
+  [@bs.deriving jsConverter]
   type payload = {
     outText: string,
     inLang: language,
     outLang: language
   };
-  type response = result(payload, string);
+  type response = result(string, payload);
+  let responseToJs = x => {
+    switch (x) {
+    | Result.Ok(x) => Obj.magic(("Ok", payloadToJs(x)))
+    | Result.Error(x) => Obj.magic(("Error", x))
+    };
+  };
+  let responseFromJs:Js.Json.t=>response = x => {
+    switch(Obj.magic(x)) {
+    | ("Ok", x) =>    Result.Ok(payloadFromJs(Obj.magic(x)))
+    | (_, x) => Result.Error(Obj.magic(x))
+    };
+  };
   /* Bucklescript's variant tags will be erased when serialized, so we have to manually serialize the response
    */
-  let serialize: result(payload, string) => (int, payloadSerialized) =
-    fun
-    | Error(error) => (0, {outText: error, inLang: "", outLang: ""})
-    | Ok(payload) => (
-        1,
-        {
-          outText: payload.outText,
-          inLang: stringOfLanguage(payload.inLang),
-          outLang: stringOfLanguage(payload.outLang)
-        }
-      );
-  let deserialize: ((int, payloadSerialized)) => result(payload, string) =
-    fun
-    | (0, {outText: error}) => Error(error)
-    | (1, payload) =>
-      Ok({
-        outText: payload.outText,
-        inLang: languageOfString(payload.inLang),
-        outLang: languageOfString(payload.outLang)
-      })
-    | _ => raise(DeserializationFail);
   let send =
       (
         text,
         ~inLang=RefmtShared.UnknownLang,
         ~inType=RefmtShared.UnknownType,
         ~outLang=RefmtShared.UnknownLang,
-        cb
+        cb:(response)=>unit
       ) =>
     Message.query(
       "refmt:refmt",
       {input: text |> normalizeText |> untoplevel, inLang, inType, outLang},
-      (response) => cb(deserialize(response))
+      (response) => cb(responseFromJs(response))
     );
   let listen: ((request, response => unit) => unit) => unit =
     (cb) =>
       Message.receive(
         "refmt:refmt",
-        (request, _, respond) => cb(request, (r) => r |> serialize |> respond)
+        (request, _, respond) => cb(request, (r) => {
+          r |> responseToJs |> respond;
+        })
       );
 };
 

src/extension/content/convert/detect.re

@@ -54,7 +54,9 @@ let getBlacklist = () => [
   "mwhittaker.github.io/distributed-systems-ocaml/code_MorePipes.html" /* #49 */
 ];
 
-let getWhitelist = () => [];
+let getWhitelist = () => [
+  "codebad.com/~hdon/reason-tools-test.html"
+];
 
 let getSignificantUrl = () => Location.hostname ++ Location.pathname;
 

src/extension/content/convertPage.re

@@ -29,8 +29,8 @@ let doListing = (mode, state, listing) => {
     text,
     (response) => {
       switch response {
-      | Protocol.Error(_) => () /* TODO */
-      | Protocol.Ok({outText}) => Replace.replaceListing(els, outText, replace)
+      | Result.Error(_) => () /* TODO */
+      | Result.Ok({outText}) => Replace.replaceListing(els, outText, replace)
       };
       /* we're in an async callback, so keep track of when we're finished by keeping count */
       state.remaining = state.remaining - 1;

src/extension/content/overlay.re

@@ -30,8 +30,8 @@ let try_ = (text) =>
     text,
     (response) =>
       switch response {
-      | Error(message) => showError(message)
-      | Ok({outText, inLang, outLang}) => showOverlay(inLang, text, outLang, outText)
+      | Result.Error(message) => showError(message)
+      | Result.Ok({outText, inLang, outLang}) => showOverlay(inLang, text, outLang, outText)
       }
   );
 

src/extension/page.re

@@ -26,8 +26,8 @@ let refmt =
     ~outLang,
     (error) =>
       switch error {
-      | Protocol.Error(error) => cb(error, RefmtShared.UnknownLang, RefmtShared.UnknownLang)
-      | Protocol.Ok({outText, inLang, outLang}) => cb(outText, inLang, outLang)
+      | Result.Error(error) => cb(error, RefmtShared.UnknownLang, RefmtShared.UnknownLang)
+      | Result.Ok({outText, inLang, outLang}) => cb(outText, inLang, outLang)
       }
   );
   Protocol.Storage.setLatestInput(input)

src/extension/popup.re

@@ -46,8 +46,8 @@ let refmt =
     ~outLang,
     (error) =>
       switch error {
-      | Error(error) => cb(error, RefmtShared.UnknownLang, RefmtShared.UnknownLang)
-      | Ok({outText, inLang, outLang}) => cb(outText, inLang, outLang)
+      | Result.Error(error) => cb(error, RefmtShared.UnknownLang, RefmtShared.UnknownLang)
+      | Result.Ok({outText, inLang, outLang}) => cb(outText, inLang, outLang)
       }
   );
   Protocol.Storage.setLatestInput(input)

src/refmt/refmt2.re

@@ -171,6 +171,8 @@ let attempts = (inLang, inType) =>
   | (UnknownLang, UnknownType) => [parseRE, parseREI, parseREOld, parseREIOld, parseML, parseMLI]
   };
 
+let optionalString = fun | Some(s:string) => s | None => "";
+
 let refmt = (code, inLang, inType, outLang) => {
   let parsersToTry = attempts(inLang, inType);
   let results = List.map((parser) => parser(code), parsersToTry);
@@ -220,12 +222,12 @@ let refmt = (code, inLang, inType, outLang) => {
       | (UnknownLang, Ast(REI(ast))) => (ML, printMLI(ast))
       | (_, Error(error)) =>
         switch error {
-        | REI(thing) => (RE, Js.Exn.message(thing) |? "")
-        | RE(thing) => (RE, Js.Exn.message(thing) |? "")
-        | ML(thing) => (ML, Js.Exn.message(thing) |? "")
-        | MLI(thing) => (ML, Js.Exn.message(thing) |? "")
-        | REO(thing) => (REO, Js.Exn.message(thing) |? "")
-        | REOI(thing) => (REO, Js.Exn.message(thing) |? "")
+        | REI(thing)  => raise(Failure(Js.Exn.message(thing)|>optionalString))
+        | RE(thing)   => raise(Failure(Js.Exn.message(thing)|>optionalString))
+        | ML(thing)   => raise(Failure(Js.Exn.message(thing)|>optionalString))
+        | MLI(thing)  => raise(Failure(Js.Exn.message(thing)|>optionalString))
+        | REO(thing)  => raise(Failure(Js.Exn.message(thing)|>optionalString))
+        | REOI(thing) => raise(Failure(Js.Exn.message(thing)|>optionalString))
         }
       };
     let trueIn =
@@ -238,13 +240,10 @@ let refmt = (code, inLang, inType, outLang) => {
       | Ast(REOI(_)) => REO
       | Error(_) => UnknownLang
       };
-    (trueIn, trueOut, printedResult)
+    Result.Ok((trueIn, trueOut, printedResult))
   } {
-  | a => (UnknownLang, UnknownLang, Obj.magic(a))
+  | a => {
+    Result.Error(a |> Printexc.to_string)
+    }
   }
 };
-
-let refmtJS = (jsString, inLang, inType, outLang) => {
-  let (trueIn, trueOut, s) = refmt(jsString, inLang, inType, outLang);
-  (stringOfLanguage(trueIn) ++ "to" ++ stringOfLanguage(trueOut), s)
-};

yarn.lock

@@ -253,8 +253,12 @@ browserify-zlib@^0.2.0:
     pako "~1.0.5"
 
 bs-platform@^2.2.1:
-  version "2.2.1"
-  resolved "https://registry.yarnpkg.com/bs-platform/-/bs-platform-2.2.1.tgz#e22b82143a43a10630d7b2040aab87648b12190c"
+  version "2.2.3"
+  resolved "https://registry.yarnpkg.com/bs-platform/-/bs-platform-2.2.3.tgz#d905ae10a5f3621e6a739041dfa0b58483a2174f"
+
+bs-result@^1.1.0:
+  version "1.1.0"
+  resolved "https://registry.yarnpkg.com/bs-result/-/bs-result-1.1.0.tgz#dcc1e3ca4692ec5fa31df83bf288b5ca2d123e6f"
 
 buffer-crc32@~0.2.3:
   version "0.2.13"