melse.tngl.sh
a code review tool
feat: add file-based logging and replace operation_id with commit_id
- Add Logs library with file reporter (~/.cache/lens/lens.log)
- Replace Lwt_process.pread with run_jj helper that captures stderr
- Log jj subprocess calls at debug level, errors on failure
- Add logging to irmin store operations
- Replace operation_id with commit_id in approval tracking
- Add error handling (Lwt.catch) around store reads and app startup
+243
-123
+1
-1
lib/backend/dune
+1
-1
lib/backend/dune
+1
-1
lib/backend/lens_backend.ml
+1
-1
lib/backend/lens_backend.ml
+2
-1
lib/backend/operation_id.ml
lib/backend/commit_id.ml
+2
-1
lib/backend/operation_id.ml
lib/backend/commit_id.ml
···
3
3
include
4
4
(val String_id.make
5
5
~include_default_validation:false
6
-
~module_name:"Lens_backend.Operation_id"
6
+
~module_name:"Lens_backend.Commit_id"
7
7
())
8
8
9
9
let t = Irmin.Type.map Irmin.Type.string of_string to_string
10
+
let prefix t length = String.prefix (to_string t) length
+88
-42
lib/backend/store.ml
+88
-42
lib/backend/store.ml
···
1
1
open! Core
2
2
3
+
let src = Logs.Src.create "lens.store" ~doc:"irmin review store operations"
4
+
5
+
module Log = (val Logs.src_log src : Logs.LOG)
6
+
3
7
module Request = struct
4
8
type t =
5
9
{ change_id : Change_id.t
···
14
18
type t =
15
19
{ change_id : Change_id.t
16
20
; user_id : User_id.t
17
-
; operation_id : Operation_id.t
21
+
; commit_id : Commit_id.t
18
22
}
19
23
[@@deriving irmin]
20
24
···
58
62
type nonrec write_error = write_error
59
63
60
64
let ref_name = `Other "lens/review"
61
-
62
65
let v repo = of_branch repo ref_name
63
66
64
67
let make_info message () =
···
69
72
;;
70
73
71
74
let request t change_id user_id =
72
-
set_exn
73
-
t
74
-
[ "request"; Change_id.to_string change_id; User_id.to_string user_id ]
75
-
(Request { change_id; user_id })
76
-
~info:(make_info "request review")
75
+
Log.info (fun m ->
76
+
m
77
+
"requesting review: change=%s user=%s"
78
+
(Change_id.to_string change_id)
79
+
(User_id.to_string user_id));
80
+
Lwt.catch
81
+
(fun () ->
82
+
set_exn
83
+
t
84
+
[ "request"; Change_id.to_string change_id; User_id.to_string user_id ]
85
+
(Request { change_id; user_id })
86
+
~info:(make_info "request review"))
87
+
(fun exn ->
88
+
Log.err (fun m -> m "failed to request review: %s" (Exn.to_string exn));
89
+
Lwt.fail exn)
77
90
;;
78
91
79
92
let pending_requests t change_id =
80
-
let open Lwt.Syntax in
81
-
let open Lwt.Infix in
82
-
let* tree = find_tree t [ "request"; Change_id.to_string change_id ] in
83
-
match tree with
84
-
| None -> Lwt.return []
85
-
| Some tree ->
86
-
let* children = Tree.list tree [] in
87
-
Lwt.all
88
-
(List.map children ~f:(fun (_, tree) -> Tree.get tree [] >|= Entry.request_exn))
93
+
Lwt.catch
94
+
(fun () ->
95
+
let open Lwt.Syntax in
96
+
let open Lwt.Infix in
97
+
Log.debug (fun m ->
98
+
m "fetching pending requests: change=%s" (Change_id.to_string change_id));
99
+
let* tree = find_tree t [ "request"; Change_id.to_string change_id ] in
100
+
match tree with
101
+
| None -> Lwt.return []
102
+
| Some tree ->
103
+
let* children = Tree.list tree [] in
104
+
Lwt.all
105
+
(List.map children ~f:(fun (_, tree) -> Tree.get tree [] >|= Entry.request_exn)))
106
+
(fun exn ->
107
+
Log.err (fun m ->
108
+
m
109
+
"failed to fetch pending requests for %s: %s"
110
+
(Change_id.to_string change_id)
111
+
(Exn.to_string exn));
112
+
Lwt.return [])
89
113
;;
90
114
91
-
let approve t change_id user_id operation_id =
92
-
set_exn
93
-
t
94
-
[ "approve"
95
-
; Change_id.to_string change_id
96
-
; User_id.to_string user_id
97
-
; Operation_id.to_string operation_id
98
-
]
99
-
(Approve { change_id; user_id; operation_id })
100
-
~info:(make_info "approve change")
115
+
let approve t change_id user_id commit_id =
116
+
Log.info (fun m ->
117
+
m
118
+
"approving: change=%s user=%s commit=%s"
119
+
(Change_id.to_string change_id)
120
+
(User_id.to_string user_id)
121
+
(Commit_id.to_string commit_id));
122
+
Lwt.catch
123
+
(fun () ->
124
+
set_exn
125
+
t
126
+
[ "approve"
127
+
; Change_id.to_string change_id
128
+
; User_id.to_string user_id
129
+
; Commit_id.to_string commit_id
130
+
]
131
+
(Approve { change_id; user_id; commit_id })
132
+
~info:(make_info "approve change"))
133
+
(fun exn ->
134
+
Log.err (fun m -> m "failed to approve: %s" (Exn.to_string exn));
135
+
Lwt.fail exn)
101
136
;;
102
137
103
138
let approvals t change_id =
104
-
let open Lwt.Syntax in
105
-
let open Lwt.Infix in
106
-
let* tree = find_tree t [ "approve"; Change_id.to_string change_id ] in
107
-
match tree with
108
-
| None -> Lwt.return []
109
-
| Some tree ->
110
-
let* children = Tree.list tree [] in
111
-
Lwt.all
112
-
(List.map children ~f:(fun (_, tree) ->
113
-
let* subtree = Tree.list tree [] in
114
-
Lwt.all
115
-
(List.map subtree ~f:(fun (_, tree) -> Tree.get tree [] >|= Entry.approve_exn))))
116
-
>|= List.concat
139
+
Lwt.catch
140
+
(fun () ->
141
+
let open Lwt.Syntax in
142
+
let open Lwt.Infix in
143
+
Log.debug (fun m ->
144
+
m "fetching approvals: change=%s" (Change_id.to_string change_id));
145
+
let* tree = find_tree t [ "approve"; Change_id.to_string change_id ] in
146
+
match tree with
147
+
| None -> Lwt.return []
148
+
| Some tree ->
149
+
let* children = Tree.list tree [] in
150
+
Lwt.all
151
+
(List.map children ~f:(fun (_, tree) ->
152
+
let* subtree = Tree.list tree [] in
153
+
Lwt.all
154
+
(List.map subtree ~f:(fun (_, tree) ->
155
+
Tree.get tree [] >|= Entry.approve_exn))))
156
+
>|= List.concat)
157
+
(fun exn ->
158
+
Log.err (fun m ->
159
+
m
160
+
"failed to fetch approvals for %s: %s"
161
+
(Change_id.to_string change_id)
162
+
(Exn.to_string exn));
163
+
Lwt.return [])
117
164
;;
118
165
119
-
let is_approved_by t change_id user_id ~commit_id =
166
+
let is_approved_by t change_id user_id commit_id =
120
167
let open Lwt.Syntax in
121
168
let* all_approvals = approvals t change_id in
122
169
Lwt.return
123
170
(List.exists all_approvals ~f:(fun (a : Approval.t) ->
124
-
User_id.equal a.user_id user_id
125
-
&& String.equal (Operation_id.to_string a.operation_id) commit_id))
171
+
User_id.equal a.user_id user_id && Commit_id.equal a.commit_id commit_id))
126
172
;;
+3
-3
lib/backend/store.mli
+3
-3
lib/backend/store.mli
···
11
11
type t =
12
12
{ change_id : Change_id.t
13
13
; user_id : User_id.t
14
-
; operation_id : Operation_id.t
14
+
; commit_id : Commit_id.t
15
15
}
16
16
end
17
17
···
33
33
val v : Repo.t -> t Lwt.t
34
34
val request : t -> Change_id.t -> User_id.t -> unit Lwt.t
35
35
val pending_requests : t -> Change_id.t -> Request.t list Lwt.t
36
-
val approve : t -> Change_id.t -> User_id.t -> Operation_id.t -> unit Lwt.t
36
+
val approve : t -> Change_id.t -> User_id.t -> Commit_id.t -> unit Lwt.t
37
37
val approvals : t -> Change_id.t -> Approval.t list Lwt.t
38
-
val is_approved_by : t -> Change_id.t -> User_id.t -> commit_id:string -> bool Lwt.t
38
+
val is_approved_by : t -> Change_id.t -> User_id.t -> Commit_id.t -> bool Lwt.t
+4
lib/tui/dune
+4
lib/tui/dune
+3
-10
lib/tui/import.ml
+3
-10
lib/tui/import.ml
···
1
1
module Catppuccin = Bonsai_tui_catppuccin
2
+
module Change_id = Lens_backend.Change_id
3
+
module Commit_id = Lens_backend.Commit_id
4
+
module User_id = Lens_backend.User_id
2
5
include Bonsai.Let_syntax
3
-
4
-
let unique_prefix_length elem elems ~f =
5
-
let open Core in
6
-
List.fold elems ~init:1 ~f:(fun needed other_elem ->
7
-
if phys_equal elem other_elem
8
-
then needed
9
-
else (
10
-
let common_prefix = String.common_prefix2_length (f elem) (f other_elem) in
11
-
Int.max needed (common_prefix + 1)))
12
-
;;
+53
-26
lib/tui/jj.ml
+53
-26
lib/tui/jj.ml
···
1
1
open! Core
2
+
open! Import
3
+
4
+
let src = Logs.Src.create "lens.jj" ~doc:"jj subprocess calls"
5
+
6
+
module Log = (val Logs.src_log src : Logs.LOG)
7
+
8
+
let run_jj args =
9
+
let open Lwt.Syntax in
10
+
let cmd_str = String.concat ~sep:" " args in
11
+
Log.debug (fun m -> m "running: jj %s" cmd_str);
12
+
let cmd = "", Array.of_list ("jj" :: args) in
13
+
let process = Lwt_process.open_process_full cmd in
14
+
let* () = Lwt_io.close process#stdin in
15
+
let stdout_p = Lwt_io.read process#stdout in
16
+
let stderr_p = Lwt_io.read process#stderr in
17
+
let* stdout, stderr = Lwt.both stdout_p stderr_p in
18
+
let* status = process#close in
19
+
(match status with
20
+
| WEXITED 0 -> ()
21
+
| WEXITED code ->
22
+
Log.err (fun m -> m "%s exited with code %d: %s" cmd_str code (String.strip stderr))
23
+
| WSIGNALED signal -> Log.err (fun m -> m "%s killed by signal %d" cmd_str signal)
24
+
| WSTOPPED signal -> Log.err (fun m -> m "%s stopped by signal %d" cmd_str signal));
25
+
Lwt.return stdout
26
+
;;
2
27
3
28
module Change = struct
4
29
type t =
5
-
{ change_id : string
6
-
; commit_id : string
30
+
{ change_id : Change_id.t
31
+
; commit_id : Commit_id.t
7
32
; description : string
8
33
; author_email : string
9
34
; timestamp : string
···
13
38
; divergent : bool
14
39
; immutable : bool
15
40
; bookmarks : string
16
-
; parents : string list
41
+
; parents : Change_id.t list
17
42
}
18
43
[@@deriving equal, fields ~getters]
19
44
20
-
let unique_prefix_length elem elems ~f =
45
+
let unique_prefix_length
46
+
(type a)
47
+
(module Id : Stringable.S with type t = a)
48
+
(elem : 'elem)
49
+
elems
50
+
~(f : 'elem -> a)
51
+
=
21
52
List.fold elems ~init:1 ~f:(fun needed other_elem ->
22
53
if phys_equal elem other_elem
23
54
then needed
24
55
else (
25
-
let common_prefix = String.common_prefix2_length (f elem) (f other_elem) in
56
+
let common_prefix =
57
+
String.common_prefix2_length
58
+
(f elem |> Id.to_string)
59
+
(f other_elem |> Id.to_string)
60
+
in
26
61
Int.max needed (common_prefix + 1)))
27
62
;;
28
63
end
···
54
89
parents_str
55
90
|> String.split ~on:','
56
91
|> List.filter ~f:(fun s -> not (String.is_empty s))
92
+
|> List.map ~f:Change_id.of_string
57
93
in
58
94
Some
59
-
{ change_id
60
-
; commit_id
95
+
{ change_id = Change_id.of_string change_id
96
+
; commit_id = Commit_id.of_string commit_id
61
97
; description
62
98
; author_email
63
99
; timestamp
···
137
173
138
174
let fetch_log () =
139
175
let open Lwt.Infix in
140
-
Lwt_process.pread
141
-
~stderr:`Dev_null
142
-
("", [| "jj"; "log"; "--no-graph"; "-r"; "all()"; "-T"; log_template |])
143
-
>|= parse_log
176
+
run_jj [ "log"; "--no-graph"; "-r"; "all()"; "-T"; log_template ] >|= parse_log
144
177
;;
145
178
146
-
let fetch_diff_stat ~change_id =
179
+
let fetch_diff_stat change_id =
147
180
let open Lwt.Infix in
148
-
Lwt_process.pread
149
-
~stderr:`Dev_null
150
-
("", [| "jj"; "log"; "--no-graph"; "-r"; change_id; "-T"; diff_stat_template |])
181
+
run_jj
182
+
[ "log"; "--no-graph"; "-r"; Change_id.to_string change_id; "-T"; diff_stat_template ]
151
183
>|= parse_diff_stat
152
184
;;
153
185
154
-
let describe ~change_id ~message =
186
+
let describe change_id ~message =
155
187
let open Lwt.Infix in
156
-
Lwt_process.pread
157
-
~stderr:`Dev_null
158
-
("", [| "jj"; "describe"; "-m"; message; "-r"; change_id |])
188
+
run_jj [ "describe"; "-m"; message; "-r"; Change_id.to_string change_id ]
159
189
>|= fun _ -> ()
160
190
;;
161
191
162
192
let new_change () =
163
193
let open Lwt.Infix in
164
-
Lwt_process.pread ~stderr:`Dev_null ("", [| "jj"; "new" |]) >|= fun _ -> ()
194
+
run_jj [ "new" ] >|= fun _ -> ()
165
195
;;
166
196
167
197
let get_user_email () =
168
198
let open Lwt.Infix in
169
-
Lwt_process.pread ~stderr:`Dev_null ("", [| "jj"; "config"; "get"; "user.email" |])
170
-
>|= String.strip
199
+
run_jj [ "config"; "get"; "user.email" ] >|= String.strip
171
200
;;
172
201
173
-
let fetch_file_diff ~change_id ~path =
174
-
Lwt_process.pread
175
-
~stderr:`Dev_null
176
-
("", [| "jj"; "diff"; "-r"; change_id; path; "--git" |])
202
+
let fetch_file_diff change_id ~path =
203
+
run_jj [ "diff"; "-r"; Change_id.to_string change_id; path; "--git" ]
177
204
;;
+13
-7
lib/tui/jj.mli
+13
-7
lib/tui/jj.mli
···
1
1
open! Core
2
+
open! Import
2
3
3
4
module Change : sig
4
5
type t =
5
-
{ change_id : string
6
-
; commit_id : string
6
+
{ change_id : Change_id.t
7
+
; commit_id : Commit_id.t
7
8
; description : string
8
9
; author_email : string
9
10
; timestamp : string
···
13
14
; divergent : bool
14
15
; immutable : bool
15
16
; bookmarks : string
16
-
; parents : string list
17
+
; parents : Change_id.t list
17
18
}
18
19
[@@deriving equal, fields ~getters]
19
20
20
-
val unique_prefix_length : t -> t list -> f:(t -> string) -> int
21
+
val unique_prefix_length
22
+
: (module Stringable.S with type t = 'a)
23
+
-> t
24
+
-> t list
25
+
-> f:(t -> 'a)
26
+
-> int
21
27
end
22
28
23
29
(** Parse structured output from [jj log --template ...] into a list of changes. *)
···
52
58
val fetch_log : unit -> Change.t list Lwt.t
53
59
54
60
(** Fetch diff stats for a specific change via Lwt subprocess. *)
55
-
val fetch_diff_stat : change_id:string -> Diff_stat.t Lwt.t
61
+
val fetch_diff_stat : Change_id.t -> Diff_stat.t Lwt.t
56
62
57
63
(** Update the description of a change. Returns the updated change list. *)
58
-
val describe : change_id:string -> message:string -> unit Lwt.t
64
+
val describe : Change_id.t -> message:string -> unit Lwt.t
59
65
60
66
(** Create a new change on the working copy. *)
61
67
val new_change : unit -> unit Lwt.t
···
64
70
val get_user_email : unit -> string Lwt.t
65
71
66
72
(** Fetch a unified diff for a specific file in a change. *)
67
-
val fetch_file_diff : change_id:string -> path:string -> string Lwt.t
73
+
val fetch_file_diff : Change_id.t -> path:string -> string Lwt.t
+75
-32
lib/tui/lens_tui.ml
+75
-32
lib/tui/lens_tui.ml
···
3
3
open! Import
4
4
open Bonsai.Let_syntax
5
5
6
+
let setup_logging () =
7
+
let cache_dir =
8
+
match Sys.getenv "XDG_CACHE_HOME" with
9
+
| Some dir -> dir
10
+
| None -> Filename.concat (Sys_unix.home_directory ()) ".cache"
11
+
in
12
+
let log_dir = Filename.concat cache_dir "lens" in
13
+
let rec ensure_dir path =
14
+
match Core_unix.stat path with
15
+
| (_ : Core_unix.stats) -> ()
16
+
| exception Core_unix.Unix_error (ENOENT, _, _) ->
17
+
ensure_dir (Filename.dirname path);
18
+
(try Core_unix.mkdir path ~perm:0o755 with
19
+
| Core_unix.Unix_error (EEXIST, _, _) -> ())
20
+
in
21
+
ensure_dir log_dir;
22
+
let log_file = Filename.concat log_dir "lens.log" in
23
+
let oc = Out_channel.create ~append:true log_file in
24
+
let fmt = Format.formatter_of_out_channel oc in
25
+
let pp_header ppf (level, src) =
26
+
let t = Core_unix.gettimeofday () in
27
+
let tm = Core_unix.localtime t in
28
+
let src_str = Option.value src ~default:"app" in
29
+
Format.fprintf
30
+
ppf
31
+
"%04d-%02d-%02d %02d:%02d:%02d [%a][%s] "
32
+
(tm.tm_year + 1900)
33
+
(tm.tm_mon + 1)
34
+
tm.tm_mday
35
+
tm.tm_hour
36
+
tm.tm_min
37
+
tm.tm_sec
38
+
Logs.pp_level
39
+
level
40
+
src_str
41
+
in
42
+
Logs.set_reporter (Logs_fmt.reporter ~pp_header ~dst:fmt ());
43
+
Logs.set_level (Some Logs.Debug)
44
+
;;
45
+
6
46
module Route = struct
7
47
type t =
8
48
| Log
9
49
| Code_review of
10
-
{ change_id : string
11
-
; commit_id : string
50
+
{ change_id : Change_id.t
51
+
; commit_id : Commit_id.t
12
52
}
13
53
[@@deriving equal, sexp_of]
14
54
end
15
55
16
-
let app ~store =
56
+
let app ~store ~user_id =
17
57
Staged.stage
18
58
@@ fun ~exit ~(dimensions : Dimensions.t Bonsai.t) (graph @ local) ->
19
59
let flavor = Bonsai.return Catppuccin.Flavor.Mocha in
20
60
Catppuccin.set_flavor_within_app
21
61
flavor
22
62
(fun (graph @ local) ->
23
-
let route, set_route = Bonsai.state (Route.Log : Route.t) graph in
63
+
let route, set_route = Bonsai.state (Log : Route.t) graph in
24
64
(* Review progress survives route changes *)
25
65
let reviewed_files_map, set_reviewed_files_map =
26
66
Bonsai.state String.Map.empty graph
···
35
75
let%bind should_review =
36
76
Effect.of_lwt_thunk (fun () ->
37
77
let open Lwt.Syntax in
38
-
let* user_email = Jj.get_user_email () in
39
-
let change_id_t = Lens_backend.Change_id.of_string change.change_id in
40
-
let user_id_t = Lens_backend.User_id.of_string user_email in
41
-
let* reqs = Lens_backend.Store.pending_requests store change_id_t in
78
+
let* reqs =
79
+
Lens_backend.Store.pending_requests store change.change_id
80
+
in
42
81
let is_reviewer =
43
82
List.exists reqs ~f:(fun (r : Lens_backend.Store.Request.t) ->
44
-
Lens_backend.User_id.equal r.user_id user_id_t)
83
+
Lens_backend.User_id.equal r.user_id user_id)
45
84
in
46
85
if is_reviewer
47
86
then
48
-
let* already_approved =
87
+
let+ already_approved =
49
88
Lens_backend.Store.is_approved_by
50
89
store
51
-
change_id_t
52
-
user_id_t
53
-
~commit_id:change.commit_id
90
+
change.change_id
91
+
user_id
92
+
change.commit_id
54
93
in
55
-
if already_approved then Lwt.return false else Lwt.return true
94
+
not already_approved
56
95
else Lwt.return false)
57
96
in
58
97
if should_review
59
98
then
60
99
set_route
61
-
(Route.Code_review
100
+
(Code_review
62
101
{ change_id = change.change_id; commit_id = change.commit_id })
63
102
else Effect.Ignore
64
103
in
···
70
109
| Code_review { change_id; commit_id } ->
71
110
let reviewed_files =
72
111
let%arr reviewed_files_map and change_id and commit_id in
73
-
let key = change_id ^ ":" ^ commit_id in
112
+
let key = [%string "%{change_id#Change_id}:%{commit_id#Commit_id}"] in
74
113
Map.find reviewed_files_map key |> Option.value ~default:String.Set.empty
75
114
in
76
115
let set_reviewed_files =
···
79
118
and change_id
80
119
and commit_id in
81
120
fun new_set ->
82
-
let key = change_id ^ ":" ^ commit_id in
121
+
let key = [%string "%{change_id#Change_id}:%{commit_id#Commit_id}"] in
83
122
set_reviewed_files_map (Map.set reviewed_files_map ~key ~data:new_set)
84
123
in
85
124
let on_exit =
86
125
let%arr set_route in
87
-
set_route Route.Log
126
+
set_route Log
88
127
in
89
128
let on_approve =
90
129
let%arr set_route and change_id and commit_id in
91
130
let open Effect.Let_syntax in
92
131
let%bind () =
93
132
Effect.of_lwt_thunk (fun () ->
94
-
let open Lwt.Syntax in
95
-
let* user_email = Jj.get_user_email () in
96
-
Lens_backend.Store.approve
97
-
store
98
-
(Lens_backend.Change_id.of_string change_id)
99
-
(Lens_backend.User_id.of_string user_email)
100
-
(Lens_backend.Operation_id.of_string commit_id))
133
+
Lens_backend.Store.approve store change_id user_id commit_id)
101
134
in
102
-
set_route Route.Log
135
+
set_route Log
103
136
in
104
137
let ~view, ~handler =
105
138
Code_review_view.component
106
139
~dimensions
107
140
~change_id
108
-
~commit_id
109
141
~on_exit
110
142
~on_approve
111
143
~reviewed_files
···
120
152
;;
121
153
122
154
let main () =
123
-
let open Lwt.Syntax in
124
-
let config = Irmin_git.config ~bare:false "." in
125
-
let* repo = Lens_backend.Store.Repo.v config in
126
-
let* store = Lens_backend.Store.v repo in
127
-
Bonsai_term.start_with_exit (app ~store |> Staged.unstage)
155
+
setup_logging ();
156
+
Printexc.record_backtrace true;
157
+
Logs.info (fun m -> m "starting lens");
158
+
Lwt.catch
159
+
(fun () ->
160
+
let open Lwt.Syntax in
161
+
let open Lwt.Infix in
162
+
let config = Irmin_git.config ~bare:false "." in
163
+
let* repo = Lens_backend.Store.Repo.v config in
164
+
let* store = Lens_backend.Store.v repo in
165
+
let* user_id = Jj.get_user_email () >|= Lens_backend.User_id.of_string in
166
+
Bonsai_term.start_with_exit (app ~store ~user_id |> Staged.unstage))
167
+
(fun exn ->
168
+
let bt = Printexc.get_backtrace () in
169
+
Logs.err (fun m -> m "fatal: %s\n%s" (Exn.to_string exn) bt);
170
+
Lwt.return (Error (Error.of_string (Exn.to_string exn))))
128
171
;;