From b3769a1c0293e1a634d8005a6825a54e5688576c Mon Sep 17 00:00:00 2001 From: orbifx Date: Fri, 16 Dec 2022 15:27:09 +0000 Subject: [PATCH] Relation dates, with conversion condition upon it --- cli/conversion.ml | 53 +++++++++++++++++++++++++++++++++++++++++----- cli/convert.ml | 53 ++++++++++++---------------------------------- cli/dune | 2 +- cli/html.ml | 15 +++++++------ cli/publish.ml | 2 +- lib/date.ml | 5 +++++ lib/header_pack.ml | 26 ++++++++++++----------- 7 files changed, 91 insertions(+), 65 deletions(-) diff --git a/cli/conversion.ml b/cli/conversion.ml index 5ea5bc5..22672c8 100644 --- a/cli/conversion.ml +++ b/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; - replies: Ref_set.t Id_map.t; + relations: Rel.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; - replies = Id_map.empty; + relations = Rel.Id_map.empty; texts = [] } diff --git a/cli/convert.ml b/cli/convert.ml index 777880d..0189e06 100644 --- a/cli/convert.ml +++ b/cli/convert.ml @@ -7,13 +7,13 @@ 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 - (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) - || a) + List.fold_left (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 || 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 = - File_store.fold ~dir:repo.Conversion.dir ~order acc_txt_rels (empty_rels ()) in - let references, replies = Peers.fold acc_pck_rels (references, replies) in - Printf.eprintf "%s %d\n" repo.Conversion.dir (Conversion.Id_map.cardinal replies); - { repo with references; replies } in + let open Conversion in + let rels = File_store.fold ~dir:repo.dir ~order Rel.acc_txt Rel.empty_map in + let relations = Peers.fold Rel.acc_pck rels in + { repo with relations } 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 repo = { (Conversion.empty ()) with dir; kv = load_kv ""; references; replies } in + let open Conversion 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 diff --git a/cli/dune b/cli/dune index 092ea3d..cf7afa3 100644 --- a/cli/dune +++ b/cli/dune @@ -2,5 +2,5 @@ (name txt) (public_name txt) (modules txt authors convert conversion edit file index last listing - new topics html atom gemini peers publish pull read recent) + new topics html atom gemini peers publish pull read recent) (libraries text_parse.converter text_parse.parsers logarion msgpck curl str cmdliner)) diff --git a/cli/html.ml b/cli/html.ml index c976542..19050e8 100644 --- a/cli/html.ml +++ b/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 "
" ^ 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 - ref_links (Conversion.Id_map.find text.id conversion.Conversion.references) - with Not_found -> "") - ^ opt_kv "Replies:" (try - ref_links (Conversion.Id_map.find text.id conversion.Conversion.replies) - with Not_found -> "") + ^ opt_kv "Referred by:" references + ^ opt_kv "Replies:" replies ^ {|
|} in
 	wrap conversion htm text.title ((T.of_string text.body header) ^ "
") diff --git a/cli/publish.ml b/cli/publish.ml index e959bdd..a78fa4c 100644 --- a/cli/publish.ml +++ b/cli/publish.ml @@ -8,7 +8,7 @@ let targets pubdir = List.fold_left let wizard () = print_endline "No txt.conf found. It's required for the repository name & id. Create one? (y/N)"; match input_line stdin with - |"y"-> + |"y"-> let title = print_endline "Title for repository: "; input_line stdin in diff --git a/lib/date.ml b/lib/date.ml index 098a813..6eab0d9 100644 --- a/lib/date.ml +++ b/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 diff --git a/lib/header_pack.ml b/lib/header_pack.ml index 9ccd480..1de60e1 100644 --- a/lib/header_pack.ml +++ b/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 = -(* Printf.eprintf "%s\n%!" @@ Msgpck.show m;*) - match m with +let txt_fold_apply fn i = function | 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 authors = try to_str_list authors with _e -> Printf.eprintf "authors %s" title; [] in + let topics = to_str_list topics 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 + | 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 fold fn init pack = List.fold_left (txt_fold_apply fn) init - (try Msgpck.to_list pack.texts with e -> prerr_string "Pack.fold"; raise e) +let iteri fn pack = List.iteri + (txt_iter_apply fn) + (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)