Commit
Author: Kevin Schoon [kevinschoon@gmail.com]
Hash: 0f5b20ee1b0ce83a47a22b3bc57a123edd5861c2
Timestamp: Wed, 03 Feb 2021 22:35:27 +0000 (3 years ago)

+103 -32 +/-4 browse
implement color mapping
1diff --git a/lib/cmd.ml b/lib/cmd.ml
2index 5dc9ec4..4c52c94 100644
3--- a/lib/cmd.ml
4+++ b/lib/cmd.ml
5 @@ -219,7 +219,8 @@ is provided then all notes will be listed.
6 Note.Filter.find_many ?strategy:filter_kind ~args:filter_args
7 get_notes
8 in
9- to_stdout ~columns ~style notes]
10+ let text_styles = cfg.styles in
11+ to_stdout ~columns ~style ~text_styles notes]
12
13 let sync =
14 Command.basic ~summary:"sync notes to a remote server"
15 diff --git a/lib/config.ml b/lib/config.ml
16index 79cf4b5..2b7ca23 100644
17--- a/lib/config.ml
18+++ b/lib/config.ml
19 @@ -1,5 +1,7 @@
20 open Core
21
22+ let noop a = a
23+
24 let home = Sys.home_directory ()
25
26 let base_xdg_config_path = Filename.concat home ".config"
27 @@ -42,6 +44,70 @@ module Encoding = struct
28 | key -> failwith (sprintf "unsupported encoding type: %s" key)
29 end
30
31+ module StylePair = struct
32+ open ANSITerminal
33+
34+ type t = { pattern : string; styles : style list }
35+
36+ let make pattern styles = { pattern; styles }
37+
38+ let style_of_string = function
39+ (* TODO: uhhh.... *)
40+ | "Foreground Black" | "Black" | "black" -> Foreground Black
41+ | "Foreground Red" | "Red" | "red" -> Foreground Red
42+ | "Foreground Green" | "Green" | "green" -> Foreground Green
43+ | "Foreground Yellow" | "Yellow" | "yellow" -> Foreground Yellow
44+ | "Foreground Blue" | "Blue" | "blue" -> Foreground Blue
45+ | "Foreground Magenta" | "Magenta" | "magenta" -> Foreground Magenta
46+ | "Foreground Cyan" | "Cyan" | "cyan" -> Foreground Cyan
47+ | "Foreground White" | "White" | "white" -> Foreground White
48+ | "Background Black" -> Background Black
49+ | "Background Red" -> Background Red
50+ | "Background Green" -> Background Green
51+ | "Background Yellow" -> Background Yellow
52+ | "Background Blue" -> Background Blue
53+ | "Background Magenta" -> Background Magenta
54+ | "Background Cyan" -> Background Cyan
55+ | "Background White" -> Background White
56+ | "Bold" -> Bold
57+ | "Inverse" -> Inverse
58+ | "Underlined" -> Underlined
59+ | name -> failwith (Core.sprintf "bad color: %s" name)
60+
61+ let style_to_string = function
62+ | Foreground Blue -> "Foreground Blue"
63+ | Foreground Red -> "Foreground Red"
64+ | Underlined -> "Underlined"
65+ | _ -> failwith "no"
66+
67+ let of_json values =
68+ Ezjsonm.get_list
69+ (fun entry ->
70+ let pattern = Ezjsonm.get_string (Ezjsonm.find entry [ "pattern" ])
71+ and styles =
72+ Ezjsonm.get_list
73+ (fun entry ->
74+ let style = Ezjsonm.get_string entry in
75+ style_of_string style)
76+ (Ezjsonm.find entry [ "style" ])
77+ in
78+ make pattern styles)
79+ values
80+
81+ let to_json styles =
82+ List.map
83+ ~f:(fun pair ->
84+ let style_strings =
85+ List.map ~f:Ezjsonm.string (List.map ~f:style_to_string pair.styles)
86+ in
87+ Ezjsonm.dict
88+ [
89+ ("pattern", Ezjsonm.string pair.pattern);
90+ ("style", Ezjsonm.list noop style_strings);
91+ ])
92+ styles
93+ end
94+
95 module Column = struct
96 type t = [ `Title | `Description | `Tags | `WordCount | `Slug ]
97
98 @@ -70,7 +136,8 @@ module Key = struct
99 | `OnSync
100 | `ListStyle
101 | `Encoding
102- | `ColumnList ]
103+ | `ColumnList
104+ | `Styles ]
105
106 let all =
107 [
108 @@ -82,6 +149,7 @@ module Key = struct
109 `ListStyle;
110 `Encoding;
111 `ColumnList;
112+ `Styles;
113 ]
114
115 let of_string = function
116 @@ -93,6 +161,7 @@ module Key = struct
117 | "list_style" -> `ListStyle
118 | "encoding" -> `Encoding
119 | "column_list" -> `ColumnList
120+ | "styles" -> `Styles
121 | key -> failwith (sprintf "bad configuration key %s" key)
122
123 let to_string = function
124 @@ -104,6 +173,7 @@ module Key = struct
125 | `ListStyle -> "list_style"
126 | `Encoding -> "encoding"
127 | `ColumnList -> "column_list"
128+ | `Styles -> "styles"
129 end
130
131 type t = {
132 @@ -115,6 +185,7 @@ type t = {
133 list_style : ListStyle.t;
134 encoding : Encoding.t;
135 column_list : Column.t list;
136+ styles : StylePair.t list;
137 }
138
139 let of_string str =
140 @@ -152,6 +223,10 @@ let of_string str =
141 | Some column_list ->
142 List.map ~f:Column.of_string (Ezjsonm.get_strings column_list)
143 | None -> [ `Title; `Tags; `WordCount; `Slug ]
144+ and styles =
145+ match Ezjsonm.find_opt json [ Key.to_string `Styles ] with
146+ | Some values -> StylePair.of_json values
147+ | None -> []
148 in
149 {
150 state_dir;
151 @@ -162,6 +237,7 @@ let of_string str =
152 list_style;
153 encoding;
154 column_list;
155+ styles;
156 }
157
158 let to_string t =
159 @@ -177,9 +253,8 @@ let to_string t =
160 else Ezjsonm.unit ()
161 and list_style = Ezjsonm.string (ListStyle.to_string t.list_style)
162 and encoding = Ezjsonm.string (Encoding.to_string t.encoding)
163- and column_list =
164- Ezjsonm.strings (List.map ~f:Column.to_string t.column_list)
165- in
166+ and column_list = Ezjsonm.strings (List.map ~f:Column.to_string t.column_list)
167+ and styles = StylePair.to_json t.styles in
168 Yaml.to_string_exn
169 (Ezjsonm.dict
170 [
171 @@ -191,6 +266,7 @@ let to_string t =
172 (Key.to_string `ListStyle, list_style);
173 (Key.to_string `Encoding, encoding);
174 (Key.to_string `ColumnList, column_list);
175+ (Key.to_string `Styles, Ezjsonm.list noop styles);
176 ])
177
178 let get t key =
179 @@ -205,6 +281,8 @@ let get t key =
180 | `Encoding -> Encoding.to_string t.encoding
181 | `ColumnList ->
182 String.concat ~sep:" " (List.map ~f:Column.to_string t.column_list)
183+ | `Styles ->
184+ Ezjsonm.to_string (Ezjsonm.list noop (StylePair.to_json t.styles))
185
186 let set t key value =
187 match key with
188 @@ -224,6 +302,9 @@ let set t key value =
189 t with
190 column_list = List.map ~f:Column.of_string (String.split ~on:' ' value);
191 }
192+ | `Styles ->
193+ let styles = StylePair.of_json (Yaml.of_string_exn value) in
194+ { t with styles }
195
196 let load =
197 let cfg =
198 @@ -243,11 +324,4 @@ let load =
199 Unix.mkdir_p cfg.state_dir;
200 cfg
201
202- let populate t =
203- List.fold ~init:t
204- ~f:(fun accm key ->
205- let value = get accm key in
206- set accm key value)
207- Key.all
208-
209 let save t = Out_channel.write_all ~data:(to_string t) config_path
210 diff --git a/lib/note.ml b/lib/note.ml
211index 6a17476..fe4328c 100644
212--- a/lib/note.ml
213+++ b/lib/note.ml
214 @@ -209,18 +209,14 @@ module Display = struct
215
216 type row = cell list
217
218- type pair = string * color
219+ let paint_tag (styles : Config.StylePair.t list) text : string =
220+ match
221+ List.find ~f:(fun entry -> String.equal entry.pattern text) styles
222+ with
223+ | Some entry -> sprintf entry.styles "%s" text
224+ | None -> sprintf [ Foreground Default ] "%s" text
225
226- let paint_tag pairs text =
227- let color =
228- match List.find ~f:(fun entry -> String.equal (fst entry) text) pairs with
229- | Some color_text ->
230- snd color_text
231- | None -> Foreground Default
232- in
233- sprintf [ color ] "%s" text
234-
235- let to_cells columns notes =
236+ let to_cells columns styles notes =
237 let header =
238 List.map
239 ~f:(fun column ->
240 @@ -245,15 +241,12 @@ module Display = struct
241 | `Description ->
242 let text_value = get_description note in
243 (text_value, String.length text_value, default_padding)
244- (* TODO: Colourized tags *)
245 | `Tags ->
246 let text_value = String.concat ~sep:"|" (get_tags note) in
247 let text_length = String.length text_value in
248 let tags = get_tags note in
249 let tags =
250- List.map
251- ~f:(fun tag -> paint_tag [ ] tag)
252- tags
253+ List.map ~f:(fun tag -> paint_tag styles tag) tags
254 in
255 let text_value = String.concat ~sep:"|" tags in
256 (text_value, text_length, default_padding)
257 @@ -323,8 +316,8 @@ module Display = struct
258 ])
259 cells
260
261- let to_stdout ~columns ~style notes =
262- let cells = to_cells columns notes in
263+ let to_stdout ~columns ~style ~text_styles notes =
264+ let cells = to_cells columns text_styles notes in
265 match style with
266 | `Simple ->
267 List.iter
268 diff --git a/lib/note.mli b/lib/note.mli
269index 85d6f3b..b5a17e1 100644
270--- a/lib/note.mli
271+++ b/lib/note.mli
272 @@ -35,7 +35,10 @@ module Display : sig
273
274 type row = cell list
275
276- type pair = string * ANSITerminal.color
277-
278- val to_stdout : columns: Config.Column.t list -> style:[< `Fixed | `Simple | `Wide ] -> t list -> unit
279+ val to_stdout :
280+ columns:Config.Column.t list ->
281+ style:Config.ListStyle.t ->
282+ text_styles:Config.StylePair.t list ->
283+ t list ->
284+ unit
285 end