cohttp-eio: rename Header.undecoded to Header.value

cohttp-eio/src/header.ml

@@ -1,5 +1,4 @@
 type name = string (* Header name, e.g. Date, Content-Length etc *)
-type value = string (* Header value, eg 10, text/html, chunked etc *)
 type lname = string
 
 let canonical_name nm =
@@ -14,17 +13,20 @@ type 'a header = ..
 type 'a header +=
   | Content_length : int header
   | Transfer_encoding : [ `chunked | `compress | `deflate | `gzip ] list header
-  | H : lname -> value header
+  | H : lname -> string header
 
-type 'a encoder = 'a -> value
-type 'a decoder = value -> 'a
-type 'a undecoded_state = Decoded of 'a | Undecoded of 'a Lazy.t
-type 'a undecoded = { v : 'a undecoded_state Atomic.t }
+type 'a encoder = 'a -> string
+type 'a decoder = string -> 'a
+type 'a value_state = Decoded of 'a | Undecoded of 'a Lazy.t
 
-let undecoded : type a. a Lazy.t -> a undecoded =
+(* We need to encode this into a record so that it plays nice with GADT.
+   Basically, this doesn't seem to work : type 'a value = 'a value_state Atomic.t *)
+type 'a value = { v : 'a value_state Atomic.t }
+
+let value : type a. a Lazy.t -> a value =
  fun v -> { v = Atomic.make (Undecoded v) }
 
-let rec decode : type a. a undecoded -> a =
+let rec decode : type a. a value -> a =
  fun v ->
   match Atomic.get v.v with
   | Decoded x -> x
@@ -111,7 +113,7 @@ class codec =
 
 let name (c : #codec) = c#name
 
-type v = V : 'a header * 'a undecoded -> v
+type v = V : 'a header * 'a value -> v
 
 class virtual t =
   object
@@ -143,17 +145,17 @@ let make code = make_n code []
 
 let of_name_values (c : #codec) l =
   List.map
-    (fun (name, value) ->
+    (fun (name, v) ->
       let h = c#header (lname name) in
-      let v = undecoded (lazy (c#decoder h value)) in
+      let v = value (lazy (c#decoder h v)) in
       V (h, v))
     l
   |> make_n c
 
 let length (t : #t) = List.length t#to_list
 
 let add_lazy (type a) (t : t) (h : a header) v =
-  let v = undecoded v in
+  let v = value v in
   t#modify (fun l -> V (h, v) :: l)
 
 let add (type a) (t : t) (h : a header) v = add_lazy t h (lazy v)
@@ -169,7 +171,7 @@ let add_name_value (t : t) ~name ~value =
 
 let encode : type a. t -> a header -> a -> string = fun t h v -> t#encoder h v
 
-let exists (t : #t) (f : < f : 'a. 'a header -> 'a undecoded -> bool >) =
+let exists (t : #t) (f : < f : 'a. 'a header -> 'a value -> bool >) =
   let rec aux = function
     | [] -> false
     | V (h, v) :: tl -> if f#f h v then true else aux tl
@@ -194,18 +196,17 @@ let find (type a) (t : #t) (h : a header) =
   in
   aux t#to_list
 
-let find_all (type a) (t : #t) (h : a header) : a undecoded list =
+let find_all (type a) (t : #t) (h : a header) : a value list =
   let[@tail_mod_cons] rec aux = function
     | [] -> []
     | V (h', v) :: tl -> (
         match t#equal h h' with
-        | Some Eq -> (v : a undecoded) :: aux tl
+        | Some Eq -> (v : a value) :: aux tl
         | None -> aux tl)
   in
   aux t#to_list
 
-let update (t : #t)
-    (f : < f : 'a. 'a header -> 'a undecoded -> 'a undecoded option >) =
+let update (t : #t) (f : < f : 'a. 'a header -> 'a value -> 'a value option >) =
   t#modify
     (List.filter_map (fun (V (h, v)) ->
          let v = f#f h v in
@@ -225,13 +226,12 @@ let remove (type a) ?(all = false) (t : #t) (h : a header) =
       in
       headers)
 
-type binding = B : 'a header * 'a undecoded -> binding
+type binding = B : 'a header * 'a value -> binding
 
-let iter (t : #t) (f : < f : 'a. 'a header -> 'a undecoded -> unit >) =
+let iter (t : #t) (f : < f : 'a. 'a header -> 'a value -> unit >) =
   List.iter (fun (V (h, v)) -> f#f h v) t#to_list
 
-let fold_left (t : #t) (f : < f : 'a. 'a header -> 'a undecoded -> 'b -> 'b >)
-    acc =
+let fold_left (t : #t) (f : < f : 'a. 'a header -> 'a value -> 'b -> 'b >) acc =
   List.fold_left (fun acc (V (h, v)) -> f#f h v acc) acc t#to_list
 
 let to_seq (t : #t) =

cohttp-eio/src/header.mli

@@ -15,9 +15,6 @@ type lname = private string
     [Content-Type -> content-type], [Date -> date],
     [Transfer-Encoding -> transfer-encoding] etc. See {!val:lname}. *)
 
-type value = string
-(** [value] is an untyped HTTP header value, eg 10, text/html, chunked etc *)
-
 val canonical_name : string -> name
 (** [canonical_name s] converts [s] to a canonical header name value. See
     {!type:name}. *)
@@ -50,30 +47,31 @@ type 'a header = ..
 type 'a header +=
   | Content_length : int header
   | Transfer_encoding : [ `chunked | `compress | `deflate | `gzip ] list header
-  | H : lname -> value header  (** A generic header. *)
+  | H : lname -> string header  (** A generic header. *)
 
 (** {1 Codec - Header Encoder & Decoder} *)
 
-type 'a encoder = 'a -> value
+type 'a encoder = 'a -> string
 (** [encoder] converts a typed value ['a] to its string representation. *)
 
-type 'a decoder = value -> 'a
+type 'a decoder = string -> 'a
 (** [decoder] converts {!type:value} to type ['a]. To denote an error while
     decoding, an OCaml exception value is raised. *)
 
-type 'a undecoded
-(** ['a undecoded] represents a lazy value that is as yet undecoded. See
-    {!val:decode}. *)
+type 'a value
+(** ['a value] represents a HTTP header value that is lazily created.
+
+    See {!val:decode}. *)
 
-val undecoded : 'a Lazy.t -> 'a undecoded
-(** [undecoded lazy_val] creates an {!type:undecoded} value.
+val value : 'a Lazy.t -> 'a value
+(** [value lazy_val] creates a {!type:value} value.
 
     {[
-      Header.undecoded (lazy (int_of_string "20"))
+      Header.value (lazy (int_of_string "20"))
     ]} *)
 
-val decode : 'a undecoded -> 'a
-(** [decode codec v] decodes [v].
+val decode : 'a value -> 'a
+(** [decode v] decodes [v].
 
     @raise exn if decoding results in an error. *)
 
@@ -92,8 +90,8 @@ type (_, _) eq = Eq : ('a, 'a) eq
     Users looking to combine both custom headers and headers defined in this
     module are recommended to inherit this class.
 
-    {i Example} Here we define two custom headers [Header1] and [Header2] and
-    implement codec for it in object [custom_codec].
+    Here we define two custom headers [Header1] and [Header2] and implement
+    codec for it in object [custom_codec].
 
     {[
       type 'a Header.header +=
@@ -198,23 +196,23 @@ val add_lazy : t -> 'a header -> 'a Lazy.t -> unit
 val add : t -> 'a header -> 'a -> unit
 (** [add t h v] add header [h] and its corresponding typed value [v] to [t].*)
 
-val add_value : t -> 'a header -> value -> unit
+val add_value : t -> 'a header -> string -> unit
 (** [add_value t h s] adds header [h] and its corresponding untyped, undecoded
     string value to [t].*)
 
-val add_name_value : t -> name:lname -> value:value -> unit
+val add_name_value : t -> name:lname -> value:string -> unit
 (** [add_name_value t ~name ~value] lazily (i.e. undecoded) add header with
     [name] and [value] to [t]. *)
 
 (** {1 Encode} *)
 
-val encode : t -> 'a header -> 'a -> value
+val encode : t -> 'a header -> 'a -> string
 (** [encode codec h v] encodes the value of header [h]. The encoder is used as
     defined in [codec]. *)
 
 (** {1 Find} *)
 
-val exists : t -> < f : 'a. 'a header -> 'a undecoded -> bool > -> bool
+val exists : t -> < f : 'a. 'a header -> 'a value -> bool > -> bool
 (** [exists t f] iterates over [t] and applies [f#f h v] where [h] and [v] are
     respectively header and undecoded value as it exists in [t]. It returns
     [true] if any of the items in [t] returns [true] for [f#f h v].
@@ -231,16 +229,15 @@ val find : t -> 'a header -> 'a
     @raise Not_found if [h] is not found in [t].
     @raise exn if decoding [h] results in an error. *)
 
-val find_all : t -> 'a header -> 'a undecoded list
+val find_all : t -> 'a header -> 'a value list
 (** [find_all t h] is a list of undecoded values [v] corresponding to header
     [h]. It is an empty list if [h] doesn't exist in [t].
 
     See {!val:decode} to decode [v]. *)
 
 (** {1 Update, Remove} *)
 
-val update :
-  t -> < f : 'a. 'a header -> 'a undecoded -> 'a undecoded option > -> unit
+val update : t -> < f : 'a. 'a header -> 'a value -> 'a value option > -> unit
 (** [update t f] iterates over [t] and applies [f#f h v] to each element. [h]
     and [v] are respectively header and undecoded value as it exists in [t]. If
     [f#f h v = Some v'] then the value of [h] is updated to [v']. If [None] then
@@ -259,17 +256,16 @@ val remove : ?all:bool -> t -> 'a header -> unit
 
 (** [binding] represents a typed header and its corresponding undecoded value.
 
-    See {!type:undecoded} and {!val:decode}. *)
-type binding = B : 'a header * 'a undecoded -> binding
+    See {!type:value} and {!val:decode}. *)
+type binding = B : 'a header * 'a value -> binding
 
-val iter : t -> < f : 'a. 'a header -> 'a undecoded -> unit > -> unit
+val iter : t -> < f : 'a. 'a header -> 'a value -> unit > -> unit
 (** [iter t f] iterates over [t] and applies [f#f h v] where [h] and [v] are
     respectively header and undecoded value as it exists in [t].
 
     See {!val:decode} to decode [v]. *)
 
-val fold_left :
-  t -> < f : 'a. 'a header -> 'a undecoded -> 'b -> 'b > -> 'b -> 'b
+val fold_left : t -> < f : 'a. 'a header -> 'a value -> 'b -> 'b > -> 'b -> 'b
 (** [fold_left t f acc] folds over [t] and applies [f#f h v acc] where [h] and
     [v] are respectively header and undecoded value as it exists in [t].
 
@@ -280,7 +276,7 @@ val to_seq : t -> binding Seq.t
 
     See {!val:decode} to decode [v]. *)
 
-val to_name_values : t -> (name * value) list
+val to_name_values : t -> (name * string) list
 (** [to_name_values t] a list of [(name,value)] tuple.
 
     @raise exn if decoding any of the values results in an error. *)

cohttp-eio/tests/header.md

@@ -179,14 +179,14 @@ val t3 : Header.t = <obj>
 
 ```ocaml
 # let f = object
-  method f: type a. a Header.header -> a Header.undecoded -> bool =
+  method f: type a. a Header.header -> a Header.value -> bool =
     fun t v ->
       let v = Header.decode v in
       match t, v with
       | Header.Content_length, 200 -> true
       | _ -> false
   end ;;
-val f : < f : 'a. 'a Header.header -> 'a Header.undecoded -> bool > = <obj>
+val f : < f : 'a. 'a Header.header -> 'a Header.value -> bool > = <obj>
 
 # Header.exists t f ;;
 - : bool = true
@@ -245,19 +245,17 @@ Apply `update`.
 
 ```ocaml
 # let f = object
-  method f: type a. a Header.header -> a Header.undecoded -> a Header.undecoded option =
+  method f: type a. a Header.header -> a Header.value -> a Header.value option =
     fun h v ->
       let v' = Header.decode v in
       match h, v' with
-      | Header.Content_length, 200 -> Some (Header.undecoded (lazy 2000))
-      | Header.H nm, "20" when ((nm :> string) = "age") -> Some (Header.undecoded (lazy "40"))
+      | Header.Content_length, 200 -> Some (Header.value (lazy 2000))
+      | Header.H nm, "20" when ((nm :> string) = "age") -> Some (Header.value (lazy "40"))
       | Header.H nm, "blah2" when ((nm :> string) = "blah2") -> None
       | _ -> Some v
   end;;
 val f :
-  < f : 'a.
-          'a Header.header ->
-          'a Header.undecoded -> 'a Header.undecoded option > =
+  < f : 'a. 'a Header.header -> 'a Header.value -> 'a Header.value option > =
   <obj>
 
 # Header.update t f ;;
@@ -291,7 +289,7 @@ val f :
 - : unit = ()
 
 # Header.(find_all t (H blah)) ;;
-- : string Header.undecoded list = []
+- : string Header.value list = []
 
 # Header.length t ;;
 - : int = 4
@@ -303,14 +301,14 @@ val f :
 
 ```ocaml
 # let f = object
-  method f: type a. a Header.header -> a Header.undecoded -> unit =
+  method f: type a. a Header.header -> a Header.value -> unit =
     fun h v ->
       let v = Header.decode v in
       let value = Header.encode t h v in
       let name = (Header.name t h :> string) in
       Printf.printf "\n%s: %s" name value
   end;;
-val f : < f : 'a. 'a Header.header -> 'a Header.undecoded -> unit > = <obj>
+val f : < f : 'a. 'a Header.header -> 'a Header.value -> unit > = <obj>
 
 # Header.iter t f ;;
 Content-Type: text/html
@@ -326,7 +324,7 @@ We get a list of headers in string form using `fold_left`.
 
 ```ocaml
 # let f = object
-  method f: type a. a Header.header -> a Header.undecoded -> 'b -> 'b =
+  method f: type a. a Header.header -> a Header.value -> 'b -> 'b =
     fun h v acc ->
       let v = Header.decode v in
       match h with
@@ -337,8 +335,7 @@ We get a list of headers in string form using `fold_left`.
 val f :
   < f : 'a.
           'a Header.header ->
-          'a Header.undecoded ->
-          (string * string) list -> (string * string) list > =
+          'a Header.value -> (string * string) list -> (string * string) list > =
   <obj>
 
 # Header.fold_left t f [];;