diff --git a/cmd/txt/html.ml b/cmd/txt/html.ml index 7fec0d6..852f8db 100644 --- a/cmd/txt/html.ml +++ b/cmd/txt/html.ml @@ -1,181 +1,173 @@ type templates_t = { header: string option; footer: string option } -type t = { templates : templates_t; style : string } - +type t = { templates: templates_t; } let ext = ".htm" let empty_templates = { header = None; footer = None } -let default_opts = { templates = empty_templates; style = "" } +let default_opts = { templates = empty_templates } let init kv = - let open Kosuzu in - let to_string key kv = match Store.KV.find key kv with - | fname -> Some (File_store.to_string fname) - | exception Not_found -> None in - let header = to_string "HTM-header" kv in - let footer = to_string "HTM-footer" kv in - let style = match to_string "HTM-style" kv with - | Some s -> Printf.sprintf "\n" s | None -> "" in - { templates = { header; footer}; style } + let open Kosuzu in + let to_string key kv = match Store.KV.find key kv with + | fname -> Some (File_store.to_string fname) + | exception Not_found -> None in + let header = to_string "HTM-header" kv in + let footer = to_string "HTM-footer" kv in + { templates = { header; footer } } -let wrap conv htm text_title body = - let site_title = try Kosuzu.Store.KV.find "Title" conv.Conversion.kv with Not_found -> "" in - let replace x = let open Str in - global_replace (regexp "{{archive-title}}") site_title x - |> global_replace (regexp "{{text-title}}") text_title - in - let feed = try Kosuzu.Store.KV.find "HTM-feed" conv.Conversion.kv - with Not_found -> if Sys.file_exists (Filename.concat conv.Conversion.dir "feed.atom") - then "feed.atom" else "" in - let header = match htm.templates.header with - | Some x -> replace x - | None -> Printf.(sprintf "%s%s" site_title - (if feed <> "" then sprintf "feed" feed else "")) - in - let footer = match htm.templates.footer with None -> "" | Some x -> replace x in - Printf.sprintf "\n\n\n\n%s%s\n%s\n%s\n\n\n\n\n\n%s%s%s\n" - text_title (if site_title <> "" then (" • " ^ site_title) else "") - htm.style - (if feed <> "" then Printf.sprintf "" feed else "") - header body footer +let wrap c htm text_title body = + let site_title = try Kosuzu.Store.KV.find "Title" c.Conversion.kv with Not_found -> "" in + let replace x = let open Str in + global_replace (regexp "{{archive-title}}") site_title x + |> global_replace (regexp "{{text-title}}") text_title + in + let header = match htm.templates.header with + | Some x -> replace x + | None -> "
" ^ site_title ^ "
" + in + let footer = match htm.templates.footer with None -> "" | Some x -> replace x in + Printf.sprintf "\n\n\n\n\n\n\n%s%s\n\n\n%s%s%s" + text_title (if site_title <> "" then (" - " ^ site_title) else "") + header body footer let topic_link root topic = - let replaced_space = String.map (function ' '->'+' | x->x) in - "" - ^ String.capitalize_ascii topic ^ "" + let replaced_space = String.map (function ' '->'+' | x->x) in + "" + ^ String.capitalize_ascii topic ^ "" + module HtmlConverter = struct - include Converter.Html - let uid_uri u a = Printf.sprintf "%s<%s>" a u ext u - let angled_uri u a = - if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false - then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a + include Converter.Html + let uid_uri u a = Printf.sprintf "%s<%s>" a u ext u + let angled_uri u a = + if try String.sub u 0 10 = "urn:txtid:" with Invalid_argument _ -> false + then angled_uri (String.(sub u 10 (length u - 10)) ^ ext) a else angled_uri u a end let page htm conversion text = - let open Kosuzu in - let open Text in - let module T = Parsers.Plain_text.Make (HtmlConverter) in - 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 "
" ^ key ^ "
" ^ value else "" in - let authors = Person.Set.to_string text.authors in - let header = - let time x = Printf.sprintf {||} -(Date.rfc_string x) (Date.pretty_date x) in - let topic_links x = - let to_linked t a = - let ts = Topic_set.of_string t in - sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in - String_set.fold to_linked x "" in - let ref_links x = - let link l = HtmlConverter.uid_uri l "" in - String_set.fold (fun r a -> sep_append a (link r)) x "" in - let references, replies = let open Conversion in - let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in - ref_links ref_set, ref_links rep_set in - "
" - ^ opt_kv "Title:" text.title - ^ opt_kv "Authors:" authors - ^ opt_kv "Date:" (time (Date.listing text.date)) - ^ opt_kv "Series:" (str_set "series" text) - ^ opt_kv "Topics:" (topic_links (set "topics" text)) - ^ opt_kv "Id:" text.id - ^ opt_kv "Refers:" (ref_links (set "references" text)) - ^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text)) - ^ opt_kv "Referred by:" references - ^ opt_kv "Replies:" replies - ^ {|
|} in
-        wrap conversion htm text.title ((T.of_string text.body header) ^ "
") + let open Kosuzu in + let open Text in + let module T = Parsers.Plain_text.Make (HtmlConverter) in + 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 "
" ^ key ^ "
" ^ value else "" in + let authors = Person.Set.to_string text.authors in + let header = + let time x = Printf.sprintf {||} + (Date.rfc_string x) (Date.pretty_date x) in + let topic_links x = + let to_linked t a = + let ts = Topic_set.of_string t in + sep_append a (List.fold_left (fun a t -> sep_append ~sep:" > " a (topic_link (List.hd ts) t)) "" ts) in + String_set.fold to_linked x "" in + let ref_links x = + let link l = HtmlConverter.uid_uri l "" in + String_set.fold (fun r a -> sep_append a (link r)) x "" in + let references, replies = let open Conversion in + let Rel.{ref_set; rep_set; _} = try Rel.Id_map.find text.id conversion.relations with Not_found -> Rel.empty in + ref_links ref_set, ref_links rep_set in + "
" + ^ opt_kv "Title:" text.title + ^ opt_kv "Authors:" authors + ^ opt_kv "Date:" (time (Date.listing text.date)) + ^ opt_kv "Series:" (str_set "series" text) + ^ opt_kv "Topics:" (topic_links (set "topics" text)) + ^ opt_kv "Id:" text.id + ^ opt_kv "Refers:" (ref_links (set "references" text)) + ^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text)) + ^ opt_kv "Referred by:" references + ^ opt_kv "Replies:" replies + ^ {|
|} in
+  wrap conversion htm text.title ((T.of_string text.body header) ^ "
") let to_dated_links ?(limit) meta_list = - let meta_list = match limit with - | None -> meta_list - | Some limit-> - let rec reduced acc i = function - | [] -> acc - | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in - List.rev @@ reduced [] 0 meta_list in - List.fold_left - (fun a m -> Printf.sprintf "%s
  • %s %s" a Kosuzu.(Date.(pretty_date (listing m.Text.date))) - (Kosuzu.Text.short_id m) m.Kosuzu.Text.title) - "" meta_list + let meta_list = match limit with + | None -> meta_list + | Some limit-> + let rec reduced acc i = function + | [] -> acc + | h::t -> if i < limit then reduced (h::acc) (i+1) t else acc in + List.rev @@ reduced [] 0 meta_list in + List.fold_left + (fun a m -> Printf.sprintf "%s
  • %s %s" a Kosuzu.(Date.(pretty_date (listing m.Text.date))) + (Kosuzu.Text.short_id m) m.Kosuzu.Text.title) + "" meta_list let date_index ?(limit) conv htm meta_list = - match limit with - | Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list) - | None -> wrap conv htm "Index" (to_dated_links meta_list) + match limit with + | Some limit -> wrap conv htm "Index" (to_dated_links ~limit meta_list) + | None -> wrap conv htm "Index" (to_dated_links meta_list) let fold_topic_roots topic_roots = - let list_item root t = "
  • " ^ topic_link root t in - "" + let list_item root t = "
  • " ^ topic_link root t in + "" let fold_topics topic_map topic_roots metas = - let open Kosuzu in - let rec unordered_list root topic = - List.fold_left (fun a x -> a ^ list_item root x) "" - and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with + let open Kosuzu in + let rec unordered_list root topic = + List.fold_left (fun a x -> a ^ list_item root x) "" and + sub_items root topic = match Topic_set.Map.find_opt topic topic_map with | None -> "" - | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) -and list_item root t = + | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) and + list_item root t = let item = - if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas - then topic_link root t else String.capitalize_ascii t in + if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas + then topic_link root t else String.capitalize_ascii t in "" in - "" + "" let text_item path meta = - let open Kosuzu in - " |} ^ meta.Text.title - ^ "
    " + let open Kosuzu in + " |} ^ meta.Text.title + ^ "
    " let listing_index topic_map topic_roots path metas = - let rec item_group topics = - List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics - and sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with + let rec item_group topics = + List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics and + sub_groups topic = match Kosuzu.Topic_set.Map.find_opt topic topic_map with | None -> "" - | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) -and items topic = + | Some (_, subtopics) -> item_group (Kosuzu.String_set.elements subtopics) and + items topic = let items = - let open Kosuzu in - List.fold_left - (fun a e -> - if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) - then text_item path e ^ a else a) "" metas in + let open Kosuzu in + List.fold_left (fun a e -> + if String_set.mem topic (String_set.map (Kosuzu.Topic_set.topic) (Text.set "Topics" e)) + then text_item path e ^ a else a) "" metas in match items with | "" -> "" - | x -> {|

    |} ^ String.capitalize_ascii topic ^ "

    " ^ x in - "" + | x -> {|

    |} ^ String.capitalize_ascii topic ^ "

    " ^ x + in + "" let topic_main_index conv htm topic_roots metas = - wrap conv htm "Topics" - (fold_topic_roots topic_roots - ^ "
    More by date|} -^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in -(if peers = "" then "" else - List.fold_left (fun a s -> Printf.sprintf {|%s
  • %s|} a s s) "

    Peers

    ")) + wrap conv htm "Topics" + (fold_topic_roots topic_roots + ^ "
    More by date|} + ^ let peers = try Kosuzu.Store.KV.find "Peers" conv.kv with Not_found -> "" in + (if peers = "" then "" else + List.fold_left (fun a s -> Printf.sprintf {|%s
  • %s|} a s s) "

    Peers

    ")) let topic_sub_index conv htm topic_map topic_root metas = - wrap conv htm topic_root - (fold_topics topic_map [topic_root] metas - ^ listing_index topic_map [topic_root] "" metas) + wrap conv htm topic_root + (fold_topics topic_map [topic_root] metas + ^ listing_index topic_map [topic_root] "" metas) let indices htm c = - let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in - let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" in - if index_name <> "" then file index_name (topic_main_index c htm c.topic_roots c.texts); - file "index.date.htm" (date_index c htm c.texts); - List.iter - (fun root -> file ("index." ^ root ^ ".htm") (topic_sub_index c htm c.topics root c.texts)) - c.topic_roots + let file name = Kosuzu.File_store.file (Filename.concat c.Conversion.dir name) in + let index_name = try Kosuzu.Store.KV.find "HTM-index" c.Conversion.kv with Not_found -> "index.html" in + if index_name <> "" then file index_name (topic_main_index c htm c.topic_roots c.texts); + file "index.date.htm" (date_index c htm c.texts); + List.iter + (fun root -> file ("index." ^ root ^ ".htm") (topic_sub_index c htm c.topics root c.texts)) + c.topic_roots let converter kv = - let htm = init kv in - Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) } + let htm = init kv in + Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) } diff --git a/cmd/txt/txt.ml b/cmd/txt/txt.ml index b395d82..ba3e1af 100644 --- a/cmd/txt/txt.ml +++ b/cmd/txt/txt.ml @@ -24,12 +24,12 @@ let txt = let man = [ `S Manpage.s_authors; `P "orbifx "; - `P "Izuru Yakumo "; + `P "Shin'ya Minazuki "; `S Manpage.s_see_also; `P "This program is named after Kosuzu Motoori from Touhou Suzunaan: Forbidden Scrollery"; `P "https://en.touhouwiki.net/wiki/Forbidden_Scrollery" ] in - Cmd.group (Cmd.info "txt" ~version:"1.4.5" ~doc ~man) ~default:default_cmd subs + Cmd.group (Cmd.info "txt" ~version:"1.4.6" ~doc ~man) ~default:default_cmd subs let main () = exit (Cmd.eval txt) let () = main () diff --git a/dune-project b/dune-project index 8caaf75..a8d592a 100644 --- a/dune-project +++ b/dune-project @@ -1,6 +1,6 @@ (lang dune 2.0) (name kosuzu) -(version 1.4.5) +(version 1.4.6) (license EUPL-1.2) (authors "orbifx ") (maintainers "Shin'ya Minazuki ") diff --git a/kosuzu.opam b/kosuzu.opam index 1789a55..4112621 100644 --- a/kosuzu.opam +++ b/kosuzu.opam @@ -1,11 +1,11 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "1.4.4" -synopsis: "Texts archival and exchange" -maintainer: ["Izuru Yakumo "] +version: "1.4.6" +synopsis: "Text archival and exchange" +maintainer: ["Shin'ya Minazuki "] authors: ["orbifx "] license: "EUPL-1.2" -homepage: "https://suzunaan.yakumo.dev/kosuzu/" +homepage: "https://projects.laidback.moe/kosuzu/" depends: ["ocaml" "dune" "ocurl" "msgpck" "cmdliner"] build: [ ["dune" "subst"] {pinned} @@ -21,4 +21,4 @@ build: [ "@doc" {with-doc} ] ] -dev-repo: "svn+https://svn.yakumo.dev/repo/kosuzu" +dev-repo: "svn+https://svn.laidback.moe/repo/kosuzu"