6c27c7c6fb
Basic unit renamed from Note to Text. New modular text-parser, internal to Logarion, for generic notation parsing. The default input format is now a much plainer text. Eliminated Meta module and generally lib/ modules. New Store interface, with additional information from Store. For example the converter can now check filesystem dates. Changed to filesystem hardlinks for tracking publications & indexing, instead of categories. New commands `publish [-i]` and `deindex [-u]`. Categories are ignored now. Logarion created texts have part of the UUID instead of a counter in their filename. New -i, --interactive flag for interactive creation & publication. Logarion's index re-written in Messagepack format. Removed `indices` command. They are generated during `convert`.
118 lines
5.1 KiB
OCaml
118 lines
5.1 KiB
OCaml
let wrap ?(keywords="") (title:string) (subtitle:string) body =
|
|
{|<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title>|}
|
|
^ subtitle ^ " | " ^ title
|
|
^ {|</title><link rel="stylesheet" href="main.css" media/><link rel="alternate" href="feed.atom" type="application/atom+xml"/><meta charset="utf-8"/> <meta name="keywords" content="|}
|
|
^ keywords ^ {|"></head><body><header><h1><a href=".">|} ^ title
|
|
^ "</a></h1></header>" ^ body
|
|
^ {|<footer><a href="feed.atom" id="feed">Subscribe to feed 📰</a></footer></body></html>|}
|
|
|
|
let topic_link root topic =
|
|
{|<a href="index.|} ^ root ^ {|.htm#|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</a>"
|
|
|
|
let page _topic_roots archive_title text =
|
|
let open Logarion in
|
|
let open Text in
|
|
let module T = Parsers.Plain_text.Make (Converter.Html) 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 "<dt>" ^ key ^ "<dd>" ^ value else "" in
|
|
(* let author acc auth = sep_append acc Person.(auth.name ^ " ") in*)
|
|
let authors = T.of_string (Person.Set.to_string text.authors ^ " ") "" in
|
|
let keywords = str_set "keywords" text in
|
|
let header =
|
|
let time x = {|<time datetime="|} ^ x ^ {|">|} ^ x ^ "</time>" 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
|
|
"<article><header><dl>"
|
|
^ 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: " (Id.to_string text.uuid)
|
|
^ {|</dl></header><pre style="white-space:pre-wrap">|} in
|
|
wrap ~keywords archive_title text.title ((T.of_string text.body header) ^ "</pre></article>")
|
|
|
|
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 ->
|
|
a ^ Logarion.(Date.(pretty_date (listing m.Text.date)) ^ " ")
|
|
^ {|<a href="|} ^ Logarion.Text.alias m ^ {|.html">|} ^ m.Logarion.Text.title ^ "</a><br/>")
|
|
"" meta_list
|
|
|
|
let date_index ?(limit) title meta_list =
|
|
match limit with
|
|
| Some limit -> wrap title "Index" (to_dated_links ~limit meta_list)
|
|
| None -> wrap title "Index" (to_dated_links meta_list)
|
|
|
|
let fold_topic_roots topic_roots =
|
|
let list_item root t = "<li>" ^ topic_link root t in
|
|
"<nav><h2>Main topics</h2>"
|
|
^ List.fold_left (fun a x -> a ^ list_item x x) "<ul>" (List.rev topic_roots)
|
|
^ "</ul></nav>"
|
|
|
|
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) "<ul>" topic ^ "</ul>"
|
|
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 t
|
|
in
|
|
"<li>" ^ item ^ sub_items root t
|
|
in
|
|
"<nav><h2>Topics</h2>"
|
|
^ List.fold_left (fun a x -> a ^ list_item x x) "<ul>" (List.rev topic_roots)
|
|
^ "</ul></nav>"
|
|
|
|
let text_item path meta =
|
|
let open Logarion in
|
|
{|<tr><td><a href="|} ^ path ^ Text.alias meta ^ {|.html">|} ^ meta.Text.title
|
|
^ "</a><td><time>" ^ Date.(pretty_date (listing meta.Text.date)) ^ "</time>"
|
|
|
|
let listing_index topic_map topic_roots path metas =
|
|
let rec item_group topics =
|
|
List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ "<tbody>" ^ 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 -> {|<tr id="|} ^ topic ^ {|"><th colspan="3">|} ^ topic ^ "</th></tr>" ^ x
|
|
in
|
|
"<nav><h2>Texts</h2><table>" ^ item_group topic_roots ^ "</table></nav>"
|
|
|
|
let topic_main_index title topic_roots metas =
|
|
wrap title "Topics"
|
|
(fold_topic_roots topic_roots
|
|
^ "<nav><h2>Recent</h2>" ^ to_dated_links ~limit:5 metas
|
|
^ {|<br/><a href="index.date.html">More by date</a></nav>|} )
|
|
|
|
let topic_sub_index title topic_map topic_root metas =
|
|
wrap title topic_root
|
|
(fold_topics topic_map [topic_root] metas
|
|
^ {|<a href="feed.atom" id="feed">Subscribe to |}^ topic_root ^{| feed 📰</a>|}
|
|
^ listing_index topic_map [topic_root] "" metas)
|