diff --git a/cli/html.ml b/cli/html.ml
index 0b2a12c..2f73d68 100644
--- a/cli/html.ml
+++ b/cli/html.ml
@@ -7,12 +7,11 @@ let default_opts = { templates = empty_templates }
let init kv =
let open Logarion in
- let header = match Store.KV.find "HTM-header" kv with
- | fname -> Some (File_store.to_string fname)
- | exception Not_found -> None in
- let footer = match Store.KV.find "HTM-footer" kv with
+ 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 c htm text_title body =
@@ -27,17 +26,19 @@ let wrap c htm text_title body =
| None -> "" ^ site_title ^
""
in
- let footer = match htm.templates.footer with None -> "" | Some x -> replace x in
- "
" ^ text_title ^ " • " ^ site_title ^ "\n\
- \
- \
- \
- \n" ^ header ^ body ^ footer ^ ""
+ let footer = match htm.templates.footer with None -> "" | Some x -> replace x in
+ Printf.sprintf "%s%s\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
@@ -46,119 +47,119 @@ module HtmlConverter = struct
end
let page htm conversion text =
- let open Logarion 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 author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
- let authors = (Person.Set.to_string text.authors ^ " ") in
- let keywords = str_set "keywords" text in
- let header =
- let time 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 open Logarion 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 author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
+ let authors = (Person.Set.to_string text.authors ^ " ") in
+ let keywords = str_set "keywords" text in
+ let header =
+ let time 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 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
- Logarion.(Date.(pretty_date (listing m.Text.date)))
- (Logarion.Text.short_id m) m.Logarion.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
+ Logarion.(Date.(pretty_date (listing m.Text.date)))
+ (Logarion.Text.short_id m) m.Logarion.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 Logarion in
- let rec unordered_list root topic =
- List.fold_left (fun a x -> a ^ list_item root x) "
" topic
- ^ "
"
- 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
- "
" ^ item ^ sub_items root t
- in
- ""
+ let open Logarion in
+ let rec unordered_list root topic =
+ List.fold_left (fun a x -> a ^ list_item root x) "
" topic
+ ^ "
"
+ 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
+ "
" ^ item ^ sub_items root t
+ in
+ ""
let text_item path meta =
- let open Logarion in
- " |} ^ meta.Text.title
- ^ " "
+ let open Logarion 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 Logarion.Topic_set.Map.find_opt topic topic_map with
- | None -> ""
- | Some (_, subtopics) -> item_group (Logarion.String_set.elements subtopics)
- and items topic =
- let items =
- let open Logarion in
- List.fold_left
- (fun a e ->
- if String_set.mem topic (String_set.map (Logarion.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 rec item_group topics =
+ List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ items topic) "" topics
+ and sub_groups topic = match Logarion.Topic_set.Map.find_opt topic topic_map with
+ | None -> ""
+ | Some (_, subtopics) -> item_group (Logarion.String_set.elements subtopics)
+ and items topic =
+ let items =
+ let open Logarion in
+ List.fold_left
+ (fun a e ->
+ if String_set.mem topic (String_set.map (Logarion.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
- ^ "