lib/note.ml -rw-r--r-- 9.1 KiB
1open Core
2
3module Frontmatter = struct
4 type t = { path : string; description : string option; tags : string list }
5
6 let empty = { path = ""; description = None; tags = [] }
7
8 let of_json ?(path = None) json =
9 let path =
10 match path with
11 | Some path -> path
12 | None -> (
13 match Ezjsonm.find_opt json [ "path" ] with
14 | Some path -> Ezjsonm.get_string path
15 | None -> "")
16 in
17 let description =
18 match Ezjsonm.find_opt json [ "description" ] with
19 | Some description -> Some (Ezjsonm.get_string description)
20 | None -> None
21 in
22 let tags =
23 match Ezjsonm.find_opt json [ "tags" ] with
24 | Some tags -> Ezjsonm.get_strings tags
25 | None -> []
26 in
27 { path; description; tags }
28
29 let to_json frontmatter =
30 let content =
31 [
32 ("path", Ezjsonm.string frontmatter.path);
33 ("tags", Ezjsonm.strings frontmatter.tags);
34 ]
35 in
36 let content =
37 match frontmatter.description with
38 | Some value -> ("description", Ezjsonm.string value) :: content
39 | None -> content
40 in
41 content |> Ezjsonm.dict
42end
43
44type t = { frontmatter : Frontmatter.t; content : string }
45
46let frontmatter note = note.frontmatter
47
48let content note = note.content
49
50let root_template =
51 {|
52---
53path: /
54description: all notes decend from here
55tags: []
56---
57
58# This is a Note!
59|}
60
61let extract_structured_data content =
62 let of_codeblock kind content =
63 match kind with
64 | "json" -> [ content |> Ezjsonm.from_string ]
65 | "yaml" -> [ Ezjsonm.wrap (content |> Yaml.of_string_exn) ]
66 | _ -> []
67 in
68 let get_data ~values doc =
69 match doc with
70 | Omd.Code_block (_, kind, content) -> of_codeblock kind content @ values
71 | _ -> values
72 in
73 let doc = content |> Omd.of_string in
74 doc |> List.concat_map ~f:(fun doc -> doc |> get_data ~values:[])
75
76let to_json note =
77 Ezjsonm.dict
78 [
79 ("frontmatter", Frontmatter.to_json note.frontmatter);
80 ("content", Ezjsonm.string note.content);
81 ( "data",
82 note.content |> extract_structured_data |> Ezjsonm.list (fun a -> a) );
83 ]
84
85let to_html note = note.content |> Omd.of_string |> Omd.to_html
86
87let to_string note =
88 let yaml = Yaml.to_string_exn (Frontmatter.to_json note.frontmatter) in
89 "\n---\n" ^ yaml ^ "\n---\n" ^ note.content
90
91let of_string ?(path = None) content =
92 let indexes =
93 String.substr_index_all ~may_overlap:true ~pattern:"---" content
94 in
95 if List.length indexes >= 2 then
96 (* parsing the top half of the note *)
97 let meta_str =
98 String.slice content (List.nth_exn indexes 0 + 3) (List.nth_exn indexes 1)
99 in
100 let frontmatter =
101 meta_str |> Yaml.of_string_exn |> Frontmatter.of_json ~path
102 in
103 (* read second half of note as "content" *)
104 let content = String.slice content (List.nth_exn indexes 1 + 3) 0 in
105 { frontmatter; content }
106 else { frontmatter = Frontmatter.empty; content }
107
108module Tree = struct
109 type tree = Tree of (t * tree list)
110
111 let flatten tree =
112 let rec flatten ~accm tree =
113 let (Tree (note, others)) = tree in
114 List.fold ~init:(note :: accm)
115 ~f:(fun accm note -> flatten ~accm note)
116 others
117 in
118 tree |> flatten ~accm:[]
119
120 let fst tree =
121 let (Tree (note, _)) = tree in
122 note
123
124 let note_to_json = to_json
125
126 let to_html tree =
127 let open Soup in
128 let rec to_nodes ~title others =
129 match others with
130 | [] ->
131 let li = create_element "li" in
132 append_child li (create_element ~inner_text:title "span");
133 li
134 | tl ->
135 let li = create_element "li" in
136 append_child li (create_element ~inner_text:title "span");
137 let ul = create_element "ul" in
138 append_child li ul;
139 tl
140 |> List.iter ~f:(fun other ->
141 let (Tree (root, others)) = other in
142 let title = (root |> frontmatter).path in
143 append_child ul (to_nodes ~title others));
144 li
145 in
146 let (Tree (root, others)) = tree in
147 let title = (root |> frontmatter).path in
148 let index = to_nodes ~title others in
149 let soup = Html.template |> parse in
150 index |> replace (soup $ "navigation");
151 soup |> to_string
152
153 let rec to_json tree =
154 let (Tree (root, others)) = tree in
155 Ezjsonm.dict
156 [
157 ("note", root |> note_to_json);
158 ( "descendants",
159 others |> List.map ~f:to_json |> Ezjsonm.list (fun a -> a) );
160 ]
161
162 let rec resolve_manifest ~path manifest =
163 match manifest |> Manifest.list ~path with
164 | [] -> []
165 | items ->
166 items
167 |> List.map ~f:(fun item ->
168 let path = item.path in
169 let slug = item.slug |> Slug.to_string in
170 let note =
171 In_channel.read_all slug |> of_string ~path:(Some path)
172 in
173 Tree (note, manifest |> resolve_manifest ~path))
174end
175
176(* high level adapter *)
177module Adapter = struct
178 type options = {
179 state_dir : string;
180 editor : string;
181 on_modification : string option;
182 }
183
184 let editor_command ~editor path = Format.sprintf "%s %s" editor path
185
186 let run_or_noop command =
187 match command with Some command -> command |> Sys_unix.command_exn | None -> ()
188
189 let load ~path options =
190 let manifest = options.state_dir |> Manifest.load_or_init in
191 (* initialize the root note *)
192 let root =
193 match manifest |> Manifest.find ~path with
194 | Some item ->
195 item.slug |> Slug.to_string |> In_channel.read_all |> of_string
196 | None -> (
197 match path with
198 | "/" ->
199 let manifest = manifest |> Manifest.create ~path:"/" in
200 let last = manifest.items |> List.hd_exn in
201 let slug = last.slug |> Slug.to_string in
202 let root = root_template |> of_string in
203 slug |> Out_channel.write_all ~data:(root |> to_string);
204 manifest |> Manifest.save;
205 root
206 | _ -> failwith "not found")
207 in
208 Tree.Tree (root, manifest |> Tree.resolve_manifest ~path)
209
210 let find ~path options =
211 let manifest = options.state_dir |> Manifest.load_or_init in
212 let item = manifest |> Manifest.find ~path in
213 match item with
214 | Some item ->
215 let slug = item.slug in
216 let note = slug |> Slug.to_string |> In_channel.read_all |> of_string in
217 Some note
218 | None -> failwith "not found"
219
220 let create ?(description = None) ?(tags = []) ?(content = None) ~path options
221 =
222 let manifest = options.state_dir |> Manifest.load_or_init in
223 let manifest = manifest |> Manifest.create ~path in
224 let item = manifest.items |> List.hd_exn in
225 let path = item.path in
226 let slug = item.slug in
227 (match content with
228 | Some content ->
229 let note = { frontmatter = { path; description; tags }; content } in
230 slug |> Slug.to_string |> Out_channel.write_all ~data:(note |> to_string)
231 | None ->
232 let note =
233 { frontmatter = { path; description; tags }; content = "" }
234 in
235 slug |> Slug.to_string |> Out_channel.write_all ~data:(note |> to_string);
236 slug |> Slug.to_string
237 |> editor_command ~editor:options.editor
238 |> Sys_unix.command_exn);
239 options.on_modification |> run_or_noop;
240 manifest |> Manifest.save
241
242 let remove ~path options =
243 let manifest = options.state_dir |> Manifest.load_or_init in
244 let item = manifest |> Manifest.find ~path in
245 match item with
246 | Some item ->
247 let slug = item.slug in
248 let manifest = manifest |> Manifest.remove ~path in
249 slug |> Slug.to_string |> Sys_unix.remove;
250 options.on_modification |> run_or_noop;
251 manifest |> Manifest.save
252 | None -> failwith "not found"
253
254 let edit ~path options =
255 let manifest = options.state_dir |> Manifest.load_or_init in
256 let item = manifest |> Manifest.find ~path in
257 match item with
258 | Some item ->
259 let slug = item.slug in
260 slug |> Slug.to_string
261 |> editor_command ~editor:options.editor
262 |> Sys_unix.command_exn;
263 let note = slug |> Slug.to_string |> In_channel.read_all |> of_string in
264 let adjusted_path = note.frontmatter.path in
265 (if not (Filename.equal adjusted_path item.path) then
266 let manifest =
267 manifest |> Manifest.move ~source:item.path ~dest:adjusted_path
268 in
269 manifest |> Manifest.save);
270 options.on_modification |> run_or_noop
271 | None -> failwith "not found"
272end
273
274include Adapter
275
276module Completion = struct
277 let suggest_paths ~hint options =
278 options.state_dir |> Manifest.load_or_init
279 |> Manifest.list ~path:(hint |> Filename.dirname)
280 |> List.map ~f:(fun item -> item.path)
281 |> List.filter ~f:(fun path -> path |> String.is_substring ~substring:hint)
282
283 let suggest_tags ~hint options =
284 let manifest = options.state_dir |> Manifest.load_or_init in
285 manifest.items
286 |> List.concat_map ~f:(fun item ->
287 let frontmatter =
288 item.slug |> Slug.to_string |> In_channel.read_all |> of_string
289 |> frontmatter
290 in
291 frontmatter.tags)
292 |> List.filter ~f:(fun tag -> tag |> String.is_substring ~substring:hint)
293end