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 f83b84c257
4 changed files with 75 additions and 51 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

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

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