···
101
+
(** Category storage - manages custom categories *)
102
+
module Category_storage = struct
103
+
let categories_file state = Eio.Path.(Xdge.state_dir state.xdg / "categories.json")
105
+
let jsont = Jsont.list Category.jsont
108
+
let file = categories_file state in
110
+
let content = Eio.Path.load file in
111
+
match Jsont_bytesrw.decode_string' jsont content with
112
+
| Ok categories -> categories
114
+
Log.warn (fun m -> m "Failed to parse categories: %s" (Jsont.Error.to_string err));
117
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
119
+
Log.err (fun m -> m "Error loading categories: %s" (Printexc.to_string e));
122
+
let save state categories =
123
+
let file = categories_file state in
124
+
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont categories with
125
+
| Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json
126
+
| Error err -> failwith ("Failed to encode categories: " ^ Jsont.Error.to_string err)
129
+
load state |> List.find_opt (fun cat -> Category.id cat = id)
131
+
let add state category =
132
+
let categories = load state in
133
+
let filtered = List.filter (fun cat -> Category.id cat <> Category.id category) categories in
134
+
save state (category :: filtered)
136
+
let remove state id =
137
+
let categories = load state in
138
+
save state (List.filter (fun cat -> Category.id cat <> id) categories)
141
+
(** Post-category mapping storage - maps post IDs to category IDs *)
142
+
module Post_category_storage = struct
143
+
let post_categories_file state = Eio.Path.(Xdge.state_dir state.xdg / "post_categories.json")
145
+
(* Type: list of (post_id, category_ids) pairs *)
148
+
let make post_id category_ids = (post_id, category_ids) in
149
+
Jsont.Object.map ~kind:"PostCategoryMapping" make
150
+
|> Jsont.Object.mem "post_id" Jsont.string ~enc:fst
151
+
|> Jsont.Object.mem "category_ids" (Jsont.list Jsont.string) ~enc:snd
152
+
|> Jsont.Object.finish
157
+
let file = post_categories_file state in
159
+
let content = Eio.Path.load file in
160
+
match Jsont_bytesrw.decode_string' jsont content with
161
+
| Ok mappings -> mappings
163
+
Log.warn (fun m -> m "Failed to parse post categories: %s" (Jsont.Error.to_string err));
166
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
168
+
Log.err (fun m -> m "Error loading post categories: %s" (Printexc.to_string e));
171
+
let save state mappings =
172
+
let file = post_categories_file state in
173
+
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent jsont mappings with
174
+
| Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json
175
+
| Error err -> failwith ("Failed to encode post categories: " ^ Jsont.Error.to_string err)
177
+
let get state post_id =
178
+
load state |> List.assoc_opt post_id |> Option.value ~default:[]
180
+
let set state post_id category_ids =
181
+
let mappings = load state in
182
+
let filtered = List.remove_assoc post_id mappings in
183
+
let updated = if category_ids = [] then filtered else (post_id, category_ids) :: filtered in
186
+
let add state post_id category_id =
187
+
let current = get state post_id in
188
+
if List.mem category_id current then ()
189
+
else set state post_id (category_id :: current)
191
+
let remove state post_id category_id =
192
+
let current = get state post_id in
193
+
set state post_id (List.filter ((<>) category_id) current)
195
+
let get_posts_by_category state category_id =
197
+
|> List.filter (fun (_, category_ids) -> List.mem category_id category_ids)
200
+
let remove_category state category_id =
201
+
let mappings = load state in
202
+
let updated = List.filter_map (fun (post_id, category_ids) ->
203
+
let filtered = List.filter ((<>) category_id) category_ids in
204
+
if filtered = [] then None else Some (post_id, filtered)
209
+
(** {2 Category Management - Internal functions} *)
211
+
let list_categories state =
212
+
Category_storage.load state
214
+
let get_category state ~id =
215
+
Category_storage.get state id
217
+
let add_category state category =
219
+
Category_storage.add state category;
222
+
Error (Printf.sprintf "Failed to add category: %s" (Printexc.to_string e))
224
+
let remove_category state ~id =
226
+
Category_storage.remove state id;
227
+
Post_category_storage.remove_category state id;
230
+
Error (Printf.sprintf "Failed to remove category: %s" (Printexc.to_string e))
232
+
let get_post_categories state ~post_id =
233
+
Post_category_storage.get state post_id
235
+
let set_post_categories state ~post_id ~category_ids =
237
+
Post_category_storage.set state post_id category_ids;
240
+
Error (Printf.sprintf "Failed to set post categories: %s" (Printexc.to_string e))
242
+
let add_post_category state ~post_id ~category_id =
244
+
Post_category_storage.add state post_id category_id;
247
+
Error (Printf.sprintf "Failed to add post category: %s" (Printexc.to_string e))
249
+
let remove_post_category state ~post_id ~category_id =
251
+
Post_category_storage.remove state post_id category_id;
254
+
Error (Printf.sprintf "Failed to remove post category: %s" (Printexc.to_string e))
256
+
let get_posts_by_category state ~category_id =
257
+
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
540
-
(username, title, author.name, entry.updated, link_uri, content_html, tags)
698
+
let post_id = Uri.to_string entry.id in
699
+
(username, title, author.name, entry.updated, link_uri, content_html, tags, post_id)
···
entry_to_html_data username entry
550
-
let unique_users = List.sort_uniq String.compare (List.map (fun (u, _, _, _, _, _, _) -> u) html_data) in
709
+
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
566
-
let post_htmls = List.map (fun (username, title, _feed_author, date, link, content, tags) ->
725
+
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
746
+
(* Get custom categories for this post *)
747
+
let custom_category_ids = get_post_categories state ~post_id in
748
+
let custom_categories = List.filter_map (fun cat_id ->
749
+
match get_category state ~id:cat_id with
750
+
| Some cat -> Some (Category.id cat, Category.name cat)
752
+
) custom_category_ids in
754
+
(* Combine feed tags and custom categories *)
755
+
let all_tags = tags @ List.map fst custom_categories in
757
+
match all_tags with
760
+
(* Display feed tags *)
let tag_links = List.map (fun tag ->
591
-
Printf.sprintf {|<a href="categories/%s.html">%s</a>|}
762
+
Printf.sprintf {|<a href="categories/%s.html" class="tag-feed">%s</a>|}
(Format.Html.html_escape (sanitize_filename tag)) (Format.Html.html_escape tag)
594
-
Printf.sprintf {|<div class="post-tags">%s</div>|}
765
+
(* Display custom categories with different styling *)
766
+
let category_links = List.map (fun (cat_id, cat_name) ->
767
+
Printf.sprintf {|<a href="categories/%s.html" class="tag-custom">%s</a>|}
768
+
(Format.Html.html_escape (sanitize_filename cat_id)) (Format.Html.html_escape cat_name)
769
+
) custom_categories in
770
+
Printf.sprintf {|<div class="post-tags">%s%s</div>|}
(String.concat "" tag_links)
772
+
(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
652
-
List.iter (fun (username, _, author, _, _, _, _) ->
829
+
List.iter (fun (username, _, author, _, _, _, _, _) ->
let count = match Hashtbl.find_opt authors_map username with
···
(* Generate individual author pages *)
Hashtbl.iter (fun username (author, _) ->
762
-
let author_posts = List.filter (fun (u, _, _, _, _, _, _) -> u = username) html_data in
939
+
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
877
-
let post_htmls = List.map (fun (_username, title, author, date, link, content, tags) ->
1054
+
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
1066
+
(* Get custom categories for this post *)
1067
+
let custom_category_ids = get_post_categories state ~post_id in
1068
+
let custom_categories = List.filter_map (fun cat_id ->
1069
+
match get_category state ~id:cat_id with
1070
+
| Some cat -> Some (Category.id cat, Category.name cat)
1072
+
) custom_category_ids in
892
-
let tag_links = List.map (fun tag ->
893
-
Printf.sprintf {|<a href="../categories/%s.html">%s</a>|}
894
-
(Format.Html.html_escape (sanitize_filename tag)) (Format.Html.html_escape tag)
896
-
Printf.sprintf {|<div class="post-tags">%s</div>|}
897
-
(String.concat "" tag_links)
1075
+
let all_tags_exist = tags <> [] || custom_categories <> [] in
1076
+
if not all_tags_exist then ""
1078
+
(* Display feed tags *)
1079
+
let tag_links = List.map (fun tag ->
1080
+
Printf.sprintf {|<a href="../categories/%s.html" class="tag-feed">%s</a>|}
1081
+
(Format.Html.html_escape (sanitize_filename tag)) (Format.Html.html_escape tag)
1083
+
(* Display custom categories with different styling *)
1084
+
let category_links = List.map (fun (cat_id, cat_name) ->
1085
+
Printf.sprintf {|<a href="../categories/%s.html" class="tag-custom">%s</a>|}
1086
+
(Format.Html.html_escape (sanitize_filename cat_id)) (Format.Html.html_escape cat_name)
1087
+
) custom_categories in
1088
+
Printf.sprintf {|<div class="post-tags">%s%s</div>|}
1089
+
(String.concat "" tag_links)
1090
+
(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
943
-
List.iter (fun (_, _, _, _, _, _, tags) ->
1136
+
List.iter (fun (_, _, _, _, _, _, tags, post_id) ->
1137
+
(* Count feed tags *)
let count = match Hashtbl.find_opt categories_map tag with
Hashtbl.replace categories_map tag count
1145
+
(* Count custom categories *)
1146
+
let custom_cat_ids = get_post_categories state ~post_id in
1147
+
List.iter (fun cat_id ->
1148
+
let count = match Hashtbl.find_opt categories_map cat_id with
1152
+
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) ->
982
-
let tag_posts = List.filter (fun (_, _, _, _, _, _, tags) ->
1185
+
let tag_posts = List.filter (fun (_, _, _, _, _, _, tags, post_id) ->
1186
+
(* Check if tag is in feed tags or custom categories *)
1187
+
let in_feed_tags = List.mem tag tags in
1188
+
let custom_cat_ids = get_post_categories state ~post_id in
1189
+
let in_custom_cats = List.exists (fun cat_id ->
1190
+
match get_category state ~id:cat_id with
1191
+
| Some cat -> Category.id cat = tag
1193
+
) custom_cat_ids in
1194
+
in_feed_tags || in_custom_cats
let tag_total = List.length tag_posts in
···
i >= start_idx && i < start_idx + posts_per_page
996
-
let post_htmls = List.map (fun (username, title, author, date, link, content, tags) ->
1207
+
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
1219
+
(* Get custom categories for this post *)
1220
+
let custom_category_ids = get_post_categories state ~post_id in
1221
+
let custom_categories = List.filter_map (fun cat_id ->
1222
+
match get_category state ~id:cat_id with
1223
+
| Some cat -> Some (Category.id cat, Category.name cat)
1225
+
) custom_category_ids in
1011
-
let tag_links = List.map (fun t ->
1012
-
Printf.sprintf {|<a href="%s.html">%s</a>|}
1013
-
(Format.Html.html_escape (sanitize_filename t)) (Format.Html.html_escape t)
1015
-
Printf.sprintf {|<div class="post-tags">%s</div>|}
1016
-
(String.concat "" tag_links)
1228
+
let all_tags_exist = tags <> [] || custom_categories <> [] in
1229
+
if not all_tags_exist then ""
1231
+
(* Display feed tags *)
1232
+
let tag_links = List.map (fun t ->
1233
+
Printf.sprintf {|<a href="%s.html" class="tag-feed">%s</a>|}
1234
+
(Format.Html.html_escape (sanitize_filename t)) (Format.Html.html_escape t)
1236
+
(* Display custom categories with different styling *)
1237
+
let category_links = List.map (fun (cat_id, cat_name) ->
1238
+
Printf.sprintf {|<a href="%s.html" class="tag-custom">%s</a>|}
1239
+
(Format.Html.html_escape (sanitize_filename cat_id)) (Format.Html.html_escape cat_name)
1240
+
) custom_categories in
1241
+
Printf.sprintf {|<div class="post-tags">%s%s</div>|}
1242
+
(String.concat "" tag_links)
1243
+
(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");
1061
-
let all_links = List.concat_map (fun (username, title, author, date, post_link, content, _) ->
1288
+
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)