logarion-2021/app/logarion_cli.ml

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 field_opt authors_opt keywords_opt topics_opt =
  match A.of_path "." 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 order = A.newest in
     let print_fold ~predicate fn =
       let ts = A.fold ~predicate ~order fn String_set.empty archive in
       String_set.iter (print_endline) ts
     in
     match field_opt with
     | None -> A.iter ~predicate ~order (fun (n,_) -> print_endline n.Text.title) archive
     | 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 ~order (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

let list_term =
  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 ["t"; "topics"] ~docv:"TOPICS" ~doc:"texts with topics") in
  Term.(const text_list $ field $ authors $ keywords $ topics),
  Term.info "list" ~doc:"list texts" ~man:[ `S "DESCRIPTION"; `P "List texts in Logarion archive" ]

let publish and_index files = match A.of_path "." with
  | Error msg -> prerr_endline msg
  | Ok archive -> File_store.(list_iter (if and_index then index else publish) archive files)

let publish_term =
  let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in
  let index = Arg.(value & flag & info ["i"; "index"] ~doc:"Also index") in
  let doc = "publish notes; it will become available in exports and for distribution" in
  let man = [ `S "DESCRIPTION"; `P doc ] in 
  Term.(const publish $ index $ files), Term.info "publish" ~doc ~man

let deindex and_unpub files = match A.of_path "." with
  | Error msg -> prerr_endline msg
  | Ok archive -> File_store.(list_iter (if and_unpub then unpublish else deindex) archive files)

let deindex_term =
  let files = Arg.(value & pos_all string [] & info [] ~doc:"filenames") in
  let unpub = Arg.(value & flag & info ["u"; "unpublish"] ~doc:"Also unpublish") in
  let doc = "deindex; it will disappear from indices" in
  let man = [ `S "DESCRIPTION"; `P doc ] in 
  Term.(const deindex $ unpub $ files), Term.info "deindex" ~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 logarion repository in present directory" in
  let man = [ `S "DESCRIPTION"; `P "Create a repository in current directory" ] in 
  Term.(const init $ force), Term.info "init" ~doc ~man

let create_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 rec yn () = match read_line () with "y" -> true | "n" -> false
              | _ -> print_string "y or n? "; flush stdout; yn () in
	          let _code = Sys.command ("$EDITOR " ^ filepath) in
	          print_string "Publish? [yn]: ";
	          match yn () with false -> ()
	          | true -> 
		          print_string "Index? [yn]: ";
		          let and_index = yn () in
		          File_store.(list_iter (if and_index then index else publish) archive [filepath])
  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 "create" ~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] summary-here>" ] in
  Term.(ret (const (`Help (`Pager, None)))), Term.info "logarion" ~version ~doc ~man

let cmds = [ init_term; create_term; publish_term; deindex_term; list_term; Convert.term ]

let () =
  Random.self_init();
  match Term.eval_choice default_cmd cmds with `Error _ -> exit 1 | _ -> exit 0