From 50225683680c06dc6b01bb372b339300265ff57b Mon Sep 17 00:00:00 2001
From: Romain Calascibetta <romain.calascibetta@gmail.com>
Date: Sun, 29 Aug 2021 14:11:22 +0200
Subject: [PATCH] Add Content_type.Type.of_string and Header.add_unless_exists

---
 lib/content_type.ml  | 15 +++++++++++++++
 lib/content_type.mli |  1 +
 lib/header.ml        |  4 ++++
 lib/header.mli       |  5 +++++
 4 files changed, 25 insertions(+)

diff --git a/lib/content_type.ml b/lib/content_type.ml
index d44e1c9..3960309 100644
--- a/lib/content_type.ml
+++ b/lib/content_type.ml
@@ -101,6 +101,21 @@ module Type = struct
     | `Multipart -> "multipart"
     | `Ietf_token token | `X_token token -> token
 
+  let of_string str =
+    match String.lowercase_ascii str with
+    | "text" -> Ok `Text
+    | "image" -> Ok `Image
+    | "audio" -> Ok `Audio
+    | "video" -> Ok `Video
+    | "application" -> Ok `Application
+    | "message" -> Ok `Message
+    | "multipart" -> Ok `Multipart
+    | str -> (
+        match (ietf str, extension str) with
+        | Ok ietf, _ -> Ok ietf
+        | _, Ok extension -> Ok extension
+        | _ -> Rresult.R.error_msgf "Invalid type: %S" str)
+
   let compare a b =
     String.(
       compare (lowercase_ascii (to_string a)) (lowercase_ascii (to_string b)))
diff --git a/lib/content_type.mli b/lib/content_type.mli
index 879cda0..b797a6b 100644
--- a/lib/content_type.mli
+++ b/lib/content_type.mli
@@ -79,6 +79,7 @@ module Type : sig
   val is_multipart : t -> bool
   val is_message : t -> bool
   val to_string : t -> string
+  val of_string : string -> (t, [> Rresult.R.msg ]) result
 end
 
 module Subtype : sig
diff --git a/lib/header.ml b/lib/header.ml
index 0f43a90..34bb801 100644
--- a/lib/header.ml
+++ b/lib/header.ml
@@ -29,6 +29,10 @@ let add : type a. Field_name.t -> a Field.t * a -> t -> t =
   let field = Field.Field (field_name, w, v) in
   Location.inj ~location:Location.none field :: t
 
+let add_unless_exists : type a. Field_name.t -> a Field.t * a -> t -> t =
+ fun field_name (w, v) t ->
+  if exists field_name t then t else add field_name (w, v) t
+
 let replace : type a. Field_name.t -> a Field.t * a -> t -> t =
  fun field_name (w, v) t ->
   let rec replace acc = function
diff --git a/lib/header.mli b/lib/header.mli
index 40d4418..c4a77d7 100644
--- a/lib/header.mli
+++ b/lib/header.mli
@@ -39,6 +39,11 @@ val add : Field_name.t -> 'a Field.t * 'a -> t -> t
 (** [add field_name (w, v) t] adds a new field-name with value v. [add]
    does not replace [field_name] if it already exists into [t]. *)
 
+val add_unless_exists : Field_name.t -> 'a Field.t * 'a -> t -> t
+(** [add_unless_exists field_name (w, v) t] is a collection of header fields that
+   is the same as [t] if [t] already includes [field_name], and otherwise is
+   equivalent to [add field_name (w, v) t]. *)
+
 val replace : Field_name.t -> 'a Field.t * 'a -> t -> t
 (** [replace field_name (w, v) t] replaces existing field-name [field_name] in [t]
    by the new value [v]. If [field_name] does not exist, it adds it. *)