Implement author & topic filter for txt pull

cli/pull.ml

@@ -49,42 +49,44 @@ let print_peers p =
 	| ps -> print_endline @@
 		List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps
 
-let parse_index _is_selected fn url dir p =
-	let open Logarion.Header_pack in
-	match Msgpck.to_list p.texts with
-	| [] -> Printf.printf "%s => %s, has empty index\n" p.info.title dir; false
-	| texts ->
-		let numof_texts = string_of_int @@ List.length texts in
-		let text_num_len = String.length numof_texts in
-		Printf.printf "%*d/%s %s => %s\r" text_num_len 0 numof_texts p.info.title dir;
-		let of_pck i x =
-			Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts;
-			match x with
-			| Msgpck.List (id::time::title::_authors::_topics) ->
-				(match Logarion.Header_pack.to_id id with
-				| "" -> Printf.eprintf "Invalid id for%s " (Msgpck.to_string title)
-				| 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 ();
-		true
+type filter_t = { authors: Logarion.Person.Set.t; topics: Logarion.String_set.t }
+
+let print_pull_start width total title dir =
+	Printf.printf "%*d/%s %s => %s %!" width 0 total title dir
+
+let print_pull width total i =
+	Printf.printf "\r%*d/%s %!" width (i+1) total
+
+let printers total title dir =
+	let width = String.length total in
+	print_pull_start width total title dir;
+	print_pull width total
 
 let fname dir text = Filename.concat dir (Logarion.Text.short_id text ^ ".txt")
+
 let pull_text url dir id =
 	let u = Filename.concat url ((Logarion.Id.short id) ^ ".txt") in
 	match curl_pull u with
 	| Error msg -> Printf.eprintf "Failed getting %s: %s" u msg
-	| Ok txt ->
-		let txt = Buffer.contents txt in
+	| Ok txt -> let txt = Buffer.contents txt in
 		match Logarion.Text.of_string txt with
 		| Error s -> prerr_endline s
 		| Ok text ->
 			let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in
 			output_string file txt; close_out file
 
-let pull_index url _authors _topics =
+let per_text url dir filter print i id time title authors topics = match id with
+	| "" -> Printf.eprintf "\nInvalid id for %s\n" title
+	| id -> let open Logarion in
+		print i;
+		if newer time id dir
+		&& (String_set.empty = filter.topics
+			|| String_set.exists (fun t -> List.mem t topics) filter.topics)
+		&& (Person.Set.empty = filter.authors
+			|| Person.Set.exists (fun t -> List.mem (Person.to_string t) authors) filter.authors)
+		then pull_text url dir id
+
+let pull_index url authors_opt topics_opt =
 	let index_url = url ^ "/index.pck" in
 	match curl_pull index_url with
 	| Error s -> prerr_endline s; false
@@ -94,15 +96,18 @@ let pull_index url _authors _topics =
 		| Ok pk ->
 			let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in
 			Logarion.File_store.with_dir dir;
-			let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (Filename.concat dir "index.pck") in
+			let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640
+				(Filename.concat dir "index.pck") in
 			output_string file ( Logarion.Header_pack.string {
 					pk with info = { pk.info with locations = url::pk.info.locations }});
 			close_out file;
-(*			let predicates = A.predicate A.authored authors_opt*)
-(*				@ A.predicate A.topics topics_opt in*)
-			let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in
-			try parse_index is_selected pull_text url dir pk with
-			Invalid_argument msg -> Printf.eprintf "Failed to parse: %s\n%!" msg; false
+			let filter = let open Logarion in {
+				authors = (match authors_opt with Some s -> Person.Set.of_string s | None -> Person.Set.empty);
+				topics =( match topics_opt with Some s -> String_set.of_string s | None -> String_set.empty);
+			} in
+			let print = printers (string_of_int @@ Logarion.Header_pack.numof_texts pk) pk.info.title dir in
+			try Logarion.Header_pack.iteri (per_text url dir filter print) pk; print_newline (); true
+			with Invalid_argument msg -> Printf.eprintf "\nFailed to parse %s: %s\n%!" url msg; false
 
 let pull_list auths topics =
 	Curl.global_init Curl.CURLINIT_GLOBALALL;

lib/header_pack.ml

@@ -68,6 +68,19 @@ let contains text = function
 		 | id -> text.Text.id = id)
 	| _ -> prerr_endline ("Invalid record pattern"); false
 
+let numof_texts pack = List.length (Msgpck.to_list pack.texts)
+
+let iteri fn pack =
+	let of_pck i = function Msgpck.List (id::time::title::authors::topics::[]) ->
+		let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i
+			| x -> Msgpck.to_uint32 x in
+		let id = to_id id in
+		let title = Msgpck.to_string title in
+		let topics = to_str_list topics in
+		let authors = to_str_list authors in
+		fn i id t title authors topics
+	| _  -> prerr_endline ("\n\nInvalid record structure\n\n")
+	in List.iteri of_pck (Msgpck.to_list pack.texts);
 
 (*let pack_filename ?(filename="index.pck") archive =*)
 (*	let dir = Store.KV.find "Export-Dir" archive.File_store.kv in (*raises Not_found*)*)