+176 -126 +/-5 browse
| 1 | diff --git a/bin/note.ml b/bin/note.ml |
| 2 | index c91323e..0ee0123 100644 |
| 3 | --- a/bin/note.ml |
| 4 | +++ b/bin/note.ml |
| 5 | @@ -1,7 +1,98 @@ |
| 6 | open Core |
| 7 | open Note_lib |
| 8 | |
| 9 | - let cfg = Config.load |
| 10 | + let cfg = Config.config_path |> Config.load |
| 11 | + let context = cfg.context |
| 12 | + |
| 13 | + module Util = struct |
| 14 | + open ANSITerminal |
| 15 | + |
| 16 | + let rec to_words (accm : string list) (doc : Omd.doc) : string list = |
| 17 | + let split_words inline = |
| 18 | + match inline with Omd.Text text -> String.split ~on:' ' text | _ -> [] |
| 19 | + in |
| 20 | + match doc with |
| 21 | + | [] -> accm |
| 22 | + | hd :: tl -> ( |
| 23 | + (* TODO: account for headings, lists, etc *) |
| 24 | + match hd.bl_desc with |
| 25 | + | Paragraph inline -> |
| 26 | + let accm = accm @ split_words inline.il_desc in |
| 27 | + to_words accm tl |
| 28 | + | _ -> to_words accm tl) |
| 29 | + |
| 30 | + let paint_tag (styles : Config.StylePair.t list) text : string = |
| 31 | + match |
| 32 | + List.find ~f:(fun entry -> String.equal entry.pattern text) styles |
| 33 | + with |
| 34 | + | Some entry -> sprintf entry.styles "%s" text |
| 35 | + | None -> sprintf [ Foreground Default ] "%s" text |
| 36 | + |
| 37 | + let to_cells ~columns ~styles (notes : Note.note list) = |
| 38 | + let header = |
| 39 | + List.map |
| 40 | + ~f:(fun column -> |
| 41 | + let text_value = Config.Column.to_string column in |
| 42 | + let text_length = String.length text_value in |
| 43 | + let text_value = sprintf [ Bold; Underlined ] "%s" text_value in |
| 44 | + (text_value, text_length, 1)) |
| 45 | + columns |
| 46 | + in |
| 47 | + let note_cells = |
| 48 | + let default_padding = 1 in |
| 49 | + List.fold ~init:[] |
| 50 | + ~f:(fun accm note -> |
| 51 | + accm |
| 52 | + @ [ |
| 53 | + List.map |
| 54 | + ~f:(fun column -> |
| 55 | + match column with |
| 56 | + | `Title -> |
| 57 | + let text_value = note.frontmatter.title in |
| 58 | + (text_value, String.length text_value, default_padding) |
| 59 | + | `Description -> |
| 60 | + let text_value = note.frontmatter.description in |
| 61 | + (text_value, String.length text_value, default_padding) |
| 62 | + | `Slug -> |
| 63 | + let text_value = |
| 64 | + match note.slug with |
| 65 | + | Some slug -> slug |> Slug.shortname |
| 66 | + | None -> "??" |
| 67 | + in |
| 68 | + (text_value, String.length text_value, default_padding) |
| 69 | + | `Tags -> |
| 70 | + let text_value = |
| 71 | + String.concat ~sep:"|" note.frontmatter.tags |
| 72 | + in |
| 73 | + let text_length = String.length text_value in |
| 74 | + let tags = note.frontmatter.tags in |
| 75 | + let tags = |
| 76 | + List.map ~f:(fun tag -> paint_tag styles tag) tags |
| 77 | + in |
| 78 | + let text_value = String.concat ~sep:"|" tags in |
| 79 | + (text_value, text_length, default_padding) |
| 80 | + | `WordCount -> |
| 81 | + let text_value = |
| 82 | + Core.sprintf "%d" |
| 83 | + (List.length |
| 84 | + (to_words [] (note.content |> Omd.of_string))) |
| 85 | + in |
| 86 | + (text_value, String.length text_value, default_padding)) |
| 87 | + columns; |
| 88 | + ]) |
| 89 | + notes |
| 90 | + in |
| 91 | + [ header ] @ note_cells |
| 92 | + end |
| 93 | + |
| 94 | + module Encoding = struct |
| 95 | + let to_string ~style (note : Note.note) = |
| 96 | + match style with |
| 97 | + | `Raw -> note.content |
| 98 | + | `Json -> Ezjsonm.to_string (Note.to_json note) |
| 99 | + | `Yaml -> Yaml.to_string_exn (Note.to_json note) |
| 100 | + | `Html -> note.content |> Omd.of_string |> Omd.to_html |
| 101 | + end |
| 102 | |
| 103 | let note_of_title title = |
| 104 | sprintf {| |
| 105 | @@ -19,7 +110,7 @@ let rec convert_tree tree = |
| 106 | Display.Tree (title, List.map ~f:convert_tree others) |
| 107 | |
| 108 | let get_notes = |
| 109 | - let notes = cfg.state_dir |> Note.load |> Note.flatten ~accm:[] in |
| 110 | + let notes = cfg.state_dir |> Note.load ~context |> Note.flatten ~accm:[] in |
| 111 | notes |
| 112 | |
| 113 | let get_title (note : Note.note) = note.frontmatter.title |
| 114 | @@ -116,11 +207,11 @@ json for consumption by other tools. |
| 115 | in |
| 116 | fun () -> |
| 117 | let notes = |
| 118 | - cfg.state_dir |> Note.load |> Note.find_many ~term ~notes:[] |
| 119 | + cfg.state_dir |> Note.load ~context |> Note.find_many ~term ~notes:[] |
| 120 | in |
| 121 | List.iter |
| 122 | ~f:(fun note -> |
| 123 | - print_endline (Note.Encoding.to_string ~style:encoding note)) |
| 124 | + print_endline (Encoding.to_string ~style:encoding note)) |
| 125 | notes] |
| 126 | |
| 127 | let config_show = |
| 128 | @@ -169,8 +260,8 @@ on_modification callback will be invoked if the file is committed to disk. |
| 129 | ~content:(Note.to_string note) |
| 130 | | None -> |
| 131 | let content = title |> note_of_title |> Note.to_string in |
| 132 | - Io.create_on_change ~callback:cfg.on_modification |
| 133 | - ~editor:cfg.editor ~content slug.path] |
| 134 | + Io.create_on_change ~callback:cfg.on_modification ~editor:cfg.editor |
| 135 | + ~content slug.path] |
| 136 | |
| 137 | let delete_note = |
| 138 | let open Command.Let_syntax in |
| 139 | @@ -182,7 +273,7 @@ Delete the first note that matches the filter criteria. |
| 140 | [%map_open |
| 141 | let term = term_args in |
| 142 | fun () -> |
| 143 | - let note = cfg.state_dir |> Note.load |> Note.find_one ~term in |
| 144 | + let note = cfg.state_dir |> Note.load ~context |> Note.find_one ~term in |
| 145 | match note with |
| 146 | | Some note -> |
| 147 | (Option.value_exn note.slug).path |
| 148 | @@ -200,7 +291,7 @@ Select a note that matches the filter criteria and open it in your text editor. |
| 149 | [%map_open |
| 150 | let term = term_args in |
| 151 | fun () -> |
| 152 | - let note = cfg.state_dir |> Note.load |> Note.find_one ~term in |
| 153 | + let note = cfg.state_dir |> Note.load ~context |> Note.find_one ~term in |
| 154 | match note with |
| 155 | | Some note -> |
| 156 | (Option.value_exn note.slug).path |
| 157 | @@ -227,13 +318,9 @@ is provided then all notes will be listed. |
| 158 | ~doc:"columns to include in output" |
| 159 | in |
| 160 | fun () -> |
| 161 | - let notes = |
| 162 | - Note.find_many |
| 163 | - ~term |
| 164 | - ~notes:[] (Note.load cfg.state_dir) |
| 165 | - in |
| 166 | + let notes = Note.find_many ~term ~notes:[] (Note.load ~context cfg.state_dir) in |
| 167 | let styles = cfg.styles in |
| 168 | - let cells = Note.Util.to_cells ~columns ~styles notes in |
| 169 | + let cells = Util.to_cells ~columns ~styles notes in |
| 170 | Display.to_stdout ~style cells] |
| 171 | |
| 172 | let sync = |
| 173 | @@ -243,7 +330,8 @@ let sync = |
| 174 | let tree = |
| 175 | Command.basic ~summary:"tree debug command" |
| 176 | (Command.Param.return (fun () -> |
| 177 | - cfg.state_dir |> Note.load |> convert_tree |> Display.to_string |> print_endline)) |
| 178 | + cfg.state_dir |> Note.load ~context |> convert_tree |> Display.to_string |
| 179 | + |> print_endline)) |
| 180 | |
| 181 | let version = |
| 182 | match Build_info.V1.version () with |
| 183 | diff --git a/lib/config.ml b/lib/config.ml |
| 184 | index 8ab9691..30d3ec4 100644 |
| 185 | --- a/lib/config.ml |
| 186 | +++ b/lib/config.ml |
| 187 | @@ -160,7 +160,8 @@ module Key = struct |
| 188 | | `ListStyle |
| 189 | | `Encoding |
| 190 | | `ColumnList |
| 191 | - | `Styles ] |
| 192 | + | `Styles |
| 193 | + | `Context ] |
| 194 | |
| 195 | let all = |
| 196 | [ |
| 197 | @@ -173,6 +174,7 @@ module Key = struct |
| 198 | `Encoding; |
| 199 | `ColumnList; |
| 200 | `Styles; |
| 201 | + `Context; |
| 202 | ] |
| 203 | |
| 204 | let of_string = function |
| 205 | @@ -185,6 +187,7 @@ module Key = struct |
| 206 | | "encoding" -> `Encoding |
| 207 | | "column_list" -> `ColumnList |
| 208 | | "styles" -> `Styles |
| 209 | + | "context" -> `Context |
| 210 | | key -> failwith (sprintf "bad configuration key %s" key) |
| 211 | |
| 212 | let to_string = function |
| 213 | @@ -197,6 +200,7 @@ module Key = struct |
| 214 | | `Encoding -> "encoding" |
| 215 | | `ColumnList -> "column_list" |
| 216 | | `Styles -> "styles" |
| 217 | + | `Context -> "context" |
| 218 | end |
| 219 | |
| 220 | type t = { |
| 221 | @@ -209,6 +213,7 @@ type t = { |
| 222 | encoding : Encoding.t; |
| 223 | column_list : Column.t list; |
| 224 | styles : StylePair.t list; |
| 225 | + context : Note.Term.t; |
| 226 | } |
| 227 | |
| 228 | let of_string str = |
| 229 | @@ -250,6 +255,10 @@ let of_string str = |
| 230 | match Ezjsonm.find_opt json [ Key.to_string `Styles ] with |
| 231 | | Some values -> StylePair.of_json values |
| 232 | | None -> [] |
| 233 | + and context = |
| 234 | + match Ezjsonm.find_opt json [ Key.to_string `Context ] with |
| 235 | + | Some value -> Note.Term.of_json value |
| 236 | + | None -> { title = []; description = []; tags = [] } |
| 237 | in |
| 238 | { |
| 239 | state_dir; |
| 240 | @@ -261,6 +270,7 @@ let of_string str = |
| 241 | encoding; |
| 242 | column_list; |
| 243 | styles; |
| 244 | + context; |
| 245 | } |
| 246 | |
| 247 | let to_string t = |
| 248 | @@ -277,7 +287,8 @@ let to_string t = |
| 249 | and list_style = Ezjsonm.string (ListStyle.to_string t.list_style) |
| 250 | and encoding = Ezjsonm.string (Encoding.to_string t.encoding) |
| 251 | and column_list = Ezjsonm.strings (List.map ~f:Column.to_string t.column_list) |
| 252 | - and styles = StylePair.to_json t.styles in |
| 253 | + and styles = StylePair.to_json t.styles |
| 254 | + and context = Note.Term.to_json t.context in |
| 255 | Yaml.to_string_exn |
| 256 | (Ezjsonm.dict |
| 257 | [ |
| 258 | @@ -290,6 +301,7 @@ let to_string t = |
| 259 | (Key.to_string `Encoding, encoding); |
| 260 | (Key.to_string `ColumnList, column_list); |
| 261 | (Key.to_string `Styles, Ezjsonm.list noop styles); |
| 262 | + (Key.to_string `Context, context); |
| 263 | ]) |
| 264 | |
| 265 | let get t key = |
| 266 | @@ -306,6 +318,7 @@ let get t key = |
| 267 | String.concat ~sep:" " (List.map ~f:Column.to_string t.column_list) |
| 268 | | `Styles -> |
| 269 | Ezjsonm.to_string (Ezjsonm.list noop (StylePair.to_json t.styles)) |
| 270 | + | `Context -> t.context |> Note.Term.to_json |> Ezjsonm.to_string |
| 271 | |
| 272 | let set t key value = |
| 273 | match key with |
| 274 | @@ -328,16 +341,18 @@ let set t key value = |
| 275 | | `Styles -> |
| 276 | let styles = StylePair.of_json (Yaml.of_string_exn value) in |
| 277 | { t with styles } |
| 278 | + | `Context -> |
| 279 | + let context = value |> Ezjsonm.from_string |> Note.Term.of_json in |
| 280 | + { t with context } |
| 281 | |
| 282 | - let load = |
| 283 | + let load path = |
| 284 | let cfg = |
| 285 | - match Sys.file_exists config_path with |
| 286 | - | `Yes -> of_string (In_channel.read_all config_path) |
| 287 | + match Sys.file_exists path with |
| 288 | + | `Yes -> of_string (In_channel.read_all path) |
| 289 | | `No | `Unknown -> |
| 290 | - Unix.mkdir_p (Filename.dirname config_path); |
| 291 | - Out_channel.write_all config_path |
| 292 | - ~data:(Ezjsonm.to_string (Ezjsonm.dict [])); |
| 293 | - of_string (In_channel.read_all config_path) |
| 294 | + Unix.mkdir_p (Filename.dirname path); |
| 295 | + Out_channel.write_all path ~data:(Ezjsonm.to_string (Ezjsonm.dict [])); |
| 296 | + of_string (In_channel.read_all path) |
| 297 | in |
| 298 | |
| 299 | (* intiailize the state directory if it is missing *) |
| 300 | diff --git a/lib/note.ml b/lib/note.ml |
| 301 | index cca5672..f791e53 100644 |
| 302 | --- a/lib/note.ml |
| 303 | +++ b/lib/note.ml |
| 304 | @@ -21,6 +21,12 @@ module Term = struct |
| 305 | |
| 306 | let empty = { title = []; description = []; tags = [] } |
| 307 | |
| 308 | + let is_empty term = |
| 309 | + [ term.title; term.description; term.tags ] |
| 310 | + |> List.fold ~init:[] ~f:(fun accm items -> |
| 311 | + match items |> List.length with 0 -> accm | _ -> items) |
| 312 | + |> List.length = 0 |
| 313 | + |
| 314 | let of_json json = |
| 315 | let title = |
| 316 | match Ezjsonm.find_opt json [ "title" ] with |
| 317 | @@ -187,6 +193,10 @@ let match_term ?(operator = Operator.Or) ~(term : Term.t) note = |
| 318 | List.length (List.filter ~f:(fun v -> v) results) = List.length results |
| 319 | | Or -> List.length (List.filter ~f:(fun v -> v) results) > 0 |
| 320 | |
| 321 | + let match_tree ?(operator = Operator.Or) ~(term : Term.t) tree = |
| 322 | + let (Tree (note, _)) = tree in |
| 323 | + note |> match_term ~operator ~term |
| 324 | + |
| 325 | let rec find_many ?(operator = Operator.Or) ~(term : Term.t) ~notes tree = |
| 326 | let (Tree (note, others)) = tree in |
| 327 | let notes = |
| 328 | @@ -196,6 +206,15 @@ let rec find_many ?(operator = Operator.Or) ~(term : Term.t) ~notes tree = |
| 329 | ~f:(fun accm note -> find_many ~operator ~term ~notes:accm note) |
| 330 | others |
| 331 | |
| 332 | + let rec find_many_tree ?(operator = Operator.Or) ~(term : Term.t) ~trees tree = |
| 333 | + let (Tree (_, others)) = tree in |
| 334 | + let trees = |
| 335 | + if match_tree ~operator ~term tree then tree :: trees else trees |
| 336 | + in |
| 337 | + List.fold ~init:trees |
| 338 | + ~f:(fun accm tree -> find_many_tree ~operator ~term ~trees:accm tree) |
| 339 | + others |
| 340 | + |
| 341 | let find_one ?(operator = Operator.Or) ~(term : Term.t) tree = |
| 342 | tree |> find_many ~operator ~term ~notes:[] |> List.hd |
| 343 | |
| 344 | @@ -249,112 +268,26 @@ let rec resolve ~root notes = |
| 345 | let tree, buf = buf_insert ~root notes in |
| 346 | match buf |> List.length with 0 -> tree | _ -> resolve ~root:tree buf |
| 347 | |
| 348 | - let load path = |
| 349 | + let load ~context path = |
| 350 | let notes = |
| 351 | path |> Slug.load |
| 352 | |> List.map ~f:(fun slug -> |
| 353 | slug.path |> In_channel.read_all |> of_string ~slug:(Some slug)) |
| 354 | in |
| 355 | (* check if a "root" note is defined *) |
| 356 | - match |
| 357 | - List.find |
| 358 | - ~f:(fun note -> |
| 359 | - note |
| 360 | - |> match_term |
| 361 | - ~term:{ title = [ "__root" ]; description = []; tags = [] }) |
| 362 | - notes |
| 363 | - with |
| 364 | - | Some root -> notes |> resolve ~root:(Tree (root, [])) |
| 365 | - | None -> notes |> resolve ~root:(Tree (of_string root_template, [])) |
| 366 | - |
| 367 | - (* fancy output *) |
| 368 | - |
| 369 | - module Util = struct |
| 370 | - open ANSITerminal |
| 371 | - |
| 372 | - let rec to_words (accm : string list) (doc : Omd.doc) : string list = |
| 373 | - let split_words inline = |
| 374 | - match inline with Omd.Text text -> String.split ~on:' ' text | _ -> [] |
| 375 | - in |
| 376 | - match doc with |
| 377 | - | [] -> accm |
| 378 | - | hd :: tl -> ( |
| 379 | - (* TODO: account for headings, lists, etc *) |
| 380 | - match hd.bl_desc with |
| 381 | - | Paragraph inline -> |
| 382 | - let accm = accm @ split_words inline.il_desc in |
| 383 | - to_words accm tl |
| 384 | - | _ -> to_words accm tl) |
| 385 | - |
| 386 | - let paint_tag (styles : Config.StylePair.t list) text : string = |
| 387 | + let tree = |
| 388 | match |
| 389 | - List.find ~f:(fun entry -> String.equal entry.pattern text) styles |
| 390 | - with |
| 391 | - | Some entry -> sprintf entry.styles "%s" text |
| 392 | - | None -> sprintf [ Foreground Default ] "%s" text |
| 393 | - |
| 394 | - let to_cells ~columns ~styles (notes : note list) = |
| 395 | - let header = |
| 396 | - List.map |
| 397 | - ~f:(fun column -> |
| 398 | - let text_value = Config.Column.to_string column in |
| 399 | - let text_length = String.length text_value in |
| 400 | - let text_value = sprintf [ Bold; Underlined ] "%s" text_value in |
| 401 | - (text_value, text_length, 1)) |
| 402 | - columns |
| 403 | - in |
| 404 | - let note_cells = |
| 405 | - let default_padding = 1 in |
| 406 | - List.fold ~init:[] |
| 407 | - ~f:(fun accm note -> |
| 408 | - accm |
| 409 | - @ [ |
| 410 | - List.map |
| 411 | - ~f:(fun column -> |
| 412 | - match column with |
| 413 | - | `Title -> |
| 414 | - let text_value = note.frontmatter.title in |
| 415 | - (text_value, String.length text_value, default_padding) |
| 416 | - | `Description -> |
| 417 | - let text_value = note.frontmatter.description in |
| 418 | - (text_value, String.length text_value, default_padding) |
| 419 | - | `Slug -> |
| 420 | - let text_value = |
| 421 | - match note.slug with |
| 422 | - | Some slug -> slug |> Slug.shortname |
| 423 | - | None -> "??" |
| 424 | - in |
| 425 | - (text_value, String.length text_value, default_padding) |
| 426 | - | `Tags -> |
| 427 | - let text_value = |
| 428 | - String.concat ~sep:"|" note.frontmatter.tags |
| 429 | - in |
| 430 | - let text_length = String.length text_value in |
| 431 | - let tags = note.frontmatter.tags in |
| 432 | - let tags = |
| 433 | - List.map ~f:(fun tag -> paint_tag styles tag) tags |
| 434 | - in |
| 435 | - let text_value = String.concat ~sep:"|" tags in |
| 436 | - (text_value, text_length, default_padding) |
| 437 | - | `WordCount -> |
| 438 | - let text_value = |
| 439 | - Core.sprintf "%d" |
| 440 | - (List.length |
| 441 | - (to_words [] (note.content |> Omd.of_string))) |
| 442 | - in |
| 443 | - (text_value, String.length text_value, default_padding)) |
| 444 | - columns; |
| 445 | - ]) |
| 446 | + List.find |
| 447 | + ~f:(fun note -> |
| 448 | + note |
| 449 | + |> match_term |
| 450 | + ~term:{ title = [ "__root" ]; description = []; tags = [] }) |
| 451 | notes |
| 452 | - in |
| 453 | - [ header ] @ note_cells |
| 454 | - end |
| 455 | - |
| 456 | - module Encoding = struct |
| 457 | - let to_string ~style t = |
| 458 | - match style with |
| 459 | - | `Raw -> t.content |
| 460 | - | `Json -> Ezjsonm.to_string (to_json t) |
| 461 | - | `Yaml -> Yaml.to_string_exn (to_json t) |
| 462 | - | `Html -> t.content |> Omd.of_string |> Omd.to_html |
| 463 | - end |
| 464 | + with |
| 465 | + | Some root -> notes |> resolve ~root:(Tree (root, [])) |
| 466 | + | None -> notes |> resolve ~root:(Tree (of_string root_template, [])) |
| 467 | + in |
| 468 | + if Term.is_empty context then tree |
| 469 | + else |
| 470 | + let root = find_many_tree ~term:context ~trees:[] tree |> List.hd_exn in |
| 471 | + root |
| 472 | diff --git a/test/config_test.ml b/test/config_test.ml |
| 473 | new file mode 100644 |
| 474 | index 0000000..e3fbfa0 |
| 475 | --- /dev/null |
| 476 | +++ b/test/config_test.ml |
| 477 | @@ -0,0 +1,14 @@ |
| 478 | + open Core |
| 479 | + open Note_lib |
| 480 | + |
| 481 | + let test_configuration () = |
| 482 | + let config_path = Filename.temp_file "note-test" "" in |
| 483 | + let cfg = config_path |> Config.load in |
| 484 | + Alcotest.(check bool) "config loaded" true (cfg.context |> Note.Term.is_empty) |
| 485 | + |
| 486 | + let () = |
| 487 | + Alcotest.run "Config" |
| 488 | + [ |
| 489 | + ( "load", |
| 490 | + [ Alcotest.test_case "test configuration" `Quick test_configuration ] ); |
| 491 | + ] |
| 492 | diff --git a/test/dune b/test/dune |
| 493 | index ee6d694..d6c1f27 100644 |
| 494 | --- a/test/dune |
| 495 | +++ b/test/dune |
| 496 | @@ -1,4 +1,4 @@ |
| 497 | (tests |
| 498 | - (names display_test note_test slug_test) |
| 499 | + (names config_test display_test note_test slug_test) |
| 500 | (libraries note_lib alcotest) |
| 501 | ) |