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 =
+		let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in
-			A.predicate A.authored authors_opt
-			@ A.predicate A.keyworded keywords_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
+		let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ t.Text.title ^ "\t" ^ fname) in
-		match field_opt with
+		match values_opt with
-		| Some "keywords"-> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "keywords" e)))
 		| 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 time   = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in
-	let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"AUTHORS" ~doc:"texts with authors") in
+	let number = Arg.(value & opt (some int) None & info ["n"] ~docv:"NUMBER" ~doc:"number of entries to list") in
-	let keywords= Arg.(value & opt (some string) None & info ["k"; "keywords"] ~docv:"KEYWORDS" ~doc:"texts with keywords") 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
+		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 =
@@ -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 =
+		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"
+			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 ->
+		| texts ->
-			 (try Unix.mkdir "peers" 0o740 with Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
+			(try Unix.mkdir "peers" 0o740 with
-			 let dir = "peers/" ^ match Uri.host url with
+				Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
-			 	| None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
+			let dir = "peers/" ^ match Uri.host url with
-			 (match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
+				| None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
-			 | Ok _ -> ()
+			(match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
-			 | _ -> prerr_endline "Error making domain dir");
+			| Ok _ -> ()
-			 print_endline @@ "Copying into: " ^ dir;
+			| _ -> prerr_endline "Error making domain dir");
-			 let text_num = List.length texts in
+				print_endline (" => " ^ dir);
-			 let of_pck i x =
+				let numof_texts= string_of_int @@ List.length texts in
-				 print_string @@ "\rDownloading " ^ string_of_int (i+1) ^ "/" ^ string_of_int text_num; flush stdout;
+				let text_num_len = String.length numof_texts in
-				 match x with
+				let of_pck i x =
-				 | Msgpck.List (id::time::title::_authors::_topics) ->
+					Printf.printf "\r%*d/%s" text_num_len (i+1) numof_texts;
-					 (match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
+					flush stdout;
-					 | None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title)
+					match x with
-					 | Some id -> if newer Msgpck.(to_uint32 time) id dir then fn url dir id)
+					| Msgpck.List (id::time::title::_authors::_topics) ->
-				 | _ -> prerr_endline ("Invalid record structure")
+						(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
-			 in List.iteri of_pck texts)
+						| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title)
+						| 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
+		let date_string t = Ptime.to_date t |>
-		MsgSet.iter (fun (t,m) -> print_endline (Ptime.to_rfc3339 t ^ " @ " ^ m)) msgs
+			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

@@ -1,159 +1,166 @@
 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 list_take n =
-  match order with
+	let rec take acc n = function [] -> []
-  | None -> Array.fold_left (fold_valid_text store predicate fn) acc @@ Sys.readdir store
+		| x::_ when n = 1 -> x::acc
-  | Some comp ->
+		| x::xs -> take (x::acc) (n-1) xs
-     List.fold_left fn acc @@ List.fast_sort comp
+	in take [] n
-     @@ Array.fold_left (fold_valid_text store predicate (fun a e -> List.cons e a)) []
+
-     @@ Sys.readdir store
+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 ?(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 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/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 "id"; String "time";  String "title"; String "authors"; String "topics"])
-	 String "authors"; String "topics"])
 
 let to_pack a t =
 	let open Text in
-	Msgpck.(List [Bytes (Id.to_bytes t.uuid);
+	Msgpck.(List [
-		of_uint32 (date (Date.listing t.date));
+	Bytes (Id.to_bytes t.uuid); of_uint32 (date (Date.listing t.date));
-		String t.title; List (persons t.authors);
+	String t.title; List (persons t.authors); List (of_set "topics" t)]) :: a
-		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

@@ -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

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: [