feat(morph_logger): basic implementation

dune-project

@@ -116,6 +116,18 @@
   graphql-lwt
   ))
 
+(package
+  (name morph_logger)
+  (synopsis "Logging middleware for morph")
+  (depends
+    (ocaml (>= 4.04.2))
+    (dune (>= 1.11))
+    reason
+    lwt
+    mtime
+    logs
+    morph))
+
 (package
   (name morph_test)
   (depends

morph_logger.json

@@ -0,0 +1,26 @@
+{
+  "name": "@reason-native-web/morph_logger",
+  "version": "0.1.2",
+  "esy": {
+    "build": "dune build -p morph_logger",
+    "buildEnv": {
+      "ODOC_SYNTAX": "re"
+    }
+  },
+  "scripts": {
+    "format": "dune build @fmt --auto-promote"
+  },
+  "dependencies": {
+    "@opam/dune": "*",
+    "@opam/lwt": "*",
+    "@opam/mtime": "*",
+    "@opam/logs": "*",
+    "@reason-native-web/morph": "*",
+    "ocaml": "< 4.09.0",
+    "@esy-ocaml/reason": "*"
+  },
+  "resolutions": {
+    "@reason-native-web/morph": "link:./morph.json"
+  },
+  "devDependencies": {}
+}

morph_logger.opam

@@ -0,0 +1,30 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Logging middleware for morph"
+homepage: "https://reason-native-web.github.io"
+doc: "https://reason-native-web.github.io/morph"
+bug-reports: "https://github.com/reason-native-web/morph/issues"
+depends: [
+  "ocaml" {>= "4.04.2"}
+  "dune" {>= "1.11"}
+  "reason"
+  "lwt"
+  "mtime"
+  "logs"
+  "morph"
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/reason-native-web/morph.git"

src/morph/src/Headers.re

@@ -0,0 +1,14 @@
+type t = list((string, string));
+
+let empty = [];
+
+let get_header = (key, headers) =>
+  headers
+  |> List.find_opt(((header, _)) =>
+       String.lowercase_ascii(header) == String.lowercase_ascii(key)
+     )
+  |> Utils.map_opt(snd);
+
+let add_header = (new_header, headers) => headers @ [new_header];
+
+let add_headers = (new_headers, headers: t) => headers @ new_headers;

src/morph/src/Headers.rei

@@ -0,0 +1,9 @@
+type t = list((string, string));
+
+let empty: t;
+
+let get_header: (string, t) => option(string);
+
+let add_header: ((string, string), t) => t;
+
+let add_headers: (list((string, string)), t) => t;

src/morph/src/Morph.re

@@ -17,3 +17,5 @@ module Response = Response;
 
 module Method = Method;
 module Status = Status;
+
+module Headers = Headers;

src/morph/src/Morph.rei

@@ -29,3 +29,5 @@ module Response = Response;
 
 module Method = Method;
 module Status = Status;
+
+module Headers = Headers;

src/morph/src/Request.re

@@ -1,15 +1,15 @@
 type t = {
   target: string,
   meth: Method.t,
-  headers: list((string, string)),
+  headers: Headers.t,
   read_body: unit => Lwt.t(string),
   context: Hmap.t,
 };
 
 let make =
     (
       ~meth=`GET,
-      ~headers=[],
+      ~headers=Headers.empty,
       ~read_body=() => Lwt.return(""),
       ~context=Hmap.empty,
       target,

src/morph/src/Request.rei

@@ -1,15 +1,15 @@
 type t = {
   target: string,
   meth: Method.t,
-  headers: list((string, string)),
+  headers: Headers.t,
   read_body: unit => Lwt.t(string),
   context: Hmap.t,
 };
 
 let make:
   (
     ~meth: Method.t=?,
-    ~headers: list((string, string))=?,
+    ~headers: Headers.t=?,
     ~read_body: unit => Lwt.t(string)=?,
     ~context: Hmap.t=?,
     string

src/morph/src/Response.re

@@ -1,5 +1,3 @@
-type headers = list((string, string));
-
 type body = [
   | `String(string)
   | `Stream(Lwt_stream.t(char))
@@ -8,20 +6,24 @@ type body = [
 
 type t = {
   status: Status.t,
-  headers,
+  headers: Headers.t,
   body,
 };
 
-let empty = {status: `OK, headers: [], body: `String("")};
+let empty = {status: `OK, headers: Headers.empty, body: `String("")};
 
-let make = (~status=`OK, ~headers=[], body) => {status, headers, body};
+let make = (~status=`OK, ~headers=Headers.empty, body) => {
+  status,
+  headers,
+  body,
+};
 
 let add_header = (new_header: (string, string), res: t) => {
-  {...res, headers: res.headers @ [new_header]};
+  {...res, headers: res.headers |> Headers.add_header(new_header)};
 };
 
-let add_headers = (new_headers: headers, res: t) => {
-  {...res, headers: res.headers @ new_headers};
+let add_headers = (new_headers: list((string, string)), res: t) => {
+  {...res, headers: res.headers |> Headers.add_headers(new_headers)};
 };
 
 let set_status = (status: Status.t, res: t) => {
@@ -33,30 +35,37 @@ let set_body = (body: body, res: t) => {
 };
 
 let ok = (res: t) => {
-  add_header(("Content-length", "2"), res)
+  res
+  |> add_header(("Content-length", "2"))
   |> set_status(`OK)
   |> set_body(`String("ok"))
   |> Lwt.return;
 };
 
 let text = (text, res: t) => {
   let content_length = text |> String.length |> string_of_int;
-  add_header(("Content-length", content_length), res)
+
+  res
+  |> add_header(("Content-length", content_length))
   |> set_body(`String(text))
   |> Lwt.return;
 };
 
 let json = (json, res: t) => {
   let content_length = json |> String.length |> string_of_int;
-  add_header(("Content-type", "application/json"), res)
+
+  res
+  |> add_header(("Content-type", "application/json"))
   |> add_header(("Content-length", content_length))
   |> set_body(`String(json))
   |> Lwt.return;
 };
 
 let html = (markup, res: t) => {
   let content_length = markup |> String.length |> string_of_int;
-  add_header(("Content-type", "text/html"), res)
+
+  res
+  |> add_header(("Content-type", "text/html"))
   |> add_header(("Content-length", content_length))
   |> set_body(`String(markup))
   |> Lwt.return;
@@ -65,28 +74,25 @@ let html = (markup, res: t) => {
 let redirect = (~code=303, targetPath, res: t) => {
   let content_length = targetPath |> String.length |> string_of_int;
 
-  add_header(("Content-length", content_length), res)
+  res
+  |> add_header(("Content-length", content_length))
   |> add_header(("Location", targetPath))
   |> set_status(`Code(code))
   |> set_body(`String(targetPath))
   |> Lwt.return;
 };
 
 let unauthorized = (message, res: t) => {
-  add_header(
-    ("Content-length", String.length(message) |> string_of_int),
-    res,
-  )
+  res
+  |> add_header(("Content-length", String.length(message) |> string_of_int))
   |> set_status(`Unauthorized)
   |> set_body(`String(message))
   |> Lwt.return;
 };
 
 let not_found = (~message="Not found", res: t) => {
-  add_header(
-    ("content-length", String.length(message) |> string_of_int),
-    res,
-  )
+  res
+  |> add_header(("content-length", String.length(message) |> string_of_int))
   |> set_status(`Not_found)
   |> set_body(`String(message))
   |> Lwt.return;

src/morph/src/Response.rei

@@ -1,8 +1,3 @@
-/**
-[headers] is represented as a list of (string, string) tuples.
-*/
-type headers = list((string, string));
-
 /**
  [Response.body] variant type structure. There are currently 3 types of bodies.
 
@@ -26,14 +21,14 @@ The core [Response.t] type
 */
 type t = {
   status: Status.t,
-  headers,
+  headers: Headers.t,
   body,
 };
 
 /**
 [make status headers body] creates a response.
 */
-let make: (~status: Status.t=?, ~headers: headers=?, body) => t;
+let make: (~status: Status.t=?, ~headers: Headers.t=?, body) => t;
 
 /**
 [empty t] an empty response, a starting place to compose an http response.
@@ -48,7 +43,7 @@ let add_header: ((string, string), t) => t;
 /**
 [add_header headers response] returns a copy of t of response with the headers added.
 */
-let add_headers: (headers, t) => t;
+let add_headers: (list((string, string)), t) => t;
 
 /**
 [set_status status response] returns a copy of t with the given status.

src/morph/src/Utils.re

@@ -3,3 +3,9 @@ let map_or = (~default: 'b, fn: 'a => 'b, opt: option('a)) =>
   | Some(value) => fn(value)
   | None => default
   };
+
+let map_opt = (fn: 'a => 'b, opt: option('a)) =>
+  switch (opt) {
+  | None => None
+  | Some(v) => Some(fn(v))
+  };

src/morph_logger/.npmignore

@@ -0,0 +1,4 @@
+*.install
+*.merlin
+*.lock
+_esy