mte/unikernel/duniverse/mirage/test/functoria/test_cli.ml

open Functoria

let result_t pp_a =
  let pp ppf = function
    | `Error `Exn -> Fmt.string ppf "error exn"
    | `Error `Parse -> Fmt.string ppf "error parse"
    | `Error `Term -> Fmt.string ppf "error term"
    | `Help -> Fmt.string ppf "help"
    | `Version -> Fmt.string ppf "version"
    | `Ok action ->
        let pp = Cli.pp_action pp_a in
        Fmt.pf ppf "ok %a" pp action
  in
  Alcotest.testable pp ( = )

let result_b = result_t Fmt.(Dump.pair bool bool)
let eval = Cli.eval ~with_setup:false ~name:"name" ~version:"0.2"

let test_configure () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~clean:extra_term ~help:extra_term ~mname:"test"
      [| "name"; "configure"; "--xyz"; "--verbose" |]
  in
  Alcotest.(check result_b)
    "configure"
    (`Ok
       (Cli.Configure
          {
            depext = true;
            extra_repo =
              [
                ( "opam-overlays",
                  "https://github.com/dune-universe/opam-overlays.git" );
                ( "mirage-overlays",
                  "https://github.com/dune-universe/mirage-opam-overlays.git" );
              ];
            args =
              {
                context = (true, false);
                output = None;
                config_file = Fpath.v "config.ml";
                context_file = None;
                dry_run = false;
              };
          }))
    result

let test_describe () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~clean:extra_term ~help:extra_term ~mname:"test"
      [|
        "name";
        "describe";
        "--context-file=config.json";
        "--cde";
        "--color=always";
        "--dot-command=dot";
        "--eval";
      |]
  in
  Alcotest.(check result_b)
    "describe"
    (`Ok
       (Cli.Describe
          {
            args =
              {
                context = (false, true);
                output = None;
                config_file = Fpath.v "config.ml";
                context_file = Some (Fpath.v "config.json");
                dry_run = false;
              };
            dotcmd = "dot";
            dot = false;
            eval = Some true;
          }))
    result

let test_clean () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let result =
    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
      ~clean:extra_term ~help:extra_term [| "name"; "clean" |] ~mname:"test"
  in
  Alcotest.(check result_b)
    "clean"
    (`Ok
       (Cli.Clean
          {
            context = (false, false);
            output = None;
            config_file = Fpath.v "config.ml";
            context_file = None;
            dry_run = false;
          }))
    result

let test_help () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let null = Fmt.with_buffer (Buffer.create 10) in
  let result =
    eval ~help_ppf:null ~configure:extra_term ~query:extra_term
      ~describe:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
      [| "name"; "help"; "--help"; "plain" |]
  in
  Alcotest.(check result_b) "help" `Help result

let test_default () =
  let extra_term =
    Cmdliner.(
      Term.(
        const (fun xyz cde -> (xyz, cde))
        $ Arg.(value (flag (info [ "x"; "xyz" ])))
        $ Arg.(value (flag (info [ "c"; "cde" ])))))
  in
  let null = Fmt.with_buffer (Buffer.create 10) in
  let result =
    eval ~help_ppf:null ~configure:extra_term ~query:extra_term
      ~describe:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
      [| "name" |]
  in
  Alcotest.(check result_b) "default" `Help result

let test_read_full_eval () =
  let check = Alcotest.(check @@ option bool) in
  check "test" None (Cli.peek_full_eval [| "test" |]);

  check "test --eval" (Some true) (Cli.peek_full_eval [| "test"; "--eval" |]);

  check "test blah --eval blah" (Some true)
    (Cli.peek_full_eval [| "test"; "blah"; "--eval"; "blah" |]);

  check "test --no-eval" (Some false)
    (Cli.peek_full_eval [| "test"; "--no-eval" |]);

  check "test blah --no-eval blah" (Some false)
    (Cli.peek_full_eval [| "test"; "blah"; "--no-eval"; "blah" |]);

  check "--no-eval test --eval" (Some true)
    (Cli.peek_full_eval [| "--no-eval"; "test"; "--eval" |]);

  check "--eval test --no-eval" (Some false)
    (Cli.peek_full_eval [| "--eval"; "test"; "--no-eval" |])

let suite =
  [
    ("read_full_eval", `Quick, test_read_full_eval);
    ("configure", `Quick, test_configure);
    ("describe", `Quick, test_describe);
    ("clean", `Quick, test_clean);
    ("help", `Quick, test_help);
    ("default", `Quick, test_default);
  ]