software-archive/logarion-2021
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Prettier txt messages

Browse Source
This commit is contained in:
orbifx 2021-10-15 17:53:38 +01:00
parent aa3350ec2f
commit f52c99d579
1 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
http/http.ml
View File

@ -48,23 +48,27 @@ let pull_text url dir id =
(*TODO: adapt Archive predication function to work with free sets*)
let parse_index _is_selected fn url = function
| Msgpck.List (info :: _fields :: [texts]) ->
let version, archive_name, _archivists =
match info with Msgpck.List (v::n::a) -> Msgpck.(to_int v, to_string n, a) | _ -> invalid_arg "Pack header"
let _version, archive_name, _archivists =
match info with Msgpck.List (v::n::a) -> Msgpck.(to_int v, to_string n, a)
| _ -> invalid_arg "Pack header"
in
print_endline @@ archive_name ^ " (pack format version " ^ string_of_int version ^ ")";
print_string archive_name;
(match Msgpck.to_list texts with
| [] -> prerr_endline "Empty index"
| [] -> print_endline ", has empty index"
| texts ->
(try Unix.mkdir "peers" 0o740 with Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
(try Unix.mkdir "peers" 0o740 with
Unix.Unix_error (EEXIST, _, _) -> () | _ -> prerr_endline "Error making peers");
let dir = "peers/" ^ match Uri.host url with
| None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in
(match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with
| Ok _ -> ()
| _ -> prerr_endline "Error making domain dir");
print_endline @@ "Copying into: " ^ dir;
let text_num = List.length texts in
print_endline (" => " ^ dir);
let numof_texts= string_of_int @@ List.length texts in
let text_num_len = String.length numof_texts in
let of_pck i x =
print_string @@ "\rDownloading " ^ string_of_int (i+1) ^ "/" ^ string_of_int text_num ^ " "; flush stdout;
Printf.printf "\r%*d/%s" text_num_len (i+1) numof_texts;
flush stdout;
match x with
| Msgpck.List (id::time::title::_authors::_topics) ->
(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with
@ -106,14 +110,18 @@ let pull_msgs url _authors _topics = match http_apply response url with
in
let s = Scanf.Scanning.from_string body in
let msgs = MsgSet.empty in
let date_string t = Ptime.to_date t |>
fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d in
let msgs = fold_msgs s msgs
(fun msgs t m -> match Ptime.of_rfc3339 t with
| Ok (v,_,_) -> let open MsgSet in
let msgs = if cardinal msgs > 3 then remove (max_elt msgs) msgs else msgs in
let msgs = if cardinal msgs > 1 then remove (max_elt msgs) msgs else msgs in
add (v,m) msgs
| _ -> msgs) in
print_endline ("\n" ^ Uri.to_string url);
MsgSet.iter (fun (t,m) -> print_endline (Ptime.to_rfc3339 t ^ "\t" ^ m)) msgs
print_endline ("\n┌────=[ " ^ Uri.to_string url);
MsgSet.iter
(fun (t,m) -> print_endline
("│ " ^ date_string t ^ "\n│\n│ " ^ m ^ "\n└─────────")) msgs
let pull_fn url = match Uri.of_string url with
| x when x = Uri.empty -> (fun _ _ -> ())