Dictory-recursing archives & peer text features

* `-n` number option for `txt ls`, limits number of ordered lines printed
* `--values` string option to select listing of field values instead of entries
* `--mine` for `txt last`, prints last text authored by archivist

cli/cli.ml

@@ -5,7 +5,7 @@ open Logarion
 module A = Logarion.Archive.Make(File_store)
 
 (* TODO: merge in lib/ so other modules can use (.e.g HTTP pull) *)
-let text_list order_opt reverse_opt values_opt authors_opt topics_opt =
+let text_list order_opt reverse_opt number_opt values_opt authors_opt topics_opt =
 	match A.of_path (Sys.getcwd ()) with
 	| Error msg -> prerr_endline msg
 	| Ok archive ->
@@ -15,7 +15,7 @@ let text_list order_opt reverse_opt values_opt authors_opt topics_opt =
 			let ts = A.fold ~predicate fn String_set.empty archive in
 			String_set.iter (print_endline) ts
 		in
-		let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ fname) in
+		let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ t.Text.title ^ "\t" ^ fname) in
 		match values_opt with
 		| Some "topics" -> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "topics" e)))
 		| Some "authors" ->
@@ -26,26 +26,40 @@ let text_list order_opt reverse_opt values_opt authors_opt topics_opt =
 			| false -> A.iter ~predicate list_text archive
 			| true ->
 				let order = match reverse_opt with true -> A.newest | false -> A.oldest in
-				A.iter ~predicate ~order list_text archive
+				match number_opt with
+				| Some number -> A.iter ~predicate ~order ~number list_text archive
+				| None -> A.iter ~predicate ~order list_text archive
 
 let list_term =
-	let time  = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in
 	let reverse = Arg.(value & flag & info ["r"] ~doc:"reverse order") in
-	let values  = Arg.(value & opt (some string) None & info ["values"] ~docv:"HEADER-FIELD" ~doc:"unique values for header field") in
+	let time   = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in
+	let number = Arg.(value & opt (some int) None & info ["n"] ~docv:"NUMBER" ~doc:"number of entries to list") in
+	let values = Arg.(value & opt (some string) None & info ["values"] ~docv:"HEADER-FIELD" ~doc:"unique values for header field") in
 	let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv:"AUTHORS" ~doc:"texts by authors") in
 	let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"TOPICS" ~doc:"texts with topics") in
-	Term.(const text_list $ time $ reverse $ values $ authed $ topics),
+	Term.(const text_list $ time $ reverse $ number $ values $ authed $ topics),
 	Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts" ]
 
-let print_last () =
+let print_last search_mine =
+	let last a ((t,_) as pair) = match a with None -> Some pair
+		| Some (t', _) as pair' -> if Text.newest t t' > 0 then Some pair else pair' in
 	match A.of_path (Sys.getcwd ()) with
 	| Error msg -> prerr_endline msg
 	| Ok archive ->
-		let last a (_t,fname) = match a with "" -> fname | x -> x in
+		let last_mine a ((t,_) as pair) =
-		print_endline @@ A.fold ~order:A.oldest last "" archive
+			let open Text in
+			match a with None ->
+				if Person.Set.subset archive.A.archivists t.authors then Some pair else None
+			| Some (t', _) as pair' ->
+				if Text.newest t t' > 0 && Person.Set.subset archive.A.archivists t'.authors
+				then Some pair else pair'
+		in
+		match A.fold (if search_mine then last_mine else last) None archive with
+		| Some (_,f) -> print_endline f | None -> ()
 
 let last_term =
-	Term.(const print_last $ const ()),
+	let mine = Arg.(value & flag & info ["mine"] ~doc:"last text authored by me") in
+	Term.(const print_last $ mine),
 	Term.info "last" ~doc:"most recent test" ~man:[ `S "DESCRIPTION"; `P "Print the filename of most recent text" ]
 
 let split_filetypes files =
@@ -58,7 +72,7 @@ let file files = match A.of_path "." with
 		let dirs, files = split_filetypes files in
 		let _link_as_named dir file = Unix.link file (dir ^"/"^ file) in
 		let link_with_id dir file =
-			match File_store.to_text "." file with Error s -> prerr_endline s
+			match File_store.to_text file with Error s -> prerr_endline s
 			| Ok t -> Unix.link file (dir ^"/"^ String.sub (Id.to_string (t.Text.uuid)) 0 8 ^".txt")
 		in
 		let link = link_with_id in

http/http.ml

@@ -28,7 +28,7 @@ let sub_id text = Logarion.(String.sub (text.Text.uuid |> Id.to_string) 0 8)
 let fname dir text = dir ^ sub_id text ^ ".txt"
 
 let newer time id dir =
-	match Logarion.File_store.to_text dir (String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") with
+	match Logarion.File_store.to_text @@ Filename.concat dir (String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") with
 	| Error x -> prerr_endline x; true
 	| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date)))
 	| exception (Sys_error _) -> true

lib/file_store.ml

@@ -1,159 +1,160 @@
 type t = string
 type item_t = string
 type archive_t = {
-  name: string; archivists: Person.Set.t; id: Id.t;
+	name: string; archivists: Person.Set.t; id: Id.t;
-  kv: string Store.KV.t; store: t }
+	kv: string Store.KV.t; store: t }
 type record_t = Text.t * item_t
 
-let extensions = [ ".txt" ]
+let extension = ".txt"
 
 let to_string f =
-  let ic = open_in f in
+	let ic = open_in f in
-  let n = in_channel_length ic in
+	let n = in_channel_length ic in
-  let s = Bytes.create n in
+	let s = Bytes.create n in
-  really_input ic s 0 n;
+	really_input ic s 0 n;
-  close_in ic;
+	close_in ic;
-  Bytes.to_string s
+	Bytes.to_string s
 
 let file path content = let out = open_out path in
-  output_string out content; close_out out
+	output_string out content; close_out out
 
 let (//) a b = a ^ "/" ^ b
 
-let to_text dir filename = let f = dir // filename in
+let to_text path =
-  to_string f |> Text.of_string |> Result.map_error (fun m -> f^": "^m)
+	if Filename.extension path = extension then
-
+		(to_string path |> Text.of_string |> Result.map_error (fun m -> path ^": "^ m))
-let text_filetype dir name = try 
+	else Error "Not txt"
-    let open Fpath in
-    let v = v name in
-    mem_ext extensions v && not (Sys.is_directory @@ dir^"/"^name)
-  with Invalid_argument str ->
-    prerr_endline ("file: " ^ name ^ " invalid (" ^ str ^ ")"); false
 
 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 store f with Ok t -> fn store t f  | Error s -> prerr_endline s in
+	let link f = match to_text (Filename.concat store f)
-  List.iter link paths
+		with Ok t -> fn store t f | Error s -> prerr_endline s in
+	List.iter link paths
 
-let iter_valid_text dir pred fn p =
+let iter_valid_text pred fn p =
-  if text_filetype dir p then
+	match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
-    match to_text dir p with Error x -> prerr_endline x | Ok t -> if pred t then fn (t, p)
 
-let fold_valid_text dir pred fn acc p =
+let fold_valid_text pred fn acc p =
-  if not (text_filetype dir p) then acc else
+	match to_text p with Error _ -> acc | Ok t -> if pred t then fn acc (t, p) else acc
-    match to_text dir p with
-    Error _x -> acc | Ok t -> if pred t then fn acc (t, p) else acc
 
-let iter ?(predicate=fun _ -> true) ?order fn {store;_} =
+let list_fs dir =
-  match order with
+	let rec loop result = function
-  | None -> Array.iter (iter_valid_text store predicate fn) @@ Sys.readdir store
+		| [] -> result
-  | Some comp ->
+		| f::fs when Sys.is_directory f ->
-     List.iter fn @@ List.fast_sort comp
+			Array.map (Filename.concat f) (Sys.readdir f)
-     @@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
+			|> Array.to_list |> List.append fs |> loop result
-     @@ Sys.readdir store
+		| f::fs -> loop (f::result) fs
+	in loop [] [dir]
 
-let fold ?(predicate=fun _ -> true) ?order fn acc {store;_} =
+let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
-  match order with
+	match order with
-  | None -> Array.fold_left (fold_valid_text store predicate fn) acc @@ Sys.readdir store
+	| None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
-  | Some comp ->
+	| Some comp ->
-     List.fold_left fn acc @@ List.fast_sort comp
+		List.iter fn
-     @@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
+		@@ (match number with None -> (fun x -> x) | Some n -> List.filteri (fun x _ -> x < n))
-     @@ Sys.readdir store
+		@@ List.fast_sort comp
+		@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
+		@@ list_fs store
+
+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.filteri (fun x _ -> x < n))
+		@@ List.fast_sort comp
+		@@ List.fold_left (fold_valid_text predicate (fun a e -> List.cons e a)) []
+		@@ list_fs store
 
 let with_id { store; _ } id =
-  let matched acc path =
+	let matched acc path =
-    if not (text_filetype store path) then acc
+		match to_text path with
-    else
+		| Error x -> prerr_endline x; acc
-      match to_text store path with
+		| Ok text when text.Text.uuid <> id -> acc
-      | Error x -> prerr_endline x; acc
+		| Ok text ->
-      | Ok text ->
+			match acc with
-        if text.Text.uuid <> id then acc
+			| Ok None -> Ok (Some text)
-        else
+			| Ok (Some prev) -> if prev = text then acc else Error [text; prev]
-          match acc with
+			| Error x -> Error (text :: x)
-          | Ok None -> Ok (Some text)
+	in List.fold_left matched (Ok None) (list_fs store)
-          | Ok (Some prev) -> if prev = text then acc else Error [text; prev]
-          | Error x -> Error (text :: x)
-  in
-  Array.fold_left matched (Ok None) @@ Sys.readdir store
 
 module Directory = struct
-  let print ?(descr="") dir result =
+	let print ?(descr="") dir result =
-    let () = match result with
+		let () = match result with
-      | Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
+			| Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir)
-      | Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
+			| Ok false -> print_endline ("Using existing " ^ descr ^ " directory " ^ dir)
-      | Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
+			| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
-    in
+		in
-    result
+		result
 
-  let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
+	let directory dir = Result.bind (Fpath.of_string dir) Bos.OS.Dir.create
 
-  let rec directories = function
+	let rec directories = function
-    | [] -> Ok ()
+		| [] -> Ok ()
-    | (d, descr)::tl ->
+		| (d, descr)::tl ->
-       match directory d |> print ~descr d with
+			match directory d |> print ~descr d with
-       | Ok _ -> directories tl
+			| Ok _ -> directories tl
-       | Error _ -> Error (d, descr)
+			| 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))
+	Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst))
 
 let versioned_basename_of_title ?(version=0) repo extension (title : string) =
-  let basename = Text.string_alias title in
+	let basename = Text.string_alias title in
-  let rec next version =
+	let rec next version =
-    let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
+		let candidate = repo // basename ^ "." ^ string_of_int version ^ extension in
-    if Sys.file_exists candidate then next (succ version) else candidate
+		if Sys.file_exists candidate then next (succ version) else candidate
-  in
+	in
-  next version
+	next version
 
 let uuid_filename repo extension text =
-  let basename = Text.alias text in
+	let basename = Text.alias text in
-  let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
+	let candidate = repo // String.sub (Id.to_string text.uuid) 0 6 ^ "." ^ basename ^ extension in
-  if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
+	if Sys.file_exists candidate then Error "Name clash, try again" else Ok candidate
 
 let with_text {store;_} new_text =
-  let extension = List.hd extensions in
+	Result.bind (uuid_filename store extension new_text) @@
-  Result.bind (uuid_filename store extension new_text) @@
+	fun path ->
-  fun path ->
+		try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
-    try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
 
 let basic_config () =
-  "Archive-Name: "
+	"Archive-Name: "
-  ^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
+	^ "\nArchive-ID: " ^ Id.(generate () |> to_string)
-  ^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
+	^ "\nArchivists: " ^ Bos.OS.Env.opt_var "USER" ~absent:""
-  |> Bytes.of_string
+	|> Bytes.of_string
 
 let init ?(dotdir=".logarion/") () =
-  match Directory.directories [dotdir, "dotdir"] with
+	match Directory.directories [dotdir, "dotdir"] with
-  | Error (_dir, _desc) -> ()
+	| Error (_dir, _desc) -> ()
-  | Ok () ->
+	| Ok () ->
-     let config_file =
+		let config_file =
-       open_out_gen [Open_creat; Open_excl; Open_wronly]
+			open_out_gen [Open_creat; Open_excl; Open_wronly]
-         0o700 (dotdir // "config") in
+				0o700 (dotdir // "config") in
-     output_bytes config_file (basic_config ());
+		output_bytes config_file (basic_config ());
-     close_out config_file
+		close_out config_file
 
 module Config = struct
-  type t = archive_t
+	type t = archive_t
-  let key_value k v a = match k with
+	let key_value k v a = match k with
-    | "Archive-Name" -> { a with name = String.trim v }
+		| "Archive-Name" -> { a with name = String.trim v }
-    | "Archive-ID" -> { a with id = Option.get (Id.of_string (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 }
+		| "Archivists" -> { a with archivists = Person.Set.of_string v }
-    | _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
+		| _ -> { a with kv = Store.KV.add k (String.trim v) a.kv }
 end
 
 let of_path store =
-  let open Text_parse in
+	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 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
+	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")
+	Ok (
-        {
+		of_string (to_string @@ store ^ "/.logarion/config") {
-          name = "";
+			name = "";
-          archivists = Person.Set.empty;
+			archivists = Person.Set.empty;
-          id = Id.nil;
+			id = Id.nil;
-          kv = Store.KV.empty;
+			kv = Store.KV.empty;
-          store = Bos.OS.Env.opt_var "LOGARION_DIR" ~absent:(Sys.getcwd ())
+			store = try Sys.getenv "LOGARION_DIR" with Not_found -> "."
-        }
+		}
-    )
+	)

lib/store.ml

@@ -1,15 +1,17 @@
 module KV = Map.Make (String)
 
 module type T = sig
-  type t
+	type t
-  type item_t
+	type item_t
-  type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
+	type archive_t = { name: string; archivists: Person.Set.t; id: Id.t; kv: string KV.t; store: t }
-  type record_t = Text.t * item_t
+	type record_t = Text.t * item_t
-  val of_path: string -> (archive_t, string) result
+	val of_path: string -> (archive_t, string) result
-  val newest: record_t -> record_t -> int
+	val newest: record_t -> record_t -> int
-  val oldest: record_t -> record_t -> int
+	val oldest: record_t -> record_t -> int
-  val with_id: archive_t -> Id.t -> (Text.t option, Text.t list) result
+	val with_id: archive_t -> Id.t -> (Text.t option, Text.t list) result
-  val with_text: archive_t -> Text.t -> (string * Text.t, string) result
+	val with_text: archive_t -> Text.t -> (string * Text.t, string) result
-  val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> (record_t -> unit) -> archive_t -> unit
+	val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
-  val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a
+		-> (record_t -> unit) -> archive_t -> unit
+	val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
+		-> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a
 end