blog.robur.coop/bin/push.ml

let reporter ppf =
  let report src level ~over k msgf =
    let k _ =
      over ();
      k ()
    in
    let with_metadata header _tags k ppf fmt =
      Format.kfprintf k ppf
        ("%a[%a]: " ^^ fmt ^^ "\n%!")
        Logs_fmt.pp_header (level, header)
        Fmt.(styled `Magenta string)
        (Logs.Src.name src)
    in
    msgf @@ fun ?header ?tags fmt -> with_metadata header tags k ppf fmt
  in
  { Logs.report }

let run_git_rev_parse () =
  let open Bos in
  let value = OS.Cmd.run_out
      Cmd.(v "git" % "describe" % "--always" % "--dirty"
           % "--exclude=*" % "--abbrev=0")
  in
  match OS.Cmd.out_string value with
  | Ok (value, (_, `Exited 0)) -> Some value
  | Ok (value, (run_info, _)) ->
    Logs.warn (fun m -> m "Failed to get commit id: %a: %s"
                  Cmd.pp (OS.Cmd.run_info_cmd run_info)
                  value);
    None
  | Error `Msg e ->
    Logs.warn (fun m -> m "Failed to get commit id: %s" e);
    None

let message () =
  match run_git_rev_parse () with
  | Some hash -> Fmt.str "Pushed by YOCaml 2 from %s" hash
  | None -> Fmt.str "Pushed by YOCaml 2"

let () = Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ()
let () = Logs.set_reporter (reporter Fmt.stdout)
(* let () = Logs.set_level ~all:true (Some Logs.Debug) *)
let author = ref "The Robur Team"
let email = ref "team@robur.coop"
let message = ref (message ())
let remote = ref "git@git.robur.coop:robur/blog.robur.coop.git#gh-pages"
let host = ref "https://blog.robur.coop"

module Source = Yocaml_git.From_identity (Yocaml_unix.Runtime)

let usage =
  Fmt.str
    "%s [--message <message>] [--author <author>] [--email <email>] -r \
     <repository>#<branch>"
    Sys.argv.(0)

let specification =
  [
    ("--message", Arg.Set_string message, "The commit message")
  ; ("--email", Arg.Set_string email, "The email used to craft the commit")
  ; ("-r", Arg.Set_string remote, "The Git repository including #branch, e.g. " ^ !remote)
  ; ("--author", Arg.Set_string author, "The Git commit author")
  ; ("--host", Arg.Set_string host, "The host where the blog is available")
  ]

let () =
  Arg.parse specification ignore usage;
  let author = !author
  and email = !email
  and message = !message
  and remote = !remote in
  let module Blog = Blog.Make_with_target (struct
    let source = Yocaml.Path.rel []
    let target = Yocaml.Path.rel []
  end) in
  Yocaml_git.run
    (module Source)
    (module Pclock)
    ~context:`SSH ~author ~email ~message ~remote
    (fun () -> Blog.process_all ~host:!host)
  |> Lwt_main.run
  |> Result.iter_error (fun (`Msg err) -> invalid_arg err)