Preliminary support for cross-domain references

This commit is contained in:
orbifx 2022-12-15 21:25:18 +00:00
parent ab366b4078
commit 92631b5954
7 changed files with 88 additions and 49 deletions

View File

@ -26,29 +26,46 @@ 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_ref id t a =
Conversion.Id_map.update t (function
| Some s -> Some (Conversion.Ref_set.add id s)
| None -> Some (Conversion.Ref_set.singleton id)
) a
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 fold_refs text refs = String_set.fold (acc_ref text.Text.id) (Text.set "references" text) refs
let fold_reps text reps = String_set.fold (acc_ref text.Text.id) (Text.set "in-reply-to" text) reps
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 fn (ts,refs,reps,ls,acc) ((elt,_) as r) =
Topic_set.to_map ts (Text.set "topics" elt),
fold_refs elt refs, fold_reps elt reps,
elt::ls,
if convert converters {repo with references = refs; replies = reps} r then acc+1 else acc in
let topics, references, replies, texts, count =
File_store.(fold ~dir:repo.Conversion.dir ~order:oldest fn
(Topic_set.Map.empty, Conversion.Id_map.empty, Conversion.Id_map.empty, [], 0)) in
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 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 =
File_store.fold ~dir:repo.Conversion.dir ~order acc (Topic_set.Map.empty, [], 0) in
let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" repo.kv)
with Not_found -> Topic_set.roots topics in
Printf.eprintf "%d\n" (Conversion.Id_map.cardinal replies);
let repo = Conversion.{ repo with
topic_roots; topics; references; replies; texts = List.rev texts } in
let repo = Conversion.{ repo with topic_roots; topics; texts = List.rev texts } in
if not noindex then
List.iter (fun c -> match c.Conversion.indices with None -> () | Some f -> f repo) converters;
Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts)
@ -78,9 +95,7 @@ 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
(fun (refs, reps) (elt, _) -> fold_refs elt refs, fold_reps elt reps)
(Conversion.Id_map.empty, Conversion.Id_map.empty)) 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
ignore @@ convert (converters types repo.kv) repo (text, [path])
)

View File

@ -88,7 +88,7 @@ let page htm conversion text =
with Not_found -> "")
^ opt_kv "Replies:" (try
ref_links (Conversion.Id_map.find text.id conversion.Conversion.replies)
with Not_found -> "empty 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>")

View File

@ -9,7 +9,7 @@ type filter_t = { authors: Logarion.Person.Set.t; topics: Logarion.String_set.t
let print_peer () peer =
let open Logarion.Peers in
Printf.printf "%s" peer.path;
List.iter (Printf.printf "\t%s\n") peer.locations
List.iter (Printf.printf "\t%s\n") peer.pack.info.locations
let remove_repo id =
let repopath = Filename.concat Logarion.Peers.text_dir id in

View File

@ -75,7 +75,7 @@ let pull_text url dir id =
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in
output_string file txt; close_out file
let per_text url dir filter print i id time title authors topics = match id with
let per_text url dir filter print i id time title authors topics _refs _reps = match id with
| "" -> Printf.eprintf "\nInvalid id for %s\n" title
| id -> let open Logarion in
print i;
@ -127,11 +127,12 @@ let pull_list auths topics =
Curl.global_init Curl.CURLINIT_GLOBALALL;
let pull got_one peer_url = if got_one then got_one else
(pull_index peer_url auths topics) in
let open Logarion in
let fold_locations init peer =
ignore @@ List.fold_left pull init peer.Logarion.Peers.locations;
ignore @@ List.fold_left pull init peer.Peers.pack.Header_pack.info.locations;
false
in
ignore @@ Logarion.Peers.fold fold_locations false;
ignore @@ Peers.fold fold_locations false;
Curl.global_cleanup ()
let pull url auths topics = match url with

View File

@ -69,7 +69,7 @@ let list_fs ?(r=false) dir =
let valid_dir f = r && String.get f 0 <> '.' && Sys.is_directory f in
let expand_dir d = Array.(to_list @@ map (Filename.concat d) (Sys.readdir d)) in
let rec loop result = function
| f::fs when valid_dir f -> expand_dir f |> List.append fs |> loop result
| f::fs when valid_dir f -> prerr_endline f; expand_dir f |> List.append fs |> loop result
| f::fs -> loop (f::result) fs
| [] -> result in
let dirs = if dir = "." then Array.to_list (Sys.readdir dir) else

View File

@ -10,7 +10,8 @@ let persons ps = Msgpck.of_list @@ List.rev @@ Person.Set.fold (fun p a -> perso
let str = Msgpck.of_string
let str_list ls = Msgpck.of_list @@ List.map str ls
let to_str_list x = List.map Msgpck.to_string (Msgpck.to_list x)
let to_str_list x = List.map Msgpck.to_string
(try Msgpck.to_list x with e -> prerr_endline "to_str_list"; raise e)
let of_set field t =
List.rev @@ String_set.fold (fun s a -> Msgpck.String s :: a) (Text.set field t) []
@ -19,7 +20,10 @@ let date = function "" -> Int32.zero | date -> Int32.of_int (Date.to_secs date)
let to_sec = function Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x
let fields = Msgpck.(List [String "id"; String "time"; String "title"; String "authors"; String "topics"])
let fields = Msgpck.(List [
String "id"; String "time"; String "title"; String "authors"; String "topics";
String "references"; String "replies";
])
let to_fields fieldpack = List.map Msgpck.to_string (Msgpck.to_list fieldpack)
let to_info = function
@ -35,8 +39,13 @@ let of_info i = let open Msgpck in
let of_text a t =
let open Text in
Msgpck.(List [
of_id t.id; of_uint32 (date (Date.listing t.date));
String t.title; persons t.authors; List (of_set "topics" t)
of_id t.id;
of_uint32 (date (Date.listing t.date));
String t.title;
persons t.authors;
List (of_set "topics" t);
List (of_set "references" t);
List (of_set "in-reply-to" t);
]) :: a
let of_text_list l = Msgpck.List l
@ -81,28 +90,42 @@ let contains text = function
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 txt_iter_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 = to_str_list topics in
let authors = to_str_list authors in
fn i id t title authors topics
let references, replies =
try begin match extra with [] -> [], []
| refs::[] -> to_str_list refs, []
| refs::replies::_xs -> to_str_list refs, to_str_list replies
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")
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*)*)
(* dir ^ "/" ^ filename*)
let txt_fold_apply fn i m =
(* 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 authors = try to_str_list authors with _e -> Printf.eprintf "authors %s" title; [] in
let references, replies = begin match extra with
| [] -> [], []
| refs::[] -> (try to_str_list refs, [] with e -> prerr_endline "fold ref"; raise e)
| 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 add archive records =*)
(* let fname = pack_filename archive in*)
(* let append published (t, _f) = if List.exists (contains t) published then published else to_pack published t in*)
(* match list fname with Error e -> prerr_endline e | Ok published_list ->*)
(* let header_pack = List.fold_left append published_list records in*)
(* let archive = Msgpck.(List [*)
(* Int 0; String archive.File_store.name; persons archive.people]) in*)
(* File_store.file fname @@ Bytes.to_string*)
(* @@ Msgpck.Bytes.to_string (List [archive; fields; Msgpck.List header_pack])*)
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)

View File

@ -1,6 +1,6 @@
let text_dir = Filename.concat (File_store.txtdir ()) "peers"
type t = { path: string; locations: string list }
type t = { path: string; pack: Header_pack.t }
let fold fn init = match Sys.readdir text_dir with
| exception (Sys_error msg) -> prerr_endline msg; init
@ -13,7 +13,7 @@ let fold fn init = match Sys.readdir text_dir with
| false -> Printf.eprintf "Missing index.pck for %s\n" path; init
| true -> match Header_pack.of_string (File_store.to_string pack_path) with
| Error s -> Printf.eprintf "%s %s\n" s pack_path; init
| Ok p -> fn init { path; locations = Header_pack.(p.info.locations) }
| Ok pack -> fn init { path; pack }
end else init
in
Array.fold_left read_pack init dirs