File bin/m.ml from the latest check-in

open Batteries
open Cmdliner

type copts = { account: string }

let id copts =
  let id' =
    try%lwt
      let%lwt id = Mastocaml.id_of copts.account in
      Lwt_io.printl id
    with
    | Failure m -> Lwt_io.eprintl m
  in
  Lwt_main.run id'

let followers copts =
  let followers' =
    try%lwt
      let%lwt followers = Mastocaml.followers_of copts.account in
      let csv_elements = Array.of_list @@ Mastocaml.(follower_header :: List.map follower_to_row followers) in
      Csv_lwt.(print @@ Csv.of_array csv_elements)
    with
    | Failure m -> Lwt_io.eprintl m
    in
  Lwt_main.run followers'

let test_domain_block copts domain =
  (* there's no Csv_lwt.print_readable so we're doing this cheeseball style and hoping it doesn't blow up *)
  let blocked = Lwt_main.run @@ Mastocaml.test_domain_block copts.account domain in
  let csv_elements = Array.of_list @@ Mastocaml.(blocked_header :: List.map blocked_follower_to_row blocked) in
  Csv.(print_readable @@ of_array csv_elements)

let post copts cw in_reply_to status =
  let status' = String.join " " status in
  let post' =
    try%lwt
      let%lwt response = Mastocaml.status_to copts.account ?cw ?in_reply_to status' in
      Lwt_io.printl Ezjsonm.(find response ["url"] |> get_string)
    with
    | Failure m -> Lwt_io.eprintl m
  in
  Lwt_main.run post'

open Cmdliner

(* Help sections common to all commands *)

let help_secs = [
 `S Manpage.s_common_options;
 `P "These options are common to all commands.";
 `S "MORE HELP";
 `P "Use $(mname) $(i,COMMAND) --help for help on a single command.";
 `S Manpage.s_files;
 `P "Account tokens are retrieved from $(b,\\$XDG_CONFIG_HOME)/mastocaml/$(i,ACCOUNT), which should contain a single line with the token.";
 `S Manpage.s_bugs; `P "Check bug reports at https://fossil.se30.xyz/mastocaml";]

(* Options common to all commands *)

let copts account = { account }
let copts_t =
  let docs = Manpage.s_common_options in
  let account =
    let doc = "Name the account to use." in
    Arg.(required & pos 0 (some string) None & info [] ~docv:"ACCT" ~docs ~doc)
  in
  Term.(const copts $ account)

let sdocs = Manpage.s_common_options

let id_cmd =
  let doc = "verify credentials and return the user's id" in
  let info = Cmd.info "id" ~doc ~sdocs in
  Cmd.v info Term.(const id $ copts_t)

let followers_cmd =
  let doc = "show followers in CSV format" in
  let info = Cmd.info "followers" ~doc ~sdocs in
  Cmd.v info Term.(const followers $ copts_t)

let post_cmd =
  let doc = "make a post" in
  let info = Cmd.info "post" ~doc ~sdocs in
  let cw = Arg.(value & opt (some' string) None & info ["c"; "cw"] ~docv:"WARNING" ~doc:"Set the content warning field") in
  let in_reply_to = Arg.(value & opt (some' string) None & info ["r"; "in-reply-to"] ~docv:"STATUS" ~doc:"Reply to this status") in
  let status = Arg.(non_empty & pos_right 0 string [] & info [] ~docv:"TEXT" ~doc:"The status to post") in
  Cmd.v info Term.(const post $ copts_t $ cw $ in_reply_to $ status)

let test_domain_block_cmd =
  let doc = "show which followers you would lose by blocking a given domain" in
  let info = Cmd.info "test_domain_block" ~doc ~sdocs in
  let blocked = Arg.(required & pos 1 (some string) None & info [] ~docv:"BLOCKED" ~doc:"Name the domain to block") in
  Cmd.v info Term.(const test_domain_block $ copts_t $ blocked)

let main_cmd =
  let doc = "a mastodon tool" in
  let man = help_secs in
  let info = Cmd.info "m" ~version:"0.1" ~doc ~sdocs ~man in
  let default = Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)) in
  Cmd.group info ~default [id_cmd; post_cmd; followers_cmd; test_domain_block_cmd;]

let () = exit @@ (Cmd.eval main_cmd)