+ wip content negotation

src/config.ml

@@ -10,9 +10,76 @@ let supported_languages = [| "en"; "fr" |]
 
 (*
 let supported_extensions =
-  [| "html"; "htm"; "txt"; "pdf"; "jpg"; "jpeg"; "png"; "gif" |]
+  [ "html"; "htm"; "txt"; "pdf"; "jpg"; "jpeg"; "png"; "gif" ]
   *)
 
-(* todo
-   terms_matrix:
-     ext X lang *)
+let supported_extensions_mimetype_assoc =
+  [
+    ("txt", ("text", "plain")); ("html", ("text", "html"))
+  ; ("htm", ("text", "html")); ("pdf", ("application", "pdf"))
+  ; ("jpg", ("image", "jpeg")); ("jpeg", ("image", "jpeg"))
+  ; ("png", ("image", "png")); ("gif", ("image", "gif"))
+  ]
+
+let terms_assoc, privacy_assoc =
+  let open Syntax in
+  let get_ok res =
+    match res with
+    | Error (`Msg s) -> Fmt.failwith "static file error: `%s`" s
+    | Ok l -> l
+  in
+  let l = Assets.file_list in
+  List.iter (Fmt.pr "file: %s@.") l;
+  let l = get_ok (list_map (fun s -> Fpath.of_string s) l) in
+  let () =
+    (* check that Assets only contains supported extensions *)
+    let supported_extensions, _ =
+      List.split supported_extensions_mimetype_assoc
+    in
+    get_ok
+    @@ list_iter
+         (fun file ->
+           match Fpath.mem_ext supported_extensions file with
+           | true -> Ok ()
+           | false ->
+               Fmt.error_msg "Assets contains ussuported file `%s`"
+                 (Fpath.to_string file))
+         l
+  in
+  let mk base_dir =
+    let file_l =
+      List.filter_map (fun file -> Fpath.rem_prefix base_dir file) l
+    in
+    List.fold_left
+      (fun acc (ext, mime) ->
+        let lang_l =
+          List.filter (Fpath.has_ext ext) file_l
+          |> List.map Fpath.split_base
+          |> List.map fst
+          |> List.map Fpath.to_string
+        in
+        if List.is_empty lang_l then acc else (mime, (ext, lang_l)) :: acc)
+      [] supported_extensions_mimetype_assoc
+  in
+  let terms_assoc = mk terms_dir in
+  let privacy_assoc = mk privacy_dir in
+  (terms_assoc, privacy_assoc)
+
+(* TODO rewrite as one find_opt *)
+(* assumes l ordered by preferrence *)
+(* O(n^2) ok because supported length is small *)
+let preferred_lang ~supported l =
+  assert (List.length supported > 0);
+  assert (List.length l > 0);
+  let default_lang = List.nth supported 0 in
+  let l =
+    List.map (fun s -> if String.equal s "*" then default_lang else s) l
+  in
+  let l = List.filter (fun s -> List.mem s supported) l in
+  List.nth_opt l 0
+
+(*
+   get_terms accept accept_language =
+      | ok v
+      | error: `No_mime | `No_lang | `Bad_headers?
+   *)