134 lines
6.1 KiB
OCaml
134 lines
6.1 KiB
OCaml
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 field_opt authors_opt keywords_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.keyworded keywords_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 fname in
|
|
match field_opt with
|
|
| Some "keywords"-> print_fold ~predicate (fun a (e,_) -> (String_set.union a (Text.set "keywords" e)))
|
|
| 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
|
|
A.iter ~predicate ~order list_text archive
|
|
|
|
let list_term =
|
|
let time = Arg.(value & flag & info ["t"] ~doc:"Sort by time, newest first") in
|
|
let reverse = Arg.(value & flag & info ["r"] ~doc:"reverse order") in
|
|
let field = Arg.(value & opt (some string) None & info ["f"; "field"] ~docv:"FIELD" ~doc:"what to list") in
|
|
let authors = Arg.(value & opt (some string) None & info ["a"; "authors"] ~docv:"AUTHORS" ~doc:"texts with authors") in
|
|
let keywords= Arg.(value & opt (some string) None & info ["k"; "keywords"] ~docv:"KEYWORDS" ~doc:"texts with keywords") in
|
|
let topics = Arg.(value & opt (some string) None & info ["topics"] ~docv:"TOPICS" ~doc:"texts with topics") in
|
|
Term.(const text_list $ time $ reverse $ field $ authors $ keywords $ topics),
|
|
Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts" ]
|
|
|
|
let print_last () =
|
|
match A.of_path (Sys.getcwd ()) with
|
|
| Error msg -> prerr_endline msg
|
|
| Ok archive ->
|
|
let last a (_t,fname) = match a with "" -> fname | x -> x in
|
|
print_endline @@ A.fold ~order:A.oldest last "" archive
|
|
|
|
let last_term =
|
|
Term.(const print_last $ const ()),
|
|
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 ]
|
|
|
|
let () =
|
|
Random.self_init();
|
|
match Term.eval_choice default_cmd cmds with `Error _ -> exit 1 | _ -> exit 0
|