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)
|
||||
|
||||
; (implicit_transitive_deps false)
|
||||
|
||||
(generate_opam_files true)
|
||||
|
||||
; (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)
|
||||
(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))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue