Browse Source
Format - New B32 ID Index - New option: txt index --print - Move scheme to peers - Replace peer.*.conf files with index packed locations Instead of adding a URL to peers.*.conf, run `txt pull <url>` Conversion - Rewritten converters - txt-convert looks for a .convert.conf containing `key: value` lines. - Specifiable topic-roots from .convert.conf. - Added `Topics:` key, with comma seperated topics. If set only those topics will appear in the main index and used as topic roots. Other topics will have sub-indices generated, but won't be listed in the main index. - HTML converter header & footer options - HTML-index renamed to HTM-index Internal - Change types: uuid:Uuid -> id:string - File_store merges identical texts - Use peer ID for store path, store peers' texts in .local/share/texts - Simple URN resolution for converter Continue to next feed if parsing one fails - Phasing-out Archive, replaced by improved packs - Eliminate Bos, Cohttp, lwt, uri, tls, Re, Ptime, dependencies - Lock version for Cmdliner, fix dune-project - Optional resursive store - Improve header_pack - Fix recursive mkdirmaster
orbifx
2 months ago
34 changed files with 923 additions and 745 deletions
@ -0,0 +1,17 @@
|
||||
open Logarion |
||||
let authors r topics_opt = |
||||
let predicates = Archive.(predicate topics topics_opt) in |
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in |
||||
let author_union a (e, _) = Person.Set.union a e.Text.authors in |
||||
let s = File_store.fold ~r ~predicate author_union Person.Set.empty in |
||||
Person.Set.iter (fun x -> print_endline (Person.to_string x)) s |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let recurse = Arg.(value & flag & info ["R"] |
||||
~doc:"include texts in subdirectories too") in |
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] |
||||
~docv:"TOPICS" ~doc:"display authors who have written on topics") in |
||||
Term.(const authors $ recurse $ topics), |
||||
Term.info "authors" ~doc:"list authors" |
||||
~man:[ `S "DESCRIPTION"; `P "List author names" ] |
||||
@ -1,142 +0,0 @@
|
||||
let version = "%%VERSION%%" |
||||
|
||||
open Cmdliner |
||||
open Logarion |
||||
module A = Logarion.Archive.Make(File_store) |
||||
|
||||
(* TODO: merge in lib/ so other modules can use (.e.g HTTP pull) *) |
||||
let text_list order_opt reverse_opt number_opt values_opt authors_opt topics_opt = |
||||
match A.of_path (Sys.getcwd ()) with |
||||
| Error msg -> prerr_endline msg |
||||
| Ok archive -> |
||||
let predicates = A.predicate A.authored authors_opt @ A.predicate A.topics topics_opt in |
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in |
||||
let print_fold ~predicate fn = |
||||
let ts = A.fold ~predicate fn String_set.empty archive in |
||||
String_set.iter (print_endline) ts |
||||
in |
||||
let list_text (t, fname) = print_endline (Text.short_id t ^ " " ^ t.Text.title ^ "\t" ^ fname) in |
||||
match values_opt with |
||||
| Some "topics" -> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "topics" e))) |
||||
| Some "authors" -> |
||||
let s = A.fold ~predicate (fun a (e,_) -> Person.Set.union a e.Text.authors) Person.Set.empty archive in |
||||
print_endline @@ Person.Set.to_string s |
||||
| Some x -> prerr_endline @@ "Unrecognised field: " ^ x |
||||
| None -> match order_opt with |
||||
| false -> A.iter ~predicate list_text archive |
||||
| true -> |
||||
let order = match reverse_opt with true -> A.newest | false -> A.oldest in |
||||
match number_opt with |
||||
| Some number -> A.iter ~predicate ~order ~number list_text archive |
||||
| None -> A.iter ~predicate ~order list_text archive |
||||
|
||||
let list_term = |
||||
let reverse = Arg.(value & flag & info ["r"] ~doc:"reverse order") in |
||||
let time = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in |
||||
let number = Arg.(value & opt (some int) None & info ["n"] ~docv:"NUMBER" ~doc:"number of entries to list") in |
||||
let values = Arg.(value & opt (some string) None & info ["values"] ~docv:"HEADER-FIELD" ~doc:"unique values for header field") in |
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] ~docv:"AUTHORS" ~doc:"texts by authors") in |
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"TOPICS" ~doc:"texts with topics") in |
||||
Term.(const text_list $ time $ reverse $ number $ values $ authed $ topics), |
||||
Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts" ] |
||||
|
||||
let print_last search_mine = |
||||
let last a ((t,_) as pair) = match a with None -> Some pair |
||||
| Some (t', _) as pair' -> if Text.newest t t' > 0 then Some pair else pair' in |
||||
match A.of_path (Sys.getcwd ()) with |
||||
| Error msg -> prerr_endline msg |
||||
| Ok archive -> |
||||
let last_mine a ((t,_) as pair) = |
||||
let open Text in |
||||
match a with None -> |
||||
if Person.Set.subset archive.A.archivists t.authors then Some pair else None |
||||
| Some (t', _) as pair' -> |
||||
if Text.newest t t' > 0 && Person.Set.subset archive.A.archivists t'.authors |
||||
then Some pair else pair' |
||||
in |
||||
match A.fold (if search_mine then last_mine else last) None archive with |
||||
| Some (_,f) -> print_endline f | None -> () |
||||
|
||||
let last_term = |
||||
let mine = Arg.(value & flag & info ["mine"] ~doc:"last text authored by me") in |
||||
Term.(const print_last $ mine), |
||||
Term.info "last" ~doc:"most recent test" ~man:[ `S "DESCRIPTION"; `P "Print the filename of most recent text" ] |
||||
|
||||
let split_filetypes files = |
||||
let acc (dirs, files) x = if Sys.is_directory x then (x::dirs, files) else (dirs, x::files) in |
||||
List.fold_left acc ([],[]) files |
||||
|
||||
let file files = match A.of_path "." with |
||||
| Error msg -> prerr_endline msg |
||||
| Ok _archive -> |
||||
let dirs, files = split_filetypes files in |
||||
let _link_as_named dir file = Unix.link file (dir ^"/"^ file) in |
||||
let link_with_id dir file = |
||||
match File_store.to_text file with Error s -> prerr_endline s |
||||
| Ok t -> Unix.link file (dir ^"/"^ String.sub (Id.to_string (t.Text.uuid)) 0 8 ^".txt") |
||||
in |
||||
let link = link_with_id in |
||||
List.iter (fun d -> List.iter (link d) files) dirs |
||||
|
||||
let file_term = |
||||
let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in |
||||
let doc = "file texts in directories" in |
||||
let man = [ `S "DESCRIPTION"; `P doc ] in |
||||
Term.(const file $ files), Term.info "file" ~doc ~man |
||||
|
||||
let unfile files = match A.of_path "." with |
||||
| Error msg -> prerr_endline msg |
||||
| Ok _archive -> |
||||
let dirs, files = split_filetypes files in |
||||
let unlink dir file = try Unix.unlink (dir ^"/"^ file) with Unix.(Unix_error(ENOENT,_,_))-> () in |
||||
List.iter (fun d -> List.iter (unlink d) files) dirs |
||||
|
||||
let unfile_term = |
||||
let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in |
||||
let doc = "unfile texts from directories" in |
||||
let man = [ `S "DESCRIPTION"; `P doc ] in |
||||
Term.(const unfile $ files), Term.info "unfile" ~doc ~man |
||||
|
||||
let init _force = File_store.init () |
||||
|
||||
let init_term = |
||||
let force = Arg.(value & flag & info ["f"; "force"] ~doc:"Initialise even if directory is not empty") in |
||||
let doc = "initialise a text repository in present directory" in |
||||
let man = [ `S "DESCRIPTION"; `P "Start an archive in current directory" ] in |
||||
Term.(const init $ force), Term.info "init" ~doc ~man |
||||
|
||||
let new_term = |
||||
let f title topics_opt interactive = |
||||
match A.of_path "." with |
||||
| Error m -> prerr_endline m |
||||
| Ok archive -> |
||||
let t = match title with "" -> "Draft" | _ -> title in |
||||
let authors = archive.archivists in |
||||
let date = Date.({ created = Some (Ptime_clock.now ()); edited = None }) in |
||||
let text = { (Text.blank ()) with title = t; authors; date } in |
||||
let text = try Text.with_str_set text "Topics" (Option.get topics_opt) with _ -> text in |
||||
match File_store.with_text archive text with |
||||
| Error s -> prerr_endline s |
||||
| Ok (filepath, _note) -> |
||||
match interactive with false -> print_endline filepath |
||||
| true -> |
||||
print_endline @@ "Created: " ^ filepath; |
||||
let _code = Sys.command ("$EDITOR " ^ filepath) in |
||||
() |
||||
in |
||||
let title = Arg.(value & pos 0 string "" & info [] ~docv:"TITLE" ~doc:"Title for new article") in |
||||
let topics= Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"TOPICS" ~doc:"Topics for new article") in |
||||
let inter = Arg.(value & flag & info ["i"; "interactive"] ~doc:"Prompts through the steps of creation and publication") in |
||||
let man = [ `S "DESCRIPTION"; `P "Create a new article, with title 'Draft' when none provided"] in |
||||
Term.(const f $ title $ topics $ inter), Term.info "new" ~doc:"create a new article" ~man |
||||
|
||||
let default_cmd = |
||||
let doc = "text archival & publishing" in |
||||
let man = [ `S "BUGS"; `P "Submit bugs <mailto:logarion@lists.orbitalfox.eu?subject=Issue: " ] in |
||||
Term.(ret (const (`Help (`Pager, None)))), Term.info "txt" ~version ~doc ~man |
||||
|
||||
let cmds = [ init_term; new_term; file_term; unfile_term; list_term; last_term; Convert.term; Http.pull_term ] |
||||
|
||||
let () = |
||||
Random.self_init(); |
||||
match Term.eval_choice default_cmd cmds with `Error _ -> exit 1 | _ -> exit 0 |
||||
@ -0,0 +1,14 @@
|
||||
open Logarion |
||||
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; |
||||
texts: Text.t list |
||||
} |
||||
|
||||
type fn_t = { |
||||
ext: string; |
||||
page: t -> Logarion.Text.t -> string; |
||||
indices: t -> unit; |
||||
} |
||||
@ -1,90 +1,67 @@
|
||||
open Logarion |
||||
module A = Archive.Make (Logarion.File_store) |
||||
|
||||
let convert_modified source dest fn title text = |
||||
if (try Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true) |
||||
then (File_store.file dest (fn title text); true) else false |
||||
let is_older source dest = try |
||||
Unix.((stat dest).st_mtime < (stat source).st_mtime) with _-> true |
||||
|
||||
let word_fname dir text = dir ^ "/" ^ Text.alias text |
||||
let id_fname dir text = dir ^ "/" ^ Text.short_id text |
||||
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 -> |
||||
let dest = dest ^ f.Conversion.ext in |
||||
if is_older source dest then (File_store.file dest (f.Conversion.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 |
||||
|
||||
let writer types dir name (text,store_item) = (* todo: single_parser -> [files] *) |
||||
(* convert_modified store_item idfilename (fun _title -> Text.to_string) text.title text;*) |
||||
let h = if "htm" = types || "all" = types then |
||||
convert_modified store_item (id_fname dir text ^ ".htm") Html.page name text |
||||
else false in |
||||
let g = if "gmi" = types || "all" = types then |
||||
convert_modified store_item (id_fname dir text ^ ".gmi") Gemini.page name text |
||||
else false in |
||||
h || g |
||||
let converters types kv = |
||||
let t = [] in |
||||
let t = if ("htm" = types || "all" = types) then |
||||
(let htm = Html.init kv in |
||||
Conversion.{ ext = Html.ext; page = Html.page htm; indices = Html.indices htm })::t |
||||
else t in |
||||
let t = if ("gmi" = types || "all" = types) then |
||||
Conversion.{ ext = Gemini.ext; page = Gemini.page; indices = Gemini.indices}::t else t in |
||||
t |
||||
|
||||
let index_writer types noindex dir archive topic_roots topic_map texts = |
||||
let name = archive.A.name in |
||||
let file path = File_store.file (dir ^ path) in |
||||
file "/index.pck" (Header_pack.pack archive texts); |
||||
if not noindex && ("htm" = types || "all" = types) then ( |
||||
let index_name = try Store.KV.find "HTML-index" archive.File_store.kv |
||||
with Not_found -> "index.html" in |
||||
if index_name <> "" then |
||||
file ("/"^index_name) (Html.topic_main_index name topic_roots texts); |
||||
file "/index.date.htm" (Html.date_index name texts); |
||||
List.iter |
||||
(fun topic -> file ("/index." ^ topic ^ ".htm") |
||||
(Html.topic_sub_index name topic_map topic texts)) |
||||
topic_roots; |
||||
let base_url = try Store.KV.find "HTTP-URL" archive.File_store.kv |
||||
with Not_found -> prerr_endline "Missing `HTTP-URL:` in config"; "" in |
||||
file "/feed.atom" (Atom.feed archive.A.name archive.A.id base_url "text/html" texts) |
||||
); |
||||
if not noindex && ("gmi" = types || "all" = types) then ( |
||||
let index_name = try Store.KV.find "Gemini-index" archive.File_store.kv |
||||
with Not_found -> "index.gmi" in |
||||
if index_name <> "" then |
||||
file ("/"^index_name) (Gemini.topic_main_index name topic_roots texts); |
||||
file "/index.date.gmi" (Gemini.date_index name texts); |
||||
List.iter |
||||
(fun topic -> file ("/index." ^ topic ^ ".gmi") |
||||
(Gemini.topic_sub_index name topic_map topic texts)) |
||||
topic_roots; |
||||
let base_url = try Store.KV.find "GEMINI-URL" archive.File_store.kv |
||||
with Not_found -> prerr_endline "Missing `GEMINI-URL:` in config"; "" in |
||||
file "/gmi.atom" (Atom.feed archive.A.name archive.A.id base_url "text/gemini" texts) |
||||
) |
||||
|
||||
let txt_writer types dir name ((text, _store_item) as r) = |
||||
match Text.str "Content-Type" text with |
||||
| "" | "text/plain" -> writer types dir name r |
||||
| x -> prerr_endline ("Can't convert Content-Type: "^x^" file: " ^text.Text.title); false |
||||
|
||||
let convert_all types noindex dir archive = |
||||
let name = archive.A.name in |
||||
let fn (ts,ls,acc) ((elt,_) as r) = |
||||
(Topic_set.to_map ts (Text.set "topics" elt)), |
||||
elt::ls, if txt_writer types dir name r then acc+1 else acc in |
||||
let convert_all converters noindex dir id kv = |
||||
let empty = Topic_set.Map.empty in |
||||
let topic_map, texts, count = A.(fold ~order:newest fn (empty,[],0) archive) in |
||||
let topic_roots = Topic_set.roots topic_map in |
||||
index_writer types noindex dir archive topic_roots topic_map texts; |
||||
print_endline @@ "Converted: " ^ string_of_int (count) |
||||
^ "\nIndexed: " ^ string_of_int (List.length texts); |
||||
Ok () |
||||
let repo = Conversion.{ id; dir; kv; topic_roots = []; topics = empty; texts = [] } in |
||||
let fn (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 ~order:newest fn (empty,[],0)) in |
||||
let topic_roots = try List.rev @@ String_set.list_of_csv (Store.KV.find "Topics" kv) |
||||
with Not_found -> Topic_set.roots topics in |
||||
let repo = Conversion.{ repo with topic_roots; topics; texts } in |
||||
if not noindex then List.iter (fun c -> c.Conversion.indices repo) converters; |
||||
Printf.printf "Converted: %d Indexed: %d\n" count (List.length texts) |
||||
|
||||
let convert_dir types noindex cmd_dir = |
||||
let (>>=) = Result.bind in |
||||
let with_dir dir = |
||||
Result.map_error (function `Msg m -> m) |
||||
Logarion.File_store.Directory.(directory dir |> print ~descr:"export" dir) in |
||||
(A.of_path "." |
||||
>>= fun archive -> (match cmd_dir with "" -> Error "unspecified export dir" | x -> Ok x) |
||||
>>= fun dir -> with_dir dir |
||||
>>= fun _ -> convert_all types noindex dir { archive with store = dir }) |
||||
|> function Ok () -> () | Error x -> prerr_endline x |
||||
let convert_dir types noindex dir = |
||||
match dir with "" -> prerr_endline "unspecified dir" |
||||
| dir -> |
||||
let fname = Filename.concat dir "index.pck" in |
||||
match Header_pack.of_string @@ File_store.to_string fname with |
||||
| Error s -> prerr_endline s |
||||
| Ok { info; _ } -> |
||||
let kv = let f = Filename.concat dir ".convert.conf" in (* TODO: better place to store convert conf? *) |
||||
if Sys.file_exists f then File_store.of_kv_file f else Store.KV.empty in |
||||
let kv = if Store.KV.mem "Title" kv then kv |
||||
else Store.KV.add "Title" info.Header_pack.title kv in |
||||
let kv = Store.KV.add "Locations" (String.concat ";\n" info.Header_pack.locations) kv in |
||||
let cs = converters types kv in |
||||
convert_all cs noindex dir info.Header_pack.id kv |
||||
|
||||
open Cmdliner |
||||
|
||||
let term = |
||||
let directory = Arg.(value & pos 0 string "" & info [] ~docv:"target directory" ~doc:"Directory to convert into") in |
||||
let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"TYPES" ~doc:"Convert to type") in |
||||
let noindex = Arg.(value & flag & info ["noindex"] ~doc:"don't write an index when converting") in |
||||
let directory = Arg.(value & pos 0 string "" & info [] ~docv:"target directory" |
||||
~doc:"Directory to convert") in |
||||
let types = Arg.(value & opt string "all" & info ["t"; "type"] ~docv:"TYPES" |
||||
~doc:"Convert to type") in |
||||
let noindex = Arg.(value & flag & info ["noindex"] |
||||
~doc:"don't create indices in target format") in |
||||
Term.(const convert_dir $ types $ noindex $ directory), |
||||
Term.info "convert" ~doc:"convert archive" ~man:[ `S "DESCRIPTION"; `P "Convert Logarion archive" ] |
||||
Term.info "convert" ~doc:"convert txts" |
||||
~man:[ `S "DESCRIPTION"; `P "Convert texts within a directory to another format. |
||||
Directory must contain an index.pck. Run `txt index` first." ] |
||||
|
||||
@ -1,5 +1,5 @@
|
||||
(executable |
||||
(name cli) |
||||
(name txt) |
||||
(public_name txt) |
||||
(modules cli convert html atom gemini) |
||||
(libraries logarion logarion.http re.str cmdliner bos ptime ptime.clock.os text_parse.converter text_parse.parsers msgpck)) |
||||
(modules txt authors convert conversion file index last listing new topics html atom gemini pull) |
||||
(libraries text_parse.converter text_parse.parsers logarion msgpck curl str cmdliner)) |
||||
|
||||
@ -0,0 +1,39 @@
|
||||
let split_filetypes files = |
||||
let acc (dirs, files) x = if Sys.is_directory x |
||||
then (x::dirs, files) else (dirs, x::files) in |
||||
List.fold_left acc ([],[]) files |
||||
|
||||
open Logarion |
||||
let file files = |
||||
let dirs, files = split_filetypes files in |
||||
let _link_as_named dir file = Unix.link file (Filename.concat dir file) in |
||||
let link_with_id dir file = |
||||
match File_store.to_text file with Error s -> prerr_endline s |
||||
| Ok t -> Unix.link file (Filename.concat dir (Text.short_id t^".txt")) in |
||||
let link = link_with_id in |
||||
List.iter (fun d -> List.iter (link d) files) dirs |
||||
|
||||
let unfile files = |
||||
let dirs, files = split_filetypes files in |
||||
let unlink dir file = try Unix.unlink (Filename.concat dir file) |
||||
with Unix.(Unix_error(ENOENT,_,_))-> () in |
||||
List.iter (fun d -> List.iter (unlink d) files) dirs |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let files = Arg.(value & pos_all string [] & info [] |
||||
~docv:"text filenames and subdirectories") in |
||||
Term.(const file $ files), Term.info "file" |
||||
~doc:"file texts in subdirectories" |
||||
~man:[ `S "DESCRIPTION"; `P "Files all texts in parameter in every |
||||
directory in parameter, using hardlinks. |
||||
|
||||
Use it to create sub-repositories for sharing or converting" ] |
||||
|
||||
let unfile_term = |
||||
let files = Arg.(value & pos_all string [] & info [] |
||||
~docv:"text filenames and subdirectories") in |
||||
Term.(const unfile $ files), Term.info "unfile" |
||||
~doc:"unfile texts from subdirectories" |
||||
~man:[ `S "DESCRIPTION"; `P "unfile texts in parameter from |
||||
directories in parameter, by removing hardlinks" ] |
||||
@ -0,0 +1,59 @@
|
||||
open Logarion |
||||
|
||||
let index print title authors locations peers dir = |
||||
let fname = Filename.concat dir "index.pck" in |
||||
let pck = match Header_pack.of_string @@ File_store.to_string fname with |
||||
| Error s -> failwith s |
||||
| Ok pck -> let info = Header_pack.{ pck.info with |
||||
title = if title <> "" then title else pck.info.title; |
||||
people = if authors <> "" |
||||
then (String_set.list_of_csv authors) else pck.info.people; |
||||
locations = if locations <> "" |
||||
then (String_set.list_of_csv locations) else pck.info.locations; |
||||
} in |
||||
Header_pack.{ info; fields; |
||||
texts = of_text_list @@ File_store.fold ~dir |
||||
(fun a (t,_) -> of_text a t) []; |
||||
peers = if peers <> "" |
||||
then (str_list @@ String_set.list_of_csv peers) else pck.peers; |
||||
} |
||||
| exception (Sys_error _) -> Header_pack.{ |
||||
info = { |
||||
version = version; id = Id.generate (); title; |
||||
people = String_set.list_of_csv authors; |
||||
locations = String_set.list_of_csv locations }; |
||||
fields; |
||||
texts = of_text_list @@ File_store.fold ~dir |
||||
(fun a (t,_) -> of_text a t) []; |
||||
peers = str_list @@ String_set.list_of_csv peers; |
||||
} in |
||||
File_store.file fname (Header_pack.string pck); |
||||
let open Header_pack in |
||||
let s ss = String.concat "\n\t" ss in |
||||
if print then |
||||
Printf.printf "Title: %s\nAuthors: %s\nLocations:\n\t%s\nPeers:\n\t%s\n" |
||||
pck.info.title (String.concat "," pck.info.people) |
||||
(s pck.info.locations) (s (to_str_list pck.peers)) |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let print = Arg.(value & flag & info ["print"] ~doc:"print info") in |
||||
let title= Arg.(value & opt string "" & info ["t"; "title"] |
||||
~docv:"string" ~doc:"Title for index") in |
||||
let auth = Arg.(value & opt string "" & info ["a"; "authors"] |
||||
~docv:"comma-separated names" ~doc:"Index authors") in |
||||
let locs = Arg.(value & opt string "" & info ["l"; "locations"] |
||||
~docv:"comma-separated URLs" ~doc:"repository URLs") in |
||||
let peers= Arg.(value & opt string "" & info ["p"; "peers"] |
||||
~docv:"comma-separated URLs" ~doc:"URLs to other known text repositories") in |
||||
let dir = Arg.(value & pos 0 string "." & info [] |
||||
~docv:"directory to index") in |
||||
let doc = "Generate an index.pck for texts in a directory" in |
||||
Term.(const index $ print $ title $ auth $ locs $ peers $ dir), |
||||
Term.info "index" ~doc |
||||
~man:[ `S "DESCRIPTION"; `Pre "An index contains:\n |
||||
* an info section with: title for the index, the authors, locations (URLs) the texts can be access\n |
||||
* listing of texts with: ID, date, title, authors, topics\n |
||||
* list of other text repositories (peers)\n\n |
||||
MessagePack format. <msgpack.org>" ] |
||||
|
||||
@ -0,0 +1,24 @@
|
||||
open Logarion |
||||
let last search_mine = |
||||
let last a ((t,_) as pair) = match a with None -> Some pair |
||||
| Some (t', _) as pair' -> if Text.newest t t' > 0 |
||||
then Some pair else pair' in |
||||
let last_mine a ((t,_) as pair) = |
||||
let name = Person.Set.of_string (Sys.getenv "USER") in |
||||
let open Text in |
||||
match a with |
||||
| None -> if Person.Set.subset name t.authors then Some pair else None |
||||
| Some (t', _) as pair' -> |
||||
if Text.newest t t' > 0 && Person.Set.subset name t'.authors |
||||
then Some pair else pair' |
||||
in |
||||
match File_store.fold (if search_mine then last_mine else last) None with |
||||
| Some (_,f) -> List.iter print_endline f | None -> () |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let mine = Arg.(value & flag & info ["mine"] |
||||
~doc:"last text authored by me") in |
||||
Term.(const last $ mine), |
||||
Term.info "last" ~doc:"most recent text" |
||||
~man:[ `S "DESCRIPTION"; `P "Print the filename of most recent text" ] |
||||
@ -0,0 +1,38 @@
|
||||
open Logarion |
||||
module FS = File_store |
||||
module A = Archive |
||||
let listing r order_opt reverse_opt number_opt authors_opt topics_opt = |
||||
let predicates = A.predicate A.authored authors_opt |
||||
@ A.predicate A.topics topics_opt in |
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in |
||||
let list_text a (t, fnames) = a ^ Printf.sprintf "%s %s %s 𐄁 %s [%s]\n" |
||||
(Text.short_id t) Date.(pretty_date @@ listing t.Text.date) |
||||
(Person.Set.to_string ~names_only:true t.Text.authors) |
||||
t.Text.title (List.hd fnames) |
||||
in |
||||
print_string @@ match order_opt with |
||||
| false -> FS.fold ~r ~predicate list_text "" |
||||
| true -> |
||||
let order = match reverse_opt with true -> FS.newest | false -> FS.oldest in |
||||
match number_opt with |
||||
| Some number -> FS.fold ~r ~predicate ~order ~number list_text "" |
||||
| None -> FS.fold ~r ~predicate ~order list_text "" |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let recurse = Arg.(value & flag & info ["R"] |
||||
~doc:"recursive, include texts in subdirectories too") in |
||||
let reverse = Arg.(value & flag & info ["r"] |
||||
~doc:"reverse order") in |
||||
let time = Arg.(value & flag & info ["t"] |
||||
~doc:"Sort by time, newest first") in |
||||
let number = Arg.(value & opt (some int) None & info ["n"] |
||||
~docv:"number" ~doc:"number of entries to list") in |
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] |
||||
~docv:"comma-separated names" ~doc:"texts by authors") in |
||||
let topics = Arg.(value & opt (some string) None & info ["topics"] |
||||
~docv:"comma-separated topics" ~doc:"texts with topics") in |
||||
Term.(const listing $ recurse $ time $ reverse $ number $ authed $ topics), |
||||
Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; |
||||
`P "List header information for current directory. If -R is used, list header |
||||
information for texts found in subdirectories too, along with their filepaths" ] |
||||
@ -0,0 +1,27 @@
|
||||
open Logarion |
||||
open Cmdliner |
||||
|
||||
let new_txt title topics_opt interactive = |
||||
let t = match title with "" -> "Draft" | _ -> title in |
||||
let authors = Person.Set.of_string (Sys.getenv "USER") in |
||||
let text = { (Text.blank ()) with title = t; authors } in |
||||
let text = try Text.with_str_set text "Topics" (Option.get topics_opt) |
||||
with _ -> text in |
||||
match File_store.with_text text with |
||||
| Error s -> prerr_endline s |
||||
| Ok (filepath, _note) -> |
||||
if not interactive then print_endline filepath |
||||
else |
||||
(print_endline @@ "Created: " ^ filepath; |
||||
Sys.command ("$EDITOR " ^ filepath) |> ignore) |
||||
|
||||
let term = |
||||
let title = Arg.(value & pos 0 string "" & info [] |
||||
~docv:"title" ~doc:"Title for new article") in |
||||
let topics= Arg.(value & opt (some string) None & info ["t"; "topics"] |
||||
~docv:"comma-separated topics" ~doc:"Topics for new article") in |
||||
let inter = Arg.(value & flag & info ["i"; "interactive"] |
||||
~doc:"Prompts through the steps of creation") in |
||||
Term.(const new_txt $ title $ topics $ inter), Term.info "new" |
||||
~doc:"create a new article" ~man:[ `S "DESCRIPTION"; |
||||
`P "Create a new article, with title 'Draft' when none provided"] |
||||
@ -0,0 +1,160 @@
|
||||
let writer accum data = |
||||
Buffer.add_string accum data; |
||||
String.length data |
||||
|
||||
let showContent content = |
||||
Printf.printf "%s" (Buffer.contents content); |
||||
flush stdout |
||||
|
||||
let showInfo connection = |
||||
Printf.printf "Time: %f for: %s\n" |
||||
(Curl.get_totaltime connection) |
||||
(Curl.get_effectiveurl connection) |
||||
|
||||
let getContent connection url = |
||||
Curl.set_url connection url; |
||||
Curl.perform connection |
||||
|
||||
let curl_pull url = |
||||
let result = Buffer.create 4069 |
||||
and errorBuffer = ref "" in |
||||
let connection = Curl.init () in |
||||
try |
||||
Curl.set_errorbuffer connection errorBuffer; |
||||
Curl.set_writefunction connection (writer result); |
||||
Curl.set_followlocation connection true; |
||||
Curl.set_url connection url; |
||||
Curl.perform connection; |
||||
(* showContent result;*) |
||||
(* showInfo connection;*) |
||||
Curl.cleanup connection; |
||||
Ok result |
||||
with |
||||
| Curl.CurlException (_reason, _code, _str) -> |
||||
Curl.cleanup connection; |
||||
Error (Printf.sprintf "Error: %s %s" url !errorBuffer) |
||||
| Failure s -> |
||||
Curl.cleanup connection; |
||||
Error (Printf.sprintf "Caught exception: %s" s) |
||||
|
||||
let newer time id dir = |
||||
match Logarion.File_store.to_text @@ Filename.(concat dir (Logarion.Id.short id) ^ ".txt") with |
||||
| Error x -> prerr_endline x; true |
||||
| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date))) |
||||
| exception (Sys_error _) -> true |
||||
|
||||
let print_peers p = |
||||
let open Logarion.Header_pack in |
||||
match Msgpck.to_list p.peers with [] -> () |
||||
| ps -> print_endline @@ |
||||
List.fold_left (fun a x -> Printf.sprintf "%s %s" a (Msgpck.to_string x)) "peers: " ps |
||||
|
||||
let parse_index _is_selected fn url dir p = |
||||
let open Logarion.Header_pack in |
||||
match Msgpck.to_list p.texts with |
||||
| [] -> Printf.printf "%s => %s, has empty index\n" p.info.title dir; false |
||||
| texts -> |
||||
let numof_texts = string_of_int @@ List.length texts in |
||||
let text_num_len = String.length numof_texts in |
||||
Printf.printf "%*d/%s %s => %s\r" text_num_len 0 numof_texts p.info.title dir; |
||||
let of_pck i x = |
||||
Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts; |
||||
match x with |
||||
| Msgpck.List (id::time::title::_authors::_topics) -> |
||||
(match Logarion.Header_pack.to_id id with |
||||
| "" -> Printf.eprintf "Invalid id for%s " (Msgpck.to_string title) |
||||
| id -> |
||||
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in |
||||
if newer t id dir then fn url dir id) |
||||
| _ -> prerr_endline ("Invalid record structure") in |
||||
List.iteri of_pck texts; |
||||
print_newline (); |
||||
true |
||||
|
||||
let fname dir text = Filename.concat dir (Logarion.Text.short_id text ^ ".txt") |
||||
let pull_text url dir id = |
||||
let u = Filename.concat url ((Logarion.Id.short id) ^ ".txt") in |
||||
match curl_pull u with |
||||
| Error msg -> Printf.eprintf "Failed getting %s: %s" u msg |
||||
| Ok txt -> |
||||
let txt = Buffer.contents txt in |
||||
match Logarion.Text.of_string txt with |
||||
| Error s -> prerr_endline s |
||||
| Ok text -> |
||||
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in |
||||
output_string file txt; close_out file |
||||
|
||||
let pull_index url _authors _topics = |
||||
let index_url = url ^ "/index.pck" in |
||||
match curl_pull index_url with |
||||
| Error s -> prerr_endline s; false |
||||
| Ok body -> |
||||
match Logarion.Header_pack.of_string (Buffer.contents body) with |
||||
| Error s -> Printf.printf "Error with %s: %s\n" url s; false |
||||
| Ok pk -> |
||||
let dir = Filename.concat Logarion.Peers.text_dir pk.info.id in |
||||
Logarion.File_store.with_dir dir; |
||||
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (Filename.concat dir "index.pck") in |
||||
output_string file ( Logarion.Header_pack.string { |
||||
pk with info = { pk.info with locations = url::pk.info.locations }}); |
||||
close_out file; |
||||
(* let predicates = A.predicate A.authored authors_opt*) |
||||
(* @ A.predicate A.topics topics_opt in*) |
||||
let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in |
||||
try parse_index is_selected pull_text url dir pk with |
||||
Invalid_argument msg -> Printf.eprintf "Failed to parse: %s\n%!" msg; false |
||||
|
||||
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 |
||||
Logarion.Peers.fold pull false; |
||||
Curl.global_cleanup () |
||||
|
||||
let pull url auths topics = match url with |
||||
| "" -> pull_list auths topics | x -> ignore (pull_index x auths topics) |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] |
||||
~docv:"comma-separated names" ~doc:"filter by authors") in |
||||
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] |
||||
~docv:"comma-separated topics" ~doc:"filter by topics") in |
||||
let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" |
||||
~doc:"Repository location") in |
||||
Term.(const pull $ url $ authors $ topics), |
||||
Term.info "pull" ~doc:"pull listed texts" ~man:[ `S "DESCRIPTION"; |
||||
`P "Pull texts from known repositories. To add a new repository use:"; |
||||
`P "txt pull [url]"; |
||||
`P ("This creates a directory in " ^ Logarion.Peers.text_dir |
||||
^ " and downloads the text index.pck file in it")] |
||||
|
||||
(*module Msg = struct*) |
||||
(* type t = string * string*) |
||||
(* let compare (x0,y0) (x1,y1) =*) |
||||
(* match compare x1 x0 with 0 -> String.compare y0 y1 | c -> c*) |
||||
(*end*) |
||||
(*module MsgSet = Set.Make(Msg)*) |
||||
(*let pull_msgs url _authors _topics =*) |
||||
(* match http_apply response url with*) |
||||
(* | Error msg ->*) |
||||
(* Printf.eprintf "Failed index request for %s %s" url msg*) |
||||
(* | Ok body ->*) |
||||
(* let rec fold_msgs s a fn =*) |
||||
(* let t, msg = Scanf.bscanf s "%s %s@\n" (fun t m -> t, m) in*) |
||||
(* if t <> "" then fold_msgs s (fn a t msg) fn else a*) |
||||
(* 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 > 1 then remove (max_elt msgs) msgs else msgs in*) |
||||
(* add (v,m) msgs*) |
||||
(* | _ -> msgs) in*) |
||||
(* let msg_string = MsgSet.fold*) |
||||
(* (fun (t,m) a -> a ^ Printf.sprintf " %s 𐄁 %s\n" (date_string t) m)*) |
||||
(* msgs "" in*) |
||||
(* Printf.printf "┌───{ %s }───┐\n%s" url msg_string*) |
||||
@ -0,0 +1,17 @@
|
||||
open Logarion |
||||
let topics r authors_opt = |
||||
let predicates = Archive.(predicate authored authors_opt) in |
||||
let predicate text = List.fold_left (fun a e -> a && e text) true predicates in |
||||
let topic_union a (e, _) = String_set.union a (Text.set "topics" e) in |
||||
let s = File_store.fold ~r ~predicate topic_union String_set.empty in |
||||
print_endline @@ String_set.to_string s |
||||
|
||||
open Cmdliner |
||||
let term = |
||||
let recurse = Arg.(value & flag & info ["R"] |
||||
~doc:"include texts in subdirectories") in |
||||
let authed = Arg.(value & opt (some string) None & info ["authored"] |
||||
~docv:"comma-separated authors" ~doc:"topics by authors") in |
||||
Term.(const topics $ recurse $ authed), |
||||
Term.info "topics" ~doc:"list topics" ~man:[ `S "DESCRIPTION"; |
||||
`P "List of topics" ] |
||||
@ -0,0 +1,19 @@
|
||||
let version = "%%VERSION%%" |
||||
|
||||
open Cmdliner |
||||
let default_cmd = |
||||
let doc = "Discover, collect & exchange texts" in |
||||
let man = [ `S "Contact"; `P "<mailto:fox@orbitalfox.eu?subject=Logarion>" ] in |
||||
Term.(ret (const (`Help (`Pager, None)))), Term.info "txt" ~version ~doc ~man |
||||
|
||||
let () = match Term.eval_choice default_cmd [ |
||||
Authors.term; |
||||
Convert.term; |
||||
File.term; File.unfile_term; |
||||
Index.term; |
||||
Last.term; |
||||
Listing.term; |
||||
New.term; |
||||
Pull.term; |
||||
Topics.term; |
||||
] with `Error _ -> exit 1 | _ -> exit 0 |
||||
@ -1,16 +1,13 @@
|
||||
(lang dune 2.0) |
||||
(name logarion) |
||||
(homepage "https://logarion.orbitalfox.eu") |
||||
|
||||
(source (uri git://orbitalfox.eu/logarion)) |
||||
(license EUPL-1.2) |
||||
(authors "orbifx") |
||||
(maintainers "fox@orbitalfox.eu") |
||||
(bug_reports "mailto:logarion@lists.orbitalfox.eu?subject=Issue:") |
||||
(maintainers "orbifx <fox@orbitalfox.eu>") |
||||
(homepage "http://logarion.orbitalfox.eu") |
||||
(source (uri git+https://git.disroot.org/orbifx/logarion.git)) |
||||
|
||||
(generate_opam_files true) |
||||
|
||||
(package |
||||
(name logarion) |
||||
(synopsis "Texts archival and exchange") |
||||
(depends re cmdliner bos ptime uuidm uri text_parse msgpck cohttp-lwt-unix tls)) |
||||
(depends text_parse (cmdliner (<= 1.0.4)) msgpck ocurl)) |
||||
|
||||
@ -1,4 +0,0 @@
|
||||
(library |
||||
(name http) |
||||
(public_name logarion.http) |
||||
(libraries logarion uri cmdliner lwt cohttp cohttp-lwt cohttp-lwt-unix tls msgpck)) |
||||
@ -1,143 +0,0 @@
|
||||
let http_body fn uri = |
||||
let open Lwt in |
||||
let open Cohttp_lwt_unix in |
||||
Client.get uri >>= fun (headers, body) -> |
||||
body |> Cohttp_lwt.Body.to_string >|= fun body -> fn (headers, body) |
||||
|
||||
let response (headers, body) = |
||||
let open Cohttp in |
||||
match Header.get (headers |> Response.headers) "content-type" with |
||||
| Some "application/msgpack" | Some "application/octet-stream" |
||||
| Some "text/plain" | Some "text/plain; charset=utf-8" -> Ok body |
||||
| Some x -> Error ("Invalid content-type: " ^ x) |
||||
| None -> Ok body |
||||
|
||||
let http_apply fn uri = Lwt_main.run (http_body fn uri) |
||||
|
||||
module S = Set.Make(String) |
||||
|
||||
(*let is_selected sl =*) |
||||
(* let check str a b c = Option.(fold ~none:(is_none b && is_none c) ~some:(fun x -> x = str) a) in*) |
||||
(* function*) |
||||
(* | `Author s -> check s sl.authors sl.topics*) |
||||
(* | `Topic s -> check s sl.topics sl.authors*) |
||||
|
||||
(* TODO: parse using Header_pack *) |
||||
|
||||
let sub_id text = Logarion.(String.sub (text.Text.uuid |> Id.to_string) 0 8) |
||||
let fname dir text = dir ^ sub_id text ^ ".txt" |
||||
|
||||
let newer time id dir = |
||||
match Logarion.File_store.to_text @@ Filename.concat dir (String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") with |
||||
| Error x -> prerr_endline x; true |
||||
| Ok txt -> time > (Logarion.(Header_pack.date (Date.listing txt.date))) |
||||
| exception (Sys_error _) -> true |
||||
|
||||
let pull_text url dir id = |
||||
let path = Uri.path url in |
||||
let u = Uri.with_path url (path ^ "/" ^ String.sub (Logarion.Id.to_string id) 0 8 ^ ".txt") in |
||||
match http_apply response u with |
||||
| Error msg -> prerr_endline @@ " Failed " ^ Uri.to_string u ^ " " ^ msg |
||||
| Ok txt -> |
||||
match Logarion.Text.of_string txt with |
||||
| Error s -> prerr_endline s |
||||
| Ok text -> |
||||
let file = open_out_gen [Open_creat; Open_trunc; Open_wronly] 0o640 (fname dir text) in |
||||
output_string file txt; close_out file |
||||
|
||||
(*TODO: adapt Archive predication function to work with free sets*) |
||||
let parse_index _is_selected fn url p = |
||||
let open Logarion.Header_pack in |
||||
let dir = "peers/" ^ match Uri.host url with |
||||
None -> "local/" ^ Uri.path url | Some s -> s ^ Uri.path url ^ "/" in |
||||
Printf.printf "%s => %s\n" p.info.name dir; |
||||
(match Msgpck.to_list p.peers with [] -> () | ps -> |
||||
print_string " peers: "; |
||||
List.iter (fun x -> print_string (" " ^ Msgpck.to_string x)) ps; |
||||
print_newline ()); |
||||
match Msgpck.to_list p.texts with |
||||
| [] -> print_endline ", has empty index" |
||||
| texts -> |
||||
match Bos.OS.Dir.create ~mode:0o740 (Fpath.v dir) with |
||||
| Error (`msg s) -> prerr_endline ("Error making domain dir:" ^ s); |
||||
| _ -> |
||||
let numof_texts = string_of_int @@ List.length texts in |
||||
let text_num_len = String.length numof_texts in |
||||
let of_pck i x = |
||||
Printf.printf "\r%*d/%s %!" text_num_len (i+1) numof_texts; |
||||
match x with |
||||
| Msgpck.List (id::time::title::_authors::_topics) -> |
||||
(match Logarion.Id.of_bytes Msgpck.(to_bytes id) with |
||||
| None -> prerr_endline ("Invalid id for " ^ Msgpck.to_string title) |
||||
| Some id -> |
||||
let t = match time with Msgpck.Int i -> Int32.of_int i | Msgpck.Uint32 i -> i | x -> Msgpck.to_uint32 x in |
||||
if newer t id dir then fn url dir id) |
||||
| _ -> prerr_endline ("Invalid record structure") in |
||||
List.iteri of_pck texts; |
||||
print_newline () |
||||
|
||||
let pull_index url _authors _topics = |
||||
let index_url = Uri.(with_path url (path url ^ "/index.pck")) in |
||||
match http_apply response index_url with |
||||
| Error msg -> prerr_endline @@ "Failed index request for " ^ Uri.to_string index_url ^ " " ^ msg |
||||
| Ok body -> |
||||
let _i, pack = Msgpck.StringBuf.read body in |
||||
(* let predicates =*) |
||||
(* A.predicate A.authored authors_opt*) |
||||
(* @ A.predicate A.topics topics_opt*) |
||||
(* in*) |
||||
let is_selected text = List.fold_left (fun a e -> a && e text) true [](*predicates*) in |
||||
match Logarion.Header_pack.unpack pack with None -> () |
||||
| Some headers -> parse_index is_selected pull_text url headers |
||||
|
||||
module Msg = struct |
||||
type t = Ptime.t * string |
||||
let compare (x0,y0) (x1,y1) = match Ptime.compare x1 x0 with 0 -> String.compare y0 y1 | c -> c |
||||
end |
||||
|
||||
module MsgSet = Set.Make(Msg) |
||||
|
||||
let pull_msgs url _authors _topics = match http_apply response url with |
||||
| Error msg -> prerr_endline @@ "Failed index request for " ^ Uri.(to_string url) ^ " " ^ msg |
||||
| Ok body -> |
||||
let rec fold_msgs s a fn = |
||||
let t, msg = Scanf.bscanf s "%s %s@\n" (fun t m -> t, m) in |
||||
if t <> "" then fold_msgs s (fn a t msg) fn else a |
||||
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 > 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 |
||||
("│ " ^ date_string t ^ "\n│ " ^ m ^ "\n└─────────")) msgs |
||||
|
||||
let pull_url url = match Uri.of_string url with |
||||
| x when x = Uri.empty -> (fun _ _ -> ()) |
||||
| x when Uri.scheme x = Some "msg+http" -> pull_msgs Uri.(with_scheme x (Some "http")) |
||||
| x when Uri.scheme x = Some "msg+https"-> pull_msgs Uri.(with_scheme x (Some "https")) |
||||
| x -> pull_index x |
||||
|
||||
let pull_list auths topics = |
||||
let pull peer_url () = pull_url peer_url auths topics in |
||||
let open Logarion.Peers in |
||||
fold_file pull () public_fname; |
||||
fold_file pull () private_fname |
||||
|
||||
let pull = function "" -> pull_list | x -> pull_url x |
||||
|
||||
open Cmdliner |
||||
|
||||
let pull_term = |
||||
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"AUTHORS" ~doc:"select authors") in |
||||
let topics = Arg.(value & opt (some string) None & info ["t"; "topics"] ~docv:"TOPICS" ~doc:"select topics") in |
||||
let url = Arg.(value & pos 0 string "" & info [] ~docv:"URL" ~doc:"HTTP URL of Logarion") in |
||||
Term.(const pull $ url $ authors $ topics), |
||||
Term.info "pull" ~doc:"pull listed texts" ~man:[ `S "DESCRIPTION"; `P "Pull texts from archive at address"] |
||||
@ -1,33 +1,13 @@
|
||||
(*let module S = Set.Make (Text) in*) |
||||
(*let module M = Map.Make (String) in*) |
||||
(*let module I = Map.Make (Id) in*) |
||||
(*let aggr = I.empty, M.empty, M.empty, M.empty in*) |
||||
(*let fn (id, a, t, k) (n,_) =*) |
||||
(* let id = I.add n.Text.uuid n id in*) |
||||
(* let a =*) |
||||
(* let f e a = M.update (e.Person.name) (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*) |
||||
(* Person.Set.fold f n.Text.authors a in*) |
||||
(* let t =*) |
||||
(* let f e a = M.update e (function Some v -> Some (S.add n v) | None -> Some (S.singleton n)) a in*) |
||||
(* String_set.fold f (Text.set "Topics" n) t in | ||||