Tidy converter

This commit is contained in:
orbifx 2021-06-13 12:54:29 +01:00
parent 551c907875
commit a7e066ab73
2 changed files with 65 additions and 56 deletions

View File

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

View File

@ -9,7 +9,7 @@ let wrap ?(keywords="") (title:string) (subtitle:string) body =
let topic_link root topic = let topic_link root topic =
{|<a href="index.|} ^ root ^ {|.htm#|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</a>" {|<a href="index.|} ^ root ^ {|.htm#|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</a>"
let page _topic_roots archive_title text = let page archive_title text =
let open Logarion in let open Logarion in
let open Text in let open Text in
let module T = Parsers.Plain_text.Make (Converter.Html) in let module T = Parsers.Plain_text.Make (Converter.Html) in