1	open Core
2
3	module Util = struct
4	(* makes any relative path absolute *)
5	let fixpath path =
6	match path |> Filename.is_relative with
7	| true -> Filename.concat "/" path
8	| false -> path
9	end
10
11	module Item = struct
12	type t = { parent : Slug.t option; slug : Slug.t; path : string }
13
14	let compare t1 t2 = String.equal t1.path t2.path
15
16	let make ~parent ~slug ~path = { parent; slug; path }
17
18	let title item = item.path |> Filename.basename
19
20	let of_json ?(basepath = None) json =
21	let slug =
22	Ezjsonm.find json [ "slug" ]
23	|> Ezjsonm.get_string |> Slug.of_string ~basepath
24	in
25	let path = Ezjsonm.find json [ "path" ] |> Ezjsonm.get_string in
26	let parent =
27	match Ezjsonm.find_opt json [ "parent" ] with
28	| Some parent -> (
29	match parent with
30	| `Null -> None
31	| `String name -> Some (name |> Slug.of_string)
32	| _ -> failwith "parent should be null or a string")
33	| None -> None
34	in
35	{ slug; parent; path }
36
37	let to_json item =
38	let parent =
39	match item.parent with
40	| Some parent -> parent |> Slug.shortname |> Ezjsonm.string
41	| None -> Ezjsonm.unit ()
42	in
43	Ezjsonm.dict
44	[
45	("parent", parent);
46	("slug", item.slug |> Slug.shortname |> Ezjsonm.string);
47	("path", item.path |> Ezjsonm.string);
48	]
49	end
50
51	type t = { state_dir : string; items : Item.t list }
52
53	let make state_dir = { state_dir; items = [] }
54
55	let empty = { state_dir = ""; items = [] }
56
57	let of_json ?(state_dir = None) json =
58	let items =
59	Ezjsonm.find json [ "items" ]
60	|> Ezjsonm.get_list (fun item -> item |> Item.of_json ~basepath:state_dir)
61	in
62	let state_dir =
63	match state_dir with Some state_dir -> state_dir | None -> "/"
64	in
65	{ state_dir; items }
66
67	let to_json manifest =
68	let items = Ezjsonm.list Item.to_json manifest.items in
69	Ezjsonm.dict [ ("items", items) ]
70
71	let of_string ?(state_dir = None) manifest =
72	manifest |> Ezjsonm.from_string |> of_json ~state_dir
73
74	let to_string manifest = manifest |> to_json |> Ezjsonm.to_string
75
76	let lockfile manifest = Filename.concat manifest.state_dir "note.lock"
77
78	let mpath manifest = Filename.concat manifest.state_dir "manifest.json"
79
80	let lock manifest =
81	let lockfile = manifest |> lockfile in
82	match lockfile |> Sys_unix.file_exists with
83	| `Yes -> failwith "unable to aquire lock"
84	| `No | `Unknown -> Out_channel.write_all ~data:"<locked>" lockfile
85
86	let unlock manifest =
87	let lockfile = manifest |> lockfile in
88	match lockfile |> Sys_unix.file_exists with
89	| `Yes -> Sys_unix.remove lockfile
90	| `No | `Unknown -> ()
91
92	let load_or_init state_dir =
93	let mpath = Filename.concat state_dir "manifest.json" in
94	match Sys_unix.file_exists mpath with
95	| `Yes ->
96	mpath |> In_channel.read_all |> of_string ~state_dir:(Some state_dir)
97	| `No | `Unknown ->
98	mpath |> Out_channel.write_all ~data:(to_string empty);
99	make state_dir
100
101	let save manifest =
102	Out_channel.write_all ~data:(to_string manifest) (manifest |> mpath)
103
104	let find ~path manifest =
105	let path = path |> Util.fixpath in
106	manifest.items |> List.find ~f:(fun item -> Filename.equal item.path path)
107
108	(* TODO: no support for recursive operations yet *)
109	let create ~path manifest =
110	let path = path |> Util.fixpath in
111	if
112	Option.is_some
113	(manifest.items
114	|> List.find ~f:(fun item -> Filename.equal item.path path))
115	then failwith "duplicate entry"
116	else
117	let parent_dir = path |> Filename.dirname in
118	let last_slug =
119	match manifest.items |> List.hd with
120	| Some item -> Some item.slug
121	| None -> None
122	in
123	let next_slug = Slug.next ~last:last_slug manifest.state_dir in
124	match parent_dir with
125	| "." | "/" | "" ->
126	(* root entry *)
127	let item = Item.make ~parent:None ~slug:next_slug ~path in
128	{ manifest with items = item :: manifest.items }
129	| parent_dir -> (
130	let parent = manifest |> find ~path:parent_dir in
131	match parent with
132	| Some parent ->
133	let parent_slug = parent.slug in
134	let item =
135	Item.make ~parent:(Some parent_slug) ~slug:next_slug ~path
136	in
137	{ manifest with items = item :: manifest.items }
138	| None -> failwith "no parent")
139
140	let list ~path manifest =
141	let path = path |> Util.fixpath in
142	manifest.items
143	|> List.filter ~f:(fun item ->
144	String.equal (item.path |> Filename.dirname) path
145	&& not (String.equal item.path "/"))
146
147	let remove ~path manifest =
148	let path = path |> Util.fixpath in
149	match manifest |> list ~path |> List.length with
150	| 0 ->
151	let items =
152	manifest.items
153	|> List.filter ~f:(fun item -> not (Filename.equal item.path path))
154	in
155	{ manifest with items }
156	| _ -> failwith "will not delete recursively"
157
158	let move ~source ~dest manifest =
159	let source = source |> Util.fixpath in
160	let dest = dest |> Util.fixpath in
161	let item = manifest |> find ~path:source in
162	let others = manifest |> list ~path:source in
163	match others |> List.length with
164	| 0 -> (
165	match item with
166	| Some _ ->
167	let manifest = manifest |> remove ~path:source in
168	manifest |> create ~path:dest
169	| None -> failwith "not found")
170	| _ -> failwith "cannot update recursively"