Relation dates, with conversion condition upon it

git-svn-id: file:///srv/svn/repo/kosuzu/trunk@43 eb64cd80-c68d-6f47-b6a3-0ada418499da

cli/conversion.ml

@@ -1,16 +1,60 @@
 open Logarion
 
-module Ref_set = Set.Make(String)
+module Rel = struct
+
+module Rel_set = Set.Make(String)
 module Id_map = Map.Make(String)
 
+type t = { last_rel: string; ref_set: String_set.t; rep_set: String_set.t }
+type map_t = t Id_map.t
+
+let empty = { last_rel = ""; ref_set = Rel_set.empty; rep_set = Rel_set.empty }
+let empty_map = Id_map.empty
+
+let acc_ref date source target = Id_map.update target (function
+	| None -> Some { last_rel = date;
+		ref_set = Rel_set.singleton source;
+		rep_set = Rel_set.empty }
+	| Some rel -> Some { rel with
+		last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel;
+		ref_set = Rel_set.add source rel.ref_set })
+
+let acc_rep date source target = Id_map.update target (function
+	| None -> Some { last_rel = date;
+		rep_set = Rel_set.singleton source;
+		ref_set = Rel_set.empty }
+	| Some rel -> Some { rel with
+		last_rel = if Date.compare date rel.last_rel > 0 then date else rel.last_rel;
+		rep_set = Rel_set.add source rel.rep_set })
+
+let acc_txt rels (text, _paths) =
+	let acc_ref = acc_ref (Date.listing text.Text.date) text.Text.id in
+	let acc_rep = acc_rep (Date.listing text.Text.date) text.Text.id in
+	let rels = String_set.fold acc_ref (Text.set "references" text) rels in
+	let rels = String_set.fold acc_rep (Text.set "in-reply-to" text) rels in
+	rels
+
+let acc_pck rels peer =
+	let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _->"" in
+	try Header_pack.fold
+		(fun rels id t _title _authors _topics refs_ls reps_ls ->
+			let acc_ref = acc_ref (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in
+			let acc_rep = acc_rep (Date.of_secs @@ Int32.to_int t) (Filename.concat path id) in
+			let rels = String_set.fold acc_ref (String_set.of_list refs_ls) rels in
+			let rels = String_set.fold acc_rep (String_set.of_list reps_ls) rels in
+			rels)
+		rels peer.Peers.pack
+	with e -> prerr_endline "acc_pck"; raise e
+end
+
+
 type t = {
 	id: string;
 	dir: string;
 	kv: string Store.KV.t;
 	topic_roots: string list;
 	topics: (String_set.t * String_set.t) Topic_set.Map.t;
-	references: Ref_set.t Id_map.t;
+	relations: Rel.map_t;
-	replies: Ref_set.t Id_map.t;
 	texts: Text.t list
 }
 
@@ -25,7 +69,6 @@ let empty () = {
 	kv = Store.KV.empty;
 	topic_roots = [];
 	topics = Topic_set.Map.empty;
-	references = Id_map.empty;
+	relations = Rel.Id_map.empty;
-	replies = Id_map.empty;
 	texts = []
 }

cli/convert.ml

@@ -7,12 +7,12 @@ let convert cs r (text, files) = match Text.str "Content-Type" text with
 	| "" | "text/plain" ->
 		let source = List.hd files in
 		let dest = Filename.concat r.Conversion.dir (Text.short_id text) in
-		List.fold_left
+		List.fold_left (fun a f ->
-			(fun a f ->
 			match f.Conversion.page with None -> false || a
 			| Some page ->
 				let dest = dest ^ f.Conversion.ext in
-					(if is_older source dest then (File_store.file dest (page r text); true) else false)
+				(if is_older source dest || Conversion.Rel.Id_map.mem text.Text.id r.relations
+				 then (File_store.file dest (page r text); true) else false)
 				|| a)
 			false cs
 	| x -> Printf.eprintf "Can't convert Content-Type: %s file: %s" x text.Text.title; false
@@ -26,39 +26,13 @@ let converters types kv =
 	let t = if List.(mem "all" n || mem "gmi-atom" n) then (Atom.converter "text/gemini")::t else t in
 	t
 
-let acc_rel source target a =
-	prerr_endline source;
-	Conversion.Id_map.update target
-	(function Some set -> Some (Conversion.Ref_set.add source set)
-		| None -> Some (Conversion.Ref_set.singleton source))
-	a
-
-let empty_rels () = Conversion.Id_map.empty, Conversion.Id_map.empty
-
-let acc_txt_refs text refs = String_set.fold (acc_rel text.Text.id) (Text.set "references" text) refs
-let acc_txt_reps text reps = String_set.fold (acc_rel text.Text.id) (Text.set "in-reply-to" text) reps
-let acc_txt_rels (refs, reps) (elt, _paths) =
-	acc_txt_refs elt refs, acc_txt_reps elt reps
-
-let acc_pck_refs id refs_ls refs = String_set.fold (acc_rel id) (String_set.of_list refs_ls) refs
-let acc_pck_reps id reps_ls reps = String_set.fold (acc_rel id) (String_set.of_list reps_ls) reps
-let acc_pck_rels refs_reps peer =
-	let path = try List.hd peer.Peers.pack.Header_pack.info.locations with Failure _ -> "" in
-	try Header_pack.fold
-		(fun (refs, reps) id _t _title _authors _topics refs_ls reps_ls ->
-			let id = Filename.concat path id in
-			acc_pck_refs id refs_ls refs, acc_pck_reps id reps_ls reps)
-		refs_reps peer.Peers.pack
-	with e -> prerr_endline "acc_pck_rels"; raise e
-
 let directory converters noindex repo =
 	let order = File_store.oldest in
 	let repo =
-		let references, replies =
+		let open Conversion in
-			File_store.fold ~dir:repo.Conversion.dir ~order acc_txt_rels (empty_rels ()) in
+		let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in
-		let references, replies = Peers.fold acc_pck_rels (references, replies) in
+		let relations = Peers.fold Rel.acc_pck rels in
-		Printf.eprintf "%s %d\n" repo.Conversion.dir (Conversion.Id_map.cardinal replies);
+		{ repo with relations } in
-		{ repo with references; replies } in
 	let acc (ts,ls,acc) ((elt,_) as r) = Topic_set.to_map ts (Text.set "topics" elt), elt::ls,
 		if convert converters repo r then acc+1 else acc in
 	let topics, texts, count =
@@ -95,8 +69,9 @@ let at_path types noindex path = match path with
 			| Error s -> prerr_endline s
 			| Ok text ->
 				let dir = "." in
-				let references, replies = File_store.(fold ~dir ~order:newest acc_txt_rels (empty_rels ())) in
+				let open Conversion in
-				let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; references; replies } in
+				let relations = File_store.(fold ~dir ~order:newest Rel.acc_txt Rel.empty_map) in
+				let repo = { (Conversion.empty ()) with dir; kv = load_kv ""; relations } in
 				ignore @@ convert (converters types repo.kv) repo (text, [path])
 		)
 	| path -> Printf.eprintf "Path doesn't exist: %s" path

cli/html.ml

@@ -73,7 +73,12 @@ let page htm conversion text =
 			let link l = HtmlConverter.uid_uri l "" in
 			String_set.fold (fun r a -> sep_append a (link r)) x ""
 		in
-		Printf.eprintf "%s %d\n" text.id (Conversion.Id_map.cardinal conversion.Conversion.replies);
+		let references, replies = let open Conversion in
+			let Rel.{ref_set; rep_set; _} =
+				try Rel.Id_map.find text.id conversion.relations
+				with Not_found -> Rel.empty in
+			ref_links ref_set, ref_links rep_set
+		in
 		"<article><header><dl>"
 		^ opt_kv "Title:" text.title
 		^ opt_kv "Authors:" authors
@@ -83,12 +88,8 @@ let page htm conversion text =
 		^ opt_kv "Id:" text.id
 		^ opt_kv "Refers:" (ref_links (set "references" text))
 		^ opt_kv "In reply to:" (ref_links (set "in-reply-to" text))
-		^ opt_kv "Referred by:" (try
+		^ opt_kv "Referred by:" references
-				ref_links (Conversion.Id_map.find text.id conversion.Conversion.references)
+		^ opt_kv "Replies:" replies
-				with Not_found -> "")
-		^ opt_kv "Replies:" (try
-				ref_links (Conversion.Id_map.find text.id conversion.Conversion.replies)
-				with Not_found -> "")
 		^ {|</dl></header><pre style="white-space:pre-wrap">|} in
 	wrap conversion htm text.title ((T.of_string text.body header) ^ "</pre></article>")
 

lib/date.ml

@@ -15,3 +15,8 @@ let now () = Unix.time () |> Unix.gmtime |>
 let to_secs date =
 	Scanf.sscanf date "%4d-%02d-%02dT%02d:%02d:%02d"
 		(fun y mo d h mi s -> (y-1970)*31557600 + mo*2629800 + d*86400 + h*3600 + mi*60 + s)
+let of_secs s =
+	let { Unix.tm_sec=seconds; tm_min=minutes; tm_hour=hours;
+		tm_mday=day; tm_mon=month; tm_year=year; _ } = Unix.localtime (float_of_int s) in
+		Printf.sprintf "%4d-%02d-%02dT%02d:%02d:%02d"
+			(year+1900) (month+1) day hours minutes seconds

lib/header_pack.ml

@@ -84,7 +84,7 @@ let list filename = try
 let contains text = function
 	| Msgpck.List (id::_time::title::_authors::_topics::[]) ->
 		(match to_id id with
-		 | "" -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title); false
+		 | "" -> Printf.eprintf "Invalid id for %s" (Msgpck.to_string title); false
 		 | id -> text.Text.id = id)
 	| _ -> prerr_endline ("Invalid record pattern"); false
 
@@ -105,27 +105,29 @@ let txt_iter_apply fn i = function
 			end with e -> prerr_endline "iter ref reps"; raise e
 		in
 		fn i id t title authors topics references replies
-	| _  -> prerr_endline ("\n\nInvalid record structure\n\n")
+	| x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x)
 
-let txt_fold_apply fn i m =
+let txt_fold_apply fn i = function
-(*	Printf.eprintf "%s\n%!" @@ Msgpck.show m;*)
-	match m with
 	| Msgpck.List (id::time::title::authors::topics::extra) ->
 		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 = try to_str_list topics with _e -> Printf.eprintf "topics %s" title; [] in
+		let topics = to_str_list topics in
-		let authors = try to_str_list authors with _e -> Printf.eprintf "authors %s" title; [] in
+		let authors = to_str_list authors in
 		let references, replies = begin match extra with
 			| [] -> [], []
-			| refs::[] -> (try to_str_list refs, [] with e -> prerr_endline "fold ref"; raise e)
+			| refs::[] -> to_str_list refs, []
 			| refs::replies::_xs -> to_str_list refs, to_str_list replies
 			end
 		in
 		fn i id t title authors topics references replies
 	| x -> Printf.eprintf "Invalid record structure: %s\n%!" (Msgpck.show x); i
 
-let iteri fn pack = List.iteri (txt_iter_apply fn) (Msgpck.to_list pack.texts)
+let iteri fn pack = List.iteri
-let fold fn init pack = List.fold_left (txt_fold_apply fn) init
+	(txt_iter_apply fn)
-	(try Msgpck.to_list pack.texts with e -> prerr_string "Pack.fold"; raise e)
+	(Msgpck.to_list pack.texts)
+
+let fold fn init pack = List.fold_left
+	(fun acc m -> try txt_fold_apply fn acc m with Invalid_argument x -> prerr_endline x; acc) init
+	(try Msgpck.to_list pack.texts with e -> prerr_string "Invalid pack.texts"; raise e)