this repo has no description
river
+503
-33
+56
stack/river/lib/category.ml
+56
stack/river/lib/category.ml
···
1
+
(*
2
+
* Copyright (c) 2014, OCaml.org project
3
+
* Copyright (c) 2015 KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*)
17
+
18
+
(** Custom categories for organizing posts. *)
19
+
20
+
type t = {
21
+
id : string;
22
+
name : string;
23
+
description : string option;
24
+
}
25
+
26
+
let create ~id ~name ?description () =
27
+
{ id; name; description }
28
+
29
+
let id t = t.id
30
+
let name t = t.name
31
+
let description t = t.description
32
+
33
+
(* Jsont codec *)
34
+
let jsont =
35
+
let make id name description = { id; name; description } in
36
+
Jsont.Object.map ~kind:"Category" make
37
+
|> Jsont.Object.mem "id" Jsont.string ~enc:id
38
+
|> Jsont.Object.mem "name" Jsont.string ~enc:name
39
+
|> Jsont.Object.mem "description" (Jsont.option Jsont.string) ~enc:description
40
+
|> Jsont.Object.finish
41
+
42
+
let to_json t =
43
+
match Jsont_bytesrw.encode_string jsont t with
44
+
| Ok json_str ->
45
+
(match Jsont_bytesrw.decode_string Jsont.json json_str with
46
+
| Ok json -> json
47
+
| Error err -> failwith ("Failed to decode encoded category: " ^ err))
48
+
| Error err -> failwith ("Failed to encode category: " ^ err)
49
+
50
+
let of_json json =
51
+
match Jsont_bytesrw.encode_string Jsont.json json with
52
+
| Ok json_str ->
53
+
(match Jsont_bytesrw.decode_string jsont json_str with
54
+
| Ok t -> Ok t
55
+
| Error err -> Error err)
56
+
| Error err -> Error err
+54
stack/river/lib/category.mli
+54
stack/river/lib/category.mli
···
1
+
(*
2
+
* Copyright (c) 2014, OCaml.org project
3
+
* Copyright (c) 2015 KC Sivaramakrishnan <sk826@cl.cam.ac.uk>
4
+
*
5
+
* Permission to use, copy, modify, and distribute this software for any
6
+
* purpose with or without fee is hereby granted, provided that the above
7
+
* copyright notice and this permission notice appear in all copies.
8
+
*
9
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16
+
*)
17
+
18
+
(** Custom categories for organizing posts.
19
+
20
+
Categories are manually defined and can be assigned to posts for
21
+
organization and filtering. This is separate from feed-extracted tags. *)
22
+
23
+
type t
24
+
(** A custom category with metadata. *)
25
+
26
+
val create :
27
+
id:string ->
28
+
name:string ->
29
+
?description:string ->
30
+
unit ->
31
+
t
32
+
(** [create ~id ~name ?description ()] creates a new category.
33
+
34
+
@param id Unique identifier for the category (e.g., "ocaml-projects")
35
+
@param name Display name (e.g., "OCaml Projects")
36
+
@param description Optional longer description *)
37
+
38
+
val id : t -> string
39
+
(** [id category] returns the unique identifier of the category. *)
40
+
41
+
val name : t -> string
42
+
(** [name category] returns the display name of the category. *)
43
+
44
+
val description : t -> string option
45
+
(** [description category] returns the description, if any. *)
46
+
47
+
val to_json : t -> Jsont.json
48
+
(** [to_json category] serializes a category to JSON. *)
49
+
50
+
val of_json : Jsont.json -> (t, string) result
51
+
(** [of_json json] deserializes a category from JSON. *)
52
+
53
+
val jsont : t Jsont.t
54
+
(** Jsont codec for categories. *)
+1
stack/river/lib/river.ml
+1
stack/river/lib/river.ml
+87
stack/river/lib/river.mli
+87
stack/river/lib/river.mli
···
234
234
end
235
235
end
236
236
237
+
(** {1 Category Management} *)
238
+
239
+
module Category : sig
240
+
(** Custom categories for organizing posts.
241
+
242
+
Categories are manually defined and can be assigned to posts for
243
+
organization and filtering. This is separate from feed-extracted tags. *)
244
+
245
+
type t
246
+
(** A custom category with metadata. *)
247
+
248
+
val create :
249
+
id:string ->
250
+
name:string ->
251
+
?description:string ->
252
+
unit ->
253
+
t
254
+
(** [create ~id ~name ?description ()] creates a new category.
255
+
256
+
@param id Unique identifier for the category (e.g., "ocaml-projects")
257
+
@param name Display name (e.g., "OCaml Projects")
258
+
@param description Optional longer description *)
259
+
260
+
val id : t -> string
261
+
(** [id category] returns the unique identifier of the category. *)
262
+
263
+
val name : t -> string
264
+
(** [name category] returns the display name of the category. *)
265
+
266
+
val description : t -> string option
267
+
(** [description category] returns the description, if any. *)
268
+
269
+
val to_json : t -> Jsont.json
270
+
(** [to_json category] serializes a category to JSON. *)
271
+
272
+
val of_json : Jsont.json -> (t, string) result
273
+
(** [of_json json] deserializes a category from JSON. *)
274
+
275
+
val jsont : t Jsont.t
276
+
(** Jsont codec for categories. *)
277
+
end
278
+
237
279
(** {1 User Management} *)
238
280
239
281
module User : sig
···
437
479
@param output_dir Directory to write HTML files to
438
480
@param title Site title
439
481
@param posts_per_page Number of posts per page (default: 25) *)
482
+
483
+
(** {2 Category Management} *)
484
+
485
+
val list_categories : t -> Category.t list
486
+
(** [list_categories state] returns all custom categories. *)
487
+
488
+
val get_category : t -> id:string -> Category.t option
489
+
(** [get_category state ~id] retrieves a category by ID. *)
490
+
491
+
val add_category : t -> Category.t -> (unit, string) result
492
+
(** [add_category state category] adds or updates a category.
493
+
494
+
@param category The category to add/update *)
495
+
496
+
val remove_category : t -> id:string -> (unit, string) result
497
+
(** [remove_category state ~id] removes a category.
498
+
499
+
This also removes the category from any posts that were tagged with it.
500
+
@param id The category ID to remove *)
501
+
502
+
val get_post_categories : t -> post_id:string -> string list
503
+
(** [get_post_categories state ~post_id] returns the list of category IDs
504
+
assigned to a post. *)
505
+
506
+
val set_post_categories : t -> post_id:string -> category_ids:string list -> (unit, string) result
507
+
(** [set_post_categories state ~post_id ~category_ids] sets the categories for a post.
508
+
509
+
Replaces any existing category assignments for this post.
510
+
@param post_id The post ID to categorize
511
+
@param category_ids List of category IDs to assign *)
512
+
513
+
val add_post_category : t -> post_id:string -> category_id:string -> (unit, string) result
514
+
(** [add_post_category state ~post_id ~category_id] adds a category to a post.
515
+
516
+
@param post_id The post ID
517
+
@param category_id The category ID to add *)
518
+
519
+
val remove_post_category : t -> post_id:string -> category_id:string -> (unit, string) result
520
+
(** [remove_post_category state ~post_id ~category_id] removes a category from a post.
521
+
522
+
@param post_id The post ID
523
+
@param category_id The category ID to remove *)
524
+
525
+
val get_posts_by_category : t -> category_id:string -> string list
526
+
(** [get_posts_by_category state ~category_id] returns all post IDs with this category. *)
440
527
441
528
(** {2 Analysis} *)
442
529
+260
-33
stack/river/lib/state.ml
+260
-33
stack/river/lib/state.ml
···
98
98
save state updated
99
99
end
100
100
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")
104
+
105
+
let jsont = Jsont.list Category.jsont
106
+
107
+
let load state =
108
+
let file = categories_file state in
109
+
try
110
+
let content = Eio.Path.load file in
111
+
match Jsont_bytesrw.decode_string' jsont content with
112
+
| Ok categories -> categories
113
+
| Error err ->
114
+
Log.warn (fun m -> m "Failed to parse categories: %s" (Jsont.Error.to_string err));
115
+
[]
116
+
with
117
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
118
+
| e ->
119
+
Log.err (fun m -> m "Error loading categories: %s" (Printexc.to_string e));
120
+
[]
121
+
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)
127
+
128
+
let get state id =
129
+
load state |> List.find_opt (fun cat -> Category.id cat = id)
130
+
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)
135
+
136
+
let remove state id =
137
+
let categories = load state in
138
+
save state (List.filter (fun cat -> Category.id cat <> id) categories)
139
+
end
140
+
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")
144
+
145
+
(* Type: list of (post_id, category_ids) pairs *)
146
+
let jsont =
147
+
let pair_t =
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
153
+
in
154
+
Jsont.list pair_t
155
+
156
+
let load state =
157
+
let file = post_categories_file state in
158
+
try
159
+
let content = Eio.Path.load file in
160
+
match Jsont_bytesrw.decode_string' jsont content with
161
+
| Ok mappings -> mappings
162
+
| Error err ->
163
+
Log.warn (fun m -> m "Failed to parse post categories: %s" (Jsont.Error.to_string err));
164
+
[]
165
+
with
166
+
| Eio.Io (Eio.Fs.E (Not_found _), _) -> []
167
+
| e ->
168
+
Log.err (fun m -> m "Error loading post categories: %s" (Printexc.to_string e));
169
+
[]
170
+
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)
176
+
177
+
let get state post_id =
178
+
load state |> List.assoc_opt post_id |> Option.value ~default:[]
179
+
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
184
+
save state updated
185
+
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)
190
+
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)
194
+
195
+
let get_posts_by_category state category_id =
196
+
load state
197
+
|> List.filter (fun (_, category_ids) -> List.mem category_id category_ids)
198
+
|> List.map fst
199
+
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)
205
+
) mappings in
206
+
save state updated
207
+
end
208
+
209
+
(** {2 Category Management - Internal functions} *)
210
+
211
+
let list_categories state =
212
+
Category_storage.load state
213
+
214
+
let get_category state ~id =
215
+
Category_storage.get state id
216
+
217
+
let add_category state category =
218
+
try
219
+
Category_storage.add state category;
220
+
Ok ()
221
+
with e ->
222
+
Error (Printf.sprintf "Failed to add category: %s" (Printexc.to_string e))
223
+
224
+
let remove_category state ~id =
225
+
try
226
+
Category_storage.remove state id;
227
+
Post_category_storage.remove_category state id;
228
+
Ok ()
229
+
with e ->
230
+
Error (Printf.sprintf "Failed to remove category: %s" (Printexc.to_string e))
231
+
232
+
let get_post_categories state ~post_id =
233
+
Post_category_storage.get state post_id
234
+
235
+
let set_post_categories state ~post_id ~category_ids =
236
+
try
237
+
Post_category_storage.set state post_id category_ids;
238
+
Ok ()
239
+
with e ->
240
+
Error (Printf.sprintf "Failed to set post categories: %s" (Printexc.to_string e))
241
+
242
+
let add_post_category state ~post_id ~category_id =
243
+
try
244
+
Post_category_storage.add state post_id category_id;
245
+
Ok ()
246
+
with e ->
247
+
Error (Printf.sprintf "Failed to add post category: %s" (Printexc.to_string e))
248
+
249
+
let remove_post_category state ~post_id ~category_id =
250
+
try
251
+
Post_category_storage.remove state post_id category_id;
252
+
Ok ()
253
+
with e ->
254
+
Error (Printf.sprintf "Failed to remove post category: %s" (Printexc.to_string e))
255
+
256
+
let get_posts_by_category state ~category_id =
257
+
Post_category_storage.get_posts_by_category state category_id
258
+
101
259
module Storage = struct
102
260
(** List all usernames with feeds from Sortal *)
103
261
let list_users state =
···
537
695
in
538
696
let author, _ = entry.authors in
539
697
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)
541
700
in
542
701
543
702
(* Get all posts *)
···
547
706
entry_to_html_data username entry
548
707
) all_posts in
549
708
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
551
710
Log.info (fun m -> m "Retrieved %d posts from %d users" (List.length html_data) (List.length unique_users));
552
711
Log.info (fun m -> m "Users: %s" (String.concat ", " unique_users));
553
712
···
563
722
i >= start_idx && i < start_idx + posts_per_page
564
723
) html_data in
565
724
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) ->
567
726
Log.debug (fun m -> m " Processing post: %s by @%s" title username);
568
727
569
728
(* Get author name from Sortal, fallback to username *)
···
583
742
in
584
743
let excerpt = Format.Html.post_excerpt_from_html content ~max_length:300 in
585
744
let full_content = Format.Html.full_content_from_html content in
745
+
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)
751
+
| None -> None
752
+
) custom_category_ids in
753
+
754
+
(* Combine feed tags and custom categories *)
755
+
let all_tags = tags @ List.map fst custom_categories in
586
756
let tags_html =
587
-
match tags with
757
+
match all_tags with
588
758
| [] -> ""
589
759
| _ ->
760
+
(* Display feed tags *)
590
761
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>|}
592
763
(Format.Html.html_escape (sanitize_filename tag)) (Format.Html.html_escape tag)
593
764
) tags in
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>|}
595
771
(String.concat "" tag_links)
772
+
(String.concat "" category_links)
596
773
in
597
774
let thumbnail_html = match get_author_thumbnail username with
598
775
| Some thumb_path ->
···
649
826
(* Generate author index *)
650
827
Log.info (fun m -> m "Generating author index and pages");
651
828
let authors_map = Hashtbl.create 32 in
652
-
List.iter (fun (username, _, author, _, _, _, _) ->
829
+
List.iter (fun (username, _, author, _, _, _, _, _) ->
653
830
let count = match Hashtbl.find_opt authors_map username with
654
831
| Some (_, c) -> c + 1
655
832
| None -> 1
···
759
936
760
937
(* Generate individual author pages *)
761
938
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
763
940
let author_total = List.length author_posts in
764
941
let author_pages = (author_total + posts_per_page - 1) / posts_per_page in
765
942
Log.info (fun m -> m " Author: %s (@%s) - %d posts, %d pages" author username author_total author_pages);
···
874
1051
i >= start_idx && i < start_idx + posts_per_page
875
1052
) author_posts in
876
1053
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) ->
878
1055
let date_str = Format.Html.format_date date in
879
1056
let link_html = match link with
880
1057
| Some uri ->
···
885
1062
in
886
1063
let excerpt = Format.Html.post_excerpt_from_html content ~max_length:300 in
887
1064
let full_content = Format.Html.full_content_from_html content in
1065
+
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)
1071
+
| None -> None
1072
+
) custom_category_ids in
1073
+
888
1074
let tags_html =
889
-
match tags with
890
-
| [] -> ""
891
-
| _ ->
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)
895
-
) tags in
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 ""
1077
+
else
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)
1082
+
) tags in
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)
898
1091
in
899
1092
Printf.sprintf {|<article class="post">
900
1093
<h2 class="post-title">%s</h2>
···
940
1133
(* Generate category index and pages *)
941
1134
Log.info (fun m -> m "Generating category index and pages");
942
1135
let categories_map = Hashtbl.create 32 in
943
-
List.iter (fun (_, _, _, _, _, _, tags) ->
1136
+
List.iter (fun (_, _, _, _, _, _, tags, post_id) ->
1137
+
(* Count feed tags *)
944
1138
List.iter (fun tag ->
945
1139
let count = match Hashtbl.find_opt categories_map tag with
946
1140
| Some c -> c + 1
947
1141
| None -> 1
948
1142
in
949
1143
Hashtbl.replace categories_map tag count
950
-
) tags
1144
+
) tags;
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
1149
+
| Some c -> c + 1
1150
+
| None -> 1
1151
+
in
1152
+
Hashtbl.replace categories_map cat_id count
1153
+
) custom_cat_ids
951
1154
) html_data;
952
1155
953
1156
let categories_list = Hashtbl.fold (fun tag count acc ->
···
979
1182
980
1183
(* Generate individual category pages *)
981
1184
List.iter (fun (tag, count) ->
982
-
let tag_posts = List.filter (fun (_, _, _, _, _, _, tags) ->
983
-
List.mem tag 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
1192
+
| None -> false
1193
+
) custom_cat_ids in
1194
+
in_feed_tags || in_custom_cats
984
1195
) html_data in
985
1196
986
1197
let tag_total = List.length tag_posts in
···
993
1204
i >= start_idx && i < start_idx + posts_per_page
994
1205
) tag_posts in
995
1206
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) ->
997
1208
let date_str = Format.Html.format_date date in
998
1209
let link_html = match link with
999
1210
| Some uri ->
···
1004
1215
in
1005
1216
let excerpt = Format.Html.post_excerpt_from_html content ~max_length:300 in
1006
1217
let full_content = Format.Html.full_content_from_html content in
1218
+
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)
1224
+
| None -> None
1225
+
) custom_category_ids in
1226
+
1007
1227
let tags_html =
1008
-
match tags with
1009
-
| [] -> ""
1010
-
| _ ->
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)
1014
-
) tags in
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 ""
1230
+
else
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)
1235
+
) tags in
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)
1017
1244
in
1018
1245
Printf.sprintf {|<article class="post">
1019
1246
<h2 class="post-title">%s</h2>
···
1058
1285
1059
1286
(* Generate links page *)
1060
1287
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, _, _) ->
1062
1289
let links = Html_markdown.extract_links content in
1063
1290
List.map (fun (href, link_text) ->
1064
1291
(href, link_text, username, author, title, post_link, date)
+45
stack/river/lib/state.mli
+45
stack/river/lib/state.mli
···
136
136
@param title Site title
137
137
@param posts_per_page Number of posts per page (default: 25) *)
138
138
139
+
(** {2 Category Management} *)
140
+
141
+
val list_categories : t -> Category.t list
142
+
(** [list_categories state] returns all custom categories. *)
143
+
144
+
val get_category : t -> id:string -> Category.t option
145
+
(** [get_category state ~id] retrieves a category by ID. *)
146
+
147
+
val add_category : t -> Category.t -> (unit, string) result
148
+
(** [add_category state category] adds or updates a category.
149
+
150
+
@param category The category to add/update *)
151
+
152
+
val remove_category : t -> id:string -> (unit, string) result
153
+
(** [remove_category state ~id] removes a category.
154
+
155
+
This also removes the category from any posts that were tagged with it.
156
+
@param id The category ID to remove *)
157
+
158
+
val get_post_categories : t -> post_id:string -> string list
159
+
(** [get_post_categories state ~post_id] returns the list of category IDs
160
+
assigned to a post. *)
161
+
162
+
val set_post_categories : t -> post_id:string -> category_ids:string list -> (unit, string) result
163
+
(** [set_post_categories state ~post_id ~category_ids] sets the categories for a post.
164
+
165
+
Replaces any existing category assignments for this post.
166
+
@param post_id The post ID to categorize
167
+
@param category_ids List of category IDs to assign *)
168
+
169
+
val add_post_category : t -> post_id:string -> category_id:string -> (unit, string) result
170
+
(** [add_post_category state ~post_id ~category_id] adds a category to a post.
171
+
172
+
@param post_id The post ID
173
+
@param category_id The category ID to add *)
174
+
175
+
val remove_post_category : t -> post_id:string -> category_id:string -> (unit, string) result
176
+
(** [remove_post_category state ~post_id ~category_id] removes a category from a post.
177
+
178
+
@param post_id The post ID
179
+
@param category_id The category ID to remove *)
180
+
181
+
val get_posts_by_category : t -> category_id:string -> string list
182
+
(** [get_posts_by_category state ~category_id] returns all post IDs with this category. *)
183
+
139
184
(** {2 Analysis} *)
140
185
141
186
val analyze_user_quality :