Browse Source

backup

master
zapashcanon 3 years ago
parent
commit
dd7dfb2071
Signed by: zapashcanon GPG Key ID: 8981C3C62D1D28F1
  1. 61
      src/breadcrumb.ml
  2. 7
      src/directory.ml
  3. 15
      src/file.ml
  4. 8
      src/html.ml

61
src/breadcrumb.ml

@ -1,21 +1,56 @@
let gen in_path out_path =
let out_path = Fpath.to_string out_path in
let in_path = Fpath.to_string in_path in
let common_path =
Utils.strings_common_suffix
(Filename.dirname @@ Fpath.to_string in_path)
(Filename.dirname @@ Fpath.to_string out_path)
Utils.strings_common_suffix (Filename.dirname in_path)
(Filename.dirname out_path)
in
let bread_crumb = String.split_on_char '/' common_path in
let buff = Buffer.create 16 in
let buff = Buffer.create 512 in
let fmt = Format.formatter_of_buffer buff in
let bread_crumb =
List.map
(fun name ->
let path_to_root = Buffer.contents buff in
Buffer.add_string buff "../";
(name, path_to_root) )
(List.rev bread_crumb)
in
if bread_crumb <> [ "." ] then
let buff = Buffer.create 16 in
let bread_crumb =
List.map
(fun name ->
let path = Buffer.contents buff in
Buffer.add_string buff "../";
(name, path) )
(List.rev bread_crumb)
in
let bread_crumb = List.rev bread_crumb in
let root_name =
List.fold_left (fun acc _el -> Filename.dirname acc) out_path bread_crumb
in
let bread_crumb =
match bread_crumb with
| [] -> assert false
| [ (_name, path) ] -> [ (root_name, path) ]
| [ _h1; (_name, path) ] -> [ (root_name, path) ]
| (_name, path) :: t -> (root_name, path) :: t
in
List.iter
(fun (name, path) ->
Format.fprintf fmt {| <a href="%sindex.html">%s</a> /|}
(Html.url_encode path) (Html.sanitize name) )
bread_crumb
else begin
Format.printf "TODO";
Format.printf "lol"
end;
Format.fprintf fmt {| %s|} (Html.sanitize (Filename.basename out_path));
Format.fprintf fmt "<br />";
Format.pp_print_flush fmt ();
List.rev bread_crumb
Buffer.contents buff

7
src/directory.ml

@ -39,10 +39,13 @@ let rec gen in_path out_path =
([], []) content
in
let content = Format.asprintf "%a" Html.pp_index (files, directories) in
let bread_crumb = Breadcrumb.gen in_path out_path in
let index_content =
Format.asprintf "%a" Html.pp_index (bread_crumb, files, directories)
in
let index_path = Fpath.append out_path (Fpath.v "index.html") in
match Bos.OS.File.write index_path content with
match Bos.OS.File.write index_path index_content with
| Ok () -> ()
| Error _e ->
Utils.error

15
src/file.ml

@ -5,21 +5,6 @@ let gen in_path out_path =
let bread_crumb = Breadcrumb.gen in_path out_path in
let buff = Buffer.create 512 in
let fmt = Format.formatter_of_buffer buff in
List.iter
(fun (name, path) ->
Format.fprintf fmt {|<a href="%sindex.html">%s</a> /|}
(Html.url_encode path) (Html.sanitize name) )
bread_crumb;
Format.fprintf fmt "<br />";
Format.pp_print_flush fmt ();
let bread_crumb = Buffer.contents buff in
let content =
match Bos.OS.File.read in_path with
| Ok content ->

8
src/html.ml

@ -33,7 +33,7 @@ let pp_unsafe fmt content =
let pp fmt content = pp_unsafe fmt (sanitize content)
let pp_index fmt (files, directories) =
let pp_index fmt (breadcrumb, files, directories) =
let to_string l =
List.map
(fun (filename, path) -> (Fpath.to_string filename, Fpath.to_string path))
@ -63,8 +63,8 @@ let pp_index fmt (files, directories) =
let dir_len = List.length directories in
let fil_len = List.length files in
Format.asprintf
{|@.%d files (%d directories, %d regular files)<ul style="list-style-type: none;">@.%a%a</ul>@.|}
(dir_len + fil_len) dir_len fil_len (pp_list pp_directories) directories
(pp_list pp_files) files
{|@.%s%d files (%d directories, %d regular files)<ul style="list-style-type: none;">@.%a%a</ul>@.|}
breadcrumb (dir_len + fil_len) dir_len fil_len (pp_list pp_directories)
directories (pp_list pp_files) files
in
pp_unsafe fmt content

Loading…
Cancel
Save