software-archive/logarion-2021
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Converter type selection, subdir conversion, htm extension

Browse Source
This commit is contained in:
orbifx 2021-06-05 23:51:37 +01:00
parent 071808367c
commit 114bfafdce
3 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
app/convert.ml
View File

@ -7,63 +7,66 @@ let file_when_changed source dest fn title text =
if (try Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true) then
File_store.file dest (fn title text)
let writer dir name acc (text,store_item) = (* todo: single_parser -> [files] *)
let writer types dir name acc (text,store_item) = (* todo: single_parser -> [files] *)
let open Logarion in
match Text.(str "Content-Type" text) with
| "" | "text/plain" ->
let filename = dir ^ "/" ^ Text.alias text in
(* let idfilename = dir ^ "/" ^ Id.to_string text.Text.uuid ^ ".txt" in*)
(* file_when_changed store_item idfilename (fun _title -> Text.to_string) text.title text;*)
file_when_changed store_item (filename ^ ".html") (Html.page "") name text;
file_when_changed store_item (filename ^ ".gmi") Gemini.page name text;
if "htm" = types || "all" = types then file_when_changed store_item (filename ^ ".htm") (Html.page "") name text;
if "gmi" = types || "all" = types then file_when_changed store_item (filename ^ ".gmi") Gemini.page name text;
(acc + 1)
| x -> prerr_endline ("No converter for Content-Type: " ^ x ^ ", for " ^ text.Text.title); acc
let index_writer dir archive topic_roots topic_map indexed_texts =
let index_writer types dir archive topic_roots topic_map indexed_texts =
let name = archive.A.name in
let file path = File_store.file (dir ^ path) in
file "/index.pck" (Header_pack.pack archive indexed_texts);
file "/index.html" (Html.topic_main_index name topic_roots indexed_texts);
List.iter
(fun topic -> file ("/index." ^ topic ^ ".htm") (Html.topic_sub_index name topic_map topic indexed_texts))
topic_roots;
file "/index.date.html" (Html.date_index name indexed_texts);
if "htm" = types || "all" = types then (
file "/index.html" (Html.topic_main_index name topic_roots indexed_texts);
List.iter
(fun topic -> file ("/index." ^ topic ^ ".htm") (Html.topic_sub_index name topic_map topic indexed_texts))
topic_roots;
file "/index.date.htm" (Html.date_index name indexed_texts);
);
let base_url = try Store.KV.find "HTTP-URL" archive.File_store.kv
with Not_found -> prerr_endline "Missing `HTTP-URL:` in config"; ""
in
file "/feed.atom" (Atom.feed archive.A.name archive.A.id base_url indexed_texts);
file "/index.date.gmi" (Gemini.date_index name indexed_texts)
if "gmi" = types || "all" = types then file "/index.date.gmi" (Gemini.date_index name indexed_texts)
let convert_all dir archive =
let convert_all types dir archive =
let name = archive.A.name in
let count = A.(fold ~order:newest (writer dir name) 0 archive) in (*TODO: merge*)
let topic_map, indexed_metas =
let topic_map, indexed_metas, count =
let topic_map = Logarion.Topic_set.Map.empty in
let fn (ts,ls) (elt,_) =
Logarion.(Topic_set.to_map ts (Text.set "topics" elt)), elt::ls in
A.(fold ~order:newest fn (topic_map,[]) archive) in
let fn (ts,ls,acc) ((elt,_) as r) =
Logarion.(Topic_set.to_map ts (Text.set "topics" elt)), elt::ls, writer types dir name acc r in
A.(fold ~order:newest fn (topic_map,[],0) archive) in
let topic_roots = Logarion.Topic_set.roots topic_map in
index_writer dir archive topic_roots topic_map indexed_metas;
index_writer types dir archive topic_roots topic_map indexed_metas;
print_endline @@ "Converted: " ^ string_of_int (count) ^ "\nIndexed: " ^ string_of_int (List.length indexed_metas);
Ok ()
let convert_dir cmd_dir =
let convert_dir types cmd_dir =
let (>>=) = Result.bind in
let config_dir archive = try Ok (Store.KV.find "Export-Dir" archive.File_store.kv) with Not_found -> Error "unspecified export dir" in
let init dir =
let with_dir dir =
Result.map_error (function `Msg m -> m)
Logarion.File_store.Directory.(directory dir |> print ~descr:"export" dir) in
(A.of_path "."
>>= fun archive -> (match cmd_dir with "" -> config_dir archive | x -> Ok x)
>>= fun dir -> init dir
>>= fun _ -> convert_all dir archive)
>>= fun archive -> (match cmd_dir with "" -> Error "unspecified export dir" | x -> Ok x)
>>= fun dir -> with_dir dir
>>= fun _ -> convert_all types dir { archive with store = dir })
|> function Ok () -> () | Error x -> prerr_endline x
open Cmdliner
let term =
let directory = Arg.(value & pos 0 string "" & info [] ~docv:"target directory" ~doc:"Directory to convert into") in
Term.(const convert_dir $ directory),
let directory = Arg.(value & pos 0 string ""
& info [] ~docv:"target directory" ~doc:"Directory to convert into") in
let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"TYPES" ~doc:"Convert to type") in
Term.(const convert_dir $ types $ directory),
Term.info
"convert" ~doc:"convert archive"
~man:[ `S "DESCRIPTION"; `P "Convert Logarion archive" ]

8
app/html.ml
View File

@ -16,7 +16,7 @@ let page _topic_roots archive_title text =
let sep_append ?(sep=", ") a x = match a,x with "",_ -> x | _, "" -> a | _ -> a ^ sep ^ x in
let opt_kv key value = if String.length value > 0 then "<dt>" ^ key ^ "<dd>" ^ value else "" in
(* let author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
let authors = T.of_string (Person.Set.to_string text.authors ^ " ") "" in
let authors = (Person.Set.to_string text.authors ^ " ") in
let keywords = str_set "keywords" text in
let header =
let time x = {|<time datetime="|} ^ x ^ {|">|} ^ x ^ "</time>" in
@ -48,7 +48,7 @@ let to_dated_links ?(limit) meta_list =
List.fold_left
(fun a m ->
a ^ Logarion.(Date.(pretty_date (listing m.Text.date)) ^ " ")
^ {|<a href="|} ^ Logarion.Text.alias m ^ {|.html">|} ^ m.Logarion.Text.title ^ "</a><br/>")
^ {|<a href="|} ^ Logarion.Text.alias m ^ {|.htm">|} ^ m.Logarion.Text.title ^ "</a><br/>")
"" meta_list
let date_index ?(limit) title meta_list =
@ -82,7 +82,7 @@ let fold_topics topic_map topic_roots metas =
let text_item path meta =
let open Logarion in
{|<tr><td><a href="|} ^ path ^ Text.alias meta ^ {|.html">|} ^ meta.Text.title
{|<tr><td><a href="|} ^ path ^ Text.alias meta ^ {|.htm">|} ^ meta.Text.title
^ "</a><td><time>" ^ Date.(pretty_date (listing meta.Text.date)) ^ "</time>"
let listing_index topic_map topic_roots path metas =
@ -108,7 +108,7 @@ let topic_main_index title topic_roots metas =
wrap title "Topics"
(fold_topic_roots topic_roots
^ "<nav><h2>Latest</h2>" ^ to_dated_links ~limit:5 metas
^ {|<br/><a href="index.date.html">More by date</a></nav>|} )
^ {|<br/><a href="index.date.htm">More by date</a></nav>|} )
let topic_sub_index title topic_map topic_root metas =
wrap title topic_root

6
lib/file_store.ml
View File

@ -119,20 +119,20 @@ let with_text {store;_} new_text =
fun path ->
try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
let basic_toml_bytes =
let basic_config () =
"Archive-Name: "
^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
|> Bytes.of_string
let init ?(dotdir=".logarion/") () =
match Directory.directories [dotdir, "dotdir"; dotdir//"published", "linkdir"; dotdir//"indexed", "link dir"] with
match Directory.directories [dotdir, "dotdir"] with
| Error (_dir, _desc) -> ()
| Ok () ->
let config_file =
open_out_gen [Open_creat; Open_excl; Open_wronly]
0o700 (dotdir // "config") in
output_bytes config_file basic_toml_bytes;
output_bytes config_file (basic_config ());
close_out config_file
module Config = struct