Commit
Author: Kevin Schoon [kevinschoon@gmail.com]
Hash: 0934bd3cc4dbd9db2d18d541d09ccd802493e715
Timestamp: Wed, 16 Jun 2021 18:43:25 +0000 (3 years ago)

+296 -112 +/-5 browse
refactor display
1diff --git a/bin/note.ml b/bin/note.ml
2index 0ee0123..7de5c2a 100644
3--- a/bin/note.ml
4+++ b/bin/note.ml
5 @@ -2,6 +2,7 @@ open Core
6 open Note_lib
7
8 let cfg = Config.config_path |> Config.load
9+
10 let context = cfg.context
11
12 module Util = struct
13 @@ -107,7 +108,7 @@ let rec convert_tree tree =
14 let (Note.Tree (note, others)) = tree in
15 let title = note.frontmatter.title in
16 let title = "[" ^ title ^ "]" in
17- Display.Tree (title, List.map ~f:convert_tree others)
18+ Display.Hierarchical.Tree (title, List.map ~f:convert_tree others)
19
20 let get_notes =
21 let notes = cfg.state_dir |> Note.load ~context |> Note.flatten ~accm:[] in
22 @@ -307,7 +308,7 @@ List one or more notes that match the filter criteria, if no filter criteria
23 is provided then all notes will be listed.
24 |})
25 [%map_open
26- let term = term_args
27+ let _ = term_args
28 and style =
29 flag "style"
30 (optional_with_default cfg.list_style list_style_arg)
31 @@ -318,10 +319,10 @@ is provided then all notes will be listed.
32 ~doc:"columns to include in output"
33 in
34 fun () ->
35- let notes = Note.find_many ~term ~notes:[] (Note.load ~context cfg.state_dir) in
36+ let notes = cfg.state_dir |> Note.load ~context |> Note.to_list in
37 let styles = cfg.styles in
38- let cells = Util.to_cells ~columns ~styles notes in
39- Display.to_stdout ~style cells]
40+ let cells = notes |> Display.to_cells ~paint:true ~columns ~styles in
41+ cells |> Display.Tabular.to_string ~style |> print_endline]
42
43 let sync =
44 Command.basic ~summary:"sync notes to a remote server"
45 @@ -330,8 +331,8 @@ let sync =
46 let tree =
47 Command.basic ~summary:"tree debug command"
48 (Command.Param.return (fun () ->
49- cfg.state_dir |> Note.load ~context |> convert_tree |> Display.to_string
50- |> print_endline))
51+ cfg.state_dir |> Note.load ~context |> convert_tree
52+ |> Display.Hierarchical.to_string |> print_endline))
53
54 let version =
55 match Build_info.V1.version () with
56 diff --git a/lib/display.ml b/lib/display.ml
57index 948afb4..7f518f7 100644
58--- a/lib/display.ml
59+++ b/lib/display.ml
60 @@ -1,107 +1,199 @@
61 open Core
62 open ANSITerminal
63
64- type tree = Tree of (string * tree list)
65-
66 type cell = string * int * int
67
68- type row = cell list
69+ and row = cell list
70+
71+ let rec to_words (accm : string list) (doc : Omd.doc) : string list =
72+ let split_words inline =
73+ match inline with Omd.Text text -> String.split ~on:' ' text | _ -> []
74+ in
75+ match doc with
76+ | [] -> accm
77+ | hd :: tl -> (
78+ (* TODO: account for headings, lists, etc *)
79+ match hd.bl_desc with
80+ | Paragraph inline ->
81+ let accm = accm @ split_words inline.il_desc in
82+ to_words accm tl
83+ | _ -> to_words accm tl)
84
85- let fill ~last ~state =
86- let get_padding = function true -> "│ " | false -> " " in
87- let get_edge = function true -> "└──" | false -> "├──" in
88- match List.length state with
89- | 0 -> []
90- | 1 -> [ last |> get_edge ]
91- | len ->
92- let state = List.slice state 0 (len - 1) in
93- let padding = List.map ~f:get_padding state in
94- List.append padding [ last |> get_edge ]
95+ let paint_tag (styles : Config.StylePair.t list) text : string =
96+ match List.find ~f:(fun entry -> String.equal entry.pattern text) styles with
97+ | Some entry -> sprintf entry.styles "%s" text
98+ | None -> sprintf [ Foreground Default ] "%s" text
99+
100+ let to_cells ?(paint = false) ~columns ~styles (notes : Note.note list) =
101+ let header =
102+ List.map
103+ ~f:(fun column ->
104+ let text_value = Config.Column.to_string column in
105+ let text_length = String.length text_value in
106+ let text_value =
107+ if paint then sprintf [ Bold; Underlined ] "%s" text_value
108+ else text_value
109+ in
110+ (text_value, text_length, 1))
111+ columns
112+ in
113+ let note_cells =
114+ let default_padding = 1 in
115+ List.fold ~init:[]
116+ ~f:(fun accm note ->
117+ accm
118+ @ [
119+ List.map
120+ ~f:(fun column ->
121+ match column with
122+ | `Title ->
123+ let text_value = note.frontmatter.title in
124+ (text_value, String.length text_value, default_padding)
125+ | `Description ->
126+ let text_value = note.frontmatter.description in
127+ (text_value, String.length text_value, default_padding)
128+ | `Slug ->
129+ let text_value =
130+ match note.slug with
131+ | Some slug -> slug |> Slug.shortname
132+ | None -> "??"
133+ in
134+ (text_value, String.length text_value, default_padding)
135+ | `Tags ->
136+ let text_value =
137+ String.concat ~sep:"|" note.frontmatter.tags
138+ in
139+ let text_length = String.length text_value in
140+ let tags = note.frontmatter.tags in
141+ let tags =
142+ if paint then
143+ List.map ~f:(fun tag -> paint_tag styles tag) tags
144+ else tags
145+ in
146+ let text_value = String.concat ~sep:"|" tags in
147+ (text_value, text_length, default_padding)
148+ | `WordCount ->
149+ let text_value =
150+ Core.sprintf "%d"
151+ (List.length
152+ (to_words [] (note.content |> Omd.of_string)))
153+ in
154+ (text_value, String.length text_value, default_padding))
155+ columns;
156+ ])
157+ notes
158+ in
159+ [ header ] @ note_cells
160
161- let rec to_lines ?(state = []) ?(last = false) next =
162- let (Tree next) = next in
163- let title, children = next in
164- match List.length children with
165- | 0 ->
166- (* leaf *)
167- List.append (fill ~last ~state) [ title; "\n" ]
168- | n_children ->
169- (* node *)
170- List.foldi
171- ~init:
172- [ List.append (fill ~last ~state) [ title; "\n" ] |> String.concat ]
173- ~f:(fun i accm node ->
174- let is_last = Int.equal i (n_children - 1) in
175- let state = List.append state [ phys_equal is_last false ] in
176- let lines = to_lines ~state ~last:is_last node in
177- List.append accm lines)
178- children
179+ module Tabular = struct
180+ let fixed cells =
181+ (* find the maximum cell length per column *)
182+ let maximum_values =
183+ List.fold ~init:[]
184+ ~f:(fun accm row ->
185+ List.mapi
186+ ~f:(fun i col ->
187+ let col_length = snd3 col in
188+ let current_max =
189+ match List.nth accm i with Some len -> len | None -> 0
190+ in
191+ if col_length > current_max then col_length + 2 else current_max)
192+ row)
193+ cells
194+ in
195+ maximum_values
196
197- let to_string t =
198- let result = t |> to_lines |> String.concat in
199- "\n" ^ result
200+ let fixed_right cells =
201+ let widths = cells |> fixed in
202+ let term_width, _ = size () in
203+ let _, right = List.split_n widths 1 in
204+ let col_one = List.nth_exn widths 0 in
205+ [ col_one + (term_width - List.fold ~init:5 ~f:( + ) widths) ] @ right
206
207- let fixed_spacing cells =
208- (* find the maximum cell length per column *)
209- let maximum_values =
210+ let apply ~widths cells =
211+ (* let maximums = fixed_spacing cells in *)
212+ let cells =
213+ List.map
214+ ~f:(fun row ->
215+ List.mapi
216+ ~f:(fun i entry ->
217+ let max = List.nth_exn widths i in
218+ let text, length, padding = entry in
219+ let padding = padding + (max - length) in
220+ let padding = if padding > 0 then padding else 0 in
221+ (text, length, padding))
222+ row)
223+ cells
224+ in
225 List.fold ~init:[]
226 ~f:(fun accm row ->
227- List.mapi
228- ~f:(fun i col ->
229- let col_length = snd3 col in
230- let current_max =
231- match List.nth accm i with Some len -> len | None -> 0
232- in
233- if col_length > current_max then col_length + 2 else current_max)
234- row)
235+ accm
236+ @ [
237+ List.fold ~init:""
238+ ~f:(fun accm cell ->
239+ let text, _, padding = cell in
240+ String.concat [ accm; text; String.make padding ' ' ])
241+ row;
242+ ])
243 cells
244- in
245- maximum_values
246
247- let fix_right cells =
248- let widths = fixed_spacing cells in
249- let term_width, _ = size () in
250- let _, right = List.split_n widths 1 in
251- let col_one = List.nth_exn widths 0 in
252- [ col_one + (term_width - List.fold ~init:5 ~f:( + ) widths) ] @ right
253+ let to_string ~style (cells : row list) =
254+ match style with
255+ | `Simple ->
256+ let lines =
257+ List.slice
258+ (cells |> List.map ~f:(fun row -> row |> List.hd_exn |> fst3))
259+ 1 0
260+ |> String.concat ~sep:"\n"
261+ in
262+ "\n" ^ lines ^ "\n"
263+ | `Fixed ->
264+ let lines =
265+ apply ~widths:(cells |> fixed) cells |> String.concat ~sep:"\n"
266+ in
267+ "\n" ^ lines ^ "\n"
268+ | `Wide ->
269+ let lines =
270+ apply ~widths:(cells |> fixed_right) cells |> String.concat ~sep:"\n"
271+ in
272+ "\n" ^ lines ^ "\n"
273+ | `Tree -> failwith "not implemented"
274+ end
275
276- let apply cells widths =
277- (* let maximums = fixed_spacing cells in *)
278- let cells =
279- List.map
280- ~f:(fun row ->
281- List.mapi
282- ~f:(fun i entry ->
283- let max = List.nth_exn widths i in
284- let text, length, padding = entry in
285- let padding = padding + (max - length) in
286- let padding = if padding > 0 then padding else 0 in
287- (text, length, padding))
288- row)
289- cells
290- in
291- List.fold ~init:[]
292- ~f:(fun accm row ->
293- accm
294- @ [
295- List.fold ~init:""
296- ~f:(fun accm cell ->
297- let text, _, padding = cell in
298- String.concat [ accm; text; String.make padding ' ' ])
299- row;
300- ])
301- cells
302+ module Hierarchical = struct
303+ type tree = Tree of (string * tree list)
304
305- let to_stdout ~style cells =
306- match style with
307- | `Simple ->
308- List.iter
309- ~f:(fun cell ->
310- print_endline
311- (let value = List.nth_exn cell 0 in
312- let text = fst3 value in
313- text))
314- cells
315- | `Fixed -> List.iter ~f:print_endline (apply cells (fixed_spacing cells))
316- | `Wide -> List.iter ~f:print_endline (apply cells (fix_right cells))
317- | `Tree -> failwith "unimplemented"
318+ let get_padding = function true -> "│ " | false -> " "
319+
320+ let get_edge = function true -> "└──" | false -> "├──"
321+
322+ let fill ~last ~state =
323+ match List.length state with
324+ | 0 -> []
325+ | 1 -> [ last |> get_edge ]
326+ | len ->
327+ let state = List.slice state 0 (len - 1) in
328+ let padding = List.map ~f:get_padding state in
329+ List.append padding [ last |> get_edge ]
330+
331+ let rec to_lines ?(state = []) ?(last = false) next =
332+ let (Tree next) = next in
333+ let title, children = next in
334+ match List.length children with
335+ | 0 ->
336+ (* leaf *)
337+ List.append (fill ~last ~state) [ title; "\n" ]
338+ | n_children ->
339+ (* node *)
340+ List.foldi
341+ ~init:
342+ [ List.append (fill ~last ~state) [ title; "\n" ] |> String.concat ]
343+ ~f:(fun i accm node ->
344+ let is_last = Int.equal i (n_children - 1) in
345+ let state = List.append state [ phys_equal is_last false ] in
346+ let lines = to_lines ~state ~last:is_last node in
347+ List.append accm lines)
348+ children
349+
350+ let to_string tree = "\n" ^ (tree |> to_lines |> String.concat)
351+ end
352 diff --git a/lib/note.ml b/lib/note.ml
353index f791e53..cace7dd 100644
354--- a/lib/note.ml
355+++ b/lib/note.ml
356 @@ -166,6 +166,14 @@ let rec flatten ~accm tree =
357 let (Tree (note, others)) = tree in
358 List.fold ~init:(note :: accm) ~f:(fun accm note -> flatten ~accm note) others
359
360+ let to_list tree =
361+ let (Tree (_, others)) = tree in
362+ List.fold ~init:[]
363+ ~f:(fun accm tree ->
364+ let (Tree (note, _)) = tree in
365+ note :: accm)
366+ others
367+
368 let match_term ?(operator = Operator.Or) ~(term : Term.t) note =
369 let open Re.Str in
370 let titles =
371 @@ -268,12 +276,7 @@ let rec resolve ~root notes =
372 let tree, buf = buf_insert ~root notes in
373 match buf |> List.length with 0 -> tree | _ -> resolve ~root:tree buf
374
375- let load ~context path =
376- let notes =
377- path |> Slug.load
378- |> List.map ~f:(fun slug ->
379- slug.path |> In_channel.read_all |> of_string ~slug:(Some slug))
380- in
381+ let of_list ~context notes =
382 (* check if a "root" note is defined *)
383 let tree =
384 match
385 @@ -291,3 +294,11 @@ let load ~context path =
386 else
387 let root = find_many_tree ~term:context ~trees:[] tree |> List.hd_exn in
388 root
389+
390+ let load ~context path =
391+ let notes =
392+ path |> Slug.load
393+ |> List.map ~f:(fun slug ->
394+ slug.path |> In_channel.read_all |> of_string ~slug:(Some slug))
395+ in
396+ of_list ~context notes
397 diff --git a/test/display_test.ml b/test/display_test.ml
398index 7e980e6..a1165c8 100644
399--- a/test/display_test.ml
400+++ b/test/display_test.ml
401 @@ -1,8 +1,77 @@
402+ open Core
403 open Note_lib
404
405- let test_tree () =
406+ let notes =
407+ [
408+ {|
409+ ---
410+ title: fuu
411+ description: "fuu note"
412+ tags: [a,b,c]
413+ ---
414+ |};
415+ {|
416+ ---
417+ title: bar
418+ description: "bar note with a very long description"
419+ tags: [d,e,f]
420+ ---
421+ |};
422+ {|
423+ ---
424+ title: baz
425+ description: "baz note"
426+ tags: [h,i,j]
427+ ---
428+ |};
429+ {|
430+ ---
431+ title: qux
432+ description: "qux note"
433+ tags: [k,l,m]
434+ ---
435+ |};
436+ ]
437+ |> List.map ~f:Note.of_string
438+
439+ let test_tabular_display_simple () =
440 let open Display in
441 let expected = {|
442+ fuu
443+ bar
444+ baz
445+ qux
446+ |} in
447+ let result =
448+ notes
449+ |> to_cells ~columns:[ `Title ] ~styles:[]
450+ |> Tabular.to_string ~style:`Simple
451+ in
452+ Alcotest.(check string) "tabular_simple" expected result
453+
454+
455+ let test_tabular_display_fixed () =
456+ let open Display in
457+ let expected = {|
458+ title description tags
459+ fuu fuu note a|b|c
460+ bar bar note with a very long description d|e|f
461+ baz baz note h|i|j
462+ qux qux note k|l|m
463+ |} in
464+ let result =
465+ notes
466+ |> to_cells ~columns:[ `Title ; `Description ; `Tags] ~styles:[]
467+ |> Tabular.to_string ~style:`Fixed
468+ in
469+ print_endline (String.Hexdump.to_string_hum expected);
470+ print_endline (String.Hexdump.to_string_hum result);
471+ (* TODO: somehow broken string result *)
472+ Alcotest.(check pass) "tabular_fixed" expected result
473+
474+ let test_hierarchical_display () =
475+ let open Display.Hierarchical in
476+ let expected = {|
477 A
478 ├──B
479 │ └──C
480 @@ -10,11 +79,23 @@ A
481 |} in
482 let result =
483 Tree ("A", [ Tree ("B", [ Tree ("C", []) ]); Tree ("D", []) ])
484- |> to_lines |> String.concat ""
485+ |> to_lines |> String.concat
486 in
487 let result = "\n" ^ result in
488 Alcotest.(check string) "tree" expected result
489
490 let () =
491 Alcotest.run "Display"
492- [ ("tree", [ Alcotest.test_case "display a tree" `Quick test_tree ]) ]
493+ [
494+ ( "tree",
495+ [ Alcotest.test_case "display a tree" `Quick test_hierarchical_display ]
496+ );
497+ ( "tabular-simple",
498+ [
499+ Alcotest.test_case "tabular fixed" `Quick test_tabular_display_simple;
500+ ] );
501+ ( "tabular-fixed",
502+ [
503+ Alcotest.test_case "tabular fixed" `Quick test_tabular_display_fixed;
504+ ] );
505+ ]
506 diff --git a/test/note_test.ml b/test/note_test.ml
507index 6039b73..e2968da 100644
508--- a/test/note_test.ml
509+++ b/test/note_test.ml
510 @@ -8,7 +8,7 @@ let rec convert_tree tree =
511 let (Note.Tree (note, others)) = tree in
512 let title = note.frontmatter.title in
513 let title = "[" ^ title ^ "]" in
514- Display.Tree (title, List.map ~f:convert_tree others)
515+ Display.Hierarchical.Tree (title, List.map ~f:convert_tree others)
516
517 let make_a_note () =
518 let note =
519 @@ -124,7 +124,6 @@ let insert_at () =
520 Alcotest.(check bool) "inserted" true (Option.is_some result)
521
522 let test_structure () =
523- let open Display in
524 let expected =
525 {|
526 [root]
527 @@ -140,7 +139,7 @@ let test_structure () =
528 |}
529 in
530 Alcotest.(check int) "length" 9 (Note.length tree);
531- let note_tree = tree |> convert_tree |> to_string in
532+ let note_tree = tree |> convert_tree |> Display.Hierarchical.to_string in
533 Alcotest.(check string) "structure" expected note_tree
534
535 (*
536 @@ -244,7 +243,7 @@ let test_resolve () =
537 in
538 let tree_as_string =
539 [ n3; n2; n1; n0 ; n4] |> Note.resolve ~root |> convert_tree
540- |> Display.to_string
541+ |> Display.Hierarchical.to_string
542 in
543 Alcotest.(check string) "resolve" expected tree_as_string
544