software-archive/logarion-2021
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Replace tables with simple lines & other html fixes

Browse Source
This commit is contained in:
orbifx 2021-06-08 13:43:01 +01:00
parent 66821398f9
commit 2d64a86506
1 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
cli/html.ml
View File

@ -2,9 +2,9 @@ let wrap ?(keywords="") (title:string) (subtitle:string) body =
{|<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title>|} {|<!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head><title>|}
^ subtitle ^ " | " ^ 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="|} ^ {|</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 ^ keywords ^ {|"></head><body><header><a href=".">|} ^ title
^ "</a></h1></header>" ^ body ^ {|</a> <nav><a href="feed.atom" id="feed">feed</a></nav></header>|} ^ body
^ {|<footer><a href="feed.atom" id="feed">Subscribe to feed 📰</a></footer></body></html>|} ^ "</body></html>"
let topic_link root topic = let topic_link root topic =
{|<a href="index.|} ^ root ^ {|.htm#|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</a>" {|<a href="index.|} ^ root ^ {|.htm#|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</a>"
@ -65,14 +65,15 @@ let fold_topic_roots topic_roots =
let fold_topics topic_map topic_roots metas = let fold_topics topic_map topic_roots metas =
let open Logarion in let open Logarion in
let rec unordered_list root topic = let rec unordered_list root topic =
List.fold_left (fun a x -> a ^ list_item root x) "<ul>" topic ^ "</ul>" 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 and sub_items root topic = match Topic_set.Map.find_opt topic topic_map with
| None -> "" | None -> ""
| Some (_, subtopics) -> unordered_list root (String_set.elements subtopics) | Some (_, subtopics) -> unordered_list root (String_set.elements subtopics)
and list_item root t = and list_item root t =
let item = let item =
if List.exists (fun x -> String_set.mem t (String_set.map Topic_set.topic (Text.set "topics" x))) metas 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 then topic_link root t else String.capitalize_ascii t
in in
"<li>" ^ item ^ sub_items root t "<li>" ^ item ^ sub_items root t
in in
@ -82,12 +83,13 @@ let fold_topics topic_map topic_roots metas =
let text_item path meta = let text_item path meta =
let open Logarion in let open Logarion in
{|<tr><td><a href="|} ^ path ^ Text.alias meta ^ {|.htm">|} ^ meta.Text.title "<time>" ^ Date.(pretty_date (listing meta.Text.date))
^ "</a><td><time>" ^ Date.(pretty_date (listing meta.Text.date)) ^ "</time>" ^ {|</time> <a href="|} ^ path ^ Text.alias meta ^ {|.htm">|} ^ meta.Text.title
^ "</a><br/>"
let listing_index topic_map topic_roots path metas = let listing_index topic_map topic_roots path metas =
let rec item_group topics = let rec item_group topics =
List.fold_left (fun acc topic -> acc ^ sub_groups topic ^ "<tbody>" ^ items topic) "" 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 and sub_groups topic = match Logarion.Topic_set.Map.find_opt topic topic_map with
| None -> "" | None -> ""
| Some (_, subtopics) -> item_group (Logarion.String_set.elements subtopics) | Some (_, subtopics) -> item_group (Logarion.String_set.elements subtopics)
@ -100,18 +102,18 @@ let listing_index topic_map topic_roots path metas =
then text_item path e ^ a else a) "" metas in then text_item path e ^ a else a) "" metas in
match items with match items with
| "" -> "" | "" -> ""
| x -> {|<tr id="|} ^ topic ^ {|"><th colspan="3">|} ^ topic ^ "</th></tr>" ^ x | x -> {|<h2 id="|} ^ topic ^ {|">|} ^ String.capitalize_ascii topic ^ "</h2>" ^ x
in in
"<nav><h2>Texts</h2><table>" ^ item_group topic_roots ^ "</table></nav>" "<nav><h1>Texts</h1>" ^ item_group topic_roots ^ "</nav>"
let topic_main_index title topic_roots metas = let topic_main_index title topic_roots metas =
wrap title "Topics" wrap title "Topics"
(fold_topic_roots topic_roots (fold_topic_roots topic_roots
^ "<nav><h2>Latest</h2>" ^ to_dated_links ~limit:5 metas ^ "<nav><h1>Latest</h1>" ^ to_dated_links ~limit:5 metas
^ {|<br/><a href="index.date.htm">More by date</a></nav>|} ) ^ {|<a href="index.date.htm">More by date</a></nav>|} )
let topic_sub_index title topic_map topic_root metas = let topic_sub_index title topic_map topic_root metas =
wrap title topic_root wrap title topic_root
(fold_topics topic_map [topic_root] metas (fold_topics topic_map [topic_root] metas
^ {|<a href="feed.atom" id="feed">Subscribe to |}^ topic_root ^{| feed 📰</a>|} (* ^ {|<a href=".atom" id="feed">|}^ String.capitalize_ascii topic_root ^{| feed </a>|}*)
^ listing_index topic_map [topic_root] "" metas) ^ listing_index topic_map [topic_root] "" metas)