Merge pull request #11 from jchavarri/atd

Integrate with atdgen

Author: jchavarri

.dockerignore

@@ -10,3 +10,7 @@ Dockerfile
 .ocamlformat
 docker.yml
 node_modules
+*.bs.js
+server/static/Index.js*
+/shared/gen/*.ml*
+

.github/workflows/main.yml

@@ -24,16 +24,30 @@ jobs:
             --file ./Dockerfile \
             --build-arg BUILDKIT_INLINE_CACHE=1 \
             "."
+      - name: Build client from dockerfile
+        run: |
+          docker build \
+            --target client \
+            --cache-from $CACHE_IMAGE:base \
+            --cache-from $CACHE_IMAGE:client \
+            --tag $CACHE_IMAGE:client \
+            --file ./Dockerfile \
+            --build-arg BUILDKIT_INLINE_CACHE=1 \
+            "."
       - name: Build stage from dockerfile
         run: |
           docker build \
+            --target stage \
             --cache-from $CACHE_IMAGE:base \
+            --cache-from $CACHE_IMAGE:client \
             --cache-from $CACHE_IMAGE:stage \
             --tag $CACHE_IMAGE:stage \
             --file ./Dockerfile \
             --build-arg BUILDKIT_INLINE_CACHE=1 \
             "."
       - name: Push base image to docker hub
         run: docker push $CACHE_IMAGE:base
+      - name: Push client image to docker hub
+        run: docker push $CACHE_IMAGE:client
       - name: Push stage image to docker hub
         run: docker push $CACHE_IMAGE:stage

.gitignore

@@ -9,3 +9,4 @@ npm-debug.log
 /node_modules/
 *.bs.js
 server/static/Index.js*
+/shared/gen/*.ml*

Dockerfile

@@ -1,4 +1,4 @@
-FROM ocaml/opam2:alpine-3.12-ocaml-4.10 as base
+FROM ocaml/opam2:debian-10-ocaml-4.10 as base
 
 WORKDIR /ocaml_webapp
 
@@ -18,13 +18,19 @@ RUN sudo chown -R opam:nogroup . && \
     opam depext -ln ocaml_webapp > depexts
 
 # Build client app
-FROM node:12 as client
+FROM node:12.18.3-buster as client
 WORKDIR /app
-COPY . ./
-RUN yarn install && yarn build && yarn webpack:production
+COPY package.json .
+COPY yarn.lock .
+RUN yarn install
+
+COPY --from=base /home/opam/.opam/4.10/bin/atdgen /usr/local/bin/atdgen
+RUN chmod +x /usr/local/bin/atdgen
+COPY . .
+RUN yarn build && yarn webpack:production
 
 # Create production image
-FROM alpine as stage
+FROM debian:buster-slim as stage
 WORKDIR /app
 COPY --from=base /ocaml_webapp/_build/default/server/main.exe ocaml_webapp.exe
 COPY --from=base /ocaml_webapp/_build/default/server/migrate/migrate.exe migrate.exe
@@ -33,6 +39,6 @@ COPY --from=client /app/server/static server/static
 # Don't forget to install the dependencies, noted from
 # the previous build.
 COPY --from=base /ocaml_webapp/depexts depexts
-RUN cat depexts | xargs apk --update add && rm -rf /var/cache/apk/*
+RUN apt-get update && cat depexts | xargs apt-get install -y && rm -rf /var/lib/apt/lists/*
 
 CMD ./ocaml_webapp.exe --port=$PORT

bsconfig.json

@@ -3,13 +3,52 @@
   "reason": {
     "react-jsx": 3
   },
+  "generators": [
+    {
+      "name": "atd_t",
+      "command": "dirname=$$(dirname $in) && basename=$$(basename $in .atd) && atdgen -t $in -o $$dirname/gen/$$basename"
+    },
+    {
+      "name": "atd_bs",
+      "command": "dirname=$$(dirname $in) && basename=$$(basename $in .atd) && atdgen -bs $in -o $$dirname/gen/$$basename"
+    }
+  ],
   "sources": [
     {
       "dir": "client/src",
       "subdirs": true
     },
     {
       "dir": "shared"
+    },
+    {
+      "dir": "shared/gen",
+      "generators": [
+        {
+          "name": "atd_t",
+          "edge": ["excerpt_t.ml", "excerpt_t.mli", ":", "../excerpt.atd"]
+        },
+        {
+          "name": "atd_bs",
+          "edge": ["excerpt_bs.ml", "excerpt_bs.mli", ":", "../excerpt.atd"]
+        },
+        {
+          "name": "atd_t",
+          "edge": ["pageAuthorExcerpts_t.ml", "pageAuthorExcerpts_t.mli", ":", "../pageAuthorExcerpts.atd"]
+        },
+        {
+          "name": "atd_bs",
+          "edge": ["pageAuthorExcerpts_bs.ml", "pageAuthorExcerpts_bs.mli", ":", "../pageAuthorExcerpts.atd"]
+        },
+        {
+          "name": "atd_t",
+          "edge": ["pageExcerpts_t.ml", "pageExcerpts_t.mli", ":", "../pageExcerpts.atd"]
+        },
+        {
+          "name": "atd_bs",
+          "edge": ["pageExcerpts_bs.ml", "pageExcerpts_bs.mli", ":", "../pageExcerpts.atd"]
+        }
+      ]
     }
   ],
   "bsc-flags": ["-bs-super-errors", "-bs-no-version-header"],
@@ -21,6 +60,11 @@
   ],
   "suffix": ".bs.js",
   "namespace": true,
-  "bs-dependencies": ["@anuragsoni/routes", "reason-react"],
+  "bs-dependencies": [
+    "@ahrefs/bs-atdgen-codec-runtime",
+    "@anuragsoni/routes",
+    "bs-fetch",
+    "reason-react"
+  ],
   "refmt": 3
 }

client/src/App.re

@@ -1,47 +1,93 @@
 /** The route handlers for our app */
-module Get = {
-  type request = string;
+module Handlers = {
+  /** The payload available in the <script id="ocaml_webapp_page_payload" /> element */
+  type request = option(string);
   type response = React.element;
 
-  /** Defines a handler that replies to requests at the root endpoint */
-  let root = _req => <PageWelcome />;
-
-  /** Defines a handler that takes a path parameter from the route */
-  let hello = (lang, _req) => <PageHello lang />;
-
-  /** Fallback handler in case the endpoint is called without a language parameter */
-  let hello_fallback = _req => <PageHelloFallback />;
-
-  let excerpts_add = _req => <PageAddExcerpt />;
-  // let excerpts_by_author = (name, req) =>
-  //   Lwt.(
-  //     Db.Get.excerpts_by_author(name, req)
-  //     >>= respond_or_err(Content.excerpts_listing_page)
-  //   );
-  // let excerpts = req =>
-  //   Lwt.(
-  //     Db.Get.authors(req) >>= respond_or_err(Content.author_excerpts_page)
-  //   );
+  module Pages = {
+    /** Defines a handler that replies to requests at the root endpoint */
+    let root = _req => <PageWelcome />;
+
+    /** Defines a handler that takes a path parameter from the route */
+    let hello = (lang, _req) => {
+      <PageHello lang />;
+    };
+
+    /** Fallback handler in case the endpoint is called without a language parameter */
+    let hello_fallback = _req => <PageHelloFallback />;
+
+    let excerpts_add = _req => <PageAddExcerpt />;
+
+    let excerpts_by_author = (authorName, payload) =>
+      switch (payload) {
+      | Some(p) =>
+        switch (p->Js.Json.parseExn->PageExcerpts_bs.read_payload) {
+        | excerpts => <PageExcerpts excerpts />
+        | exception _exn =>
+          Js.log("Couldn't parse excerpts from JSON payload " ++ p);
+          <PageNotFound />;
+        }
+      | None =>
+        <Client.FetchRender
+          url={Routes.sprintf(
+            Router.ApiRoutes.excerpts_by_author(),
+            authorName,
+          )}
+          decoder=PageExcerpts_bs.read_payload>
+          {(
+             excerpts => {
+               <PageExcerpts excerpts />;
+             }
+           )}
+        </Client.FetchRender>
+      };
+
+    let authors_with_excerpts = payload =>
+      switch (payload) {
+      | Some(p) =>
+        switch (p->Js.Json.parseExn->PageAuthorExcerpts_bs.read_payload) {
+        | authors => <PageAuthorExcerpts authors />
+        | exception _exn =>
+          Js.log("Couldn't parse authors from JSON payload " ++ p);
+          <PageNotFound />;
+        }
+      | None =>
+        <Client.FetchRender
+          url={Routes.sprintf(Router.ApiRoutes.authors_with_excerpts())}
+          decoder=PageAuthorExcerpts_bs.read_payload>
+          {(authors => <PageAuthorExcerpts authors />)}
+        </Client.FetchRender>
+      };
+  };
+  module Api = {
+    // Api routes should never be loaded from React app, show the backing page in case it happens
+    let excerpts_by_author = Pages.excerpts_by_author;
+    let authors_with_excerpts = Pages.authors_with_excerpts;
+  };
 };
 
-module Router = Router.Make(Get);
-let router = Routes.one_of(Router.routes);
+module Router = Router.Make(Handlers);
+let router = Method_routes.one_of(Router.routes);
+
 [@react.component]
 let make = () => {
   let url = ReasonReactRouter.useUrl();
   let target = url.path->Array.of_list->Js.Array2.joinWith("/");
-  // let excerpts = [
-  //   {
-  //     Excerpt_t.author: "Hey",
-  //     excerpt: "one excerpt",
-  //     source: "sdfdsf",
-  //     page: Some("2"),
-  //   },
-  // ];
+  let payloadElement = Bindings.getElementById(Api.payload_id);
+
   switch (
-    Routes.match'(router, ~target=Js.Global.decodeURIComponent(target))
+    Method_routes.match'(
+      ~meth=`GET,
+      ~target=Js.Global.decodeURIComponent(target),
+      router,
+    )
   ) {
   | None => <PageNotFound />
-  | Some(h) => h(target)
+  | Some(handler) =>
+    let payload = payloadElement->Belt.Option.map(Bindings.innerHTML);
+    /* After processing the payload from server, it can be safely removed so other pages don't try to decode it again
+       as the client will take over navigation + data fetching through API */
+    payloadElement->Belt.Option.forEach(e => e->Bindings.remove());
+    handler(payload);
   };
 };

client/src/Bindings.re

@@ -0,0 +1,7 @@
+[@bs.val] [@bs.return nullable]
+external getElementById: string => option(Dom.element) =
+  "document.getElementById";
+
+[@bs.get] external innerHTML: Dom.element => string = "innerHTML";
+
+[@bs.send] external remove: (Dom.element, unit) => unit = "remove";

client/src/Client.re

@@ -0,0 +1,69 @@
+module Result = Belt.Result;
+
+type data('a, 'b) =
+  | Loading
+  | Finished(Result.t('a, 'b));
+
+let get = (url, decoder) => {
+  Js.Promise.(
+    Fetch.fetchWithInit(url, Fetch.RequestInit.make(~method_=Get, ()))
+    |> then_(res => {
+         res->Fetch.Response.status >= 400
+           ? Js.log(
+               "Server returned status code "
+               ++ res->Fetch.Response.status->string_of_int
+               ++ " for url: "
+               ++ url,
+             )
+           : ();
+         Fetch.Response.text(res)
+         |> then_(jsonText =>
+              try(jsonText->Js.Json.parseExn->decoder->Result.Ok->resolve) {
+              | Js.Exn.Error(error) =>
+                let errMsg = error->Js.Exn.message;
+                `DecodingError(errMsg)->Result.Error->resolve;
+              }
+            );
+       })
+    |> catch(err => {
+         Js.log("Network error for url: " ++ url);
+         `NetworkError(err)->Result.Error->resolve;
+       })
+  );
+};
+
+let usePrevious = value => {
+  let valueRef = React.useRef(value);
+  React.useEffect(() => {
+    valueRef.current = value;
+    None;
+  });
+  valueRef.current;
+};
+
+module FetchRender = {
+  [@react.component]
+  let make = (~url, ~decoder, ~children) => {
+    let (data, setData) = React.useState(() => Loading);
+    let urlChanged = usePrevious(url) != url;
+    let data = urlChanged ? Loading : data;
+
+    React.useEffect2(
+      () => {
+        setData(_ => Loading);
+        get(url, decoder)
+        |> Js.Promise.then_(res =>
+             setData(_ => Finished(res))->Js.Promise.resolve
+           )
+        |> ignore;
+        None;
+      },
+      (url, decoder),
+    );
+    switch (data) {
+    | Loading => <div> {React.string("Loading")} </div>
+    | Finished(Ok(payload)) => children(payload)
+    | Finished(Error(_)) => <div> {React.string("Error")} </div>
+    };
+  };
+};

client/src/Index.re

@@ -1,10 +1,6 @@
 [%bs.raw {|require("./index.css")|}];
 
-[@bs.val] [@bs.return nullable]
-external getElementById: string => option(Dom.element) =
-  "document.getElementById";
-
-switch (getElementById("root")) {
+switch (Bindings.getElementById("root")) {
 | Some(el) => ReactDOMRe.hydrate(<App />, el)
 | None => ()
 };

dune-project

@@ -32,6 +32,7 @@
   (routes (and (>= 0.8.0) (< 0.9.0)))
   (reason (>= 3.6.0))
   (uri (and (>= 3.1.0) (< 4.0.0)))
+  (atdgen (and (>= 2.2.1) (< 2.3.0)))
 
   ;; HTML generation
   (tyxml :dev)