Prettier txt messages

* `-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,52 +5,61 @@ 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 field_opt authors_opt keywords_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 ->
-		let predicates =
-			A.predicate A.authored authors_opt
-			@ A.predicate A.keyworded keywords_opt
-			@ A.predicate A.topics topics_opt
-		in
+		let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in
 		let predicate text = List.fold_left (fun a e -> a && e text) true predicates in
 		let print_fold ~predicate fn =
 			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 fname in
-		match field_opt with
-		| Some "keywords"-> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "keywords" e)))
+		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" ->
 				let s = A.fold ~predicate (fun a (e,_) -> Person.Set.union a e.Text.authors) Person.Set.empty archive in
 				print_endline @@ Person.Set.to_string s
 		| Some x -> prerr_endline @@ "Unrecognised field: " ^ x
-		| None -> match order_opt with false -> A.iter ~predicate list_text archive
+		| None -> match order_opt with
+			| 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 field = Arg.(value & opt (some string) None & info ["f"; "field"] ~docv:"FIELD" ~doc:"what to list") in
-	let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"AUTHORS" ~doc:"texts with authors") in
-	let keywords= Arg.(value & opt (some string) None & info ["k"; "keywords"] ~docv:"KEYWORDS" ~doc:"texts with keywords") 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 $ field $ authors $ keywords $ 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
-		print_endline @@ A.fold ~order:A.oldest last "" archive
+		let last_mine a ((t,_) as pair) =
+			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 =
@@ -63,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

dune-project

@@ -3,7 +3,7 @@
 (homepage "https://logarion.orbitalfox.eu")
 
 (source (uri git://orbitalfox.eu/logarion))
-(license EUPL)
+(license EUPL-1.2)
 (authors "orbifx")
 (maintainers "fox@orbitalfox.eu")
 (bug_reports "mailto:logarion@lists.orbitalfox.eu?subject=Issue:")

http/http.ml

@@ -7,9 +7,10 @@ let http_body fn uri =
 let response (headers, body) =
 	let open Cohttp in
 	match Header.get (headers |> Response.headers) "content-type" with
-	| Some "application/msgpack" | Some "text/plain" | Some "application/octet-stream" -> Ok body
+	| Some "application/msgpack" | Some "application/octet-stream"
+		| Some "text/plain" | Some "text/plain; charset=utf-8" -> Ok body
 	| Some x -> Error ("Invalid content-type: " ^ x)
-	| None -> Error ("No content-type")
+	| None -> Ok body
 
 let http_apply fn uri = Lwt_main.run (http_body fn uri)
 
@@ -27,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
@@ -47,30 +48,37 @@ let pull_text url dir id =
 (*TODO: adapt Archive predication function to work with free sets*)
 let parse_index _is_selected fn url = function
 	| Msgpck.List (info :: _fields :: [texts]) ->
-		let version, archive_name, _archivists =
-			match info with Msgpck.List (v::n::a) -> Msgpck.(to_int v, to_string n, a) | _ -> invalid_arg "Pack header"
+		let _version, archive_name, _archivists =
+			match info with Msgpck.List (v::n::a) -> Msgpck.(to_int v, to_string n, a)
+			| _ -> invalid_arg "Pack header"
 		in
-		print_endline @@ archive_name ^ " (pack format version " ^ string_of_int version ^ ")";
+		print_string archive_name;
 		(match Msgpck.to_list texts with
-		 | [] -> prerr_endline "Empty index"
+		| [] -> print_endline ", has empty index"
 		| texts ->
-			 (try Unix.mkdir "peers" 0o740 with Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
+			(try Unix.mkdir "peers" 0o740 with
+				Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
 			let dir = "peers/" ^ match Uri.host url with
 				| None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
 			(match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
 			| Ok _ -> ()
 			| _ -> prerr_endline "Error making domain dir");
-			 print_endline @@ "Copying into: " ^ dir;
-			 let text_num = List.length texts in
+				print_endline (" => " ^ dir);
+				let numof_texts= string_of_int @@ List.length texts in
+				let text_num_len = String.length numof_texts in
 				let of_pck i x =
-				 print_string @@ "\rDownloading " ^ string_of_int (i+1) ^ "/" ^ string_of_int text_num; flush stdout;
+					Printf.printf "\r%*d/%s" text_num_len (i+1) numof_texts;
+					flush stdout;
 					match x with
 					| Msgpck.List (id::time::title::_authors::_topics) ->
 						(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
 						| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title)
-					 | Some id -> if newer Msgpck.(to_uint32 time) id dir then fn url dir id)
-				 | _ -> prerr_endline ("Invalid record structure")
-			 in List.iteri of_pck texts)
+						| Some id ->
+							let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in
+							if newer t id dir then fn url dir id)
+					| _ -> prerr_endline ("Invalid record structure") in
+				List.iteri of_pck texts;
+				print_newline ())
 	| _ -> prerr_endline "malformed feed"
 
 let pull_index url _authors _topics =
@@ -102,8 +110,18 @@ let pull_msgs url _authors _topics = match http_apply response url with
 		in
 		let s = Scanf.Scanning.from_string body in
 		let msgs = MsgSet.empty in
-		let msgs = fold_msgs s msgs (fun msgs t m -> match Ptime.of_rfc3339 t with Ok (v,_,_) -> MsgSet.add (v,m) msgs | _ -> msgs) in
-		MsgSet.iter (fun (t,m) -> print_endline (Ptime.to_rfc3339 t ^ " @ " ^ m)) msgs
+		let date_string t = Ptime.to_date t |>
+			fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d in
+		let msgs = fold_msgs s msgs
+			(fun msgs t m -> match Ptime.of_rfc3339 t with
+			| Ok (v,_,_) -> let open MsgSet in
+				let msgs = if cardinal msgs > 1 then remove (max_elt msgs) msgs else msgs in
+				add (v,m) msgs
+			| _ -> msgs) in
+		print_endline ("\n┌────=[ " ^ Uri.to_string url);
+		MsgSet.iter
+			(fun (t,m) -> print_endline
+				("│ " ^ date_string t ^ "\n│\n│ " ^ m ^ "\n└─────────")) msgs
 
 let pull_fn url = match Uri.of_string url with
 	| x when x = Uri.empty -> (fun _ _ -> ())
@@ -111,7 +129,7 @@ let pull_fn url = match Uri.of_string url with
 	| x when Uri.scheme x = Some "msg+https"-> pull_msgs Uri.(with_scheme x (Some "https"))
 	| x -> pull_index x
 
-let pull_list auths topics = match open_in "peers.txt" with
+let pull_list auths topics = match open_in "peers.conf" with
 	| exception (Sys_error msg) -> prerr_endline msg
 	| file ->
 		let rec read () =

lib/file_store.ml

@@ -5,7 +5,7 @@ type archive_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
@@ -20,63 +20,71 @@ let file path content = let out = open_out path in
 
 let (//) a b = a ^ "/" ^ b
 
-let to_text dir filename = let f = dir // filename in
-  to_string f |> Text.of_string |> Result.map_error (fun m -> f^": "^m)
-
-let text_filetype dir name = try 
-    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 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"
 
 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)
+		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 =
-  if text_filetype dir p then
-    match to_text dir p with Error x -> prerr_endline x | Ok t -> if pred t then fn (t, p)
+let iter_valid_text pred fn p =
+	match to_text p with Error _ -> () | Ok t -> if pred t then fn (t, p)
 
-let fold_valid_text dir pred fn acc p =
-  if not (text_filetype dir p) then acc else
-    match to_text dir p with
-    Error _x -> acc | Ok t -> if pred t then fn acc (t, p) else acc
+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
 
-let iter ?(predicate=fun _ -> true) ?order fn {store;_} =
+let list_fs dir =
+	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 -> loop (f::result) fs
+	in loop [] [dir]
+
+let list_take n =
+	let rec take acc n = function [] -> []
+		| x::_ when n = 1 -> x::acc
+		| x::xs -> take (x::acc) (n-1) xs
+	in take [] n
+
+let iter ?(predicate=fun _ -> true) ?order ?number fn {store;_} =
 	match order with
-  | None -> Array.iter (iter_valid_text store predicate fn) @@ Sys.readdir store
+	| None -> List.iter (iter_valid_text predicate fn) @@ list_fs store
 	| Some comp ->
-     List.iter fn @@ List.fast_sort comp
-     @@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
-     @@ Sys.readdir store
+		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 ?(predicate=fun _ -> true) ?order fn acc {store;_} =
+let fold ?(predicate=fun _ -> true) ?order ?number fn acc {store;_} =
 	match order with
-  | None -> Array.fold_left (fold_valid_text store predicate fn) acc @@ Sys.readdir store
+	| None -> List.fold_left (fold_valid_text predicate fn) acc @@ list_fs store
 	| Some comp ->
-     List.fold_left fn acc @@ List.fast_sort comp
-     @@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
-     @@ Sys.readdir store
+		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 with_id { store; _ } id =
 	let matched acc path =
-    if not (text_filetype store path) then acc
-    else
-      match to_text store path with
+		match to_text path with
 		| Error x -> prerr_endline x; acc
+		| Ok text when text.Text.uuid <> id -> acc
 		| Ok text ->
-        if text.Text.uuid <> id then acc
-        else
 			match acc with
 			| Ok None -> Ok (Some text)
 			| 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
+	in List.fold_left matched (Ok None) (list_fs store)
 
 module Directory = struct
 	let print ?(descr="") dir result =
@@ -114,7 +122,6 @@ let uuid_filename repo extension text =
 	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) @@
 	fun path ->
 		try file path (Text.to_string new_text); Ok (path, new_text) with Sys_error s -> Error s
@@ -148,12 +155,12 @@ let of_path store =
 	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")
-        {
+	Ok (
+		of_string (to_string @@ store ^ "/.logarion/config") {
 			name = "";
 			archivists = Person.Set.empty;
 			id = Id.nil;
 			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/header_pack.ml

@@ -13,15 +13,13 @@ let date = function
 		Int32.add Int32.(mul (of_int days) 86400l) Int64.(to_int32 (div ps 1000000000000L))
 
 let columns = Msgpck.(List
-	[String "id"; String "time";  String "title";
-	 String "authors"; String "topics"])
+	[String "id"; String "time";  String "title"; String "authors"; String "topics"])
 
 let to_pack a t =
 	let open Text in
-	Msgpck.(List [Bytes (Id.to_bytes t.uuid);
-		of_uint32 (date (Date.listing t.date));
-		String t.title; List (persons t.authors);
-		List (of_set "topics" t)]) :: a
+	Msgpck.(List [
+	Bytes (Id.to_bytes t.uuid); of_uint32 (date (Date.listing t.date));
+	String t.title; List (persons t.authors); List (of_set "topics" t)]) :: a
 
 let pack_filename ?(filename="index.pck") archive =
 	let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)

lib/store.ml

@@ -10,6 +10,8 @@ module type T = sig
 	val oldest: record_t -> record_t -> int
 	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 iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> (record_t -> unit) -> archive_t -> unit
-  val fold: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ('a -> record_t -> 'a) -> 'a -> archive_t -> 'a
+	val iter: ?predicate:(Text.t -> bool) -> ?order:(record_t -> record_t -> int) -> ?number:int
+		-> (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

logarion.opam

@@ -3,7 +3,7 @@ opam-version: "2.0"
 synopsis: "Texts archival and exchange"
 maintainer: ["fox@orbitalfox.eu"]
 authors: ["orbifx"]
-license: "EUPL"
+license: "EUPL-1.2"
 homepage: "https://logarion.orbitalfox.eu"
 bug-reports: "mailto:logarion@lists.orbitalfox.eu?subject=Issue:"
 depends: [