open! Dune_engine__
open Import

module Context_type = struct
  type t =
    | Empty
    | With_sources
end

module Gen_rules = struct
  module Build_only_sub_dirs = struct
    type t = Subdir_set.t Path.Build.Map.t

    let iter_dirs_containing_sub_dirs t ~f =
      Path.Build.Map.iteri t ~f:(fun dir _ -> f dir)
    ;;

    let empty = Path.Build.Map.empty
    let singleton ~dir sub_dirs = Path.Build.Map.singleton dir sub_dirs
    let find t dir = Path.Build.Map.find t dir |> Option.value ~default:Subdir_set.empty
    let union a b = Path.Build.Map.union a b ~f:(fun _ a b -> Some (Subdir_set.union a b))
  end

  module Rules = struct
    type nonrec t =
      { build_dir_only_sub_dirs : Build_only_sub_dirs.t
      ; directory_targets : Loc.t Path.Build.Map.t
      ; rules : Rules.t Memo.t
      }

    let empty =
      { build_dir_only_sub_dirs = Path.Build.Map.empty
      ; directory_targets = Path.Build.Map.empty
      ; rules = Memo.return Rules.empty
      }
    ;;

    let create
          ?(build_dir_only_sub_dirs = empty.build_dir_only_sub_dirs)
          ?(directory_targets = empty.directory_targets)
          rules
      =
      { build_dir_only_sub_dirs; directory_targets; rules }
    ;;

    let combine_exn r { build_dir_only_sub_dirs; directory_targets; rules } =
      { build_dir_only_sub_dirs =
          Build_only_sub_dirs.union r.build_dir_only_sub_dirs build_dir_only_sub_dirs
      ; directory_targets = Path.Build.Map.union_exn r.directory_targets directory_targets
      ; rules =
          (let open Memo.O in
           let+ r = r.rules
           and+ r' = rules in
           Rules.union r r')
      }
    ;;
  end

  module Gen_rules_result = struct
    type t =
      | Rules of Rules.t
      | Unknown_context
      | Redirect_to_parent of Rules.t

    let redirect_to_parent rules = Redirect_to_parent rules
    let rules_here rules = Rules rules
    let unknown_context = Unknown_context
    let no_rules = rules_here Rules.empty
  end

  module type Rule_generator = sig
    val gen_rules
      :  Context_name.t
      -> dir:Path.Build.t
      -> string list
      -> Gen_rules_result.t Memo.t
  end
end

module type Source_tree = sig
  module Dir : sig
    type t

    val sub_dir_names : t -> Filename.Set.t
    val filenames : t -> Filename.Set.t
  end

  val find_dir : Path.Source.t -> Dir.t option Memo.t
end

type t =
  { contexts : (Build_context.t * Context_type.t) Context_name.Map.t Memo.Lazy.t
  ; rule_generator : (module Gen_rules.Rule_generator)
  ; sandboxing_preference : Sandbox_mode.t list
  ; promote_source :
      chmod:(int -> int)
      -> delete_dst_if_it_is_a_directory:bool
      -> src:Path.Build.t
      -> dst:Path.Source.t
      -> unit Fiber.t
  ; implicit_default_alias : Path.Build.t -> unit Action_builder.t option Memo.t
  ; execution_parameters :
      Context_name.t -> dir:Path.Build.t -> Execution_parameters.t Memo.t
  ; source_tree : (module Source_tree)
  }

let t : t Fdecl.t = Fdecl.create Dyn.opaque
let get () = Fdecl.get t

let set
      ~contexts
      ~promote_source
      ~sandboxing_preference
      ~rule_generator
      ~implicit_default_alias
      ~execution_parameters
      ~source_tree
  =
  let contexts =
    Memo.lazy_ ~name:"Build_config.set" (fun () ->
      let open Memo.O in
      let+ contexts = Memo.Lazy.force contexts in
      Context_name.Map.of_list_map_exn
        contexts
        ~f:(fun ((ctx : Build_context.t), ctx_type) -> ctx.name, (ctx, ctx_type)))
  in
  Fdecl.set
    t
    { contexts
    ; rule_generator
    ; sandboxing_preference =
        sandboxing_preference @ Sandbox_mode.all_except_patch_back_source_tree
    ; promote_source
    ; implicit_default_alias
    ; execution_parameters
    ; source_tree
    }
;;
