open Import
open Memo.O

let remove_extension file =
  let dir = Path.Build.parent_exn file in
  let basename =
    let basename = Path.Build.basename file in
    match String.lsplit2 basename ~on:'.' with
    | Some (basename, _ext) -> basename
    | None -> basename
  in
  Path.Build.relative dir basename
;;

module Processed = struct
  (* The actual content of the merlin file as built by the [Unprocessed.process]
     function from the unprocessed info gathered through [gen_rules]. The first
     three fields map directly to Merlin's B, S and FLG directives and the last
     one represents a list of preprocessors described by a preprocessing flag
     and its arguments. *)

  module Pp_kind = struct
    type t =
      | Pp
      | Ppx

    let to_dyn =
      let open Dyn in
      function
      | Pp -> variant "Pp" []
      | Ppx -> variant "Ppx" []
    ;;

    let to_flag = function
      | Pp -> "-pp"
      | Ppx -> "-ppx"
    ;;
  end

  type pp_flag =
    { flag : Pp_kind.t
    ; args : string
    }

  let dyn_of_pp_flag { flag; args } =
    let open Dyn in
    record [ "flag", Pp_kind.to_dyn flag; "args", string args ]
  ;;

  let pp_kind x = x.flag
  let pp_args x = x.args

  (* Most of the configuration is shared across a same lib/exe... *)
  type config =
    { stdlib_dir : Path.t option
    ; source_root : Path.t
    ; obj_dirs : Path.Set.t
    ; src_dirs : Path.Set.t
    ; hidden_obj_dirs : Path.Set.t
    ; hidden_src_dirs : Path.Set.t
    ; flags : string list
    ; extensions : string option Ml_kind.Dict.t list
    ; indexes : Path.t list
    }

  let dyn_of_config
    { stdlib_dir
    ; source_root
    ; obj_dirs
    ; src_dirs
    ; hidden_obj_dirs
    ; hidden_src_dirs
    ; flags
    ; extensions
    ; indexes
    }
    =
    let open Dyn in
    record
      [ "stdlib_dir", option Path.to_dyn stdlib_dir
      ; "source_root", Path.to_dyn source_root
      ; "obj_dirs", Path.Set.to_dyn obj_dirs
      ; "src_dirs", Path.Set.to_dyn src_dirs
      ; "hidden_obj_dirs", Path.Set.to_dyn hidden_obj_dirs
      ; "hidden_src_dirs", Path.Set.to_dyn hidden_src_dirs
      ; "flags", list string flags
      ; "extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions
      ; "indexes", list Path.to_dyn indexes
      ]
  ;;

  type module_config =
    { opens : Module_name.t list
    ; module_ : Module.t
    ; reader : string list option
    }

  let dyn_of_module_config { opens; module_; reader } =
    let open Dyn in
    record
      [ "opens", list Module_name.to_dyn opens
      ; "module_", Module.to_dyn module_
      ; "reader", option (list string) reader
      ]
  ;;

  (* ...but modules can have different preprocessing specifications*)
  type t =
    { config : config
    ; per_file_config : module_config Path.Build.Map.t
    ; pp_config : pp_flag option Module_name.Per_item.t
    }

  let to_dyn { config; per_file_config; pp_config } =
    let open Dyn in
    record
      [ "config", dyn_of_config config
      ; "per_file_config", Path.Build.Map.to_dyn dyn_of_module_config per_file_config
      ; "pp_config", Module_name.Per_item.to_dyn (option dyn_of_pp_flag) pp_config
      ]
  ;;

  module D = struct
    type nonrec t = t

    let name = "merlin-conf"
    let version = 6
    let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead"

    let test_example () =
      { config =
          { stdlib_dir = None
          ; source_root = Path.Source.root |> Path.source
          ; obj_dirs = Path.Set.empty
          ; src_dirs = Path.Set.empty
          ; hidden_obj_dirs = Path.Set.empty
          ; hidden_src_dirs = Path.Set.empty
          ; flags = [ "-x" ]
          ; extensions = [ { Ml_kind.Dict.intf = None; impl = Some "ext" } ]
          ; indexes = []
          }
      ; per_file_config = Path.Build.Map.empty
      ; pp_config =
          (match
             Module_name.Per_item.of_mapping
               [ [ Module_name.of_string "Test" ], Some { flag = Ppx; args = "-x" } ]
               ~default:None
           with
           | Ok s -> s
           | Error (_, _, _) -> assert false)
      }
    ;;
  end

  module Persist = Dune_util.Persistent.Make (D)

  let load_file f =
    (* Failing to load the file at that point means that the configuration file
       has been written by a version of Dune in which the [Merlin.Processed.t]
       type is different from the one in the current version. *)
    match Persist.load f with
    | Some s -> Ok s
    | None ->
      Error
        "The current Merlin configuration has been generated by another, incompatible, \
         version of Dune. Please rebuild the project. (Using the same version of Dune as \
         the one running the 'ocaml-merlin' server.)"
  ;;

  let serialize_path = Path.to_absolute_filename

  let get_ext { Ml_kind.Dict.impl; intf } =
    match impl, intf with
    | Some impl, Some intf -> Some (impl, intf)
    | Some impl, None -> Some (impl, impl)
    | None, Some intf -> Some (intf, intf)
    | None, None -> None
  ;;

  let to_sexp
    ~unit_name
    ~opens
    ~pp
    ~reader
    { stdlib_dir
    ; source_root
    ; obj_dirs
    ; src_dirs
    ; hidden_obj_dirs
    ; hidden_src_dirs
    ; flags
    ; extensions
    ; indexes
    }
    =
    let make_directive tag value = Sexp.List [ Atom tag; value ] in
    let make_directive_of_path tag path =
      make_directive tag (Sexp.Atom (serialize_path path))
    in
    let index_files = List.map indexes ~f:(fun p -> make_directive_of_path "INDEX" p) in
    let stdlib_dir =
      match stdlib_dir with
      | None -> []
      | Some stdlib_dir -> [ make_directive_of_path "STDLIB" stdlib_dir ]
    in
    let source_root = [ make_directive_of_path "SOURCE_ROOT" source_root ] in
    let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in
    let obj_dirs = Path.Set.to_list_map obj_dirs ~f:(make_directive_of_path "B") in
    let src_dirs = Path.Set.to_list_map src_dirs ~f:(make_directive_of_path "S") in
    let hidden_obj_dirs =
      Path.Set.to_list_map hidden_obj_dirs ~f:(make_directive_of_path "BH")
    in
    let hidden_src_dirs =
      Path.Set.to_list_map hidden_src_dirs ~f:(make_directive_of_path "SH")
    in
    let flags =
      let flags =
        match flags with
        | [] -> []
        | flags ->
          [ make_directive "FLG" (Sexp.List (List.map ~f:(fun s -> Sexp.Atom s) flags)) ]
      in
      let flags =
        match pp with
        | None -> flags
        | Some { flag; args } ->
          make_directive "FLG" (Sexp.List [ Atom (Pp_kind.to_flag flag); Atom args ])
          :: flags
      in
      match opens with
      | [] -> flags
      | opens ->
        make_directive
          "FLG"
          (Sexp.List (Ocaml_flags.open_flags opens |> List.map ~f:(fun x -> Sexp.Atom x)))
        :: flags
    in
    let unit_name = [ make_directive "UNIT_NAME" (Sexp.Atom unit_name) ] in
    let suffixes =
      List.filter_map extensions ~f:(fun x ->
        let open Option.O in
        let+ impl, intf = get_ext x in
        make_directive "SUFFIX" (Sexp.Atom (Printf.sprintf "%s %s" impl intf)))
    in
    let reader =
      match reader with
      | Some reader ->
        [ make_directive "READER" (Sexp.List (List.map ~f:(fun r -> Sexp.Atom r) reader))
        ]
      | None -> []
    in
    Sexp.List
      (List.concat
         [ index_files
         ; stdlib_dir
         ; source_root
         ; exclude_query_dir
         ; obj_dirs
         ; src_dirs
         ; hidden_obj_dirs
         ; hidden_src_dirs
         ; flags
         ; unit_name
         ; suffixes
         ; reader
         ])
  ;;

  let quote_for_dot_merlin s =
    let s =
      if Sys.win32
      then
        (* We need this hack because merlin unescapes backslashes (except when
           protected by single quotes). It is only a problem on windows because
           Filename.quote is using double quotes. *)
        String.escape_only '\\' s
      else s
    in
    if String.need_quoting s then Filename.quote s else s
  ;;

  let to_dot_merlin
    stdlib_dir
    source_root
    pp_configs
    flags
    obj_dirs
    src_dirs
    hidden_obj_dirs
    hidden_src_dirs
    extensions
    indexes
    =
    let b = Buffer.create 256 in
    let printf = Printf.bprintf b in
    let print = Buffer.add_string b in
    print "EXCLUDE_QUERY_DIR\n";
    Option.iter stdlib_dir ~f:(fun stdlib_dir ->
      printf "STDLIB %s\n" (serialize_path stdlib_dir));
    printf "SOURCE_ROOT %s\n" (serialize_path source_root);
    Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p));
    Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p));
    Path.Set.iter hidden_obj_dirs ~f:(fun p -> printf "BH %s\n" (serialize_path p));
    Path.Set.iter hidden_src_dirs ~f:(fun p -> printf "SH %s\n" (serialize_path p));
    List.iter indexes ~f:(fun p -> printf "INDEX %s\n" (serialize_path p));
    List.iter extensions ~f:(fun x ->
      Option.iter (get_ext x) ~f:(fun (impl, intf) ->
        printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf)));
    (* We print all FLG directives as comments *)
    List.iter
      pp_configs
      ~f:
        (Module_name.Per_item.fold ~init:() ~f:(fun pp () ->
           Option.iter pp ~f:(fun { flag; args } ->
             printf "# FLG %s\n" (Pp_kind.to_flag flag ^ " " ^ quote_for_dot_merlin args))));
    List.iter flags ~f:(fun flags ->
      match flags with
      | [] -> ()
      | flags ->
        print "# FLG";
        List.iter flags ~f:(fun f -> printf " %s" (quote_for_dot_merlin f));
        print "\n");
    Buffer.contents b
  ;;

  let get { per_file_config; pp_config; config } ~file =
    let open Option.O in
    let+ { module_; opens; reader } =
      let find file = Path.Build.Map.find per_file_config file in
      match find file with
      | Some _ as s -> s
      | None ->
        (match Copy_line_directive.DB.follow_while file ~f:find with
         | Some _ as s -> s
         | None ->
           (* Fallback to handle preprocessed files (where the preprocessor has
              the file extensison changed).

              We choose to fallback by a lookup by filename without extension.

              This is too rough but, really, preprocessors should emit copy
              line directives instead and then Dune should have the database
              similar to Copy_line_directive to handle this. *)
           Path.Build.Map.find per_file_config (remove_extension file))
    in
    let pp = Module_name.Per_item.get pp_config (Module.name module_) in
    let unit_name = Module_name.Unique.to_string (Module.obj_name module_) in
    to_sexp ~unit_name ~opens ~pp ~reader config
  ;;

  let print_file path =
    match load_file path with
    | Error msg -> Printf.eprintf "%s\n" msg
    | Ok { per_file_config; pp_config; config } ->
      let pp_one (source, { module_; opens; reader }) =
        let open Pp.O in
        let name = Module.name module_ in
        let unit_name = Module_name.Unique.to_string (Module.obj_name module_) in
        let pp = Module_name.Per_item.get pp_config name in
        let sexp = to_sexp ~unit_name ~reader ~opens ~pp config in
        Pp.hvbox
          (Pp.textf "%s: %s" (Module_name.to_string name) (Path.Build.to_string source))
        ++ Pp.newline
        ++ Pp.vbox (Sexp.pp sexp)
      in
      let pp =
        Path.Build.Map.to_list per_file_config
        |> Pp.concat_map ~sep:Pp.cut ~f:pp_one
        |> Pp.vbox
      in
      Format.printf "%a%a@." Format.pp_set_margin 1000 Pp.to_fmt pp
  ;;

  let print_generic_dot_merlin paths =
    match Result.List.map paths ~f:load_file with
    | Error msg -> Printf.eprintf "%s\n" msg
    | Ok [] -> Printf.eprintf "No merlin configuration found.\n"
    | Ok (init :: tl) ->
      let ( pp_configs
          , obj_dirs
          , src_dirs
          , hidden_obj_dirs
          , hidden_src_dirs
          , flags
          , extensions
          , indexes )
        =
        (* We merge what is easy to merge and ignore the rest *)
        List.fold_left
          tl
          ~init:
            ( [ init.pp_config ]
            , init.config.obj_dirs
            , init.config.src_dirs
            , init.config.hidden_obj_dirs
            , init.config.hidden_src_dirs
            , [ init.config.flags ]
            , init.config.extensions
            , init.config.indexes )
          ~f:
            (fun
              ( acc_pp
              , acc_obj
              , acc_src
              , acc_hidden_obj
              , acc_hidden_src
              , acc_flags
              , acc_ext
              , acc_indexes )
              { per_file_config = _
              ; pp_config
              ; config =
                  { stdlib_dir = _
                  ; source_root = _
                  ; obj_dirs
                  ; src_dirs
                  ; hidden_obj_dirs
                  ; hidden_src_dirs
                  ; flags
                  ; extensions
                  ; indexes
                  }
              }
            ->
            ( pp_config :: acc_pp
            , Path.Set.union acc_obj obj_dirs
            , Path.Set.union acc_src src_dirs
            , Path.Set.union acc_hidden_obj hidden_obj_dirs
            , Path.Set.union acc_hidden_src hidden_src_dirs
            , flags :: acc_flags
            , extensions @ acc_ext
            , indexes @ acc_indexes ))
      in
      Printf.printf
        "%s\n"
        (to_dot_merlin
           init.config.stdlib_dir
           init.config.source_root
           pp_configs
           flags
           obj_dirs
           src_dirs
           hidden_obj_dirs
           hidden_src_dirs
           extensions
           indexes)
  ;;
end

let obj_dir_of_lib kind mode obj_dir =
  (match kind, mode with
   | `Private, Lib_mode.Ocaml _ -> Obj_dir.byte_dir
   | `Private, Melange -> Obj_dir.melange_dir
   | `Public, Ocaml _ -> Obj_dir.public_cmi_ocaml_dir
   | `Public, Melange -> Obj_dir.public_cmi_melange_dir)
    obj_dir
;;

module Unprocessed = struct
  (* We store separate information for each "module". These information do not
     reflect the actual content of the Merlin configuration yet but are needed
     for it's elaboration via the function [process : Unprocessed.t ... ->
     Processed.t] *)
  type config =
    { stdlib_dir : Path.t
    ; requires_compile : Lib.t list Resolve.t
    ; requires_hidden : Lib.t list Resolve.t
    ; flags : string list Action_builder.t
    ; preprocess :
        Preprocess.Without_instrumentation.t Preprocess.t Module_name.Per_item.t
    ; libname : Lib_name.Local.t option
    ; objs_dirs : Path.Set.t
    ; extensions : string option Ml_kind.Dict.t list
    ; readers : string list String.Map.t
    ; mode : Lib_mode.t
    }

  type t =
    { ident : Merlin_ident.t
    ; config : config
    ; modules : Modules.With_vlib.t
    }

  let make
    ~requires_compile
    ~requires_hidden
    ~stdlib_dir
    ~flags
    ~preprocess
    ~libname
    ~modules
    ~obj_dir
    ~dialects
    ~ident
    ~modes
    =
    (* Merlin shouldn't cause the build to fail, so we just ignore errors *)
    let mode =
      match modes with
      | `Exe -> Lib_mode.Ocaml Byte
      | `Melange_emit -> Melange
      | `Lib (m : Lib_mode.Map.Set.t) -> Lib_mode.Map.Set.for_merlin m
    in
    let objs_dirs =
      Path.Set.singleton @@ obj_dir_of_lib `Private mode (Obj_dir.of_local obj_dir)
    in
    let flags = Ocaml_flags.get flags mode in
    let { Dialect.DB.extensions; readers } = Dialect.DB.for_merlin dialects in
    let config =
      { stdlib_dir
      ; mode
      ; requires_compile
      ; requires_hidden
      ; flags
      ; preprocess
      ; libname
      ; objs_dirs
      ; extensions
      ; readers
      }
    in
    { ident; config; modules }
  ;;

  let encode_command =
    let quote_if_needed s = if String.need_quoting s then Filename.quote s else s in
    fun ~bin ~args ->
      Path.to_absolute_filename bin :: args
      |> List.map ~f:quote_if_needed
      |> String.concat ~sep:" "
  ;;

  let pp_flag_of_action ~expander ~loc ~action : Processed.pp_flag option Action_builder.t
    =
    match (action : Dune_lang.Action.t) with
    | Run args ->
      (match
         let open Option.O in
         let* args, input_file = List.destruct_last args in
         match input_file with
         | Slang.Literal input_file ->
           if String_with_vars.is_pform input_file (Var Input_file)
           then Some args
           else None
         | _ -> None
       with
       | None -> Action_builder.return None
       | Some args ->
         let action =
           let action = Action_unexpanded.Run args in
           let chdir = Expander.context expander |> Context_name.build_dir in
           Action_unexpanded.expand_no_targets
             ~loc
             ~expander
             ~deps:[]
             ~chdir
             ~what:"preprocessing actions"
             action
         in
         let pp_of_action exe args =
           match exe with
           | Error _ -> None
           | Ok bin ->
             let args =
               let args = Array.Immutable.to_list args in
               encode_command ~bin ~args
             in
             Some { Processed.flag = Processed.Pp_kind.Pp; args }
         in
         Action_builder.map action ~f:(fun act ->
           match act.action with
           | Run (exe, args) -> pp_of_action exe args
           | Chdir (_, Run (exe, args)) -> pp_of_action exe args
           | Chdir (_, Chdir (_, Run (exe, args))) -> pp_of_action exe args
           | _ -> None))
    | _ -> Action_builder.return None
  ;;

  let pp_flags ctx ~expander lib_name preprocess
    : Processed.pp_flag option Action_builder.t
    =
    let open Action_builder.O in
    let* ocaml = Action_builder.of_memo (Context.ocaml ctx) in
    match Preprocess.remove_future_syntax preprocess ~for_:Merlin ocaml.version with
    | Action (loc, (action : Dune_lang.Action.t)) ->
      pp_flag_of_action ~expander ~loc ~action
    | No_preprocessing -> Action_builder.return None
    | Pps { loc; pps; flags; staged = _ } ->
      let open Action_builder.O in
      let+ exe, flags =
        let* scope =
          Expander.dir expander |> Scope.DB.find_by_dir |> Action_builder.of_memo
        in
        Ppx_driver.get_ppx_driver ctx ~loc ~expander ~lib_name ~flags ~scope pps
      in
      let args = encode_command ~bin:(Path.build exe) ~args:("--as-ppx" :: flags) in
      Some { Processed.flag = Processed.Pp_kind.Ppx; args }
  ;;

  let src_dirs sctx lib =
    match Lib.Local.of_lib lib with
    | None -> Lib.info lib |> Lib_info.src_dir |> Path.Set.singleton |> Memo.return
    | Some lib ->
      Dir_contents.modules_of_local_lib sctx lib
      >>| Modules.source_dirs
      >>| Path.Set.map ~f:Path.drop_optional_build_context
  ;;

  module Per_item_action_builder =
    Module_name.Per_item.Make_monad_traversals (Action_builder)

  let pp_config t ctx ~expander =
    Per_item_action_builder.map
      t.config.preprocess
      ~f:(pp_flags ctx ~expander t.config.libname)
  ;;

  let add_lib_dirs sctx mode libs =
    Action_builder.of_memo
      (Memo.parallel_map libs ~f:(fun lib ->
         let+ dirs = src_dirs sctx lib in
         lib, dirs)
       >>| List.fold_left
             ~init:(Path.Set.empty, Path.Set.empty)
             ~f:(fun (src_dirs, obj_dirs) (lib, more_src_dirs) ->
               ( Path.Set.union src_dirs more_src_dirs
               , let public_cmi_dir =
                   let info = Lib.info lib in
                   obj_dir_of_lib `Public mode (Lib_info.obj_dir info)
                 in
                 Path.Set.add obj_dirs public_cmi_dir )))
  ;;

  let process
    ({ modules
     ; ident = _
     ; config =
         { stdlib_dir
         ; extensions
         ; readers
         ; flags
         ; objs_dirs
         ; requires_compile
         ; requires_hidden
         ; preprocess = _
         ; libname = _
         ; mode
         }
     } as t)
    sctx
    ~dir
    ~more_src_dirs
    ~expander
    =
    let open Action_builder.O in
    let+ config =
      let* stdlib_dir =
        Action_builder.of_memo
        @@
        match t.config.mode with
        | Ocaml _ -> Memo.return (Some stdlib_dir)
        | Melange ->
          let open Memo.O in
          let+ dirs = Melange_binary.where sctx ~loc:None ~dir in
          (match dirs with
           | [] -> None
           | stdlib_dir :: _ -> Some stdlib_dir)
      in
      let requires_compile = Resolve.peek requires_compile |> Result.value ~default:[] in
      let requires_hidden = Resolve.peek requires_hidden |> Result.value ~default:[] in
      let* requires_compile, requires_hidden =
        match t.config.mode with
        | Ocaml _ -> Action_builder.return (requires_compile, requires_hidden)
        | Melange ->
          Action_builder.of_memo
            (let open Memo.O in
             let* scope = Scope.DB.find_by_dir (Expander.dir expander) in
             let libs = Scope.libs scope in
             Lib.DB.find libs (Lib_name.of_string "melange")
             >>= function
             | Some lib ->
               let+ libs =
                 let linking =
                   Dune_project.implicit_transitive_deps (Scope.project scope)
                 in
                 Lib.closure [ lib ] ~linking
                 |> Resolve.Memo.peek
                 >>| function
                 | Ok libs -> libs
                 | Error _ -> []
               in
               List.concat [ requires_compile; libs ], requires_hidden
             | None -> Memo.return (requires_compile, requires_hidden))
      in
      let+ flags = flags
      and+ indexes = Action_builder.of_memo (Ocaml_index.context_indexes sctx)
      and+ deps_src_dirs, deps_obj_dirs = add_lib_dirs sctx mode requires_compile
      and+ hidden_src_dirs, hidden_obj_dirs = add_lib_dirs sctx mode requires_hidden in
      let src_dirs =
        Path.Set.of_list_map ~f:Path.source more_src_dirs |> Path.Set.union deps_src_dirs
      in
      let obj_dirs = Path.Set.union deps_obj_dirs objs_dirs in
      let source_root = Path.Source.root |> Path.source in
      { Processed.stdlib_dir
      ; source_root
      ; src_dirs
      ; obj_dirs
      ; hidden_src_dirs
      ; hidden_obj_dirs
      ; flags
      ; extensions
      ; indexes
      }
    and+ pp_config = pp_config t (Super_context.context sctx) ~expander in
    let per_file_config =
      (* And copy for each module the resulting pp flags *)
      modules
      |> Modules.With_vlib.drop_vlib
      |> Modules.fold ~init:[] ~f:(fun m init ->
        Module.sources_without_pp m
        |> Path.Build.Set.of_list_map ~f:(fun src -> Path.as_in_build_dir_exn src)
        |> Path.Build.Set.fold ~init ~f:(fun src acc ->
          let config =
            { Processed.module_ = Module.set_pp m None
            ; opens = Modules.With_vlib.local_open modules m
            ; reader = String.Map.find readers (Path.Build.extension src)
            }
          in
          (* we add the config with and without the extension, the latter is
             needed for a fallback in this file's [get] function. *)
          let src_without_extension = remove_extension src in
          (src, config) :: (src_without_extension, config) :: acc))
      |> Path.Build.Map.of_list_reduce ~f:(fun existing _ -> existing)
    in
    { Processed.pp_config; config; per_file_config }
  ;;
end

let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) =
  let merlin_file = Merlin_ident.merlin_file_path dir t.ident in
  let* () =
    Rules.Produce.Alias.add_deps
      (Alias.make Alias0.check ~dir)
      (Action_builder.path (Path.build merlin_file))
  in
  let action =
    Unprocessed.process t sctx ~dir ~more_src_dirs ~expander
    |> Action_builder.map ~f:Processed.Persist.to_string
    |> Action_builder.with_no_targets
    |> Action_builder.With_targets.write_file_dyn merlin_file
  in
  Super_context.add_rule sctx ~dir action
;;

let add_rules sctx ~dir ~more_src_dirs ~expander merlin =
  Memo.when_
    (Context.merlin (Super_context.context sctx))
    (fun () -> dot_merlin sctx ~more_src_dirs ~expander ~dir merlin)
;;

let more_src_dirs dir_contents ~source_dirs =
  let lib_src_dirs =
    Dir_contents.dirs dir_contents
    |> List.map ~f:(fun dc -> Path.Build.drop_build_context_exn (Dir_contents.dir dc))
  in
  List.rev_append source_dirs lib_src_dirs
;;

include Unprocessed
