From adab8c4bbbb092020723af1fa2cf437e66b2fdd7 Mon Sep 17 00:00:00 2001
From: Thibaut Mattio <thibaut.mattio@gmail.com>
Date: Mon, 3 May 2021 17:47:32 +0200
Subject: [PATCH] Add live reloading example (#52)

---
 example/w-live-reloading/README.md         | 17 +++++
 example/w-live-reloading/dune              |  4 +
 example/w-live-reloading/dune-project      |  1 +
 example/w-live-reloading/esy.json          | 10 +++
 example/w-live-reloading/live_reloading.ml | 89 ++++++++++++++++++++++
 5 files changed, 121 insertions(+)
 create mode 100644 example/w-live-reloading/README.md
 create mode 100644 example/w-live-reloading/dune
 create mode 100644 example/w-live-reloading/dune-project
 create mode 100644 example/w-live-reloading/esy.json
 create mode 100644 example/w-live-reloading/live_reloading.ml

diff --git a/example/w-live-reloading/README.md b/example/w-live-reloading/README.md
new file mode 100644
index 00000000..954ae54e
--- /dev/null
+++ b/example/w-live-reloading/README.md
@@ -0,0 +1,17 @@
+# `w-live-reload`
+
+<br>
+
+This example demonstrates how to setup live reloading of the client HTML content.
+
+It works by injecting a script in the HTML pages sent to clients that will initiate a WebSocket.
+
+When the server restarts, the WebSocket connection is lost, at which point, the client will try to reconnect every 500ms for 5s.
+If within these 5s the client is able to reconnect to the server, it will trigger a reload of the page.
+
+This example plays very well with `w-fswatch`, which demonstrates how to restart the server every time the filesystem is modified.
+When integrating the two examples, one is able to have a setup where the clients' pages are reloaded every time a file is modified.
+
+<br>
+
+[Up to the example index](../#examples)
diff --git a/example/w-live-reloading/dune b/example/w-live-reloading/dune
new file mode 100644
index 00000000..dafcbcdf
--- /dev/null
+++ b/example/w-live-reloading/dune
@@ -0,0 +1,4 @@
+(executable
+ (name live_reloading)
+ (libraries dream lambdasoup)
+ (preprocess (pps lwt_ppx)))
diff --git a/example/w-live-reloading/dune-project b/example/w-live-reloading/dune-project
new file mode 100644
index 00000000..929c696e
--- /dev/null
+++ b/example/w-live-reloading/dune-project
@@ -0,0 +1 @@
+(lang dune 2.0)
diff --git a/example/w-live-reloading/esy.json b/example/w-live-reloading/esy.json
new file mode 100644
index 00000000..ed4a56fc
--- /dev/null
+++ b/example/w-live-reloading/esy.json
@@ -0,0 +1,10 @@
+{
+  "dependencies": {
+    "@opam/dream": "aantron/dream:dream.opam",
+    "@opam/dune": "^2.0",
+    "ocaml": "4.12.x"
+  },
+  "scripts": {
+    "start": "dune exec --root . ./live_reloading.exe"
+  }
+}
diff --git a/example/w-live-reloading/live_reloading.ml b/example/w-live-reloading/live_reloading.ml
new file mode 100644
index 00000000..26234c4e
--- /dev/null
+++ b/example/w-live-reloading/live_reloading.ml
@@ -0,0 +1,89 @@
+let livereload_script
+    ?(retry_interval_ms = 500)
+    ?(max_retry_ms = 5000)
+    ?(route = "/_livereload")
+    ()
+  =
+  Printf.sprintf
+    {js|
+var socketUrl = "ws://" + location.host + "%s"
+var s = new WebSocket(socketUrl);
+
+s.onopen = function(even) {
+  console.log("WebSocket connection open.");
+};
+
+s.onclose = function(even) {
+  console.log("WebSocket connection closed.");
+  const innerMs = %i;
+  const maxMs = %i;
+  const maxAttempts = Math.round(maxMs / innerMs);
+  let attempts = 0;
+  function reload() {
+    attempts++;
+    if(attempts > maxAttempts) {
+      console.error("Could not reconnect to dev server.");
+      return;
+    }
+
+    s2 = new WebSocket(socketUrl);
+
+    s2.onerror = function(event) {
+      setTimeout(reload, innerMs);
+    };
+
+    s2.onopen = function(event) {
+      location.reload();
+    };
+  };
+  reload();
+};
+
+s.onerror = function(event) {
+  console.error("WebSocket error observed:", event);
+};
+|js}
+    route
+    retry_interval_ms
+    max_retry_ms
+
+let inject_livereload_script
+    ?(reload_script = livereload_script ())
+    ()
+    (next_handler : Dream.request -> Dream.response Lwt.t)
+    (request : Dream.request)
+    : Dream.response Lwt.t
+  =
+  let%lwt response = next_handler request in
+  match Dream.header "Content-Type" response with
+  | Some "text/html" | Some "text/html; charset=utf-8" ->
+    let%lwt body = Dream.body response in
+    let soup = Soup.parse body in
+    let open Soup.Infix in
+    (match soup $? "head" with
+    | None ->
+      Lwt.return response
+    | Some head ->
+      Soup.create_element "script" ~inner_text:reload_script
+      |> Soup.append_child head;
+      Lwt.return (Dream.with_body (Soup.to_string soup) response))
+  | _ ->
+    Lwt.return response
+
+let livereload_route ?(path = "/_livereload") () =
+  Dream.get path (fun _ ->
+      Dream.websocket (fun socket ->
+          Lwt.bind (Dream.receive socket) (fun _ ->
+              Dream.close_websocket socket)))
+
+let () =
+  Dream.run
+  @@ Dream.logger
+  @@ inject_livereload_script ()
+  @@ Dream.router [
+    livereload_route ();
+    Dream.get "/"
+      (fun _ ->
+        Dream.html "Good morning, world!");
+  ]
+  @@ Dream.not_found