wip: custom static files crunching
This commit is contained in:
parent
6cdd1dcf9e
commit
aed9c6a559
5 changed files with 127 additions and 25 deletions
|
|
@ -2,6 +2,8 @@
|
||||||
|
|
||||||
(name mte)
|
(name mte)
|
||||||
|
|
||||||
|
; (implicit_transitive_deps false)
|
||||||
|
|
||||||
(generate_opam_files true)
|
(generate_opam_files true)
|
||||||
|
|
||||||
; (source
|
; (source
|
||||||
|
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
<!DOCTYPE html>
|
|
||||||
<html lang="en">
|
|
||||||
<head>
|
|
||||||
<meta charset="UTF-8">
|
|
||||||
<title>MTE terms</title>
|
|
||||||
</head>
|
|
||||||
<body>
|
|
||||||
<h1>MTE terms</h1>
|
|
||||||
TODO
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
<!DOCTYPE html>
|
|
||||||
<html lang="en">
|
|
||||||
<head>
|
|
||||||
<meta charset="UTF-8">
|
|
||||||
<title>MTE terms</title>
|
|
||||||
</head>
|
|
||||||
<body>
|
|
||||||
<h1>MTE terms</h1>
|
|
||||||
TODO
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
117
src/assets_script.ml
Normal file
117
src/assets_script.ml
Normal file
|
|
@ -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
|
||||||
11
src/dune
11
src/dune
|
|
@ -2,7 +2,12 @@
|
||||||
(public_name mte)
|
(public_name mte)
|
||||||
(name mte)
|
(name mte)
|
||||||
(modules assets mte config syntax)
|
(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
|
(rule
|
||||||
(target assets.ml)
|
(target assets.ml)
|
||||||
|
|
@ -10,5 +15,5 @@
|
||||||
(source_tree assets))
|
(source_tree assets))
|
||||||
(action
|
(action
|
||||||
(with-stdout-to
|
(with-stdout-to
|
||||||
%{null}
|
%{target}
|
||||||
(run ocaml-crunch -m plain assets -o %{target}))))
|
(run ./assets_script.exe))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue