all the goods

bsconfig.json

@@ -1,9 +1,9 @@
 {
   "name": "reason-cli-tools",
-  "namespace": true,
+  // "namespace": true,
   "bsc-flags": "-w -27 -g",
   "warnings": {
-    "number": "-40+6+7-26-27+32..39-28-44+45",
+    "number": "-40+6+7-26-27+32..39-28-44+45-102",
     "error": "+8",
   },
   "sources": [
@@ -14,12 +14,13 @@
     ]},
     {"dir": "test", "type": "dev"},
   ],
+  "ppx-flags": ["./node_modules/matchenv/matchenv"],
   "entries": [{
     "backend": "native",
-    "main-module": "Test"
+    "main-module": "Test_native"
   }, {
     "backend": "js",
-    "main-module": "Test"
+    "main-module": "Test_js"
   }],
   "refmt": 3
 }

package.json

@@ -11,11 +11,14 @@
   "scripts": {
     "build": "bsb -make-world -backend native",
     "watch": "bsb -make-world -backend native -w",
-    "clean": "bsb -clean-world"
+    "clean": "bsb -clean-world",
+    "js": "bsb -make-world -backend js",
+    "js:watch": "bsb -make-world -backend js -w"
   },
-  "// js": "bsb -make-world -backend js",
-  "// js:watch": "bsb -make-world -backend js -w",
   "devDependencies": {
     "bs-platform": "bsansouci/bsb-native#fast"
+  },
+  "dependencies": {
+    "matchenv": "github:bsansouci/matchenv"
   }
 }

src/Commands.re

@@ -0,0 +1,8 @@
+
+include [%matchenv
+  switch BSB_BACKEND {
+  | "bytecode" => Commands_native
+  | "native" => Commands_native
+  | "js" => Commands_js
+  }
+];

src/native/Commands.rei → src/Commands.rei

@@ -1,11 +1,13 @@
 
+type job;
+ /* = (unit => unit, unit => unit); */
 
 /**
  * Get the output of a command, in lines, and whether it succeeded.
  */
 let execSync: (~cmd: string, ~onOut: string => unit=?, unit) => (list(string), bool);
 
-let exec: (~cmd: string, ~onOut: string => unit) => Async.job;
+let exec: (~cmd: string, ~onOut: string => unit) => job;
 
 /**
  * Returns a poll function, and a close function. Checks every `checkInterval`
@@ -22,4 +24,17 @@ let keepAlive:
     ~onStart: unit => unit=?,
     ~checkInterval: float=?,
     unit
-  ) => Async.job;
+  ) => job;
+
+let kill: job => unit;
+let poll: job => unit;
+
+/**
+ * Run an async command until it exits.
+ */
+let run: job => unit;
+
+/**
+ * Run multiple async commands in parallel until they all exit.
+ */
+let runAll: list(job) => unit;

src/Files.re

@@ -0,0 +1,8 @@
+
+include [%matchenv
+  switch BSB_BACKEND {
+  | "bytecode" => Files_native
+  | "native" => Files_native
+  | "js" => Files_js
+  }
+];

src/Utils.re

@@ -0,0 +1,7 @@
+include [%matchenv
+  switch BSB_BACKEND {
+  | "bytecode" => Utils_native
+  | "native" => Utils_native
+  | "js" => Utils_js
+  }
+];

src/Utils.rei

@@ -0,0 +1,2 @@
+
+let now: unit => float;

src/js/Commands_js.re

@@ -0,0 +1,65 @@
+
+
+type proc;
+
+type job = unit => unit;
+
+type buffer;
+[@bs.module "child_process"] external spawnSync:
+  (~cmd: string, ~args: array(string), ~options: Js.t({. shell: Js.boolean})) => Js.t({. stdout: buffer, stderr: buffer, status: int}) = "";
+
+[@bs.module "child_process"] external spawn:
+  (~cmd: string, ~args: array(string), ~options: Js.t({. shell: Js.boolean})) => proc = "";
+
+[@bs.send] external on: (proc, string, unit => unit) => unit = "";
+[@bs.send] external kill: proc => unit = "";
+[@bs.send] external onData: (proc, string, buffer => unit) => unit = "on";
+
+[@bs.send.pipe: buffer] external toString: (string) => string = "";
+
+let trimLastNewline = text => if (Js.String.endsWith("\n", text)) {
+  Js.String.slice(~from=0, ~to_=Js.String.length(text) - 1, text)
+} else {
+  text
+};
+
+let execSync = (~cmd, ~onOut=a => (), ()) => {
+  let res = spawnSync(~cmd, ~args=[||], ~options={"shell": Js.true_});
+  (res##stdout |> toString("utf8") |> trimLastNewline |> Js.String.split("\n") |> Array.to_list, res##status == 0)
+};
+
+let exec = (~cmd, ~onOut) => {
+  let proc = spawn(~cmd, ~args=[||], ~options={"shell": Js.true_});
+  () => ()
+};
+
+let run = (job) => ();
+let runAll = jobs => ();
+let poll = (job) => ();
+
+let keepAlive = (~cmd, ~onOut=l => (), ~onErr=a => (), ~onStart=() => (), ~checkInterval=1., ()) => {
+  let save = ref(None);
+  let rec start = () => {
+    Js.log("starting");
+    onStart();
+    let proc = spawn(~cmd, ~args=[||], ~options={"shell": Js.true_});
+    on(proc, "close", () => {
+      Js.log("close");
+      Js.Global.setTimeout(() => {
+        save := Some(start());
+        Js.log("AAA");
+      }, int_of_float(checkInterval *. 1000.)) |> ignore;
+    });
+    proc
+  };
+  let kill = () => {
+    switch save^ {
+    | Some(p) => kill(p)
+    | None => ()
+    }
+  };
+  save := Some(start());
+  kill
+};
+
+let kill = (job) => job();

src/js/Files_js.re

@@ -2,28 +2,30 @@
 type stat;
 
 [@bs.module "fs"] external existsSync: string => bool = "";
+[@bs.module "fs"] external rmdirSync: string => unit = "";
 [@bs.module "fs"] external readdirSync: string => array(string) = "";
-[@bs.module "fs"] external readFileSync: string => string = "";
-[@bs.module "fs"] external writeFileSync: string => string => string = "";
+[@bs.module "fs"] external readFileSync: string => string => string = "";
+[@bs.module "fs"] external writeFileSync: string => string => string => unit = "";
 [@bs.module "fs"] external statSync: string => stat = "";
-[@bs.module "fs"] external mkdir: string => unit = "";
-[@bs.module "fs"] external unlink: string => unit = "";
+[@bs.module "fs"] external mkdirSync: string => unit = "";
+[@bs.module "fs"] external unlinkSync: string => unit = "";
 [@bs.send] external isFile: stat => bool = "";
 [@bs.send] external isDirectory: stat => bool = "";
 
 [@bs.module "path"] external dirname: string => string = "";
 [@bs.module "path"] external join: string => string => string = "";
 
-let removeDeep = path => {
+let rec removeDeep = path => {
   if (existsSync(path)) {
     let stat = statSync(path);
     if (isDirectory(stat)) {
       Array.iter(
         name => removeDeep(join(path, name)),
         readdirSync(path)
-      )
+      );
+      rmdirSync(path);
     } else {
-      unlink(path)
+      unlinkSync(path)
     }
   }
 };
@@ -33,15 +35,31 @@ let isFile = path => try (isFile(statSync(path))) { | _ => false };
 let isDirectory = path => try (isDirectory(statSync(path))) { | _ => false };
 let rec mkdirp = path => {
   if (!exists(path)) {
-    mkdirp(dirname(path))
-    mkdir(path);
+    mkdirp(dirname(path));
+    mkdirSync(path);
   }
 };
 
 let readDirectory = path => Array.to_list(readdirSync(path));
-let readFile = path => try (Some(readFileSync(path))) { | _ => None };
-let writeFile = (path, contents) => writeFileSync(path, contents, "utf8");
+let readFile = path => try (Some(readFileSync(path, "utf8"))) { | e => {Js.log(e); None} };
+let writeFile = (path, contents) => try {writeFileSync(path, contents, "utf8"); true} { | _ => false };
 
-let copy: (~source: string, ~dest: string) => bool;
-let copyDeep: (~source: string, ~dest: string) => unit;
+let copy = (~source, ~dest) => {
+  switch (readFile(source)) {
+  | None => false
+  | Some(text) => writeFile(dest, text)
+  }
+};
+
+let rec copyDeep = (~source, ~dest) => {
+  mkdirp(dirname(dest));
+  if (isFile(source)) {
+    copy(~source, ~dest) |> ignore
+  } else if (isDirectory(source)) {
+    Array.iter(
+      name => copyDeep(~source=join(source, name), ~dest=join(dest, name)),
+      readdirSync(source)
+    );
+  }
+};
 

src/js/Utils_js.re

@@ -0,0 +1,2 @@
+
+let now = () => Js.Date.now() /. 1000.;

src/native/Commands.re → src/native/Commands_native.re

@@ -1,3 +1,5 @@
+type job = (unit => unit, unit => unit);
+
 /**
  * Get the output of a command, in lines.
  */
@@ -95,4 +97,12 @@ let keepAlive = (~cmd, ~onOut=line => (), ~onErr=line => (), ~onStart=() => (),
     Unix.kill(pid, 9)
   };
   (poll, close)
-};
+};
+
+let poll = ((poll, close)) => poll();
+
+let run = ((poll, close)) => while (true) poll();
+
+let runAll = jobs => while (true) List.iter(f => ());
+
+let kill = ((poll, close)) => close();

src/native/StaticServer.re → src/native/StaticServer.re_x

@@ -17,17 +17,25 @@ let ext = path => {
   List.nth(parts, List.length(parts) - 1)
 };
 
+let unwrap = (message, opt) => switch opt { | Some(x) => x | None => failwith(message)};
+
 open BasicServer.Response;
+
+let sendFile = (path, full_path) => switch (Files.readFile(full_path)) {
+| Some(text) => Ok(mime_for_name(ext(path)), text)
+| None => Bad(404, "File not found: " ++ path)
+};
+
 let serveStatic = (full_path, path) => {
   switch (Unix.stat(full_path)) {
   | exception Unix.Unix_error(Unix.ENOENT, _, _) => Bad(404, "File not found: " ++ path)
   | stat =>
   switch (stat.Unix.st_kind) {
-  | Unix.S_REG => Ok(mime_for_name(ext(path)), Files.readFile(full_path))
+  | Unix.S_REG => sendFile(path, full_path)
   | Unix.S_DIR => {
     let index = Filename.concat(full_path, "index.html");
-    if (isFile(index)) {
-      Ok("text/html", readFile(index))
+    if (Files.isFile(index)) {
+      sendFile(path, index)
     } else {
       Ok("text/plain", "Directory")
     }

src/native/Utils_native.re

@@ -0,0 +1,2 @@
+
+let now = Unix.gettimeofday;

test/Test_js.re

@@ -0,0 +1,3 @@
+open Test_shared;
+
+report();