Add support for text and html content in mails

src/email/email.mli

@@ -46,7 +46,7 @@ module Template : sig
 
   val t : t Caqti_type.t
 
-  val render : Data.t -> t -> string
+  val render : Data.t -> t -> string * string
 end
 
 module DevInbox = Email_core.DevInbox
@@ -57,7 +57,8 @@ val make :
   sender:string ->
   recipient:string ->
   subject:string ->
-  content:string ->
+  text_content:string ->
+  html_content:string ->
   ?cc:string list ->
   ?bcc:string list ->
   html:bool ->
@@ -76,15 +77,19 @@ val bcc : t -> string list
 
 val cc : t -> string list
 
-val content : t -> string
+val text_content : t -> string
+
+val html_content : t -> string
 
 val subject : t -> string
 
 val recipient : t -> string
 
 val sender : t -> string
 
-val set_content : string -> t -> t
+val set_text_content : string -> t -> t
+
+val set_html_content : string -> t -> t
 
 val pp : Format.formatter -> t -> unit
 

src/email/email_core.ml

@@ -46,7 +46,9 @@ module Template = struct
       | [] -> value
       | (k, v) :: data -> render_value data @@ replace_element value k v
     in
-    render_value data template.content_text
+    let text = render_value data template.content_text in
+    let html = render_value data template.content_html in
+    (text, html)
 
   module Data = struct
     type t = (string * string) list [@@deriving show, eq]
@@ -63,7 +65,8 @@ type t = {
   sender : string;
   recipient : string;
   subject : string;
-  content : string;
+  text_content : string;
+  html_content : string;
   cc : string list;
   bcc : string list;
   html : bool;
@@ -83,4 +86,6 @@ module DevInbox = struct
   let set email = inbox := Some email
 end
 
-let set_content content email = { email with content }
+let set_text_content text_content email = { email with text_content }
+
+let set_html_content html_content email = { email with html_content }

src/email/email_service.ml

@@ -37,8 +37,9 @@ module Template = struct
     let render ctx email =
       let template_id = Email_core.template_id email in
       let template_data = Email_core.template_data email in
-      let content = Email_core.content email in
-      let* content =
+      let text_content = Email_core.text_content email in
+      let html_content = Email_core.html_content email in
+      let* text_content, html_content =
         match template_id with
         | Some template_id ->
             let* template = Repo.get ctx ~id:template_id in
@@ -50,11 +51,16 @@ module Template = struct
                         template_id)
               |> Lwt.return
             in
-            let content = Email_core.Template.render template_data template in
-            Lwt.return @@ Ok content
-        | None -> Lwt.return @@ Ok content
+            let render_result =
+              Email_core.Template.render template_data template
+            in
+            Lwt.return @@ Ok render_result
+        | None -> Lwt.return @@ Ok (text_content, html_content)
       in
-      Email_core.set_content content email |> Result.return |> Lwt.return
+      email
+      |> Email_core.set_text_content text_content
+      |> Email_core.set_html_content html_content
+      |> Result.return |> Lwt.return
   end
 
   module Repo = struct
@@ -357,18 +363,25 @@ module Make = struct
       let sender = Email_core.sender email in
       let recipient = Email_core.recipient email in
       let subject = Email_core.subject email in
-      let content = Email_core.content email in
+      let text_content = Email_core.text_content email in
+      let html_content = Email_core.html_content email in
       Printf.sprintf
         {|
 -----------------------
 Email sent by: %s
 Recpient: %s
 Subject: %s
+-----------------------
+Text:
+
+%s
+-----------------------
+Html:
 
 %s
 -----------------------
 |}
-        sender recipient subject content
+        sender recipient subject text_content html_content
 
     let send request email =
       let* email = TemplateService.render request email in
@@ -401,8 +414,8 @@ Subject: %s
       in
       let body =
         match rendered.html with
-        | true -> Letters.Html rendered.content
-        | false -> Letters.Plain rendered.content
+        | true -> Letters.Html rendered.html_content
+        | false -> Letters.Plain rendered.text_content
       in
       let message =
         Letters.build_email ~from:email.sender ~recipients
@@ -476,8 +489,10 @@ Subject: %s
       let sender = Email_core.sender email in
       let recipient = Email_core.recipient email in
       let subject = Email_core.subject email in
-      let content = Email_core.content email in
-      let req_body = body ~recipient ~subject ~sender ~content in
+      let text_content = Email_core.text_content email in
+      (* TODO support html content *)
+      (* let html_content = Email_core.text_content email in *)
+      let req_body = body ~recipient ~subject ~sender ~content:text_content in
       let* resp, resp_body =
         Cohttp_lwt_unix.Client.post
           ~body:(Cohttp_lwt.Body.of_string req_body)

test/test-unit/test_email.ml

@@ -3,7 +3,7 @@ let test_email_rendering_simple _ () =
     Sihl.Email.Template.Data.empty
     |> Sihl.Email.Template.Data.add ~key:"foo" ~value:"bar"
   in
-  let actual =
+  let actual, _ =
     Sihl.Email.Template.render data
       (Sihl.Email.Template.make ~text:"{foo}" "test")
   in
@@ -13,7 +13,7 @@ let test_email_rendering_simple _ () =
     |> Sihl.Email.Template.Data.add ~key:"foo" ~value:"hey"
     |> Sihl.Email.Template.Data.add ~key:"bar" ~value:"ho"
   in
-  let actual =
+  let actual, _ =
     Sihl.Email.Template.render data
       (Sihl.Email.Template.make ~text:"{foo} {bar}" "test")
   in
@@ -25,7 +25,7 @@ let test_email_rendering_complex _ () =
     |> Sihl.Email.Template.Data.add ~key:"foo" ~value:"hey"
     |> Sihl.Email.Template.Data.add ~key:"bar" ~value:"ho"
   in
-  let actual =
+  let actual, _ =
     Sihl.Email.Template.render data
       (Sihl.Email.Template.make ~text:"{foo} {bar}{foo}" "test")
   in