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 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 dir file = Unix.link file (dir ^"/"^ file) 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 " ] in Term.(ret (const (`Help (`Pager, None)))), Term.info "logarion" ~version ~doc ~man let cmds = [ init_term; new_term; file_term; unfile_term; list_term; Convert.term ] let () = Random.self_init(); match Term.eval_choice default_cmd cmds with `Error _ -> exit 1 | _ -> exit 0