first commit
This commit is contained in:
commit
d2043caf34
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
_build
|
1
dune-project
Normal file
1
dune-project
Normal file
@ -0,0 +1 @@
|
||||
(lang dune 2.8)
|
13
src/any.ml
Normal file
13
src/any.ml
Normal file
@ -0,0 +1,13 @@
|
||||
let gen in_path out_path =
|
||||
begin match Bos.OS.Path.must_exist in_path with
|
||||
| Ok in_path ->
|
||||
begin match Bos.OS.File.must_exist in_path with
|
||||
| Ok in_path -> File.gen in_path out_path
|
||||
| Error _e ->
|
||||
begin match Bos.OS.Dir.must_exist in_path with
|
||||
| Ok in_path -> Directory.gen in_path out_path
|
||||
| Error _e -> Utils.error (Format.sprintf "path `%s` isn't a directory or a file, don't know what to do with it" (Fpath.to_string in_path))
|
||||
end;
|
||||
end;
|
||||
| Error _e -> Utils.error (Format.sprintf "path `%s` doesn't exist" (Fpath.to_string in_path))
|
||||
end
|
44
src/directory.ml
Normal file
44
src/directory.ml
Normal file
@ -0,0 +1,44 @@
|
||||
let rec gen in_path out_path =
|
||||
match Bos.OS.Dir.must_exist in_path with
|
||||
| Ok in_path ->
|
||||
begin match Bos.OS.Dir.contents ~dotfiles:true ~rel:true in_path with
|
||||
| Ok content ->
|
||||
begin match Bos.OS.Dir.create ~path:true ~mode:0o755 out_path with
|
||||
| Ok true ->
|
||||
let index_f, index_d = List.fold_left (fun (index_f, index_d) filename ->
|
||||
let in_path = Fpath.append in_path filename in
|
||||
match Bos.OS.Dir.must_exist in_path with
|
||||
| Ok path ->
|
||||
gen in_path (Fpath.append out_path path);
|
||||
index_f, ((filename, path)::index_d)
|
||||
| Error _e ->
|
||||
begin match Bos.OS.File.must_exist in_path with
|
||||
| Ok in_path ->
|
||||
let file_path = Fpath.v (Fpath.to_string filename ^ ".html") in
|
||||
File.gen in_path (Fpath.append out_path file_path);
|
||||
((filename, file_path)::index_f), index_d
|
||||
| Error _e -> Utils.error (Format.sprintf "can't gen `%s`" (Fpath.to_string in_path))
|
||||
end
|
||||
) ([], [])
|
||||
content
|
||||
in
|
||||
let index_f = List.map (fun (filename, path) ->
|
||||
Format.sprintf {|<li><a href="%s">%s</a></li>|} (Fpath.to_string path) (Fpath.to_string filename)
|
||||
) index_f in
|
||||
let index_d = List.map (fun (filename, path) ->
|
||||
Format.sprintf {|<li><a href="%s/index.html">%s</li>|} (Fpath.to_string path) (Fpath.to_string filename)
|
||||
) index_d in
|
||||
let pp_list = Format.pp_print_list ~pp_sep:(fun fmt () -> Format.fprintf fmt "") Format.pp_print_string in
|
||||
let content = Format.asprintf "<ul>%a%a</ul>" pp_list index_d pp_list index_f in
|
||||
let content = Format.asprintf "%a" Html.pp content in
|
||||
let index_path = Fpath.append out_path (Fpath.v "index.html") in
|
||||
begin match Bos.OS.File.write index_path content with
|
||||
| Ok () -> ()
|
||||
| Error _e -> Utils.error (Format.sprintf "can't write to file `%s`" (Fpath.to_string index_path))
|
||||
end
|
||||
| Error _ | Ok false -> Utils.error (Format.sprintf "can't create directory `%s` or it already exists" (Fpath.to_string out_path))
|
||||
end;
|
||||
| Error _e -> Utils.error (Format.sprintf "can't get content of directory `%s`" (Fpath.to_string in_path))
|
||||
|
||||
end
|
||||
| Error _e -> Utils.error (Format.sprintf "directory `%s` doesn't exist" (Fpath.to_string in_path))
|
9
src/dune
Normal file
9
src/dune
Normal file
@ -0,0 +1,9 @@
|
||||
(library
|
||||
(name hize)
|
||||
(modules any directory file html utils)
|
||||
(libraries bos fpath))
|
||||
|
||||
(executable
|
||||
(name hize)
|
||||
(modules hize)
|
||||
(libraries hize bos fpath))
|
13
src/file.ml
Normal file
13
src/file.ml
Normal file
@ -0,0 +1,13 @@
|
||||
let gen in_path out_path =
|
||||
match Bos.OS.File.must_exist in_path with
|
||||
| Ok in_path ->
|
||||
begin match Bos.OS.File.read in_path with
|
||||
| Ok s ->
|
||||
let content = Format.asprintf "%a" Html.pp s in
|
||||
begin match Bos.OS.File.write out_path content with
|
||||
| Ok () -> ()
|
||||
| Error _e -> Utils.error (Format.sprintf "can't write to file `%s`" (Fpath.to_string out_path))
|
||||
end
|
||||
| Error _e -> Utils.error (Format.sprintf "can't read file `%s`" (Fpath.to_string in_path))
|
||||
end
|
||||
| Error _e -> Utils.error (Format.sprintf "file `%s` doesn't exist" (Fpath.to_string in_path))
|
11
src/hize.ml
Normal file
11
src/hize.ml
Normal file
@ -0,0 +1,11 @@
|
||||
open Hize
|
||||
|
||||
let () =
|
||||
if Array.length Sys.argv <> 3 then Utils.error (Format.sprintf "usage: %s <input file or directory> <output>" Sys.argv.(0));
|
||||
|
||||
let in_path = Fpath.(v Sys.argv.(1)) in
|
||||
let out_path = Fpath.(v Sys.argv.(2)) in
|
||||
|
||||
Any.gen in_path out_path;
|
||||
|
||||
Format.printf "done !@."
|
14
src/html.ml
Normal file
14
src/html.ml
Normal file
@ -0,0 +1,14 @@
|
||||
let pp fmt content =
|
||||
Format.fprintf fmt {|<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="utf-8">
|
||||
<style>
|
||||
body { color: #444; background-color: #EEEEEE; line-height: 1.6; font-size: 18px;}
|
||||
</style>
|
||||
<title>Title</title>
|
||||
</head>
|
||||
<body>
|
||||
<pre>%s</pre>
|
||||
</body>
|
||||
</html>|} content
|
3
src/utils.ml
Normal file
3
src/utils.ml
Normal file
@ -0,0 +1,3 @@
|
||||
let error e =
|
||||
Format.eprintf "error: %s@." e;
|
||||
exit 1
|
Loading…
x
Reference in New Issue
Block a user