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 - "
" - ^ opt_kv "Title:" text.title - ^ opt_kv "Authors:" authors - ^ opt_kv "Date: " (time (Date.(pretty_date @@ listing text.date))) - ^ opt_kv "Series: " (str_set "series" text) - ^ opt_kv "Topics: " (topic_links (set "topics" text)) - ^ opt_kv "Keywords: " keywords - ^ opt_kv "Id: " text.id - ^ {|
|} in
-  wrap conversion htm text.title ((T.of_string text.body header) ^ "
") + 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 + "
" + ^ opt_kv "Title:" text.title + ^ opt_kv "Authors:" authors + ^ opt_kv "Date: " (time (Date.(pretty_date @@ listing text.date))) + ^ opt_kv "Series: " (str_set "series" text) + ^ opt_kv "Topics: " (topic_links (set "topics" text)) + ^ opt_kv "Keywords: " keywords + ^ opt_kv "Id: " text.id + ^ {|
|} 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 - 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) "" - 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) "" + 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 - ^ "