type templates_t = { header: string option; footer: string option } type t = { templates : templates_t; style : string } let ext = ".htm" let empty_templates = { header = None; footer = None } let default_opts = { templates = empty_templates; style = "" } 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 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 topic_link root 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 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 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 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) let fold_topic_roots topic_roots = 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 | None -> "" | 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 "" in "" let text_item path meta = 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 | None -> "" | 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 match items with | "" -> "" | 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

    ")) 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) 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 converter kv = let htm = init kv in Conversion.{ ext; page = Some (page htm); indices = Some (indices htm) }