open Functoria
open Cmdliner

let key_a = Key.create "a" Key.Arg.(flag @@ Arg.info [ "a" ])
let key_b = Key.create "b" Key.Arg.(opt Arg.int 0 @@ Arg.info [ "b" ])
let key_c = Key.create "c" Key.Arg.(required Arg.string @@ Arg.info [ "c" ])
let key_d = Key.create "d" Key.Arg.(opt_all Arg.int @@ Arg.info [ "d" ])
let empty = Context.empty
let ( & ) (k, v) c = Key.add_to_context k v c
let ( && ) x y = x & y & empty

let test_eval () =
  let context = (key_a, true) & (key_b, 0) && (key_c, Some "foo") in

  let if_ = Key.if_ Key.(value key_a) "hello" "world" in
  let r = Key.eval context if_ in
  Alcotest.(check string) "if" "hello" r;

  let match_1 =
    Key.match_ Key.(value key_b) (function 0 -> "hello" | _ -> "world")
  in
  let r = Key.eval context match_1 in
  Alcotest.(check string) "match 1" "hello" r;

  let match_2 =
    Key.match_
      Key.(value key_c)
      (function Some "foo" -> "hello" | _ -> "world")
  in
  let r = Key.eval context match_2 in
  Alcotest.(check string) "match 1" "hello" r

let keys = Key.Set.of_list Key.[ v key_a; v key_b; v key_c; v key_d ]
let keys_no_required = Key.Set.of_list Key.[ v key_a; v key_b; v key_d ]

let eval f keys argv =
  let argv = Array.of_list ("" :: argv) in
  match
    Cmdliner.Cmd.eval_value ~argv
      (Cmdliner.Cmd.v (Cmdliner.Cmd.info "keys") (f keys))
  with
  | Error _ -> Alcotest.fail "Error"
  | Ok (`Ok x) -> x
  | Ok `Version -> Alcotest.fail "version"
  | Ok `Help -> Alcotest.fail "help"

exception Error

let test_get () =
  let context = eval Key.context keys [ "-a"; "-c"; "foo" ] in
  Alcotest.(check bool) "get a" true (Key.get context key_a);
  Alcotest.(check int) "get b" 0 (Key.get context key_b);
  Alcotest.(check (option string)) "get c" (Some "foo") (Key.get context key_c);

  let context = eval Key.context keys_no_required [ "-a" ] in
  Alcotest.(check (option string))
    "get c with_required:false" None (Key.get context key_c);

  Alcotest.check_raises "get c with_required:true" Error (fun () ->
      try ignore (eval Key.context keys [ "-a" ]) with _ -> raise Error)

let test_find () =
  let context = eval Key.context keys_no_required [] in
  Alcotest.(check (option bool)) "find a" None (Key.find context key_a);
  Alcotest.(check (option int)) "find b" None (Key.find context key_b);
  Alcotest.(check (option (option string)))
    "find c" None (Key.find context key_c)

let test_merge () =
  let cache = (key_a, true) && (key_c, Some "foo") in
  let cli = (key_a, false) && (key_b, 2) in
  let context = Context.merge ~default:cache cli in
  Alcotest.(check bool) "merge a" false (Key.get context key_a);
  Alcotest.(check int) "merge b" 2 (Key.get context key_b);
  Alcotest.(check (option string))
    "merge c" (Some "foo") (Key.get context key_c)

let key = Alcotest.testable Key.pp Key.equal

let test_equal () =
  let module A = Arg in
  let k1 = Key.(v @@ create "foo" Arg.(opt A.int 1 (A.info [ "foo" ]))) in
  let k2 = Key.(v @@ create "foo" Arg.(opt A.int 2 (A.info [ "foo" ]))) in
  let k3 = Key.(v @@ create "foo" Arg.(opt A.int 1 (A.info [ "foo" ]))) in
  Alcotest.(check @@ neg key) "different defaults" k1 k2;
  Alcotest.(check @@ key) "same defaults" k1 k3

let test_cmdliner () =
  let module A = Arg in
  let k1 = Key.(v @@ create "foo" Arg.(opt A.int 1 (A.info [ "foo" ]))) in
  let k2 = Key.(v @@ create "foo" Arg.(opt A.int 2 (A.info [ "foo" ]))) in
  let keys = Key.Set.of_list [ k1; k2 ] in
  let context = Key.context keys in
  let _ = eval (fun x -> x) context [] in
  ()

let test_opt_all () =
  let context =
    eval Key.context keys_no_required [ "-d"; "1"; "-d"; "2"; "-d"; "3" ]
  in
  Alcotest.(check (list int)) "get d" [ 1; 2; 3 ] (Key.get context key_d);
  let context = eval Key.context keys_no_required [] in
  Alcotest.(check (list int)) "get d" [] (Key.get context key_d);
  match
    Cmdliner.Cmd.eval_value ~argv:[| ""; "-d" |]
      Cmdliner.(Cmd.v (Cmd.info "keys") (Key.context keys_no_required))
  with
  | Ok (`Ok _ | `Help | `Version) ->
      Alcotest.failf "Invalid given command-line, eval must fail."
  | Error _ -> Alcotest.(check pass) "invalid opt-all argument" () ()

let suite =
  List.map
    (fun (n, f) -> (n, `Quick, f))
    [
      ("equal", test_equal);
      ("eval", test_eval);
      ("get", test_get);
      ("find", test_find);
      ("merge", test_merge);
      ("cmdliner", test_cmdliner);
      ("opt-all", test_opt_all);
    ]