···
+
(** Category storage - manages custom categories *)
+
module Category_storage = struct
+
let categories_file state = Eio.Path.(Xdge.state_dir state.xdg / "categories.json")
+
let jsont = Jsont.list Category.jsont
+
let file = categories_file state in
+
let content = Eio.Path.load file in
+
match Jsont_bytesrw.decode_string' jsont content with
+
| Ok categories -> categories
+
Log.warn (fun m -> m "Failed to parse categories: %s" (Jsont.Error.to_string err));
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
+
Log.err (fun m -> m "Error loading categories: %s" (Printexc.to_string e));
+
let save state categories =
+
let file = categories_file state in
+
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont categories with
+
| Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json
+
| Error err -> failwith ("Failed to encode categories: " ^ Jsont.Error.to_string err)
+
load state |> List.find_opt (fun cat -> Category.id cat = id)
+
let add state category =
+
let categories = load state in
+
let filtered = List.filter (fun cat -> Category.id cat <> Category.id category) categories in
+
save state (category :: filtered)
+
let categories = load state in
+
save state (List.filter (fun cat -> Category.id cat <> id) categories)
+
(** Post-category mapping storage - maps post IDs to category IDs *)
+
module Post_category_storage = struct
+
let post_categories_file state = Eio.Path.(Xdge.state_dir state.xdg / "post_categories.json")
+
(* Type: list of (post_id, category_ids) pairs *)
+
let make post_id category_ids = (post_id, category_ids) in
+
Jsont.Object.map ~kind:"PostCategoryMapping" make
+
|> Jsont.Object.mem "post_id" Jsont.string ~enc:fst
+
|> Jsont.Object.mem "category_ids" (Jsont.list Jsont.string) ~enc:snd
+
let file = post_categories_file state in
+
let content = Eio.Path.load file in
+
match Jsont_bytesrw.decode_string' jsont content with
+
| Ok mappings -> mappings
+
Log.warn (fun m -> m "Failed to parse post categories: %s" (Jsont.Error.to_string err));
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
+
Log.err (fun m -> m "Error loading post categories: %s" (Printexc.to_string e));
+
let save state mappings =
+
let file = post_categories_file state in
+
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont mappings with
+
| Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json
+
| Error err -> failwith ("Failed to encode post categories: " ^ Jsont.Error.to_string err)
+
let get state post_id =
+
load state |> List.assoc_opt post_id |> Option.value ~default:[]
+
let set state post_id category_ids =
+
let mappings = load state in
+
let filtered = List.remove_assoc post_id mappings in
+
let updated = if category_ids = [] then filtered else (post_id, category_ids) :: filtered in
+
let add state post_id category_id =
+
let current = get state post_id in
+
if List.mem category_id current then ()
+
else set state post_id (category_id :: current)
+
let remove state post_id category_id =
+
let current = get state post_id in
+
set state post_id (List.filter ((<>) category_id) current)
+
let get_posts_by_category state category_id =
+
|> List.filter (fun (_, category_ids) -> List.mem category_id category_ids)
+
let remove_category state category_id =
+
let mappings = load state in
+
let updated = List.filter_map (fun (post_id, category_ids) ->
+
let filtered = List.filter ((<>) category_id) category_ids in
+
if filtered = [] then None else Some (post_id, filtered)
+
(** {2 Category Management - Internal functions} *)
+
let list_categories state =
+
Category_storage.load state
+
let get_category state ~id =
+
Category_storage.get state id
+
let add_category state category =
+
Category_storage.add state category;
+
Error (Printf.sprintf "Failed to add category: %s" (Printexc.to_string e))
+
let remove_category state ~id =
+
Category_storage.remove state id;
+
Post_category_storage.remove_category state id;
+
Error (Printf.sprintf "Failed to remove category: %s" (Printexc.to_string e))
+
let get_post_categories state ~post_id =
+
Post_category_storage.get state post_id
+
let set_post_categories state ~post_id ~category_ids =
+
Post_category_storage.set state post_id category_ids;
+
Error (Printf.sprintf "Failed to set post categories: %s" (Printexc.to_string e))
+
let add_post_category state ~post_id ~category_id =
+
Post_category_storage.add state post_id category_id;
+
Error (Printf.sprintf "Failed to add post category: %s" (Printexc.to_string e))
+
let remove_post_category state ~post_id ~category_id =
+
Post_category_storage.remove state post_id category_id;
+
Error (Printf.sprintf "Failed to remove post category: %s" (Printexc.to_string e))
+
let get_posts_by_category state ~category_id =
+
Post_category_storage.get_posts_by_category state category_id
(** List all usernames with feeds from Sortal *)
···
let author, _ = entry.authors in
let tags = List.map (fun (c : Syndic.Atom.category) -> c.term) entry.categories in
+
let post_id = Uri.to_string entry.id in
+
(username, title, author.name, entry.updated, link_uri, content_html, tags, post_id)
···
entry_to_html_data username entry
+
let unique_users = List.sort_uniq String.compare (List.map (fun (u, _, _, _, _, _, _, _) -> u) html_data) in
Log.info (fun m -> m "Retrieved %d posts from %d users" (List.length html_data) (List.length unique_users));
Log.info (fun m -> m "Users: %s" (String.concat ", " unique_users));
···
i >= start_idx && i < start_idx + posts_per_page
+
let post_htmls = List.map (fun (username, title, _feed_author, date, link, content, tags, post_id) ->
Log.debug (fun m -> m " Processing post: %s by @%s" title username);
(* Get author name from Sortal, fallback to username *)
···
let excerpt = Format.Html.post_excerpt_from_html content ~max_length:300 in
let full_content = Format.Html.full_content_from_html content in
+
(* Get custom categories for this post *)
+
let custom_category_ids = get_post_categories state ~post_id in
+
let custom_categories = List.filter_map (fun cat_id ->
+
match get_category state ~id:cat_id with
+
| Some cat -> Some (Category.id cat, Category.name cat)
+
) custom_category_ids in
+
(* Combine feed tags and custom categories *)
+
let all_tags = tags @ List.map fst custom_categories in
+
(* Display feed tags *)
let tag_links = List.map (fun tag ->
+
Printf.sprintf {|<a href="categories/%s.html" class="tag-feed">%s</a>|}
(Format.Html.html_escape (sanitize_filename tag)) (Format.Html.html_escape tag)
+
(* Display custom categories with different styling *)
+
let category_links = List.map (fun (cat_id, cat_name) ->
+
Printf.sprintf {|<a href="categories/%s.html" class="tag-custom">%s</a>|}
+
(Format.Html.html_escape (sanitize_filename cat_id)) (Format.Html.html_escape cat_name)
+
Printf.sprintf {|<div class="post-tags">%s%s</div>|}
(String.concat "" tag_links)
+
(String.concat "" category_links)
let thumbnail_html = match get_author_thumbnail username with
···
(* Generate author index *)
Log.info (fun m -> m "Generating author index and pages");
let authors_map = Hashtbl.create 32 in
+
List.iter (fun (username, _, author, _, _, _, _, _) ->
let count = match Hashtbl.find_opt authors_map username with
···
(* Generate individual author pages *)
Hashtbl.iter (fun username (author, _) ->
+
let author_posts = List.filter (fun (u, _, _, _, _, _, _, _) -> u = username) html_data in
let author_total = List.length author_posts in
let author_pages = (author_total + posts_per_page - 1) / posts_per_page in
Log.info (fun m -> m " Author: %s (@%s) - %d posts, %d pages" author username author_total author_pages);
···
i >= start_idx && i < start_idx + posts_per_page
+
let post_htmls = List.map (fun (_username, title, author, date, link, content, tags, post_id) ->
let date_str = Format.Html.format_date date in
let link_html = match link with
···
let excerpt = Format.Html.post_excerpt_from_html content ~max_length:300 in
let full_content = Format.Html.full_content_from_html content in
+
(* Get custom categories for this post *)
+
let custom_category_ids = get_post_categories state ~post_id in
+
let custom_categories = List.filter_map (fun cat_id ->
+
match get_category state ~id:cat_id with
+
| Some cat -> Some (Category.id cat, Category.name cat)
+
) custom_category_ids in
+
let all_tags_exist = tags <> [] || custom_categories <> [] in
+
if not all_tags_exist then ""
+
(* Display feed tags *)
+
let tag_links = List.map (fun tag ->
+
Printf.sprintf {|<a href="../categories/%s.html" class="tag-feed">%s</a>|}
+
(Format.Html.html_escape (sanitize_filename tag)) (Format.Html.html_escape tag)
+
(* Display custom categories with different styling *)
+
let category_links = List.map (fun (cat_id, cat_name) ->
+
Printf.sprintf {|<a href="../categories/%s.html" class="tag-custom">%s</a>|}
+
(Format.Html.html_escape (sanitize_filename cat_id)) (Format.Html.html_escape cat_name)
+
Printf.sprintf {|<div class="post-tags">%s%s</div>|}
+
(String.concat "" tag_links)
+
(String.concat "" category_links)
Printf.sprintf {|<article class="post">
<h2 class="post-title">%s</h2>
···
(* Generate category index and pages *)
Log.info (fun m -> m "Generating category index and pages");
let categories_map = Hashtbl.create 32 in
+
List.iter (fun (_, _, _, _, _, _, tags, post_id) ->
let count = match Hashtbl.find_opt categories_map tag with
Hashtbl.replace categories_map tag count
+
(* Count custom categories *)
+
let custom_cat_ids = get_post_categories state ~post_id in
+
List.iter (fun cat_id ->
+
let count = match Hashtbl.find_opt categories_map cat_id with
+
Hashtbl.replace categories_map cat_id count
let categories_list = Hashtbl.fold (fun tag count acc ->
···
(* Generate individual category pages *)
List.iter (fun (tag, count) ->
+
let tag_posts = List.filter (fun (_, _, _, _, _, _, tags, post_id) ->
+
(* Check if tag is in feed tags or custom categories *)
+
let in_feed_tags = List.mem tag tags in
+
let custom_cat_ids = get_post_categories state ~post_id in
+
let in_custom_cats = List.exists (fun cat_id ->
+
match get_category state ~id:cat_id with
+
| Some cat -> Category.id cat = tag
+
in_feed_tags || in_custom_cats
let tag_total = List.length tag_posts in
···
i >= start_idx && i < start_idx + posts_per_page
+
let post_htmls = List.map (fun (username, title, author, date, link, content, tags, post_id) ->
let date_str = Format.Html.format_date date in
let link_html = match link with
···
let excerpt = Format.Html.post_excerpt_from_html content ~max_length:300 in
let full_content = Format.Html.full_content_from_html content in
+
(* Get custom categories for this post *)
+
let custom_category_ids = get_post_categories state ~post_id in
+
let custom_categories = List.filter_map (fun cat_id ->
+
match get_category state ~id:cat_id with
+
| Some cat -> Some (Category.id cat, Category.name cat)
+
) custom_category_ids in
+
let all_tags_exist = tags <> [] || custom_categories <> [] in
+
if not all_tags_exist then ""
+
(* Display feed tags *)
+
let tag_links = List.map (fun t ->
+
Printf.sprintf {|<a href="%s.html" class="tag-feed">%s</a>|}
+
(Format.Html.html_escape (sanitize_filename t)) (Format.Html.html_escape t)
+
(* Display custom categories with different styling *)
+
let category_links = List.map (fun (cat_id, cat_name) ->
+
Printf.sprintf {|<a href="%s.html" class="tag-custom">%s</a>|}
+
(Format.Html.html_escape (sanitize_filename cat_id)) (Format.Html.html_escape cat_name)
+
Printf.sprintf {|<div class="post-tags">%s%s</div>|}
+
(String.concat "" tag_links)
+
(String.concat "" category_links)
Printf.sprintf {|<article class="post">
<h2 class="post-title">%s</h2>
···
(* Generate links page *)
Log.info (fun m -> m "Generating links page");
+
let all_links = List.concat_map (fun (username, title, author, date, post_link, content, _, _) ->
let links = Html_markdown.extract_links content in
List.map (fun (href, link_text) ->
(href, link_text, username, author, title, post_link, date)
anil.recoil.org