Source file contract_email_template.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
type t =
  { id : string
  ; label : string
  ; text : string
  ; html : string option
  ; created_at : Ptime.t
  ; updated_at : Ptime.t
  }

let name = "email.template"

module type Sig = sig
  (** [get ?ctx id] returns the email template by [id]. *)
  val get : ?ctx:(string * string) list -> string -> t option Lwt.t

  (** [get_by_label ?ctx label] returns the email template by [label]. *)
  val get_by_label : ?ctx:(string * string) list -> string -> t option Lwt.t

  (** [create ?ctx ?id ?html label text] creates an email template with [text]
      as text emal content and a [label]. An optional [html] content can be
      provided that will be displayed in email clients that support HTML. *)
  val create
    :  ?ctx:(string * string) list
    -> ?id:string
    -> ?html:string
    -> label:string
    -> string
    -> t Lwt.t

  (** [update ?ctx template] updates the email [template]. *)
  val update : ?ctx:(string * string) list -> t -> t Lwt.t

  val register : unit -> Core_container.Service.t

  include Core_container.Service.Sig
end

(* Common *)

let to_sexp { id; label; text; html; created_at; updated_at } =
  let open Sexplib0.Sexp_conv in
  let open Sexplib0.Sexp in
  List
    [ List [ Atom "id"; sexp_of_string id ]
    ; List [ Atom "label"; sexp_of_string label ]
    ; List [ Atom "text"; sexp_of_string text ]
    ; List [ Atom "html"; sexp_of_option sexp_of_string html ]
    ; List [ Atom "created_at"; sexp_of_string (Ptime.to_rfc3339 created_at) ]
    ; List [ Atom "updated_at"; sexp_of_string (Ptime.to_rfc3339 updated_at) ]
    ]
;;

let pp fmt t = Sexplib0.Sexp.pp_hum fmt (to_sexp t)

let of_yojson json =
  let open Yojson.Safe.Util in
  try
    let id = json |> member "id" |> to_string in
    let label = json |> member "label" |> to_string in
    let text = json |> member "text" |> to_string in
    let html = json |> member "html" |> to_string_option in
    let created_at = json |> member "created_at" |> to_string in
    let updated_at = json |> member "updated_at" |> to_string in
    match Ptime.of_rfc3339 created_at, Ptime.of_rfc3339 updated_at with
    | Ok (created_at, _, _), Ok (updated_at, _, _) ->
      Some { id; label; text; html; created_at; updated_at }
    | _ -> None
  with
  | _ -> None
;;

let to_yojson template =
  `Assoc
    [ "id", `String template.id
    ; "label", `String template.label
    ; "text", `String template.text
    ; ( "html"
      , match template.html with
        | Some html -> `String html
        | None -> `Null )
    ; "created_at", `String (Ptime.to_rfc3339 template.created_at)
    ; "updated_at", `String (Ptime.to_rfc3339 template.updated_at)
    ]
;;

let set_label label template = { template with label }
let set_text text template = { template with text }
let set_html html template = { template with html }

let replace_element str k v =
  let regexp = Str.regexp @@ "{" ^ k ^ "}" in
  Str.global_replace regexp v str
;;

let render data text html =
  let rec render_value data value =
    match data with
    | [] -> value
    | (k, v) :: data -> render_value data @@ replace_element value k v
  in
  let text = render_value data text in
  let html = Option.map (render_value data) html in
  text, html
;;

(* TODO Deprecate in later version *)
(* [@@deprecated "Use Sihl_email.Template.render_email_with_data() instead"] *)

let email_of_template ?template (email : Contract_email.t) data =
  let text, html =
    match template with
    | Some template -> render data template.text template.html
    | None -> render data email.text email.html
  in
  email
  |> Contract_email.set_text text
  |> Contract_email.set_html html
  |> Lwt.return
;;

(* TODO Deprecate in later version *)
(* [@@deprecated "Use Sihl_email.Template.render_email() instead"] *)

let create_email_of_template
    ?(cc = [])
    ?(bcc = [])
    ~sender
    ~recipient
    ~subject
    template
    data
  =
  (* Create an empty mail, the content is rendered *)
  let email = Contract_email.create ~cc ~bcc ~sender ~recipient ~subject "" in
  let text, html = render data template.text template.html in
  email |> Contract_email.set_text text |> Contract_email.set_html html
;;

let render_email_with_data data (email : Contract_email.t) =
  let text, html = render data email.text email.html in
  { email with text; html }
;;