Commit
Author: Kevin Schoon [kevinschoon@gmail.com]
Hash: 8992b6d379654ed28990fa6a64d5277381d661c9
Timestamp: Sat, 26 Sep 2020 23:23:49 +0000 (4 years ago)

+215 -220 +/-5 browse
improve typing of config system
1diff --git a/lib/cmd.ml b/lib/cmd.ml
2index 1634953..f0243c8 100644
3--- a/lib/cmd.ml
4+++ b/lib/cmd.ml
5 @@ -1,41 +1,12 @@
6 open Core
7-
8- let init_config path =
9- let config_path =
10- match path with Some path -> path | None -> Config.default_path
11- in
12- let config = Config.read_config config_path in
13- Config.initialize config_path config;
14- config
15+ open Config
16
17 let get_notes =
18- let open Config in
19- let cfg = init_config None in
20- let state_dir = get_exn cfg "state_dir" in
21 List.map
22 ~f:(fun slug ->
23 let data = In_channel.read_all (Slug.get_path slug) in
24 Note.of_string ~data slug)
25- (Slug.load state_dir)
26-
27- type encoding = Json | Yaml | Text | Raw
28-
29- let encoding_argument =
30- Command.Arg_type.create (fun encoding_str ->
31- match encoding_str with
32- | "Json" | "json" | "JSON" -> Json
33- | "Yaml" | "yaml" | "YAML" -> Yaml
34- | "Text" | "text" | "TEXT" -> Text
35- | "Raw" | "raw" | "RAW" -> Raw
36- | _ -> failwith "unsupported encoding type")
37-
38- let style_argument =
39- Command.Arg_type.create (fun encoding_str ->
40- match encoding_str with
41- | "Fixed" | "fixed" | "FIXED" -> Note.Display.Fixed
42- | "Wide" | "wide" | "WIDE" -> Note.Display.Wide
43- | "Simple" | "simple" | "SIMPLE" -> Note.Display.Simple
44- | _ -> failwith "unsupported style type")
45+ (Slug.load (get_string load StateDir))
46
47 let filter_arg =
48 Command.Arg_type.create
49 @@ -50,27 +21,6 @@ let filter_arg =
50 notes)
51 (fun filter -> filter)
52
53- type value = Config of Config.t | Note of Note.t
54-
55- let encode_value value = function
56- (* TODO: move all of this into the note module *)
57- | Json -> (
58- match value with
59- | Config config -> Ezjsonm.to_string (Config.to_json config)
60- | Note note -> Ezjsonm.to_string (Note.to_json note) )
61- | Yaml -> (
62- match value with
63- | Config config -> Yaml.to_string_exn (Config.to_json config)
64- | Note note -> Yaml.to_string_exn (Note.to_json note) )
65- | Text -> (
66- match value with
67- | Config config -> Config.to_string config
68- | Note note -> Note.to_string note )
69- | Raw -> (
70- match value with
71- | Config config -> Config.to_string config
72- | Note note -> In_channel.read_all (Note.get_path note) )
73-
74 (*
75 * commands
76 *)
77 @@ -98,8 +48,9 @@ note cat -encoding json
78 ~doc:"perform a fulltext search instead of just key comparison"
79 and encoding =
80 flag "encoding"
81- (optional_with_default Raw encoding_argument)
82- ~doc:"format [Text | Json | Yaml | Raw] (default: Raw)"
83+ (optional_with_default Encoding.Raw
84+ (Command.Arg_type.create Encoding.of_string))
85+ ~doc:"format [json | yaml | raw] (default: raw)"
86 in
87 fun () ->
88 let open Note.Filter in
89 @@ -108,7 +59,12 @@ note cat -encoding json
90 find_many ?strategy:filter_kind ~args:filter_args get_notes
91 in
92 List.iter
93- ~f:(fun note -> print_endline (encode_value (Note note) encoding))
94+ ~f:(fun note ->
95+ print_endline
96+ ( match encoding with
97+ | Json -> Ezjsonm.to_string (Note.to_json note)
98+ | Yaml -> Yaml.to_string_exn (Note.to_json note)
99+ | Raw -> In_channel.read_all (Note.get_path note) ))
100 notes]
101
102 let show_config =
103 @@ -127,18 +83,17 @@ note config
104 note config -get state_dir
105 |})
106 [%map_open
107- let key = flag "get" (optional string) ~doc:"get a config value"
108- and encoding =
109- flag "encoding"
110- (optional_with_default Json encoding_argument)
111- ~doc:"encoding"
112+ let key =
113+ flag "get"
114+ (optional (Command.Arg_type.create Key.of_string))
115+ ~doc:"get a config value"
116 in
117 fun () ->
118- let open Config in
119- let cfg = init_config None in
120 match key with
121- | Some key -> print_string (get_exn cfg key)
122- | None -> print_endline (encode_value (Config cfg) encoding)]
123+ | Some key ->
124+ let value = get load key in
125+ print_endline (value_as_string value)
126+ | None -> print_endline (to_string load)]
127
128 let create_note =
129 let open Command.Let_syntax in
130 @@ -168,23 +123,23 @@ note ls "My Important Note"
131 and title = anon ("title" %: string)
132 and tags = anon (sequence ("tag" %: string)) in
133 fun () ->
134- let open Config in
135- let cfg = init_config None in
136- let slug = Slug.next (get_exn cfg "state_dir") in
137+ let cfg = load in
138+ let slug = Slug.next (get_string cfg Key.StateDir) in
139 match open_stdin with
140 | Some _ ->
141 (* reading from stdin so write directly to note *)
142 let content = In_channel.input_all In_channel.stdin in
143 let note = Note.build ~tags ~content ~title slug in
144 Io.create
145- ~callback:(get cfg "on_modification")
146+ ~callback:(get_string_opt cfg Key.OnModification)
147 ~content:(Note.to_string note) (Slug.get_path slug)
148 | None ->
149 let note = Note.build ~tags ~content:"" ~title slug in
150 let init_content = Note.to_string note in
151 Io.create_on_change
152- ~callback:(get cfg "on_modification")
153- ~editor:(get_exn cfg "editor") init_content (Slug.get_path slug)]
154+ ~callback:(get_string_opt cfg Key.OnModification)
155+ ~editor:(get_string cfg Key.Editor)
156+ init_content (Slug.get_path slug)]
157
158 let delete_note =
159 let open Command.Let_syntax in
160 @@ -205,8 +160,6 @@ note delete fuubar
161 ~doc:"perform a fulltext search instead of just key comparison"
162 in
163 fun () ->
164- let open Config in
165- let cfg = init_config None in
166 let open Note.Filter in
167 let filter_kind = if fulltext then Fulltext else Keys in
168 let notes = get_notes in
169 @@ -216,7 +169,7 @@ note delete fuubar
170 match note with
171 | Some note ->
172 Io.delete
173- ~callback:(get cfg "on_modification")
174+ ~callback:(get_string_opt load Key.OnModification)
175 ~title:(Note.get_title note) (Note.get_path note)
176 | None -> failwith "not found"]
177
178 @@ -239,16 +192,16 @@ note edit fuubar
179 ~doc:"perform a fulltext search instead of just key comparison"
180 in
181 fun () ->
182- let open Config in
183- let cfg = init_config None in
184+ let cfg = load in
185 let open Note.Filter in
186 let filter_kind = if fulltext then Fulltext else Keys in
187 let note = find_one ~strategy:filter_kind ~args:filter_args get_notes in
188 match note with
189 | Some note ->
190 Io.edit
191- ~callback:(get cfg "on_modification")
192- ~editor:(get_exn cfg "editor") (Note.get_path note)
193+ ~callback:(get_string_opt cfg Key.OnModification)
194+ ~editor:(get_string cfg Key.Editor)
195+ (Note.get_path note)
196 | None -> failwith "not found"]
197
198 let list_notes =
199 @@ -272,7 +225,8 @@ note ls
200 ~doc:"perform a fulltext search instead of just key comparison"
201 and style =
202 flag "style"
203- (optional_with_default Note.Display.Fixed style_argument)
204+ (optional_with_default ListStyle.Fixed
205+ (Arg_type.create ListStyle.of_string))
206 ~doc:"list style [fixed | wide | simple]"
207 in
208 fun () ->
209 @@ -282,6 +236,12 @@ note ls
210 Note.Filter.find_many ?strategy:filter_kind ~args:filter_args
211 get_notes
212 in
213+ let style =
214+ match style with
215+ | ListStyle.Fixed -> `Fixed
216+ | ListStyle.Wide -> `Wide
217+ | ListStyle.Simple -> `Simple
218+ in
219 print_short ~style notes]
220
221 let run =
222 diff --git a/lib/config.ml b/lib/config.ml
223index deb4e73..b29a320 100644
224--- a/lib/config.ml
225+++ b/lib/config.ml
226 @@ -1,128 +1,137 @@
227 open Core
228
229- type t = {
230- state_dir : string;
231- lock_file : string;
232- editor : string option;
233- on_modification : string option;
234- }
235-
236- let default_path =
237- Filename.concat (Sys.home_directory ()) ".config/note/config.yaml"
238-
239- let default_config =
240- let home_dir = Sys.home_directory () in
241- {
242- state_dir = Filename.concat home_dir ".local/share/note";
243- lock_file = Filename.concat home_dir ".local/share/note.lock";
244- editor = None;
245- on_modification = None;
246- }
247-
248- let to_json config =
249- let editor =
250- match config.editor with
251- | Some value -> Ezjsonm.string value
252- | None -> Ezjsonm.unit ()
253- in
254- let on_mod =
255- match config.on_modification with
256- | Some value -> Ezjsonm.string value
257- | None -> Ezjsonm.unit ()
258- in
259- Ezjsonm.dict
260- [
261- ("state_dir", Ezjsonm.string config.state_dir);
262- ("lock_file", Ezjsonm.string config.lock_file);
263- ("editor", editor);
264- ("on_modification", on_mod);
265- ]
266-
267- let to_string config =
268- let dict = to_json config in
269- Yaml.to_string_exn dict
270-
271- let of_string config_str =
272- let value = Yaml.of_string_exn config_str in
273- let state_dir = Ezjsonm.get_string (Ezjsonm.find value [ "state_dir" ]) in
274- let lock_file = Ezjsonm.get_string (Ezjsonm.find value [ "lock_file" ]) in
275- let string_or_none key =
276- match Ezjsonm.find_opt value [ key ] with
277- | Some v -> (
278- match v with
279- | `String v -> Some v
280- | `Null -> None
281- | _ ->
282- failwith
283- (sprintf "config entry %s must either be a string or NULL" key) )
284- | None -> None
285- in
286- let editor = string_or_none "editor" in
287- let on_modification = string_or_none "on_modification" in
288- { state_dir; lock_file; editor; on_modification }
289+ let home = Sys.home_directory ()
290+
291+ let base_xdg_config_path = Filename.concat home ".config"
292+
293+ let base_xdg_share_path = Filename.concat home ".local/share"
294+
295+ module ListStyle = struct
296+ type t = Fixed | Wide | Simple
297+
298+ let to_string = function
299+ | Fixed -> "fixed"
300+ | Wide -> "wide"
301+ | Simple -> "simple"
302+
303+ let of_string = function
304+ | "fixed" -> Fixed
305+ | "wide" -> Wide
306+ | "simple" -> Simple
307+ | key -> failwith key
308+ end
309+
310+ module Encoding = struct
311+ type t = Json | Yaml | Raw
312+
313+ let to_string = function Json -> "json" | Yaml -> "yaml" | Raw -> "simple"
314+
315+ let of_string = function
316+ | "json" -> Json
317+ | "yaml" -> Yaml
318+ | "raw" -> Raw
319+ | _ -> failwith "unsupported encoding type"
320+ end
321+
322+ type t = Yaml.value
323+
324+ type value =
325+ | String of string option
326+ | ListStyle of ListStyle.t option
327+ | Encoding of Encoding.t option
328
329+ module Key = struct
330+ type t =
331+ | StateDir
332+ | LockFile
333+ | Editor
334+ | OnModification
335+ | ListStyle
336+ | Encoding
337
338- let get config key =
339+ let of_string = function
340+ | "state_dir" -> StateDir
341+ | "lock_file" -> LockFile
342+ | "editor" -> Editor
343+ | "on_modification" -> OnModification
344+ | "list_style" -> ListStyle
345+ | "encoding" -> Encoding
346+ | key -> failwith (sprintf "bad configuration key %s" key)
347+
348+ let to_string = function
349+ | StateDir -> "state_dir"
350+ | LockFile -> "lock_file"
351+ | Editor -> "editor"
352+ | OnModification -> "on_modification"
353+ | ListStyle -> "list_style"
354+ | Encoding -> "encoding"
355+ end
356+
357+ let get_default = function
358+ | Key.StateDir -> String (Some (Filename.concat base_xdg_share_path "/note"))
359+ | Key.LockFile -> String (Some (Filename.concat base_xdg_share_path "/note"))
360+ | Key.Editor -> String (Sys.getenv "EDITOR")
361+ | Key.OnModification -> String None
362+ | Key.ListStyle -> ListStyle (Some ListStyle.Fixed)
363+ | Key.Encoding -> Encoding (Some Encoding.Raw)
364+
365+ let of_json key json =
366 match key with
367- | "state_dir" -> Some config.state_dir
368- | "lock_file" -> Some config.lock_file
369- | "editor" -> (
370- match config.editor with
371- | Some v -> Some v
372- | None -> (
373- match Sys.getenv "EDITOR" with
374- | Some v -> Some v
375- | None ->
376- failwith
377- "No editor is specified in your configuration and environment \
378- variable $EDITOR is not set" ) )
379- | "on_modification" -> config.on_modification
380- | _ -> None
381-
382- let get_exn config key =
383- let result = get config key in
384- match result with
385+ | Key.StateDir -> String (Some (Ezjsonm.get_string json))
386+ | Key.LockFile -> String (Some (Ezjsonm.get_string json))
387+ | Key.Editor -> String (Some (Ezjsonm.get_string json))
388+ | Key.OnModification -> String (Some (Ezjsonm.get_string json))
389+ | Key.ListStyle ->
390+ ListStyle (Some (ListStyle.of_string (Ezjsonm.get_string json)))
391+ | Key.Encoding ->
392+ Encoding (Some (Encoding.of_string (Ezjsonm.get_string json)))
393+
394+ let to_string t = Ezjsonm.to_string (Ezjsonm.wrap t)
395+
396+ let get t key =
397+ match Ezjsonm.find_opt t [ Key.to_string key ] with
398+ | Some json -> of_json key json
399+ | None -> get_default key
400+
401+ let value_as_string value =
402+ match value with
403+ | String value -> ( match value with Some v -> v | None -> "" )
404+ | ListStyle value -> (
405+ match value with Some v -> ListStyle.to_string v | None -> "" )
406+ | Encoding value -> (
407+ match value with Some v -> Encoding.to_string v | None -> "" )
408+
409+ let get_string_opt t key =
410+ match get t key with
411+ | String value -> value
412+ | _ ->
413+ failwith
414+ (sprintf "BUG: you asked for a string but provided a %s"
415+ (Key.to_string key))
416+
417+ let get_string t key =
418+ match get_string_opt t key with
419 | Some value -> value
420- | None -> failwith (sprintf "bad configuration key: %s" key)
421-
422- let initialize path config =
423- (* ensure the directory exists *)
424- ( match Sys.file_exists (Filename.dirname path) with
425- | `Yes -> ()
426- | `No | `Unknown -> () );
427- (* write config if that file does not exist *)
428- (let config_dir = Filename.concat (Sys.home_directory ()) ".config/note" in
429- match Sys.file_exists config_dir with
430- | `Yes -> ()
431- | `No | `Unknown -> Unix.mkdir_p config_dir);
432- (* write the config to disk if it does not already exist *)
433- ( match Sys.file_exists path with
434- | `Yes -> ()
435- | `No | `Unknown ->
436- let str_config = to_string config in
437- Out_channel.write_all ~data:str_config path );
438- (* create the state directory if it is missing *)
439- ( match Sys.file_exists config.state_dir with
440- | `Yes -> ()
441- | `No | `Unknown -> Unix.mkdir_p config.state_dir );
442- ()
443-
444- let resolve config =
445- let editor =
446- match config.editor with
447- | Some name -> Some name
448- | None -> Sys.getenv "NOTE_EDITOR"
449+ | None -> failwith (sprintf "%s not defined" (Key.to_string key))
450+
451+ let load =
452+ let path =
453+ match Sys.getenv "NOTE_CONFIG" with
454+ | Some path -> path
455+ | None -> Filename.concat base_xdg_config_path "/note/config.yaml"
456 in
457- {
458- editor;
459- state_dir = config.state_dir;
460- lock_file = config.lock_file;
461- on_modification = config.on_modification;
462- }
463-
464- let read_config path =
465- match Sys.file_exists path with
466- | `Yes ->
467- let config_str = In_channel.read_all path in
468- resolve (of_string config_str)
469- | `No | `Unknown -> resolve default_config
470+ let cfg =
471+ match Sys.file_exists path with
472+ | `Yes -> Yaml.of_string_exn (In_channel.read_all path)
473+ | `No | `Unknown ->
474+ Unix.mkdir_p (Filename.dirname path);
475+ Out_channel.write_all path ~data:(Ezjsonm.to_string (Ezjsonm.dict []));
476+ Yaml.of_string_exn (In_channel.read_all path)
477+ in
478+
479+ let state_dir = get_string cfg Key.StateDir in
480+ match Sys.file_exists state_dir with
481+ | `Yes -> cfg
482+ | `No | `Unknown ->
483+ Unix.mkdir_p state_dir;
484+ cfg
485 diff --git a/lib/config.mli b/lib/config.mli
486index 15604f7..743cbec 100644
487--- a/lib/config.mli
488+++ b/lib/config.mli
489 @@ -1,27 +1,56 @@
490 open Base
491
492+ module ListStyle : sig
493+ type t = Fixed | Wide | Simple
494+
495+ val of_string : string -> t
496+
497+ val to_string : t -> string
498+ end
499+
500+ module Encoding : sig
501+ type t = Json | Yaml | Raw
502+
503+ val of_string : string -> t
504+
505+ val to_string : t -> string
506+ end
507+
508+ module Key : sig
509+ type t =
510+ | StateDir
511+ | LockFile
512+ | Editor
513+ | OnModification
514+ | ListStyle
515+ | Encoding
516+
517+ val of_string : string -> t
518+
519+ val to_string : t -> string
520+ end
521+
522 type t
523 (** configuration for the note cli *)
524
525- val default_path : string
526- (** the default configuration path *)
527+ type value
528+ (** a configuration value *)
529
530 val to_string : t -> string
531 (** convert the configuration into a string *)
532
533- val of_string : string -> t
534- (** read the configuration from a string *)
535+ val load : t
536+ (** load the configuration from disk *)
537
538- val to_json : t -> [>Ezjsonm.t]
539+ val value_as_string : value -> string
540+ (** convert a value to string form *)
541
542- val read_config : string -> t
543- (** read the configuration from a filesystem path *)
544+ val get : t -> Key.t -> value
545+ (** get a single value by key *)
546
547- val initialize : string -> t -> unit
548- (** initialize the host system with the configuration *)
549+ val get_string : t -> Key.t -> string
550+ (** get a single value as a string by key *)
551
552- val get : t -> string -> string option
553- (** returns a key-value string pair from the configuration *)
554+ val get_string_opt : t -> Key.t -> string option
555+ (** get a string option by key *)
556
557- val get_exn : t -> string -> string
558- (** returns a key-value string pair from the configuration and throws an exception if it is missing *)
559 diff --git a/lib/note.ml b/lib/note.ml
560index 3605486..6e0171a 100644
561--- a/lib/note.ml
562+++ b/lib/note.ml
563 @@ -201,8 +201,6 @@ module Display = struct
564
565 open ANSITerminal
566
567- type style = Fixed | Wide | Simple
568-
569 type cell = string * ANSITerminal.style list
570
571 type row = cell list
572 @@ -267,12 +265,13 @@ module Display = struct
573 let print_short ~style notes =
574 let cells = to_cells notes in
575 match style with
576- | Simple ->
577+ | `Simple ->
578 List.iter
579 ~f:(fun cell -> print_endline (fst (List.nth_exn cell 0)))
580 cells
581- | Fixed -> List.iter ~f:print_endline (apply (fixed_spacing cells) cells)
582- | Wide ->
583+ | `Fixed ->
584+ List.iter ~f:print_endline (apply (fixed_spacing cells) cells)
585+ | `Wide ->
586 List.iter ~f:print_endline
587 (apply (fix_right (fixed_spacing cells)) cells)
588 end
589 diff --git a/lib/note.mli b/lib/note.mli
590index 2969487..6333aa9 100644
591--- a/lib/note.mli
592+++ b/lib/note.mli
593 @@ -57,11 +57,9 @@ module Filter : sig
594 end
595
596 module Display : sig
597- type style = Fixed | Wide | Simple
598-
599 type cell = string * ANSITerminal.style list
600
601 type row = cell list
602
603- val print_short : style:style -> t list -> unit
604+ val print_short : style:[<`Fixed | `Simple | `Wide] -> t list -> unit
605 end