Merge pull request #725 from dinosaure/media-params

Media params
mirage · Oct 28, 2020 · 46f304e · 46f304e
2 parents c2c3f06 + 59f06f4
commit 46f304e
Show file tree

Hide file tree

Showing 5 changed files with 16 additions and 18 deletions.
diff --git a/cohttp/src/accept.ml b/cohttp/src/accept.ml
@@ -44,8 +44,11 @@ let languages = function
 
 let rec string_of_pl = function
  | [] -> ""
- | (k,T v)::r -> sprintf ";%s=%s%s" k v (string_of_pl r)
- | (k,S v)::r -> sprintf ";%s=\"%s\"%s" k (Stringext.quote v) (string_of_pl r)
+ | (k, v)::r ->
+ let e = Stringext.quote v in
+ if v = e
+ then sprintf ";%s=%s%s" k v (string_of_pl r)
+ else sprintf ";%s=\"%s\"%s" k e (string_of_pl r)
 
 let string_of_q = function
  | q when q < 0 ->

diff --git a/cohttp/src/accept.mli b/cohttp/src/accept.mli
@@ -30,11 +30,7 @@ type 'a qlist = (q * 'a) list [@@deriving sexp]
 *)
 val qsort : 'a qlist -> 'a qlist
 
-type pv = Accept_types.pv =
- T of string
- | S of string [@@deriving sexp]
-
-type p = string * pv [@@deriving sexp]
+type p = string * string [@@deriving sexp]
 
 type media_range =
  Accept_types.media_range =
@@ -73,7 +69,7 @@ val encodings : string option -> encoding qlist
 
 val languages : string option -> language qlist
 
-val string_of_media_range : media_range * (string * pv) list -> q -> string
+val string_of_media_range : media_range * p list -> q -> string
 val string_of_charset : charset -> q -> string
 val string_of_encoding : encoding -> q -> string
 val string_of_language : language -> q -> string

diff --git a/cohttp/src/accept_parser.mly b/cohttp/src/accept_parser.mly
@@ -19,7 +19,7 @@
 %{
  open Accept_types
 
- type param = Q of int | Kv of (string * pv)
+ type param = Q of int | Kv of p
 
  let rec get_q = function
  | (Q q)::_ -> q
@@ -40,11 +40,11 @@
 %%
 
 param :
-| SEMI TOK EQUAL QS { Kv ($2, S $4) }
+| SEMI TOK EQUAL QS { Kv ($2, $4) }
 | SEMI TOK EQUAL TOK {
  if $2="q" then try Q (truncate (1000.*.(float_of_string $4)))
  with Failure _ -> raise Parsing.Parse_error
- else Kv ($2, T $4)
+ else Kv ($2, $4)
 }
 
 params :

diff --git a/cohttp/src/accept_types.ml b/cohttp/src/accept_types.ml
@@ -19,8 +19,7 @@
 
 open Sexplib0.Sexp_conv
 
-type pv = T of string | S of string [@@deriving sexp]
-type p = string * pv [@@deriving sexp]
+type p = string * string [@@deriving sexp]
 type media_range =
  | MediaType of string * string
  | AnyMediaSubtype of string

diff --git a/cohttp/test/test_accept.ml b/cohttp/test/test_accept.ml
@@ -74,12 +74,12 @@ let valid_media_ranges = [
  1000,(A.AnyMediaSubtype "text",[]);
  ];
  "text/plain; q=0.8; charset=utf-8,text/HTML;charset=utf-8;q=0.9", [
- 800,(A.MediaType ("text","plain"),["charset",A.T"utf-8"]);
- 900,(A.MediaType ("text","html"),["charset",A.T"utf-8"]);
+ 800,(A.MediaType ("text","plain"),["charset","utf-8"]);
+ 900,(A.MediaType ("text","html"),["charset","utf-8"]);
  ];
- "text/*;foo=\"bar\"", [1000,(A.AnyMediaSubtype "text",["foo",A.S"bar"])];
- "*/*;qu=\"\\\"\"", [1000,(A.AnyMedia,["qu",A.S"\""])];
- "*/*;f=\";q=0,text/plain\"", [1000,(A.AnyMedia,["f",A.S";q=0,text/plain"])];
+ "text/*;foo=\"bar\"", [1000,(A.AnyMediaSubtype "text",["foo","bar"])];
+ "*/*;qu=\"\\\"\"", [1000,(A.AnyMedia,["qu","\""])];
+ "*/*;f=\";q=0,text/plain\"", [1000,(A.AnyMedia,["f",";q=0,text/plain"])];
 ]
 
 let invalid_media_ranges = [