open Core
open Option.Let_syntax

let join_str_list ~sep = function
  | [] -> ""
  | s :: ss -> List.fold ss ~init:s ~f:(fun acc s -> acc ^ sep ^ s)

type cmd = {
  args : string;
  opts : unit -> string list;
  next : (string -> (string, cmd) Either.t) option;
  call : string list -> bool;
}

let set_opt_cmd opt setting =
  {
    args = "<option value>";
    opts = (fun () -> Settings.allowed_values setting);
    next = None;
    call =
      (fun args ->
        match Settings.set_to setting args with
        | None -> true
        | Some msg ->
            printf "Failed to set option %s: %s\n%!" opt msg;
            false);
  }

let set_cmd =
  {
    args = "<option name> <option value>";
    opts = (fun () -> Map.keys Settings.settings);
    next =
      Some
        (fun opt ->
          match Map.find Settings.settings opt with
          | Some setting -> Second (set_opt_cmd opt setting)
          | None -> First (sprintf "Unknown option '%s'" opt));
    call =
      (fun _ ->
        printf "Missing option argument value\n%!";
        false);
  }

let settings_cmd =
  {
    args = "";
    opts = (fun () -> []);
    next = None;
    call =
      (function
      | [] ->
          Settings.print ();
          true
      | _ ->
          printf "Expected no arguments\n%!";
          false);
  }

let run_cmd =
  {
    args = "<filename>";
    opts = (fun () -> []);
    next = None;
    call =
      (function
      | [ filename ] -> Run.eval_file filename
      | _ ->
          printf "Expected one argument (the filename)\n%!";
          false);
  }

let quit_cmd =
  { args = ""; opts = (fun () -> []); next = None; call = (fun _ -> exit 0) }

let commands =
  Map.of_alist_exn
    (module String)
    [
      ("quit", quit_cmd);
      ("set", set_cmd);
      ("settings", settings_cmd);
      ("run", run_cmd);
    ]

let root_cmd =
  {
    args = "<command>";
    opts = (fun () -> Map.keys commands);
    next =
      Some
        (fun cmd_name ->
          match Map.find commands cmd_name with
          | Some cmd -> Second cmd
          | None ->
              First
                (sprintf "Unknown command '%s' (expected one of {%s})" cmd_name
                   (Map.keys commands |> join_str_list ~sep:", ")));
    call =
      (fun _ ->
        printf "Missing command!\n%!";
        false);
  }

let is_space = Char.( = ) ' '
let strip_space = String.strip ~drop:is_space
let lstrip_space = String.lstrip ~drop:is_space

let clean_str_list ss =
  ss |> List.map ~f:strip_space
  |> List.filter ~f:(fun s -> not (String.is_empty s))

let words s = s |> String.split ~on:' ' |> clean_str_list
let unwords ss = clean_str_list ss |> join_str_list ~sep:" "

let rec call cmd args =
  match args with
  | [] -> cmd.call []
  | arg0 :: argn -> (
      match cmd.next with
      | None -> cmd.call args
      | Some next -> (
          match next arg0 with
          | First msg ->
              printf "%s\n%!" msg;
              false
          | Second cmd' -> call cmd' argn))

let try_lsplit2_space s =
  match String.lsplit2 s ~on:' ' with Some (l, r) -> (l, r) | None -> (s, "")

let lsplit2_space' s =
  let%bind l, r = String.lsplit2 s ~on:' ' in
  (* s = l ^ " " ^ r *)
  let r' = lstrip_space r in
  let space = " " ^ String.chop_suffix_exn r ~suffix:r' in
  (* s = l ^ space ^ r' *)
  return (l, space, r')

let rec completions cmd args =
  (* cmd|<TAB> -> options
     cmd|abc<TAB> -> options with prefix 'abc'
     cmd|abc .*<TAB> -> subcommand 'abc' options, pass .* *)
  if String.(args = "") then cmd.opts ()
  else
    match lsplit2_space' args with
    | None -> cmd.opts () |> List.filter ~f:(String.is_prefix ~prefix:args)
    | Some (arg0, space, argn) -> (
        match cmd.next with
        | None -> []
        | Some next -> (
            match next arg0 with
            | First _ -> []
            | Second cmd' ->
                completions cmd' argn
                |> List.map ~f:(String.append (arg0 ^ space))))

let rec hints cmd args =
  (* cmd: "" -> " <args>"
     cmd: "<space>+" -> "<args>"
     cmd: "<space>+<subcmd>" -> "<hints for subcmd>"
     cmd: "<space>+<subcmd> .*" -> "<hints for subcmd with .*>" *)
  if String.(args = "") then Some (" " ^ cmd.args)
  else if String.(strip_space args = "") then Some cmd.args
  else
    let args = lstrip_space args in
    let%bind next = cmd.next in
    match lsplit2_space' args with
    | None ->
        let%bind cmd' = next args |> Either.Second.to_option in
        hints cmd' ""
    | Some (arg0, space, argn) ->
        let%bind cmd' = next arg0 |> Either.Second.to_option in
        hints cmd' (space ^ argn)

let invoke cmd = call root_cmd (words cmd)
let complete cmd = completions root_cmd cmd
let hint cmd = hints root_cmd cmd