104 lines
3.4 KiB
OCaml
104 lines
3.4 KiB
OCaml
open Cmdliner
|
|
open Logarion
|
|
module C = Archive.Configuration
|
|
module Lpath = Logarion.Lpath
|
|
|
|
let conf () =
|
|
let module Config = Confix.Config.Make (Confix.ConfixToml) in
|
|
let archive_res =
|
|
let open Confix.Config in
|
|
Confix.Config.Path.with_file ".logarion/config.toml"
|
|
&> Config.from_path
|
|
|> Config.to_record C.of_config
|
|
in
|
|
match archive_res with
|
|
| Ok config -> config
|
|
| Error str -> prerr_endline str; exit 1
|
|
|
|
let init force =
|
|
let rec create_dirs = function
|
|
| [] -> ()
|
|
| (dir,descr)::tl ->
|
|
match Bos.OS.Dir.create (Fpath.v dir) with
|
|
| Ok true -> print_endline ("Created " ^ descr ^ " directory in " ^ dir); create_dirs tl
|
|
| Ok false -> print_endline ("Reinitialise existing " ^ descr ^ " directory in " ^ dir); create_dirs tl
|
|
| Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg
|
|
in
|
|
let dirs = [
|
|
".logarion", "Logarion";
|
|
".logarion/static", "static files";
|
|
".logarion/html-templates", "templates";
|
|
]
|
|
in
|
|
let toml_data =
|
|
Random.self_init();
|
|
let open Toml in
|
|
let open TomlTypes in
|
|
of_key_values [
|
|
key "archive",
|
|
TTable (
|
|
of_key_values [
|
|
key "title", TString "";
|
|
key "owner", TString (Bos.OS.Env.opt_var "USER" "");
|
|
key "email", TString (Bos.OS.Env.opt_var "EMAIL" "");
|
|
key "uuid", TString (Meta.Id.(generate () |> to_string));
|
|
]);
|
|
key "web",
|
|
TTable (
|
|
of_key_values [
|
|
key "url", TString "http://localhost:3666";
|
|
key "stylesheets", TArray ( NodeString ["main.css"] );
|
|
key "static_dir", TString "share/static";
|
|
]);
|
|
key "templates", TTable (of_key_values []);
|
|
]
|
|
in
|
|
create_dirs dirs;
|
|
let config_file = open_out ".logarion/config.toml" in
|
|
output_bytes config_file (Toml.Printer.string_of_table toml_data);
|
|
close_out config_file
|
|
|
|
let init_term =
|
|
let force =
|
|
let doc = "Initialise repository even if directory is non empty" in
|
|
Arg.(value & flag & info ["f"; "force"] ~doc)
|
|
in
|
|
Term.(const init $ force),
|
|
Term.info
|
|
"init" ~doc:"initialise a logarion repository in present directory"
|
|
~man:[ `S "DESCRIPTION"; `P "Create a repository in current directory" ]
|
|
|
|
let create_term =
|
|
let title =
|
|
Arg.(value & pos 0 string "" & info [] ~docv:"TITLE" ~doc:"Title for new article")
|
|
in
|
|
let f title =
|
|
let conf = conf () in
|
|
let t = match title with "" -> "Draft" | _ -> title in
|
|
let note =
|
|
let meta =
|
|
let open Meta in
|
|
let author = Author.({ name = conf.C.owner; email = Email.of_string conf.C.email }) in
|
|
{ (blank ()) with title = t; author }
|
|
in
|
|
Note.({ (blank ()) with meta })
|
|
in
|
|
File.Lwt.with_note (File.store conf.C.repository) note
|
|
|> Lwt_main.run
|
|
|> ignore
|
|
in
|
|
Term.(const f $ title),
|
|
Term.info "create"
|
|
~doc:"create a new article"
|
|
~man:[ `S "DESCRIPTION"; `P "Create a new article, with title 'Draft' when none provided"]
|
|
|
|
let default_cmd =
|
|
Term.(ret (const (`Help (`Pager, None)))),
|
|
Term.info "logarion" ~version:"0.2" ~doc:"an article collection & publishing system"
|
|
~man:[ `S "BUGS"; `P "Submit bugs https://gitlab.com/orbifx/logarion/issues/new."; ]
|
|
|
|
let cmds = [ init_term; create_term ]
|
|
|
|
let () = match Term.eval_choice default_cmd cmds with
|
|
| `Error _ -> exit 1 | _ -> exit 0
|