Add Content_type.Type.of_string and Header.add_unless_exists

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)))

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

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

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. *)