stitch
Note taking for messy minimalists
git clone git://mccd.space/stitch| Log | Files | Refs | README | LICENSE | Mail |
grep.ml (8309B)
1 let execution_directory =
2 Sys.getenv_opt "STITCH_DIRECTORY" |> Option.value ~default:"/anywhere"
3
4
5 let grep_cmd = Sys.getenv_opt "STITCH_GREP_CMD" |> Option.value ~default:"grep"
6
7 let tag_pattern =
8 Sys.getenv_opt "STITCH_TAG_PATTERN" |> Option.value ~default:"\\:[a-z-]+\\:"
9
10
11 let headline_pattern_regexp =
12 Sys.getenv_opt "STITCH_HEADLINE_PATTERN_REGEXP" |> Option.value ~default:"^\\* "
13
14
15 let headline_pattern =
16 Sys.getenv_opt "STITCH_HEADLINE_PATTERN" |> Option.value ~default:"* "
17
18
19 let todo_pattern = Sys.getenv_opt "STITCH_TODO" |> Option.value ~default:"* TODO"
20
21 let todo_pattern_regexp =
22 Sys.getenv_opt "STITCH_TODO_REGEXP" |> Option.value ~default:"\\* TODO"
23
24
25 let done_pattern = Sys.getenv_opt "STITCH_DONE" |> Option.value ~default:"* DONE"
26
27 let done_pattern_regexp =
28 Sys.getenv_opt "STITCH_DONE_REGEXP" |> Option.value ~default:"\\* DONE"
29
30
31 (* Utils *)
32
33 let run_calls calls =
34 let open Shexp_process in
35 let open Shexp_process.Infix in
36 eval (chdir execution_directory (calls |- read_all))
37
38
39 let get_padding_arr arr =
40 Array.fold_left (fun n (file_name, _) -> Int.max n (String.length file_name)) 0 arr
41
42
43 let get_padding_list list =
44 List.fold_left (fun n (file_name, _) -> Int.max n (String.length file_name)) 0 list
45
46
47 let pad str n =
48 let padding = n - String.length str in
49 String.concat "" [ str; String.make padding ' ' ]
50
51
52 exception Not_A_Tuple of string * string
53
54 (* todo parsing *)
55 let done_get_args = [ grep_cmd; done_pattern_regexp; "-H"; "-r"; "-n"; "--no-messages" ]
56
57 let get_done () =
58 let open Shexp_process in
59 let open Shexp_process.Infix in
60 try run_calls (call done_get_args |- call [ "sort"; "-n"; "-r" ]) with
61 | _ -> ""
62
63
64 let todo_get_args = [ grep_cmd; todo_pattern_regexp; "-H"; "-r"; "-n"; "--no-messages" ]
65
66 let get_todos () =
67 let open Shexp_process in
68 let open Shexp_process.Infix in
69 try run_calls (call todo_get_args |- call [ "sort"; "-n"; "-r" ]) with
70 | _ -> ""
71
72
73 let parse_todo_files files =
74 List.concat
75 @@ List.mapi
76 (fun file_number ((file_name : string), content) ->
77 let content = String.split_on_char '\n' content in
78 List.mapi
79 (fun line_number line -> file_name, line_number, line, file_number)
80 content)
81 files
82
83
84 let parse_todo_string s =
85 String.split_on_char '\n' s
86 |> List.filter_map (fun message ->
87 if String.equal message ""
88 then None
89 else (
90 let split = Str.bounded_split (Str.regexp ":[0-9]+:") message 2 in
91 match split with
92 (* file, line, content *)
93 | [ file_name; content ] -> Some (file_name, content)
94 | _ -> raise (Not_A_Tuple (String.concat " SPLIT " split, message))))
95
96
97 let pretty_format_todo ~hide_file_name parsed_headlines =
98 let padding = get_padding_list parsed_headlines in
99 List.map
100 (fun (file_name, content) ->
101 if not hide_file_name
102 then String.concat " " [ pad file_name padding; content ]
103 else content)
104 parsed_headlines
105
106
107 let get_tagged_done tag () =
108 let open Shexp_process in
109 let open Shexp_process.Infix in
110 try
111 eval
112 (chdir
113 execution_directory
114 (call done_get_args
115 |- call [ grep_cmd; "--no-messages"; "-E"; tag ]
116 |- call [ "sort"; "-n"; "-r" ]
117 |- read_all))
118 with
119 | _ -> ""
120
121
122 let get_tagged_todo tag () =
123 let open Shexp_process in
124 let open Shexp_process.Infix in
125 try
126 eval
127 (chdir
128 execution_directory
129 (call todo_get_args
130 |- call [ grep_cmd; "--no-messages"; "-E"; tag ]
131 |- call [ "sort"; "-n"; "-r" ]
132 |- read_all))
133 with
134 | _ -> ""
135
136
137 let toggle_done file_name =
138 let open Shexp_process in
139 run_calls
140 (call
141 [ "sed"; "-i"; "s/" ^ todo_pattern_regexp ^ "/" ^ done_pattern ^ "/g"; file_name ])
142
143
144 let toggle_todo file_name =
145 let open Shexp_process in
146 run_calls
147 (call
148 [ "sed"; "-i"; "s/" ^ done_pattern_regexp ^ "/" ^ todo_pattern ^ "/g"; file_name ])
149
150
151 (* Headline parsing *)
152 let headline_pattern_length = String.length headline_pattern
153
154 let find_sort_modification () =
155 let open Shexp_process in
156 let open Shexp_process.Infix in
157 call [ "find"; "."; "-printf"; "%Ts/%f\\n" ]
158 |- call [ "sort"; "-n" ]
159 |- call [ "cut"; "-c12-" ]
160
161
162 let find_sort_name () =
163 let open Shexp_process in
164 call [ "ls" ]
165
166
167 let run_print ~dir args =
168 let open Shexp_process in
169 let open Shexp_process.Infix in
170 eval (chdir dir (call args |- read_all))
171
172
173 let filter_todos_args = [ grep_cmd; todo_pattern_regexp; "--no-messages"; "-v" ]
174 let filter_done_args = [ grep_cmd; done_pattern_regexp; "--no-messages"; "-v" ]
175
176 let headline_args =
177 [ "xargs"; grep_cmd; headline_pattern_regexp; "-H"; "-r"; "-n"; "--no-messages" ]
178
179
180 let get_headlines () =
181 let open Shexp_process in
182 let open Shexp_process.Infix in
183 try
184 eval
185 (chdir
186 execution_directory
187 (find_sort_name ()
188 |- call headline_args
189 |- call filter_todos_args
190 |- call filter_done_args
191 |- call [ "sort"; "-n"; "-r" ]
192 |- read_all))
193 with
194 | _ -> ""
195
196
197 let get_tagged_headlines tag () =
198 let open Shexp_process in
199 let open Shexp_process.Infix in
200 let cmd () =
201 eval
202 (chdir
203 execution_directory
204 (find_sort_name ()
205 |- call headline_args
206 |- call [ grep_cmd; "--no-messages"; "-E"; tag ]
207 |- call filter_todos_args
208 |- call filter_done_args
209 |- call [ "sort"; "-n"; "-r" ]
210 |- read_all))
211 |> Option.some
212 in
213 try cmd () with
214 | _ -> None
215
216
217 let get_tags () =
218 let open Shexp_process in
219 let open Shexp_process.Infix in
220 eval
221 (chdir
222 execution_directory
223 (call headline_args |- call [ grep_cmd; "-E"; tag_pattern; "-o" ] |- read_all))
224
225
226 (** Returns a tuple of file name and Content *)
227 let parse_headlines s =
228 String.split_on_char '\n' s
229 (* Testing in utop it seems like there is maybe a bug with bounded_split, 1 doesn't work for ':'. Therefore using a slower implementation. *)
230 |> List.filter_map (fun message ->
231 if String.equal message ""
232 then None
233 else (
234 let split = Str.bounded_split (Str.regexp ":[0-9]+:") message 2 in
235 match split with
236 (* file, line, content *)
237 | [ file_name; content ] -> Some (file_name, content)
238 | _ -> None))
239 |> Array.of_list
240
241
242 (** Turns "2024-03-05.org:* Hello world" into "2024-03-05 | * Hello world" *)
243 let pretty_format ~hide_file_name parsed_headlines =
244 let padding = get_padding_arr parsed_headlines in
245 Array.map
246 (fun (file_name, content) ->
247 if not hide_file_name
248 then String.concat " " [ pad file_name padding; content ]
249 else content)
250 parsed_headlines
251
252
253 (** Full body parsing *)
254
255 let read_whole_file filename =
256 (* open_in_bin works correctly on Unix and Windows *)
257 try
258 let ch = open_in_bin filename in
259 let s = really_input_string ch (in_channel_length ch) in
260 close_in ch;
261 s
262 with
263 | _ -> ""
264
265
266 let get_full_file_content_content file =
267 file, read_whole_file (execution_directory ^ "/" ^ file)
268
269
270 let parse_full_content files =
271 List.concat
272 @@ List.mapi
273 (fun file_number ((file_name : string), content) ->
274 let content = String.split_on_char '\n' content in
275 List.mapi
276 (fun line_number line -> file_name, line_number, line, file_number)
277 content)
278 files
279
280
281 let get_file_names tag =
282 try
283 let cmd =
284 let open Shexp_process in
285 let open Shexp_process.Infix in
286 find_sort_name ()
287 |- call [ "xargs"; grep_cmd; "-H"; "-l"; "-E"; tag ]
288 |- call [ "sort"; "-n"; "-r" ]
289 |- read_all
290 in
291 Shexp_process.eval (Shexp_process.chdir execution_directory cmd)
292 |> String.split_on_char '\n'
293 |> List.filter (fun s -> not (String.equal "" s))
294 with
295 | _ -> []
296
297
298 type display_type =
299 | Bold of string
300 | Normal of string
301
302 let display_type_line = function
303 | Bold s -> s
304 | Normal s -> s
305
306
307 let pretty_print_parsed_content parsed_files =
308 let padding = String.make headline_pattern_length ' ' in
309 List.concat_map
310 (fun (file_name, line_number, line_content, file_number) ->
311 if line_number == 0
312 then
313 [ file_number, Normal ("--------- " ^ file_name); file_number, Bold line_content ]
314 else [ file_number, Normal (padding ^ line_content) ])
315 parsed_files