lib/config.ml -rw-r--r-- 10.8 KiB
1open Core
2
3let noop a = a
4
5let home = Sys_unix.home_directory ()
6
7let base_xdg_config_path = Filename.concat home ".config"
8
9let base_xdg_share_path = Filename.concat home ".local/share"
10
11let config_path =
12 match Sys.getenv "NOTE_CONFIG" with
13 | Some path -> path
14 | None -> Filename.concat base_xdg_config_path "/note/config.yaml"
15
16module ListStyle = struct
17 type t = [ `Fixed | `Wide | `Simple | `Tree ]
18
19 let all = [ `Fixed; `Wide; `Simple; `Tree ]
20
21 let to_string = function
22 | `Fixed -> "fixed"
23 | `Wide -> "wide"
24 | `Simple -> "simple"
25 | `Tree -> "tree"
26
27 let of_string = function
28 | "fixed" -> `Fixed
29 | "wide" -> `Wide
30 | "simple" -> `Simple
31 | "tree" -> `Tree
32 | key -> failwith key
33end
34
35module Encoding = struct
36 type t = [ `Json | `Yaml | `Html | `Raw ]
37
38 let all = [ `Json; `Yaml; `Html; `Raw ]
39
40 let to_string = function
41 | `Json -> "json"
42 | `Yaml -> "yaml"
43 | `Html -> "html"
44 | `Raw -> "raw"
45
46 let of_string = function
47 | "json" -> `Json
48 | "yaml" -> `Yaml
49 | "html" -> `Html
50 | "raw" -> `Raw
51 | key -> failwith (sprintf "unsupported encoding type: %s" key)
52end
53
54module StylePair = struct
55 open ANSITerminal
56
57 type t = { pattern : string; styles : style list }
58
59 let make pattern styles = { pattern; styles }
60
61 let style_of_string = function
62 (* TODO: uhhh.... *)
63 | "Foreground Black" -> Foreground Black
64 | "Foreground Red" -> Foreground Red
65 | "Foreground Green" -> Foreground Green
66 | "Foreground Yellow" -> Foreground Yellow
67 | "Foreground Blue" -> Foreground Blue
68 | "Foreground Magenta" -> Foreground Magenta
69 | "Foreground Cyan" -> Foreground Cyan
70 | "Foreground White" -> Foreground White
71 | "Background Black" -> Background Black
72 | "Background Red" -> Background Red
73 | "Background Green" -> Background Green
74 | "Background Yellow" -> Background Yellow
75 | "Background Blue" -> Background Blue
76 | "Background Magenta" -> Background Magenta
77 | "Background Cyan" -> Background Cyan
78 | "Background White" -> Background White
79 | "Bold" -> Bold
80 | "Inverse" -> Inverse
81 | "Underlined" -> Underlined
82 | name -> failwith (Core.sprintf "bad color: %s" name)
83
84 let style_to_string = function
85 | Foreground Black -> "Foreground Black"
86 | Foreground Red -> "Foreground Red"
87 | Foreground Green -> "Foreground Green"
88 | Foreground Yellow -> "Foreground Yellow"
89 | Foreground Blue -> "Foreground Blue"
90 | Foreground Magenta -> "Foreground Magenta"
91 | Foreground Cyan -> "Foreground Cyan"
92 | Foreground White -> "Foreground White"
93 | Background Black -> "Background Black"
94 | Background Red -> "Background Red"
95 | Background Green -> "Background Green"
96 | Background Yellow -> "Background Yellow"
97 | Background Blue -> "Background Blue"
98 | Background Magenta -> "Background Magenta"
99 | Background Cyan -> "Background Cyan"
100 | Background White -> "Background White"
101 | Bold -> "Bold"
102 | Inverse -> "Inverse"
103 | Underlined -> "Underlined"
104 | _ -> failwith "no"
105
106 let of_json values =
107 Ezjsonm.get_list
108 (fun entry ->
109 let pattern = Ezjsonm.get_string (Ezjsonm.find entry [ "pattern" ])
110 and styles =
111 Ezjsonm.get_list
112 (fun entry ->
113 let style = Ezjsonm.get_string entry in
114 style_of_string style)
115 (Ezjsonm.find entry [ "style" ])
116 in
117 make pattern styles)
118 values
119
120 let to_json styles =
121 List.map
122 ~f:(fun pair ->
123 let style_strings =
124 List.map ~f:Ezjsonm.string (List.map ~f:style_to_string pair.styles)
125 in
126 Ezjsonm.dict
127 [
128 ("pattern", Ezjsonm.string pair.pattern);
129 ("style", Ezjsonm.list noop style_strings);
130 ])
131 styles
132end
133
134module Column = struct
135 type t = [ `Title | `Description | `Tags ]
136
137 let to_string = function
138 | `Title -> "title"
139 | `Description -> "description"
140 | `Tags -> "tags"
141
142 let of_string = function
143 | "title" -> `Title
144 | "description" -> `Description
145 | "tags" -> `Tags
146 | key -> failwith (sprintf "unsupported column type: %s" key)
147end
148
149module Key = struct
150 type t =
151 [ `StateDir
152 | `LockFile
153 | `Editor
154 | `OnModification
155 | `OnSync
156 | `ListStyle
157 | `Encoding
158 | `ColumnList
159 | `Styles
160 | `Context ]
161
162 let all =
163 [
164 `StateDir;
165 `LockFile;
166 `Editor;
167 `OnModification;
168 `OnSync;
169 `ListStyle;
170 `Encoding;
171 `ColumnList;
172 `Styles;
173 `Context;
174 ]
175
176 let of_string = function
177 | "state_dir" -> `StateDir
178 | "lock_file" -> `LockFile
179 | "editor" -> `Editor
180 | "on_modification" -> `OnModification
181 | "on_sync" -> `OnSync
182 | "list_style" -> `ListStyle
183 | "encoding" -> `Encoding
184 | "column_list" -> `ColumnList
185 | "styles" -> `Styles
186 | "context" -> `Context
187 | key -> failwith (sprintf "bad configuration key %s" key)
188
189 let to_string = function
190 | `StateDir -> "state_dir"
191 | `LockFile -> "lock_file"
192 | `Editor -> "editor"
193 | `OnModification -> "on_modification"
194 | `OnSync -> "on_sync"
195 | `ListStyle -> "list_style"
196 | `Encoding -> "encoding"
197 | `ColumnList -> "column_list"
198 | `Styles -> "styles"
199 | `Context -> "context"
200end
201
202type t = {
203 state_dir : string;
204 lock_file : string;
205 editor : string;
206 on_modification : string option;
207 on_sync : string option;
208 list_style : ListStyle.t;
209 encoding : Encoding.t;
210 column_list : Column.t list;
211 styles : StylePair.t list;
212 context : string option;
213}
214
215let of_string str =
216 let json = Yaml.of_string_exn str in
217 let state_dir =
218 match Ezjsonm.find_opt json [ Key.to_string `StateDir ] with
219 | Some state_dir -> Ezjsonm.get_string state_dir
220 | None -> Filename.concat base_xdg_share_path "/note"
221 and lock_file =
222 match Ezjsonm.find_opt json [ Key.to_string `LockFile ] with
223 | Some lock_file -> Ezjsonm.get_string lock_file
224 | None -> Filename.concat base_xdg_share_path "/note.lock"
225 and editor =
226 match Ezjsonm.find_opt json [ Key.to_string `Editor ] with
227 | Some editor -> Ezjsonm.get_string editor
228 | None -> Sys.getenv_exn "EDITOR"
229 and on_modification =
230 match Ezjsonm.find_opt json [ Key.to_string `OnModification ] with
231 | Some on_modification -> Some (Ezjsonm.get_string on_modification)
232 | None -> None
233 and on_sync =
234 match Ezjsonm.find_opt json [ Key.to_string `OnSync ] with
235 | Some on_sync -> Some (Ezjsonm.get_string on_sync)
236 | None -> None
237 and list_style =
238 match Ezjsonm.find_opt json [ Key.to_string `ListStyle ] with
239 | Some list_style -> ListStyle.of_string (Ezjsonm.get_string list_style)
240 | None -> `Fixed
241 and encoding =
242 match Ezjsonm.find_opt json [ Key.to_string `Encoding ] with
243 | Some encoding -> Encoding.of_string (Ezjsonm.get_string encoding)
244 | None -> `Raw
245 and column_list =
246 match Ezjsonm.find_opt json [ Key.to_string `ColumnList ] with
247 | Some column_list ->
248 List.map ~f:Column.of_string (Ezjsonm.get_strings column_list)
249 | None -> [ `Title; `Tags; ]
250 and styles =
251 match Ezjsonm.find_opt json [ Key.to_string `Styles ] with
252 | Some values -> StylePair.of_json values
253 | None -> []
254 and context =
255 match Ezjsonm.find_opt json [ Key.to_string `Context ] with
256 | Some value -> Some (Ezjsonm.get_string value)
257 | None -> None
258 in
259 {
260 state_dir;
261 lock_file;
262 editor;
263 on_modification;
264 on_sync;
265 list_style;
266 encoding;
267 column_list;
268 styles;
269 context;
270 }
271
272let to_string t =
273 let state_dir = Ezjsonm.string t.state_dir
274 and lock_file = Ezjsonm.string t.lock_file
275 and editor = Ezjsonm.string t.editor
276 and on_modification =
277 if Option.is_some t.on_modification then
278 Ezjsonm.string (Option.value_exn t.on_modification)
279 else Ezjsonm.unit ()
280 and on_sync =
281 if Option.is_some t.on_sync then Ezjsonm.string (Option.value_exn t.on_sync)
282 else Ezjsonm.unit ()
283 and list_style = Ezjsonm.string (ListStyle.to_string t.list_style)
284 and encoding = Ezjsonm.string (Encoding.to_string t.encoding)
285 and column_list = Ezjsonm.strings (List.map ~f:Column.to_string t.column_list)
286 and styles = StylePair.to_json t.styles
287 and context =
288 match t.context with
289 | Some context -> Ezjsonm.string context
290 | None -> Ezjsonm.unit ()
291 in
292 Yaml.to_string_exn
293 (Ezjsonm.dict
294 [
295 (Key.to_string `StateDir, state_dir);
296 (Key.to_string `LockFile, lock_file);
297 (Key.to_string `Editor, editor);
298 (Key.to_string `OnModification, on_modification);
299 (Key.to_string `OnSync, on_sync);
300 (Key.to_string `ListStyle, list_style);
301 (Key.to_string `Encoding, encoding);
302 (Key.to_string `ColumnList, column_list);
303 (Key.to_string `Styles, Ezjsonm.list noop styles);
304 (Key.to_string `Context, context);
305 ])
306
307let get t key =
308 match key with
309 | `StateDir -> t.state_dir
310 | `LockFile -> t.lock_file
311 | `Editor -> t.editor
312 | `OnModification -> (
313 match t.on_modification with Some value -> value | None -> "null")
314 | `OnSync -> ( match t.on_sync with Some value -> value | None -> "null")
315 | `ListStyle -> ListStyle.to_string t.list_style
316 | `Encoding -> Encoding.to_string t.encoding
317 | `ColumnList ->
318 String.concat ~sep:" " (List.map ~f:Column.to_string t.column_list)
319 | `Styles ->
320 Ezjsonm.to_string (Ezjsonm.list noop (StylePair.to_json t.styles))
321 | `Context -> ( match t.context with Some context -> context | None -> "")
322
323let set t key value =
324 match key with
325 | `StateDir -> { t with state_dir = value }
326 | `LockFile -> { t with lock_file = value }
327 | `Editor -> { t with editor = value }
328 | `OnModification ->
329 if String.length value = 0 then { t with on_modification = None }
330 else { t with on_modification = Some value }
331 | `OnSync ->
332 if String.length value = 0 then { t with on_sync = None }
333 else { t with on_sync = Some value }
334 | `ListStyle -> { t with list_style = ListStyle.of_string value }
335 | `Encoding -> { t with encoding = Encoding.of_string value }
336 | `ColumnList ->
337 {
338 t with
339 column_list = List.map ~f:Column.of_string (String.split ~on:' ' value);
340 }
341 | `Styles ->
342 let styles = StylePair.of_json (Yaml.of_string_exn value) in
343 { t with styles }
344 | `Context ->
345 let context = match value with "" -> None | _ -> Some value in
346 { t with context }
347
348let load path =
349 let cfg =
350 match Sys_unix.file_exists path with
351 | `Yes -> of_string (In_channel.read_all path)
352 | `No | `Unknown ->
353 Core_unix.mkdir_p (Filename.dirname path);
354 Out_channel.write_all path ~data:(Ezjsonm.to_string (Ezjsonm.dict []));
355 of_string (In_channel.read_all path)
356 in
357
358 (* intiailize the state directory if it is missing *)
359 match Sys_unix.file_exists cfg.state_dir with
360 | `Yes -> cfg
361 | `No | `Unknown ->
362 Core_unix.mkdir_p cfg.state_dir;
363 cfg
364
365let save t = Out_channel.write_all ~data:(to_string t) config_path