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 conf 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 conf)
    @ 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))

(* Remove the build directory content, but preserve the currently running
   executable if it lives inside it: with a self-hosted obuild, a plain
   `obuild configure && obuild build` would otherwise delete the very binary
   the shell is about to invoke.  Identity is compared by (device, inode) so
   no realpath (OCaml 4.13+) is needed. *)
let remove_build_content_keep_self () =
  (* identity by (device, inode) on Unix.  On native Windows Unix.stat
     reports 0 for both fields, so fall back to comparing normalized paths
     (case-insensitive, / and \ equivalent). *)
  let normalize p =
    let p = if Filename.is_relative p then Filename.concat (Sys.getcwd ()) p else p in
    let b = Buffer.create (String.length p) in
    String.iter
      (fun c ->
        let c = if c = '/' then '\\' else c in
        let c = if c >= 'A' && c <= 'Z' then Char.chr (Char.code c + 32) else c in
        Buffer.add_char b c)
      p;
    Buffer.contents b
  in
  let self_id =
    try
      let st = Unix.stat Sys.executable_name in
      if st.Unix.st_ino = 0 then None else Some (st.Unix.st_dev, st.Unix.st_ino)
    with _ -> None
  in
  let self_path = try Some (normalize Sys.executable_name) with _ -> None in
  let is_self path =
    match self_id with
    | Some id -> (
        try
          let st = Unix.stat (fp_to_string path) in
          (st.Unix.st_dev, st.Unix.st_ino) = id
        with _ -> false)
    | None -> (
        match self_path with
        | Some sp -> (try normalize (fp_to_string path) = sp with _ -> false)
        | None -> false)
  in
  let rec remove_content dir =
    Filesystem.iterate
      (fun ent ->
        let p = dir </> ent in
        if Filesystem.is_dir p then begin
          remove_content p;
          try Unix.rmdir (fp_to_string p) with _ -> ()
        end
        else if not (is_self p) then
          try Sys.remove (fp_to_string p) with _ -> ())
      dir
  in
  let build_path = Dist.build_path () in
  if Filesystem.exists build_path then remove_content build_path

let create_dist project flags =
  log Verbose "configuration changed, deleting dist\n%!";
  remove_build_content_keep_self ();
  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 conf hashtable =
  (* load the environment *)
  let opts = Gconf.get_target_options_keys () in
  List.iter (fun k -> Gconf.set_target_options conf k (bool_of_opt hashtable k)) opts

let check_ocaml conf =
  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 conf.Gconf.bin_annot <- false;
      if maj > 4 || (maj = 4 && min > 1) then conf.Gconf.short_path <- true;
      if maj > 5 || (maj = 5 && min >= 2) then conf.Gconf.bin_annot_occurrences <- true
  | _ -> conf.Gconf.bin_annot <- false);
  ocamlCfg

let run hier_registry proj_file user_flags user_opts =
  let conf = Hier.conf hier_registry in
  Dist.create_maybe ();
  let _ = check_ocaml conf 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;
  conf.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 conf 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 conf o v) user_opts;
  let project = Analyze.prepare proj_file flags hier_registry in
  let currentSetup = makeSetup conf 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 -> (
        try
          comparekvs "setup" stp (hashtbl_to_list currentSetup);
          false (* no changes detected *)
        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 hier_registry proj_file reconf setup =
  let conf = Hier.conf hier_registry in
  let ocamlCfg = check_ocaml conf 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 hier_registry in
    create_dist project flags;
    (* write setup file *)
    log Verbose "Writing new setup\n%!";
    let current_setup = makeSetup conf digestKV project flags in
    Dist.write_setup current_setup);
  flags
