wip clean up ToS

src/headers.ml

@@ -1,61 +1,47 @@
-let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item
+(* TODO header
+   Cohttp -> Http *)
 
 let accept_header_value =
-  let s =
-    Fmt.str "%a"
-      (pp_array Assets.Mimetype.pp_mime)
-      Assets.supported_mimetype_arr
-  in
-  s
+  let pp_list pp_item item = Fmt.list ~sep:(Fmt.any ", ") pp_item item in
+  Fmt.str "%a" (pp_list Assets.Mimetype.pp) Assets.Mimetype.all_supported
 
 let avail_languages_header_value =
+  let pp_array pp_item item = Fmt.array ~sep:(Fmt.any ", ") pp_item item in
   let s = Fmt.str "%a" (pp_array Fmt.string) Assets.supported_lang_arr in
   s
 
 let select_mimetype headers =
   let opt = Vif.Headers.get headers "accept" in
-  Logs.err (fun m ->
-      let s = Option.value ~default:"none" opt in
-      m "Header accept: %s" s);
   Cohttp.Accept.media_ranges opt
   |> Cohttp.Accept.qsort
-  |> List.filter_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
-  |> List.find_opt Assets.is_supported_mimetype
+  |> List.find_map (fun (_q, (m, _p)) -> Assets.Mimetype.of_cohttp_media m)
+  |> function
+  | None -> Assets.default_mimetype
+  | Some mime -> mime
 
 let select_language headers =
   let opt = Vif.Headers.get headers "accept-language" in
-  Logs.err (fun m ->
-      let s = Option.value ~default:"none" opt in
-      m "Header accept-language: %s" s);
   Cohttp.Accept.languages opt
   |> Cohttp.Accept.qsort
-  |> List.map (fun (_q, lang) -> lang)
-  |> List.map (function
-    | Cohttp.Accept.AnyLanguage -> Assets.default_lang
-    | Language language_range -> (
-        (* ignore language subtags (e.g. "en-US" -> "en") *)
-        match language_range with
-        | [] -> assert false
-        | primary_tag :: _ -> primary_tag))
-  |> List.find_opt Assets.is_supported_lang
-  |> Option.value ~default:Assets.default_lang
+  |> List.map snd
+  |> List.find_map Assets.Language.of_cohttp_language
+  |> function
+  | None -> Assets.default_lang
+  | Some lang -> lang
 
 let select_encoding headers =
   let opt = Vif.Headers.get headers "accept-encoding" in
-  Logs.err (fun m ->
-      let s = Option.value ~default:"none" opt in
-      m "Header accept-encoding: %s" s);
   Cohttp.Accept.encodings opt
   |> Cohttp.Accept.qsort
   |> List.map snd
-  |> List.filter_map (function
+  |> List.find_map (function
     | Cohttp.Accept.Identity -> Some `Identity
     | Deflate -> Some `DEFLATE
     | Gzip -> Some `Gzip
     | AnyEncoding -> Some Assets.default_encoding
     | Encoding _ | Compress -> (* unsupported *) None)
   |> function
-  | [] -> assert false
-  | `Identity :: _ -> None
-  | `DEFLATE :: _ -> Some `DEFLATE
-  | `Gzip :: _ -> Some `Gzip
+  | None -> None
+  | Some `Identity -> None
+  | Some `DEFLATE -> Some `DEFLATE
+  | Some `Gzip -> Some `Gzip