open Fugue
open Filepath
open Compat
open Helper
open Printf
open Gconf

exception ConfigChanged of string
exception ToolNotFound of filename
exception ConfigurationMissingKey of string
exception ConfigurationTypeMismatch of string * string * string
exception ConfigureScriptFailed of string

type flag_action =
  | SetFlag of string
  | ClearFlag of string

let getDigestKV () =
  let digest = Project.digest () in
  [ ("obuild-digest", digest) ]

let generateMlFile project file flags =
  Utils.generateFile file (fun add ->
      add "(* autogenerated file by obuild. do not modify *)\n";
      add (sprintf "let project_name = \"%s\"\n" (String_utils.escape_ocaml_string project.Analyze.project_file.Project.name));
      add (sprintf "let project_version = \"%s\"\n" (String_utils.escape_ocaml_string project.Analyze.project_file.Project.version));
      List.iter (fun (name, v) -> add (sprintf "let project_flag_%s = %b\n" name v)) flags)

let generateCFile project file flags =
  Utils.generateFile file (fun add ->
      add "/* autogenerated file by obuild. do not modify */\n";
      add (sprintf "#define PROJECT_NAME \"%s\"\n" (String_utils.escape_c_string project.Analyze.project_file.Project.name));
      add (sprintf "#define PROJECT_VERSION \"%s\"\n" (String_utils.escape_c_string project.Analyze.project_file.Project.version));
      List.iter
        (fun (name, v) ->
          add (sprintf "#define PROJECT_FLAG_%s %d\n" (string_uppercase name) (if v then 1 else 0)))
        flags)

let makeSetup digestKV project flags =
  hashtbl_from_list
    (digestKV
    @ hashtbl_to_list project.Analyze.project_ocamlcfg
    @ List.map (fun (opt, v) -> (opt, string_of_bool v)) (Gconf.get_target_options ())
    @ List.map (fun (flagname, flagval) -> ("flag-" ^ flagname, string_of_bool flagval)) flags)

let sanityCheck ?(needs_c_toolchain=false) () =
  let (_ : string) = Prog.get_ocamlopt () in
  let (_ : string) = Prog.get_ocamlc () in
  let (_ : string) = Prog.get_ocamldep () in
  if needs_c_toolchain then begin
    let (_ : string) = Prog.get_cc () in
    let (_ : string) = Prog.get_ar () in
    let (_ : string) = Prog.get_ranlib () in
    ()
  end

let comparekvs reason setup l =
  List.iter
    (fun (k, v) ->
      try
        let v' = Hashtbl.find setup k in
        if v' <> v then
          raise (ConfigChanged reason)
      with Not_found -> raise (ConfigChanged reason))
    l

let comparekvs_hashtbl reason setup l =
  Hashtbl.iter
    (fun k v ->
      try
        let v' = Hashtbl.find setup k in
        if v' <> v then
          raise (ConfigChanged reason)
      with Not_found -> raise (ConfigChanged reason))
    l

let execute_configure_script proj_file =
  match proj_file.Project.configure_script with
  | None -> ()
  | Some script -> (
      let args = [ Prog.get_ocaml (); fp_to_string script ] in
      match Process.run args with
      | Process.Success (_, warnings, _) -> print_warnings warnings
      | Process.Failure er -> raise (ConfigureScriptFailed er))

let create_dist project flags =
  log Verbose "configuration changed, deleting dist\n%!";
  Filesystem.remove_dir_content Dist.build_path;
  Dist.remove_dead_links ();
  log Verbose "auto-generating configuration files\n%!";
  let autogenDir = Dist.create_build Dist.Autogen in
  generateMlFile project (autogenDir </> fn "path_generated.ml") flags;
  generateCFile project (autogenDir </> fn "obuild_macros.h") flags

let get_assoc name assoc =
  try
    let v = List.assoc name assoc in
    Some v
  with Not_found -> None

let get_flags_value proj_file setup_flags user_flags =
  List.map
    (fun flag ->
      let name = flag.Project.Flag.name in
      let def = flag.Project.Flag.default in
      let override = ref (get_assoc name setup_flags) in
      List.iter
        (fun tw ->
          match tw with
          | ClearFlag s -> if s = name then override := Some false
          | SetFlag s -> if s = name then override := Some true)
        user_flags;
      match (!override, def) with
      | None, None -> (name, false)
      | None, Some v -> (name, v)
      | Some v, _ -> (name, v))
    proj_file.Project.flags

let check_extra_tools proj_file =
  let syspath = Utils.get_system_paths () in
  List.iter
    (fun tool ->
      try
        let _ = Utils.find_in_paths syspath tool in
        ()
      with Utils.FileNotFoundInPaths _ -> raise (ToolNotFound tool))
    proj_file.Project.extra_tools

let get_flags hash =
  Hashtbl.fold
    (fun k v acc ->
      if String_utils.startswith "flag-" k then
        (String_utils.drop 5 k, bool_of_string v) :: acc
      else
        acc)
    hash []

let bool_of_opt hashtable k =
  let get_opt k =
    try Hashtbl.find hashtable k with Not_found -> raise (ConfigurationMissingKey k)
  in
  let v = get_opt k in
  try bool_of_string v with Failure _ -> raise (ConfigurationTypeMismatch (k, "bool", v))

let set_opts hashtable =
  (* load the environment *)
  let opts = Gconf.get_target_options_keys () in
  List.iter (fun k -> Gconf.set_target_options k (bool_of_opt hashtable k)) opts

let check_ocaml () =
  let ocamlCfg = Prog.get_ocaml_config () in
  let ocaml_ver = Hashtbl.find ocamlCfg "version" in
  let ver = String_utils.split '.' ocaml_ver in
  (match ver with
  | major :: minor :: _ ->
      let maj = int_of_string major in
      let min = int_of_string minor in
      if maj < 4 then gconf.bin_annot <- false;
      if maj > 4 || (maj = 4 && min > 1) then gconf.short_path <- true;
      if maj > 5 || (maj = 5 && min >= 2) then gconf.bin_annot_occurrences <- true
  | _ -> gconf.bin_annot <- false);
  ocamlCfg

let run proj_file user_flags user_opts =
  Dist.create_maybe ();
  let _ = check_ocaml () in
  (* Auto-detect CPU count and set default parallelism *)
  let cpu_count = Utils.get_cpu_count () in
  log Report "Detected %d CPU core%s, setting default parallelism to %d\n" cpu_count
    (if cpu_count = 1 then "" else "s")
    cpu_count;
  gconf.parallel_jobs <- cpu_count;
  let digestKV = getDigestKV () in
  execute_configure_script proj_file;
  let configure = try Some (Dist.read_configure ()) with Dist.DistFileNotFound _ -> None in
  let configure_flags =
    match configure with
    | None -> []
    | Some h ->
        (* set opts and return the flags *)
        Hashtbl.iter
          (fun k _ ->
            if not (String_utils.startswith "flag-" k) then
              Gconf.set_target_options k (bool_of_opt h k))
          h;
        get_flags h
  in
  let flags = get_flags_value proj_file configure_flags user_flags in
  log Debug "  configure flag: [%s]\n"
    (Utils.showList "," (fun (n, v) -> n ^ "=" ^ string_of_bool v) flags);
  check_extra_tools proj_file;
  (* Set the user opts BEFORE analyzing the project *)
  List.iter (fun (o, v) -> Gconf.set_target_options o v) user_opts;
  let project = Analyze.prepare proj_file flags in
  let currentSetup = makeSetup digestKV project flags in
  let actualSetup = try Some (Dist.read_setup ()) with Dist.DistFileNotFound _ -> None in
  let projectSystemChanged =
    match actualSetup with
    | None -> true
    | Some stp -> (
        (* TODO harcoded for now till we do all the checks. *)
        try
          comparekvs "setup" stp (hashtbl_to_list currentSetup);
          (* FORCED should be false *) true
        with ConfigChanged _ | Not_found -> true)
  in

  if projectSystemChanged then (
    create_dist project flags;
    (* write setup file *)
    log Verbose "Writing new setup\n%!";
    Dist.write_setup currentSetup)

let check proj_file reconf setup =
  let ocamlCfg = check_ocaml () in
  let digestKV = getDigestKV () in
  (* check if the environment changed. *)
  comparekvs_hashtbl "ocaml config" setup ocamlCfg;
  (* if the digest of .obuild changed, let's reconfigure *)
  let reconfigure =
    try
      comparekvs "digest" setup digestKV;
      false
    with e -> if reconf then true else raise e
  in
  (* user_flags are also restored from setup file *)
  let setup_flags = get_flags setup in
  let flags = get_flags_value proj_file setup_flags [] in
  (* .obuild changed, maybe we should compare a little bit deeper to not retriggerd reconf too often ... *)
  if reconfigure then (
    (* let's call configure-script if available, however we don't care about the content of dist/configure *)
    execute_configure_script proj_file;
    log Debug "  configure flag: [%s]\n"
      (Utils.showList "," (fun (n, v) -> n ^ "=" ^ string_of_bool v) flags);
    check_extra_tools proj_file;
    let project = Analyze.prepare proj_file flags in
    create_dist project flags;
    (* write setup file *)
    log Verbose "Writing new setup\n%!";
    let current_setup = makeSetup digestKV project flags in
    Dist.write_setup current_setup);
  flags