Index: trunk/lib/file_store.ml
===================================================================
--- trunk/lib/file_store.ml	(revision 2)
+++ trunk/lib/file_store.ml	(revision 3)
@@ -1,51 +1,64 @@
 type t = string
-type item_t = string
-type archive_t = {
-	name: string; archivists: Person.Set.t; id: Id.t;
-	kv: string Store.KV.t; store: t }
+type item_t = t list
 type record_t = Text.t * item_t
 
 let extension = ".txt"
+let def_dir = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
 
 let to_string f =
 	let ic = open_in f in
-	let n = in_channel_length ic in
-	let s = Bytes.create n in
-	really_input ic s 0 n;
+	let s = really_input_string ic (in_channel_length ic) in
 	close_in ic;
-	Bytes.to_string s
+	s
 
-let file path content = let out = open_out path in
-	output_string out content; close_out out
+let fold_file_line fn init file = match open_in file with
+	| exception (Sys_error msg) -> prerr_endline msg; init
+	| file ->
+		let rec read acc = match input_line file with
+			| "" as s | s when String.get s 0 = '#' -> read acc
+			| s -> read (fn s acc)
+			| exception End_of_file -> close_in file; acc
+		in read init
 
-let (//) a b = a ^ "/" ^ b
+let file path str = let o = open_out path in output_string o str; close_out o
 
 let to_text path =
 	if Filename.extension path = extension then
 		(to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
-	else Error "Not txt"
+	else Error (Printf.sprintf "Not txt: %s" path)
 
 let newest (a,_pa) (b,_pb) = Text.newest a b
 let oldest (a,_pa) (b,_pb) = Text.oldest a b
 
-let list_iter fn {store;_} paths =
-	let link f = match to_text (Filename.concat store f)
-		with Ok t -> fn store t f | Error s -> prerr_endline s in
+let list_iter fn dir paths =
+	let link f = match to_text (Filename.concat dir f) with
+		| Ok t -> fn dir t f | Error s -> prerr_endline s in
 	List.iter link paths
 
-let iter_valid_text pred fn p =
-	match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
+module TextMap = Map.Make(Text)
 
-let fold_valid_text pred fn acc p =
-	match to_text p with Error _ -> acc | Ok t -> if pred t then fn acc (t, p) else acc
+type iteration_t = item_t TextMap.t
+let new_iteration = TextMap.empty
 
-let list_fs dir =
+(*let iter_valid_text pred fn path =*)
+(*	match to_text path with Error _ -> () | Ok t -> if pred t then fn (t, p)*)
+
+let fold_valid_text pred it path =
+	match to_text path with Error _ -> it
+	| Ok t -> if pred t then (TextMap.update t
+			(function None -> Some [path] | Some ps -> Some (path::ps)) it
+		) else it
+
+(* Compare file system nodes to skip reparsing? *)
+let list_fs ?(r=false) dir =
+	let valid_dir f = r && String.get f 0 <> '.' && Sys.is_directory f in
+	let expand_dir d = Array.(to_list @@ map (Filename.concat d) (Sys.readdir d)) in
 	let rec loop result = function
-		| [] -> result
-		| f::fs when Sys.is_directory f ->
-			Array.map (Filename.concat f) (Sys.readdir f)
-			|> Array.to_list |> List.append fs |> loop result
+		| f::fs when valid_dir f -> expand_dir f |> List.append fs |> loop result
 		| f::fs -> loop (f::result) fs
-	in loop [] [dir]
+		| [] -> result in
+	let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else
+		if not r then expand_dir dir else [dir] in
+	loop [] dirs
 
 let list_take n =
@@ -55,29 +68,26 @@
 	in take [] n
 
-let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
-	match order with
-	| None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
-	| Some comp ->
-		List.iter fn
-		@@ (match number with None -> (fun x -> x) | Some n -> list_take n)
-		@@ List.fast_sort comp
-		@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
-		@@ list_fs store
+let fold_sort_take ?(predicate=fun _ -> true) ?(number=None) comp flist =
+	(match number with None -> (fun x -> x) | Some n -> list_take n)
+	@@ List.fast_sort comp @@ TextMap.bindings
+	@@ List.fold_left (fold_valid_text predicate) new_iteration flist
 
-let fold ?(predicate=fun _ -> true) ?order ?number fn acc {store;_} =
-	match order with
-	| None -> List.fold_left (fold_valid_text predicate fn) acc @@ list_fs store
-	| Some comp ->
-		List.fold_left fn acc
-		@@ (match number with None -> (fun x -> x) | Some n -> list_take n)
-		@@ List.fast_sort comp
-		@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
-		@@ list_fs store
+let iter ?(r=false) ?(dir=def_dir) ?(predicate=fun _ -> true) ?order ?number fn =
+	let flist = list_fs ~r dir in match order with
+	| Some comp -> List.iter fn @@ fold_sort_take ~predicate ~number comp flist
+	| None -> List.iter fn @@ TextMap.bindings @@
+		List.fold_left (fold_valid_text predicate) new_iteration flist
 
-let with_id { store; _ } id =
+let fold ?(r=false) ?(dir=def_dir) ?(predicate=fun _ -> true) ?order ?number fn acc =
+	let flist = list_fs ~r dir in match order with
+	| Some comp -> List.fold_left fn acc @@ fold_sort_take ~predicate ~number comp flist
+	| None -> List.fold_left fn acc @@ TextMap.bindings @@
+		List.fold_left (fold_valid_text predicate) new_iteration flist
+
+let with_id ?(r=false) ?(dir=def_dir) id =
 	let matched acc path =
 		match to_text path with
 		| Error x -> prerr_endline x; acc
-		| Ok text when text.Text.uuid <> id -> acc
+		| Ok text when text.Text.id <> id -> acc
 		| Ok text ->
 			match acc with
@@ -85,82 +95,52 @@
 			| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
 			| Error x -> Error (text :: x)
-	in List.fold_left matched (Ok None) (list_fs store)
+	in List.fold_left matched (Ok None) (list_fs ~r dir)
 
-module Directory = struct
-	let print ?(descr="") dir result =
-		let () = match result with
-			| Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
-			| Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
-			| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
-		in
-		result
+let with_dir ?(descr="") ?(perm=0o740) dir =
+	let mkdir dir = match Unix.mkdir dir perm with
+	| exception Unix.Unix_error (EEXIST, _, _) -> ()
+	| exception Unix.Unix_error (code, _fn, arg) ->
+		failwith @@ Printf.sprintf "Error %s making %s dir: %s"
+			(Unix.error_message code) descr arg
+	| _ -> () in
+	let rec mkeach path = function [] | [""] -> () | ""::t -> mkeach path t
+		| hd::t -> let d = Filename.concat path hd in mkdir d; mkeach d t in
+	mkeach
+		(if Filename.is_relative dir then "" else "/")
+		(String.split_on_char '/' dir)
 
-	let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
-
-	let rec directories = function
-		| [] -> Ok ()
-		| (d, descr)::tl ->
-			match directory d |> print ~descr d with
-			| Ok _ -> directories tl
-			| Error _ -> Error (d, descr)
-end
-
-let copy ?(recursive = false) src dst =
-	Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
+let rec with_dirs = function [] -> () | (d, descr)::tl -> with_dir ~descr d; with_dirs tl
 
 let versioned_basename_of_title ?(version=0) repo extension (title : string) =
 	let basename = Text.string_alias title in
 	let rec next version =
-		let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
+		let candidate = Filename.concat repo
+			(basename ^ "." ^ string_of_int version ^ extension) in
 		if Sys.file_exists candidate then next (succ version) else candidate
 	in
 	next version
 
-let uuid_filename repo extension text =
+let id_filename repo extension text =
 	let basename = Text.alias text in
-	let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
+	let candidate = Filename.concat repo (text.id ^ "." ^ basename ^ extension) in
 	if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
 
-let with_text {store;_} new_text =
-	Result.bind (uuid_filename store extension new_text) @@
-	fun path ->
-		try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
-
-let basic_config () =
-	"Archive-Name: "
-	^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
-	^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
-	|> Bytes.of_string
-
-let init ?(dotdir=".logarion/") () =
-	match Directory.directories [dotdir, "dotdir"] with
-	| Error (_dir, _desc) -> ()
-	| Ok () ->
-		let config_file =
-			open_out_gen [Open_creat; Open_excl; Open_wronly]
-				0o700 (dotdir // "config") in
-		output_bytes config_file (basic_config ());
-		close_out config_file
+let with_text ?(dir=def_dir) new_text =
+	match id_filename dir extension new_text with
+	| Error _ as e -> e
+	| Ok path ->
+		try file path (Text.to_string new_text); Ok (path, new_text)
+		with Sys_error s -> Error s
 
 module Config = struct
-	type t = archive_t
-	let key_value k v a = match k with
-		| "Archive-Name" -> { a with name = String.trim v }
-		| "Archive-ID" -> { a with id = Option.get (Id.of_string (String.trim v)) }
-		| "Archivists" -> { a with archivists = Person.Set.of_string v }
-		| _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
+	type t = string Store.KV.t
+	let key_value k v a = Store.KV.add k (String.trim v) a
 end
 
-let of_path store =
+let of_kv_file path =
 	let open Text_parse in
-	let subsyntaxes = [| (module Parsers.Key_value.Make (Config) : Parser.S with type t = Config.t); (module Parsers.Key_value.Make (Config)); |] in
-	let of_string text acc = Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
-	Ok (
-		of_string (to_string @@ store ^ "/.logarion/config") {
-			name = "";
-			archivists = Person.Set.empty;
-			id = Id.nil;
-			kv = Store.KV.empty;
-			store = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
-		}
-	)
+	let subsyntaxes = Parsers.Key_value.[|
+		(module Make (Config) : Parser.S with type t = Config.t); (module Make (Config)); |] in
+	let of_string text acc =
+		Parser.parse subsyntaxes { text; pos = 0; right_boundary = String.length text - 1 } acc in
+	of_string (to_string @@ path) Store.KV.empty
