Merge pull request #104 from inhabitedtype/choose-encoding

choose-encoding: move choosing encoding code to Encoding module
inhabitedtype · Apr 26, 2020 · 2e4f009 · 2e4f009
2 parents 42bc5f1 + 013cdf0
commit 2e4f009
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 19 deletions.
diff --git a/lib/encoding.ml b/lib/encoding.ml
@@ -31,7 +31,7 @@
     POSSIBILITY OF SUCH DAMAGE.
   ----------------------------------------------------------------------------*)
 
-let choose ~available ~acceptable ~default =
+let choose_actual ~available ~acceptable ~default =
   let any_prio     = List.filter (fun (_, c) -> c = "*"    ) acceptable in
   let default_prio = List.filter (fun (_, c) -> c = default) acceptable in
   let default_ok =
@@ -79,7 +79,28 @@ let choose_charset ~available ~acceptable =
       q, c)
     acceptable
   in
-  choose
+  choose_actual
     ~available
     ~acceptable
     ~default:"iso-885a-1"
+;;
+
+let choose ~available ~acceptable =
+  let acceptable =
+    List.map (fun (q, c) ->
+      let c =
+        match (c : Cohttp.Accept.encoding) with
+        | AnyEncoding -> "*"
+        | Encoding e  -> e
+        | Identity    -> "identity"
+        | Gzip        -> "gzip"
+        | Compress    -> "compress"
+        | Deflate     -> "deflate"
+      in
+      q, c)
+    acceptable
+  in
+  choose_actual
+    ~available
+    ~acceptable
+    ~default:"identity"
diff --git a/lib/encoding.mli b/lib/encoding.mli
@@ -33,8 +33,7 @@
 
 val choose
   :  available:(string * 'a) list
-  -> acceptable:(int * string) list
-  -> default:string
+  -> acceptable:(int * Cohttp.Accept.encoding) list
   -> (string * 'a) option
 
 val choose_charset

diff --git a/lib/webmachine.ml b/lib/webmachine.ml
@@ -303,25 +303,11 @@ module Make(IO:IO)(Clock:CLOCK) = struct
           self#halt n
 
     method private choose_encoding acceptable k =
-      let open Accept in
-      (* Shadow the definition in Accept because it requires that you provide a
-       * quality, which should not be included *)
-      let string_of_encoding = function
-        | AnyEncoding -> "*"
-        | Encoding e  -> e
-        | Identity    -> "identity"
-        | Gzip        -> "gzip"
-        | Compress    -> "compress"
-        | Deflate     -> "deflate"
-      in
-      let acceptable =
-        List.map (fun (q, c) -> (q, string_of_encoding c)) acceptable
-      in
       resource#encodings_provided rd
       >>= function
         | Ok available, rd' ->
           rd <- rd';
-          encoding <- Encoding.choose ~available ~acceptable ~default:"identity";
+          encoding <- Encoding.choose ~available ~acceptable;
           k encoding
         | Error n, rd' ->
           rd <- rd';