let version = "0.5" 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 "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 create_dir dir = Bos.OS.Dir.create (Fpath.v dir) let create_dir_msg ?(descr="") dir res = let () = match res with | Ok true -> print_endline ("Created " ^ descr ^ " directory " ^ dir) | Ok false -> print_endline ("Reinitialise existing " ^ descr ^ " directory " ^ dir) | Error (`Msg msg) -> prerr_endline @@ "Failed making " ^ descr ^ ". " ^ msg in res let copy ?(recursive = false) src dst = Bos.OS.Cmd.run (Bos.Cmd.(v "cp" %% (on recursive @@ v "-r") % src % dst)) let init _force = let rec create_dirs = function | [] -> () | (dir,descr)::tl -> match create_dir dir |> create_dir_msg ~descr dir with | Ok _ -> create_dirs tl | Error _ -> () in let dirs = [ ".logarion", "Logarion"; ".logarion/static", "static files"; ".logarion/html-templates", "templates"; ] in let toml_data = 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" ~absent:""); key "email", TString (Bos.OS.Env.opt_var "EMAIL" ~absent:""); 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 ".logarion/static"; ]); key "templates", TTable (of_key_values []); ] in create_dirs dirs; let config_file = open_out "config.toml" in output_bytes config_file (Toml.Printer.string_of_table toml_data |> Bytes.of_string); 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 authors = AuthorSet.singleton Author.({ name = conf.C.owner; address = Uri.of_string conf.C.email }) in let date = Date.({ created = Some (Ptime_clock.now ()); published = None; edited = None }) in { (blank ()) with title = t; authors; date } 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 convert directory = let module Config = Confix.Config.Make (Confix.ConfixToml) in let toml_config = let open Confix.Config in Path.with_file "config.toml" |> function Ok cfg -> Config.from_path cfg | Error str -> prerr_endline str; exit 1 in let config = Config.to_record_or_exit Logarion.Archive.Configuration.of_config toml_config in let module L = Logarion.Archive.Make(File) in let store = File.store config.repository in let archive = L.{ config; store } in let notes = List.filter Meta.(fun n -> CategorySet.published n.Note.meta.categories) @@ File.to_list L.note_lens archive.store in let metas = List.filter Meta.(fun m -> CategorySet.published m.categories && CategorySet.listed m.categories) @@ File.to_list ~order:(L.recency_order) L.meta_lens archive.store in let template_config = toml_config in let module T = Converters.Template in let header = T.header_converter template_config in let body = T.body_converter template_config in let style = T.default_style in let linker x = match Fpath.(relativize ~root:(v "/") (v x)) with Some l -> Fpath.to_string l | None -> "" in let page_of_log metas = T.page_of_log linker header config metas in let page_of_index metas = T.page_of_index linker header config metas in let page_of_note note = T.page_of_note linker header body config note in let path_of_note note = directory ^ "/" ^ Meta.alias note.Note.meta ^ ".html" in let file_creation path content = let out = open_out path in output_string out content; close_out out in match create_dir directory |> create_dir_msg ~descr:"export" directory with | Error _ -> () | Ok _ -> match copy ~recursive:true ".logarion/static" (directory) with | Ok _ -> let note_write note = file_creation (path_of_note note) (page_of_note ~style note) in List.iter note_write notes; file_creation (directory ^ "/log.html") (page_of_log ~style metas); file_creation (directory ^ "/index.html") (page_of_index ~style metas); file_creation (directory ^ "/feed.atom") (Converters.Atom.feed config "/" (L.note_with_id archive) metas) | Error (`Msg m) -> prerr_endline m let convert_term = let directory = Arg.(value & pos 0 string "html-conversion" & info [] ~docv:"Directory" ~doc:"Directory to convert to") in Term.(const convert $ directory), Term.info "convert" ~doc:"convert archive to HTML" ~man:[ `S "DESCRIPTION"; `P "Create a repository in current directory" ] let default_cmd = Term.(ret (const (`Help (`Pager, None)))), Term.info "logarion" ~version ~doc:"an article collection & publishing system" ~man:[ `S "BUGS"; `P "Submit bugs "; ] let cmds = [ init_term; create_term; convert_term ] let () = Random.self_init(); match Term.eval_choice default_cmd cmds with `Error _ -> exit 1 | _ -> exit 0