orbifx
/
logarion
1
1
Fork 0
Code Pull Requests Releases Activity

Relation dates, with conversion condition upon it

This commit is contained in:
orbifx 2022-12-16 15:27:09 +00:00
parent 92631b5954
commit b3769a1c02
7 changed files with 91 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
cli/conversion.ml
View File

@ -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 = []
}

53
cli/convert.ml
View File

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

2
cli/dune
View File

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

15
cli/html.ml
View File

@ -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
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
^ {|</dl></header><pre style="white-space:pre-wrap">|} in
wrap conversion htm text.title ((T.of_string text.body header) ^ "</pre></article>")

2
cli/publish.ml
View File

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

5
lib/date.ml
View File

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

26
lib/header_pack.ml
View File

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