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

@@ -0,0 +1,182 @@
+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);
+  ]