diff --git a/dune-project b/dune-project
index 8b2e9ddb..07270ac2 100644
--- a/dune-project
+++ b/dune-project
@@ -2,6 +2,8 @@
(name mte)
+; (implicit_transitive_deps false)
+
(generate_opam_files true)
; (source
diff --git a/src/assets/privacy/en/0.html b/src/assets/privacy/en/0.html
deleted file mode 100644
index 829f6b79..00000000
--- a/src/assets/privacy/en/0.html
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
-
-
- MTE terms
-
-
- MTE terms
- TODO
-
-
diff --git a/src/assets/terms/en/0.html b/src/assets/terms/en/0.html
deleted file mode 100644
index 829f6b79..00000000
--- a/src/assets/terms/en/0.html
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
-
-
- MTE terms
-
-
- MTE terms
- TODO
-
-
diff --git a/src/assets_script.ml b/src/assets_script.ml
new file mode 100644
index 00000000..ea21f462
--- /dev/null
+++ b/src/assets_script.ml
@@ -0,0 +1,117 @@
+(* crunchy crunch ~ *)
+(* we enforce a "complete" folder structure to keep it simple
+ (all languages must support the same mimetypes) *)
+open Bos
+
+let terms_dir = Fpath.v "assets/terms/"
+let privacy_dir = Fpath.v "assets/privacy/"
+let etag = Fpath.v "0"
+
+let dir_contents dir =
+ match OS.Dir.contents ~rel:true dir with
+ | Error e -> Fmt.failwith "Error reading dir: %a" Rresult.R.pp_msg e
+ | Ok files -> files
+
+let read_tos_dir kind =
+ let dir = match kind with `Terms -> terms_dir | `Privacy -> privacy_dir in
+ (*
+ let l = OS.Dir.contents ~rel:true (Fpath.v ".") |> Rresult.R.get_ok in
+ List.iter (fun p -> Fmt.epr "%s, " (Fpath.to_string p)) l;
+ Fmt.epr "@.";
+ *)
+ let subdirs =
+ let files = dir_contents dir in
+ List.filter
+ (fun p -> OS.Dir.exists Fpath.(dir // p) |> Rresult.R.get_ok)
+ files
+ in
+ let lang_arr = subdirs |> List.sort Fpath.compare |> Array.of_list in
+ let fpaths_l =
+ lang_arr
+ |> Array.to_list
+ |> List.map (fun lang ->
+ let subdir = Fpath.(dir // lang) in
+ (*
+ Fmt.pr "subdir: %s\n" (Fpath.to_string lang)
+ (Fpath.to_string subdir);
+ *)
+ dir_contents subdir)
+ in
+ let ext_arr =
+ let exts_l =
+ fpaths_l
+ |> List.map (fun l ->
+ List.map Fpath.get_ext l |> List.sort String.compare)
+ in
+ let ext_l =
+ match exts_l with
+ | [] -> []
+ | [ ext_l ] -> ext_l
+ | hd :: tl ->
+ let all_language_support_same_extensions =
+ List.for_all (List.equal String.equal hd) tl
+ in
+ if all_language_support_same_extensions then hd
+ else
+ Fmt.failwith "Invalid assets folder structure" |> Rresult.R.get_ok
+ in
+ ext_l |> List.sort String.compare |> Array.of_list
+ in
+ let content_mat =
+ Array.init_matrix (Array.length lang_arr) (Array.length ext_arr) (fun i j ->
+ let lang = lang_arr.(i) in
+ let ext = ext_arr.(j) in
+ let path = Fpath.(dir // lang // (etag + ext)) in
+ match OS.File.read path with
+ | Error e -> Fmt.failwith "Error reading dir: %a" Rresult.R.pp_msg e
+ | Ok data -> data)
+ in
+ let lang_arr = Array.map Fpath.to_string lang_arr in
+ (lang_arr, ext_arr, content_mat)
+
+let lang_arr, ext_arr, terms_mat, privacy_mat =
+ let lang_arr, ext_arr, terms_mat = read_tos_dir `Terms in
+ let lang_arr', ext_arr', privacy_mat = read_tos_dir `Privacy in
+ (* TODO stdlib no Array.equal *)
+ match
+ List.equal String.equal (Array.to_list lang_arr) (Array.to_list lang_arr')
+ && List.equal String.equal (Array.to_list ext_arr) (Array.to_list ext_arr')
+ with
+ | false ->
+ Fmt.failwith "terms and privacy folder does not have the same structure@."
+ | true -> (lang_arr, ext_arr, terms_mat, privacy_mat)
+
+let pp_string_data ppf s =
+ let open Fmt in
+ pf ppf "%S" s
+
+let pp_row ppf row =
+ let open Fmt in
+ pf ppf "[|%a|]" (array ~sep:(any "; ") pp_string_data) row
+
+let pp_mat ppf mat =
+ let open Fmt in
+ pf ppf "[|%a|]" (array ~sep:(any "; ") pp_row) mat
+
+let () =
+ Fmt.pr
+ {|
+type t = | Terms | Privacy
+
+let get_static_file_content =
+ let lang_arr = %a in
+ let ext_arr = %a in
+ let terms_mat = %a in
+ let privacy_mat = %a in
+ fun ~lang ~ext kind ->
+ match
+ ( Array.find_index (String.equal lang) lang_arr
+ , Array.find_index (String.equal ext) ext_arr )
+ with
+ | None, _ | _, None -> None
+ | Some i, Some j -> (
+ match kind with
+ | Terms -> Some terms_mat.(i).(j)
+ | Privacy -> Some privacy_mat.(i).(j))
+|}
+ pp_row lang_arr pp_row ext_arr pp_mat terms_mat pp_mat privacy_mat
diff --git a/src/dune b/src/dune
index 397a7942..cf47d448 100644
--- a/src/dune
+++ b/src/dune
@@ -2,7 +2,12 @@
(public_name mte)
(name mte)
(modules assets mte config syntax)
- (libraries vif fmt jsont cohttp))
+ (libraries vif fmt fpath jsont cohttp))
+
+(executable
+ (name assets_script)
+ (modules assets_script)
+ (libraries bos fmt fpath))
(rule
(target assets.ml)
@@ -10,5 +15,5 @@
(source_tree assets))
(action
(with-stdout-to
- %{null}
- (run ocaml-crunch -m plain assets -o %{target}))))
+ %{target}
+ (run ./assets_script.exe))))