anil.recoil.org
My aggregated monorepo of OCaml code, automaintained
Merge monopam_changes into monopam library and update poe
Consolidate the separate monopam_changes library into the main monopam
library as submodules (Changes.Aggregated, Changes.Daily, Changes.Query).
This simplifies the dependency graph and provides a cleaner interface.
Update poe to use the new Monopam.Changes interface and add:
- Git pull before checking for changes in the polling loop
- Detailed logging of git pull results (up-to-date vs new changes)
- --requests-verbose flag to control HTTP request logging (off by default)
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
-12
monopam/dune-project
-12
monopam/dune-project
···
33
(ptime (>= 1.0.0))
34
(odoc :with-doc)))
35
36
-
(package
37
-
(name monopam-changes)
38
-
(synopsis "Parse and query aggregated daily changes from monopam")
39
-
(description "Library for parsing and querying the aggregated daily changes format produced by monopam, suitable for broadcasting via Zulip or other channels.")
40
-
(depends
41
-
(ocaml (>= 5.2.0))
42
-
(dune (>= 3.20))
43
-
(eio (>= 1.2))
44
-
(jsont (>= 0.2.0))
45
-
(ptime (>= 1.0.0))
46
-
(fpath (>= 0.7.0))
47
-
(odoc :with-doc)))
+22
-10
monopam/lib/changes.ml
+22
-10
monopam/lib/changes.ml
···
5
6
Changes are stored in a .changes directory at the monorepo root:
7
- .changes/<repo_name>.json - weekly changelog entries
8
-
- .changes/<repo_name>-<YYYY-MM-DD>.json - daily changelog entries (one file per day per repo) *)
9
10
type commit_range = {
11
from_hash : string;
···
740
if String.starts_with ~prefix:"initial import" summary_lower ||
741
String.starts_with ~prefix:"added as subtree" summary_lower ||
742
String.starts_with ~prefix:"added" summary_lower && String.ends_with ~suffix:"library" summary_lower then
743
-
Monopam_changes.Aggregated.New_library
744
else if List.exists (fun kw -> string_contains_s summary_lower kw)
745
["fix"; "bugfix"; "bug fix"; "repair"; "patch"; "resolve"; "correct"] then
746
-
Monopam_changes.Aggregated.Bugfix
747
else if List.exists (fun kw -> string_contains_s summary_lower kw)
748
["refactor"; "cleanup"; "clean up"; "reorganize"; "restructure"; "simplify"] then
749
-
Monopam_changes.Aggregated.Refactor
750
else if List.exists (fun kw -> string_contains_s summary_lower kw)
751
["doc"; "documentation"; "readme"; "comment"; "tutorial"; "guide"] then
752
-
Monopam_changes.Aggregated.Documentation
753
else if List.exists (fun kw -> string_contains_s summary_lower kw)
754
["add"; "new"; "feature"; "implement"; "support"; "introduce"; "enable"] then
755
-
Monopam_changes.Aggregated.Feature
756
else
757
-
Monopam_changes.Aggregated.Unknown
758
759
(** Generate an aggregated daily file from individual daily json files.
760
This creates a YYYYMMDD.json file in the .changes directory. *)
···
795
let now = Ptime_clock.now () in
796
let agg_entries = List.map (fun (repo_name, (e : daily_entry)) ->
797
let change_type = infer_change_type e.summary in
798
-
Monopam_changes.Aggregated.{
799
repository = repo_name;
800
hour = e.hour;
801
timestamp = e.timestamp;
···
820
in
821
822
(* Create the aggregated structure *)
823
-
let aggregated : Monopam_changes.Aggregated.t = {
824
date;
825
generated_at = now;
826
git_head;
···
830
831
(* Save to YYYYMMDD.json *)
832
let changes_dir_fpath = Fpath.(v (Fpath.to_string monorepo) / ".changes") in
833
-
Monopam_changes.Aggregated.save ~fs ~changes_dir:changes_dir_fpath aggregated
···
5
6
Changes are stored in a .changes directory at the monorepo root:
7
- .changes/<repo_name>.json - weekly changelog entries
8
+
- .changes/<repo_name>-<YYYY-MM-DD>.json - daily changelog entries (one file per day per repo)
9
+
- .changes/YYYYMMDD.json - aggregated daily changes for broadcasting
10
+
11
+
{1 Submodules}
12
+
13
+
- {!Aggregated} - Types and I/O for aggregated daily changes (YYYYMMDD.json)
14
+
- {!Daily} - Types and I/O for per-day-per-repo changes (repo-YYYY-MM-DD.json)
15
+
- {!Query} - High-level query interface for changes *)
16
+
17
+
(** Re-export submodules for querying changes *)
18
+
module Aggregated = Changes_aggregated
19
+
module Daily = Changes_daily
20
+
module Query = Changes_query
21
22
type commit_range = {
23
from_hash : string;
···
752
if String.starts_with ~prefix:"initial import" summary_lower ||
753
String.starts_with ~prefix:"added as subtree" summary_lower ||
754
String.starts_with ~prefix:"added" summary_lower && String.ends_with ~suffix:"library" summary_lower then
755
+
Changes_aggregated.New_library
756
else if List.exists (fun kw -> string_contains_s summary_lower kw)
757
["fix"; "bugfix"; "bug fix"; "repair"; "patch"; "resolve"; "correct"] then
758
+
Changes_aggregated.Bugfix
759
else if List.exists (fun kw -> string_contains_s summary_lower kw)
760
["refactor"; "cleanup"; "clean up"; "reorganize"; "restructure"; "simplify"] then
761
+
Changes_aggregated.Refactor
762
else if List.exists (fun kw -> string_contains_s summary_lower kw)
763
["doc"; "documentation"; "readme"; "comment"; "tutorial"; "guide"] then
764
+
Changes_aggregated.Documentation
765
else if List.exists (fun kw -> string_contains_s summary_lower kw)
766
["add"; "new"; "feature"; "implement"; "support"; "introduce"; "enable"] then
767
+
Changes_aggregated.Feature
768
else
769
+
Changes_aggregated.Unknown
770
771
(** Generate an aggregated daily file from individual daily json files.
772
This creates a YYYYMMDD.json file in the .changes directory. *)
···
807
let now = Ptime_clock.now () in
808
let agg_entries = List.map (fun (repo_name, (e : daily_entry)) ->
809
let change_type = infer_change_type e.summary in
810
+
Changes_aggregated.{
811
repository = repo_name;
812
hour = e.hour;
813
timestamp = e.timestamp;
···
832
in
833
834
(* Create the aggregated structure *)
835
+
let aggregated : Changes_aggregated.t = {
836
date;
837
generated_at = now;
838
git_head;
···
842
843
(* Save to YYYYMMDD.json *)
844
let changes_dir_fpath = Fpath.(v (Fpath.to_string monorepo) / ".changes") in
845
+
Changes_aggregated.save ~fs ~changes_dir:changes_dir_fpath aggregated
+15
-1
monopam/lib/changes.mli
+15
-1
monopam/lib/changes.mli
···
5
6
Changes are stored in a .changes directory at the monorepo root:
7
- .changes/<repo_name>.json - weekly changelog entries
8
+
- .changes/<repo_name>-<YYYY-MM-DD>.json - daily changelog entries (one file per day per repo)
9
+
- .changes/YYYYMMDD.json - aggregated daily changes for broadcasting
10
+
11
+
{1 Submodules}
12
+
13
+
These modules provide types and I/O for querying the generated changes files. *)
14
+
15
+
(** Aggregated daily changes format (YYYYMMDD.json files). *)
16
+
module Aggregated = Changes_aggregated
17
+
18
+
(** Daily changes with per-day-per-repo structure (repo-YYYY-MM-DD.json files). *)
19
+
module Daily = Changes_daily
20
+
21
+
(** High-level query interface for changes. *)
22
+
module Query = Changes_query
23
24
(** {1 Types} *)
25
+1
-1
monopam/lib/dune
+1
-1
monopam/lib/dune
+7
monopam/lib_changes/aggregated.ml
monopam/lib/changes_aggregated.ml
+7
monopam/lib_changes/aggregated.ml
monopam/lib/changes_aggregated.ml
···
3
SPDX-License-Identifier: ISC
4
---------------------------------------------------------------------------*)
5
6
+
(** Aggregated daily changes format.
7
+
8
+
This module provides types and JSON codecs for the aggregated daily changes
9
+
format stored in [.changes/YYYYMMDD.json] files. These files combine all
10
+
repository changes for a single day into a structured format suitable for
11
+
broadcasting. *)
12
+
13
type change_type =
14
| Feature
15
| Bugfix
+2
-2
monopam/lib_changes/aggregated.mli
monopam/lib/changes_aggregated.mli
+2
-2
monopam/lib_changes/aggregated.mli
monopam/lib/changes_aggregated.mli
···
66
67
val load : fs:_ Eio.Path.t -> changes_dir:Fpath.t -> date:string -> (t, string) result
68
(** Load aggregated changes for a specific date.
69
-
[date] should be in YYYYMMDD format. *)
70
71
val load_range :
72
fs:_ Eio.Path.t ->
···
75
to_date:string ->
76
(t list, string) result
77
(** Load all aggregated changes files in date range.
78
-
Dates should be in YYYYMMDD format. *)
79
80
val latest : fs:_ Eio.Path.t -> changes_dir:Fpath.t -> (t option, string) result
81
(** Load the most recent aggregated changes file. *)
···
66
67
val load : fs:_ Eio.Path.t -> changes_dir:Fpath.t -> date:string -> (t, string) result
68
(** Load aggregated changes for a specific date.
69
+
[date] should be in YYYY-MM-DD format. *)
70
71
val load_range :
72
fs:_ Eio.Path.t ->
···
75
to_date:string ->
76
(t list, string) result
77
(** Load all aggregated changes files in date range.
78
+
Dates should be in YYYY-MM-DD format. *)
79
80
val latest : fs:_ Eio.Path.t -> changes_dir:Fpath.t -> (t option, string) result
81
(** Load the most recent aggregated changes file. *)
+7
monopam/lib_changes/daily.ml
monopam/lib/changes_daily.ml
+7
monopam/lib_changes/daily.ml
monopam/lib/changes_daily.ml
···
3
SPDX-License-Identifier: ISC
4
---------------------------------------------------------------------------*)
5
6
+
(** Daily changes with per-day-per-repo structure.
7
+
8
+
This module provides an immutable data structure for loading and querying
9
+
daily changes from per-day-per-repo JSON files. Files are named
10
+
[<repo>-<YYYY-MM-DD>.json] and contain timestamped entries for real-time
11
+
tracking. *)
12
+
13
type commit_range = {
14
from_hash : string;
15
to_hash : string;
monopam/lib_changes/daily.mli
monopam/lib/changes_daily.mli
monopam/lib_changes/daily.mli
monopam/lib/changes_daily.mli
-4
monopam/lib_changes/dune
-4
monopam/lib_changes/dune
-16
monopam/lib_changes/monopam_changes.ml
-16
monopam/lib_changes/monopam_changes.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2026 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** Library for parsing and querying aggregated daily changes.
7
-
8
-
This library provides types and functions for working with the aggregated
9
-
daily changes format used by the monopam tool and the poe Zulip bot.
10
-
11
-
The {!Daily} module provides an immutable data structure for loading
12
-
per-day-per-repo JSON files ([<repo>-<YYYY-MM-DD>.json]). *)
13
-
14
-
module Aggregated = Aggregated
15
-
module Daily = Daily
16
-
module Query = Query
···
+21
-16
monopam/lib_changes/query.ml
monopam/lib/changes_query.ml
+21
-16
monopam/lib_changes/query.ml
monopam/lib/changes_query.ml
···
3
SPDX-License-Identifier: ISC
4
---------------------------------------------------------------------------*)
5
6
let changes_since ~fs ~changes_dir ~since =
7
(* Get the date part of since for filtering *)
8
let since_date =
···
15
let (y, m, d), _ = Ptime.to_date_time now in
16
Printf.sprintf "%04d-%02d-%02d" y m d
17
in
18
-
match Aggregated.load_range ~fs ~changes_dir ~from_date:since_date ~to_date:now_date with
19
| Error e -> Error e
20
| Ok aggregated_files ->
21
(* Filter to files generated after 'since' and collect entries *)
22
-
let entries = List.concat_map (fun (agg : Aggregated.t) ->
23
if Ptime.compare agg.generated_at since > 0 then
24
agg.entries
25
else
···
49
end;
50
(* Group by change type *)
51
let by_type = [
52
-
(Aggregated.New_library, "New Libraries", []);
53
-
(Aggregated.Feature, "Features", []);
54
-
(Aggregated.Bugfix, "Bug Fixes", []);
55
-
(Aggregated.Documentation, "Documentation", []);
56
-
(Aggregated.Refactor, "Improvements", []);
57
-
(Aggregated.Unknown, "Other Changes", []);
58
] in
59
let grouped = List.map (fun (ct, title, _) ->
60
-
let matching = List.filter (fun (e : Aggregated.entry) -> e.change_type = ct) entries in
61
(ct, title, matching)) by_type
62
in
63
List.iter (fun (_ct, title, entries) ->
64
if entries <> [] then begin
65
Buffer.add_string buf (Printf.sprintf "### %s\n\n" title);
66
-
List.iter (fun (entry : Aggregated.entry) ->
67
let repo_link = format_repo_link entry.repository entry.repo_url in
68
Buffer.add_string buf (Printf.sprintf "**%s**: %s\n" repo_link entry.summary);
69
List.iter (fun change ->
···
82
else
83
let count = List.length entries in
84
let repos = List.sort_uniq String.compare
85
-
(List.map (fun (e : Aggregated.entry) -> e.repository) entries) in
86
Printf.sprintf "%d change%s across %d repositor%s: %s"
87
count (if count = 1 then "" else "s")
88
(List.length repos) (if List.length repos = 1 then "y" else "ies")
···
91
(** {1 Daily Changes (Real-time)} *)
92
93
let daily_changes_since ~fs ~changes_dir ~since =
94
-
Daily.entries_since ~fs ~changes_dir ~since
95
96
let has_new_daily_changes ~fs ~changes_dir ~since =
97
daily_changes_since ~fs ~changes_dir ~since <> []
···
108
end;
109
(* Group by repository *)
110
let repos = List.sort_uniq String.compare
111
-
(List.map (fun (e : Daily.entry) -> e.repository) entries) in
112
List.iter (fun repo ->
113
-
let repo_entries = List.filter (fun (e : Daily.entry) -> e.repository = repo) entries in
114
if repo_entries <> [] then begin
115
let first_entry = List.hd repo_entries in
116
let repo_link = format_repo_link repo first_entry.repo_url in
117
Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_link);
118
-
List.iter (fun (entry : Daily.entry) ->
119
Buffer.add_string buf (Printf.sprintf "**%s**\n" entry.summary);
120
List.iter (fun change ->
121
Buffer.add_string buf (Printf.sprintf "- %s\n" change)) entry.changes;
···
133
else
134
let count = List.length entries in
135
let repos = List.sort_uniq String.compare
136
-
(List.map (fun (e : Daily.entry) -> e.repository) entries) in
137
Printf.sprintf "%d change%s across %d repositor%s: %s"
138
count (if count = 1 then "" else "s")
139
(List.length repos) (if List.length repos = 1 then "y" else "ies")
···
3
SPDX-License-Identifier: ISC
4
---------------------------------------------------------------------------*)
5
6
+
(** High-level query interface for changes.
7
+
8
+
This module provides convenient functions for querying changes since a
9
+
specific timestamp and formatting them for broadcast. *)
10
+
11
let changes_since ~fs ~changes_dir ~since =
12
(* Get the date part of since for filtering *)
13
let since_date =
···
20
let (y, m, d), _ = Ptime.to_date_time now in
21
Printf.sprintf "%04d-%02d-%02d" y m d
22
in
23
+
match Changes_aggregated.load_range ~fs ~changes_dir ~from_date:since_date ~to_date:now_date with
24
| Error e -> Error e
25
| Ok aggregated_files ->
26
(* Filter to files generated after 'since' and collect entries *)
27
+
let entries = List.concat_map (fun (agg : Changes_aggregated.t) ->
28
if Ptime.compare agg.generated_at since > 0 then
29
agg.entries
30
else
···
54
end;
55
(* Group by change type *)
56
let by_type = [
57
+
(Changes_aggregated.New_library, "New Libraries", []);
58
+
(Changes_aggregated.Feature, "Features", []);
59
+
(Changes_aggregated.Bugfix, "Bug Fixes", []);
60
+
(Changes_aggregated.Documentation, "Documentation", []);
61
+
(Changes_aggregated.Refactor, "Improvements", []);
62
+
(Changes_aggregated.Unknown, "Other Changes", []);
63
] in
64
let grouped = List.map (fun (ct, title, _) ->
65
+
let matching = List.filter (fun (e : Changes_aggregated.entry) -> e.change_type = ct) entries in
66
(ct, title, matching)) by_type
67
in
68
List.iter (fun (_ct, title, entries) ->
69
if entries <> [] then begin
70
Buffer.add_string buf (Printf.sprintf "### %s\n\n" title);
71
+
List.iter (fun (entry : Changes_aggregated.entry) ->
72
let repo_link = format_repo_link entry.repository entry.repo_url in
73
Buffer.add_string buf (Printf.sprintf "**%s**: %s\n" repo_link entry.summary);
74
List.iter (fun change ->
···
87
else
88
let count = List.length entries in
89
let repos = List.sort_uniq String.compare
90
+
(List.map (fun (e : Changes_aggregated.entry) -> e.repository) entries) in
91
Printf.sprintf "%d change%s across %d repositor%s: %s"
92
count (if count = 1 then "" else "s")
93
(List.length repos) (if List.length repos = 1 then "y" else "ies")
···
96
(** {1 Daily Changes (Real-time)} *)
97
98
let daily_changes_since ~fs ~changes_dir ~since =
99
+
Changes_daily.entries_since ~fs ~changes_dir ~since
100
101
let has_new_daily_changes ~fs ~changes_dir ~since =
102
daily_changes_since ~fs ~changes_dir ~since <> []
···
113
end;
114
(* Group by repository *)
115
let repos = List.sort_uniq String.compare
116
+
(List.map (fun (e : Changes_daily.entry) -> e.repository) entries) in
117
List.iter (fun repo ->
118
+
let repo_entries = List.filter (fun (e : Changes_daily.entry) -> e.repository = repo) entries in
119
if repo_entries <> [] then begin
120
let first_entry = List.hd repo_entries in
121
let repo_link = format_repo_link repo first_entry.repo_url in
122
Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_link);
123
+
List.iter (fun (entry : Changes_daily.entry) ->
124
Buffer.add_string buf (Printf.sprintf "**%s**\n" entry.summary);
125
List.iter (fun change ->
126
Buffer.add_string buf (Printf.sprintf "- %s\n" change)) entry.changes;
···
138
else
139
let count = List.length entries in
140
let repos = List.sort_uniq String.compare
141
+
(List.map (fun (e : Changes_daily.entry) -> e.repository) entries) in
142
Printf.sprintf "%d change%s across %d repositor%s: %s"
143
count (if count = 1 then "" else "s")
144
(List.length repos) (if List.length repos = 1 then "y" else "ies")
+6
-6
monopam/lib_changes/query.mli
monopam/lib/changes_query.mli
+6
-6
monopam/lib_changes/query.mli
monopam/lib/changes_query.mli
···
14
fs:_ Eio.Path.t ->
15
changes_dir:Fpath.t ->
16
since:Ptime.t ->
17
-
(Aggregated.entry list, string) result
18
(** Get all change entries from aggregated files created after [since].
19
Returns entries from all days after the timestamp. *)
20
···
28
(** {1 Formatting} *)
29
30
val format_for_zulip :
31
-
entries:Aggregated.entry list ->
32
include_date:bool ->
33
date:string option ->
34
string
···
37
[date] is used for the header if provided. *)
38
39
val format_summary :
40
-
entries:Aggregated.entry list ->
41
string
42
(** Format a brief summary of the changes. *)
43
···
47
fs:_ Eio.Path.t ->
48
changes_dir:Fpath.t ->
49
since:Ptime.t ->
50
-
Daily.entry list
51
(** Get all daily change entries created after [since] timestamp.
52
Uses the per-day-per-repo files for real-time access. *)
53
···
59
(** Check if there are any new daily changes since the given timestamp. *)
60
61
val format_daily_for_zulip :
62
-
entries:Daily.entry list ->
63
include_date:bool ->
64
date:string option ->
65
string
···
67
Groups entries by repository. *)
68
69
val format_daily_summary :
70
-
entries:Daily.entry list ->
71
string
72
(** Format a brief summary of daily changes. *)
···
14
fs:_ Eio.Path.t ->
15
changes_dir:Fpath.t ->
16
since:Ptime.t ->
17
+
(Changes_aggregated.entry list, string) result
18
(** Get all change entries from aggregated files created after [since].
19
Returns entries from all days after the timestamp. *)
20
···
28
(** {1 Formatting} *)
29
30
val format_for_zulip :
31
+
entries:Changes_aggregated.entry list ->
32
include_date:bool ->
33
date:string option ->
34
string
···
37
[date] is used for the header if provided. *)
38
39
val format_summary :
40
+
entries:Changes_aggregated.entry list ->
41
string
42
(** Format a brief summary of the changes. *)
43
···
47
fs:_ Eio.Path.t ->
48
changes_dir:Fpath.t ->
49
since:Ptime.t ->
50
+
Changes_daily.entry list
51
(** Get all daily change entries created after [since] timestamp.
52
Uses the per-day-per-repo files for real-time access. *)
53
···
59
(** Check if there are any new daily changes since the given timestamp. *)
60
61
val format_daily_for_zulip :
62
+
entries:Changes_daily.entry list ->
63
include_date:bool ->
64
date:string option ->
65
string
···
67
Groups entries by repository. *)
68
69
val format_daily_summary :
70
+
entries:Changes_daily.entry list ->
71
string
72
(** Format a brief summary of daily changes. *)
-35
monopam/monopam-changes.opam
-35
monopam/monopam-changes.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "Parse and query aggregated daily changes from monopam"
4
-
description:
5
-
"Library for parsing and querying the aggregated daily changes format produced by monopam, suitable for broadcasting via Zulip or other channels."
6
-
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
-
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
8
-
license: "ISC"
9
-
homepage: "https://tangled.org/@anil.recoil.org/monopam"
10
-
bug-reports: "https://tangled.org/@anil.recoil.org/monopam/issues"
11
-
depends: [
12
-
"ocaml" {>= "5.2.0"}
13
-
"dune" {>= "3.20" & >= "3.20"}
14
-
"eio" {>= "1.2"}
15
-
"jsont" {>= "0.2.0"}
16
-
"ptime" {>= "1.0.0"}
17
-
"fpath" {>= "0.7.0"}
18
-
"odoc" {with-doc}
19
-
]
20
-
build: [
21
-
["dune" "subst"] {dev}
22
-
[
23
-
"dune"
24
-
"build"
25
-
"-p"
26
-
name
27
-
"-j"
28
-
jobs
29
-
"@install"
30
-
"@runtest" {with-test}
31
-
"@doc" {with-doc}
32
-
]
33
-
]
34
-
dev-repo: "git+https://tangled.org/@anil.recoil.org/monopam.git"
35
-
x-maintenance-intent: ["(latest)"]
···
+31
-12
poe/bin/main.ml
+31
-12
poe/bin/main.ml
···
3
SPDX-License-Identifier: ISC
4
---------------------------------------------------------------------------*)
5
6
-
let setup_logging style_renderer level =
7
Fmt_tty.setup_std_outputs ?style_renderer ();
8
Logs.set_level level;
9
-
Logs.set_reporter (Logs_fmt.reporter ())
10
11
let run_bot bot_name config_file =
12
Eio_main.run @@ fun env ->
···
51
Logs.info (fun m -> m "Starting Poe bot...");
52
Zulip_bot.Bot.run ~sw ~env ~config:zulip_config ~handler
53
54
let run_cmd =
55
let open Cmdliner in
56
let bot_name =
···
67
& info [ "c"; "config" ] ~docv:"FILE"
68
~doc:"Path to poe.toml configuration file.")
69
in
70
-
let run style_renderer level bot_name config_file =
71
-
setup_logging style_renderer level;
72
run_bot bot_name config_file
73
in
74
let doc = "Run the Poe Zulip bot" in
75
let info = Cmd.info "run" ~doc in
76
Cmd.v info
77
Term.(
78
-
const run $ Fmt_cli.style_renderer () $ Logs_cli.level () $ bot_name
79
-
$ config_file)
80
81
let broadcast_cmd =
82
let open Cmdliner in
···
94
& info [ "n"; "name" ] ~docv:"NAME"
95
~doc:"Bot name for Zulip configuration lookup.")
96
in
97
-
let broadcast style_renderer level config_file bot_name =
98
-
setup_logging style_renderer level;
99
Eio_main.run @@ fun env ->
100
Eio.Switch.run @@ fun sw ->
101
let fs = Eio.Stdenv.fs env in
···
134
Cmd.v info
135
Term.(
136
const broadcast $ Fmt_cli.style_renderer () $ Logs_cli.level ()
137
-
$ config_file $ bot_name)
138
139
let loop_cmd =
140
let open Cmdliner in
···
159
& info [ "i"; "interval" ] ~docv:"SECONDS"
160
~doc:"Interval in seconds between change checks (default: 3600).")
161
in
162
-
let loop style_renderer level config_file bot_name interval =
163
-
setup_logging style_renderer level;
164
Eio_main.run @@ fun env ->
165
Eio.Switch.run @@ fun sw ->
166
let fs = Eio.Stdenv.fs env in
···
189
Cmd.v info
190
Term.(
191
const loop $ Fmt_cli.style_renderer () $ Logs_cli.level ()
192
-
$ config_file $ bot_name $ interval)
193
194
let main_cmd =
195
let open Cmdliner in
···
3
SPDX-License-Identifier: ISC
4
---------------------------------------------------------------------------*)
5
6
+
(* Log source prefixes for requests library - disabled by default to reduce noise *)
7
+
let requests_src_prefix = "requests"
8
+
9
+
let setup_logging style_renderer level ~requests_verbose =
10
Fmt_tty.setup_std_outputs ?style_renderer ();
11
Logs.set_level level;
12
+
Logs.set_reporter (Logs_fmt.reporter ());
13
+
(* Disable requests logging by default unless explicitly enabled *)
14
+
if not requests_verbose then
15
+
List.iter (fun src ->
16
+
let name = Logs.Src.name src in
17
+
if String.length name >= String.length requests_src_prefix &&
18
+
String.sub name 0 (String.length requests_src_prefix) = requests_src_prefix then
19
+
Logs.Src.set_level src (Some Logs.Warning)
20
+
) (Logs.Src.list ())
21
22
let run_bot bot_name config_file =
23
Eio_main.run @@ fun env ->
···
62
Logs.info (fun m -> m "Starting Poe bot...");
63
Zulip_bot.Bot.run ~sw ~env ~config:zulip_config ~handler
64
65
+
let requests_verbose_arg =
66
+
let open Cmdliner in
67
+
Arg.(
68
+
value
69
+
& flag
70
+
& info [ "requests-verbose" ]
71
+
~doc:"Enable verbose HTTP request logging (disabled by default).")
72
+
73
let run_cmd =
74
let open Cmdliner in
75
let bot_name =
···
86
& info [ "c"; "config" ] ~docv:"FILE"
87
~doc:"Path to poe.toml configuration file.")
88
in
89
+
let run style_renderer level requests_verbose bot_name config_file =
90
+
setup_logging style_renderer level ~requests_verbose;
91
run_bot bot_name config_file
92
in
93
let doc = "Run the Poe Zulip bot" in
94
let info = Cmd.info "run" ~doc in
95
Cmd.v info
96
Term.(
97
+
const run $ Fmt_cli.style_renderer () $ Logs_cli.level ()
98
+
$ requests_verbose_arg $ bot_name $ config_file)
99
100
let broadcast_cmd =
101
let open Cmdliner in
···
113
& info [ "n"; "name" ] ~docv:"NAME"
114
~doc:"Bot name for Zulip configuration lookup.")
115
in
116
+
let broadcast style_renderer level requests_verbose config_file bot_name =
117
+
setup_logging style_renderer level ~requests_verbose;
118
Eio_main.run @@ fun env ->
119
Eio.Switch.run @@ fun sw ->
120
let fs = Eio.Stdenv.fs env in
···
153
Cmd.v info
154
Term.(
155
const broadcast $ Fmt_cli.style_renderer () $ Logs_cli.level ()
156
+
$ requests_verbose_arg $ config_file $ bot_name)
157
158
let loop_cmd =
159
let open Cmdliner in
···
178
& info [ "i"; "interval" ] ~docv:"SECONDS"
179
~doc:"Interval in seconds between change checks (default: 3600).")
180
in
181
+
let loop style_renderer level requests_verbose config_file bot_name interval =
182
+
setup_logging style_renderer level ~requests_verbose;
183
Eio_main.run @@ fun env ->
184
Eio.Switch.run @@ fun sw ->
185
let fs = Eio.Stdenv.fs env in
···
208
Cmd.v info
209
Term.(
210
const loop $ Fmt_cli.style_renderer () $ Logs_cli.level ()
211
+
$ requests_verbose_arg $ config_file $ bot_name $ interval)
212
213
let main_cmd =
214
let open Cmdliner in
+3
-3
poe/lib/broadcast.ml
+3
-3
poe/lib/broadcast.ml
···
26
| Some t -> t
27
in
28
29
-
match Monopam_changes.Query.changes_since ~fs ~changes_dir ~since with
30
| Error e ->
31
Log.warn (fun m -> m "Error loading changes: %s" e);
32
(* Fall back to reading the markdown file *)
···
51
end
52
else begin
53
(* Format the changes for Zulip *)
54
-
let content = Monopam_changes.Query.format_for_zulip
55
~entries ~include_date:true ~date:None
56
in
57
···
61
Log.info (fun m -> m "Updated broadcast time to %s" (Ptime.to_rfc3339 now));
62
63
(* Send as stream message *)
64
-
let summary = Monopam_changes.Query.format_summary ~entries in
65
Log.info (fun m -> m "Broadcasting: %s" summary);
66
67
(* Return a compound response: stream message + confirmation reply *)
···
26
| Some t -> t
27
in
28
29
+
match Monopam.Changes.Query.changes_since ~fs ~changes_dir ~since with
30
| Error e ->
31
Log.warn (fun m -> m "Error loading changes: %s" e);
32
(* Fall back to reading the markdown file *)
···
51
end
52
else begin
53
(* Format the changes for Zulip *)
54
+
let content = Monopam.Changes.Query.format_for_zulip
55
~entries ~include_date:true ~date:None
56
in
57
···
61
Log.info (fun m -> m "Updated broadcast time to %s" (Ptime.to_rfc3339 now));
62
63
(* Send as stream message *)
64
+
let summary = Monopam.Changes.Query.format_summary ~entries in
65
Log.info (fun m -> m "Broadcasting: %s" summary);
66
67
(* Return a compound response: stream message + confirmation reply *)
+1
-1
poe/lib/dune
+1
-1
poe/lib/dune
+37
-2
poe/lib/loop.ml
+37
-2
poe/lib/loop.ml
···
17
| `Exited 0 -> Some (String.trim (Buffer.contents buf))
18
| _ -> None
19
20
let run_monopam_changes ~proc ~cwd =
21
Log.info (fun m -> m "Running monopam changes --daily --aggregate");
22
Eio.Switch.run @@ fun sw ->
···
35
false
36
37
let send_changes ~client ~stream ~topic ~entries =
38
-
let content = Monopam_changes.Query.format_for_zulip
39
~entries ~include_date:true ~date:None
40
in
41
let msg = Zulip.Message.create ~type_:`Channel ~to_:[stream] ~topic ~content () in
···
59
let rec loop () =
60
Log.info (fun m -> m "Checking for changes...");
61
62
(* Get current git HEAD *)
63
let current_head = get_git_head ~proc ~cwd:monorepo_path in
64
let last_head = Admin.get_last_git_head storage in
···
90
| Some t -> t
91
in
92
93
-
match Monopam_changes.Query.changes_since ~fs ~changes_dir ~since with
94
| Error e ->
95
Log.warn (fun m -> m "Error loading changes: %s" e)
96
| Ok entries when entries = [] ->
···
17
| `Exited 0 -> Some (String.trim (Buffer.contents buf))
18
| _ -> None
19
20
+
let run_git_pull ~proc ~cwd =
21
+
Log.info (fun m -> m "Pulling latest changes from remote");
22
+
Eio.Switch.run @@ fun sw ->
23
+
let buf_stdout = Buffer.create 256 in
24
+
let buf_stderr = Buffer.create 256 in
25
+
let child = Eio.Process.spawn proc ~sw ~cwd
26
+
~stdout:(Eio.Flow.buffer_sink buf_stdout)
27
+
~stderr:(Eio.Flow.buffer_sink buf_stderr)
28
+
["git"; "pull"; "--ff-only"]
29
+
in
30
+
match Eio.Process.await child with
31
+
| `Exited 0 ->
32
+
let output = String.trim (Buffer.contents buf_stdout) in
33
+
if output = "Already up to date." then
34
+
Log.info (fun m -> m "Repository already up to date")
35
+
else begin
36
+
Log.info (fun m -> m "Pulled new changes from remote");
37
+
(* Log the output which shows what was updated *)
38
+
String.split_on_char '\n' output
39
+
|> List.iter (fun line ->
40
+
let line = String.trim line in
41
+
if line <> "" then Log.info (fun m -> m " %s" line))
42
+
end;
43
+
true
44
+
| `Exited code ->
45
+
let stderr = String.trim (Buffer.contents buf_stderr) in
46
+
Log.warn (fun m -> m "git pull exited with code %d: %s" code stderr);
47
+
false
48
+
| `Signaled sig_ ->
49
+
Log.warn (fun m -> m "git pull killed by signal %d" sig_);
50
+
false
51
+
52
let run_monopam_changes ~proc ~cwd =
53
Log.info (fun m -> m "Running monopam changes --daily --aggregate");
54
Eio.Switch.run @@ fun sw ->
···
67
false
68
69
let send_changes ~client ~stream ~topic ~entries =
70
+
let content = Monopam.Changes.Query.format_for_zulip
71
~entries ~include_date:true ~date:None
72
in
73
let msg = Zulip.Message.create ~type_:`Channel ~to_:[stream] ~topic ~content () in
···
91
let rec loop () =
92
Log.info (fun m -> m "Checking for changes...");
93
94
+
(* Pull latest changes from remote *)
95
+
let _pull_ok = run_git_pull ~proc ~cwd:monorepo_path in
96
+
97
(* Get current git HEAD *)
98
let current_head = get_git_head ~proc ~cwd:monorepo_path in
99
let last_head = Admin.get_last_git_head storage in
···
125
| Some t -> t
126
in
127
128
+
match Monopam.Changes.Query.changes_since ~fs ~changes_dir ~since with
129
| Error e ->
130
Log.warn (fun m -> m "Error loading changes: %s" e)
131
| Ok entries when entries = [] ->
+5
-4
poe/lib/loop.mli
+5
-4
poe/lib/loop.mli
···
22
(** [run ~sw ~env ~config ~zulip_config ~interval] starts the polling loop.
23
24
Loop flow:
25
-
1. Check if git HEAD has changed (compare with stored last_git_head)
26
-
2. If changed:
27
- Run [monopam changes --daily --aggregate] via subprocess
28
- Load new aggregated changes since last_broadcast_time
29
- If new entries exist, format and send to Zulip channel
30
- Update last_broadcast_time and last_git_head in storage
31
-
3. Sleep for interval seconds
32
-
4. Repeat
33
34
@param sw Eio switch for resource management
35
@param env Eio environment
···
22
(** [run ~sw ~env ~config ~zulip_config ~interval] starts the polling loop.
23
24
Loop flow:
25
+
1. Pull latest changes from remote (git pull --ff-only)
26
+
2. Check if git HEAD has changed (compare with stored last_git_head)
27
+
3. If changed:
28
- Run [monopam changes --daily --aggregate] via subprocess
29
- Load new aggregated changes since last_broadcast_time
30
- If new entries exist, format and send to Zulip channel
31
- Update last_broadcast_time and last_git_head in storage
32
+
4. Sleep for interval seconds
33
+
5. Repeat
34
35
@param sw Eio switch for resource management
36
@param env Eio environment