<commit_before>(* {{{ COPYING *(

  This file is part of Merlin, an helper for ocaml editors

  Copyright (C) 2013 - 2015  <NAME>  <frederic.bour(_)lakaban.net>
                             <NAME>  <refis.thomas(_)gmail.com>
                             <NAME>  <simon.castellan(_)iuwt.fr>

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation the
  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
  sell copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  The Software is provided "as is", without warranty of any kind, express or
  implied, including but not limited to the warranties of merchantability,
  fitness for a particular purpose and noninfringement. In no event shall
  the authors or copyright holders be liable for any claim, damages or other
  liability, whether in an action of contract, tort or otherwise, arising
  from, out of or in connection with the software or the use or other dealings
  in the Software.

)* }}} *)

open Std

(* Copy global state after initialization *)
let initial_warnings = ref (Warnings.backup ())
let initial_clflags = ref (Clflags.save ())

let initialized () =
  initial_warnings := Warnings.backup ();
  initial_clflags := Clflags.save ()

type config = {
  dot_config    : Dot_merlin.config;
  flags         : Clflags.config;
  warnings      : Warnings.state;
  keywords      : Merlin_lexer.keywords;
  extensions    : Extension.set;
  suffixes      : (string * string) list;

  source_path    : string list;
  cmt_path       : string list;
  build_path     : string list;

  dot_failures  : (string * exn) list;
  user_failures : (string * exn) list;
}

type t = {
  dot_merlin          : Dot_merlin.t;
  version_stamp       : int ref;
  mutable user_config : Dot_merlin.config;
  mutable local_path  : string list;
  mutable config      : config option;
}

let compute_packages prj =
  let `Failures dfails, dpaths, dppxs =
    Dot_merlin.path_of_packages (Dot_merlin.config prj.dot_merlin)
  and `Failures ufails, upaths, uppxs =
    Dot_merlin.path_of_packages prj.user_config
  in
  dfails, ufails, upaths @ dpaths, Ppxsetup.union uppxs dppxs

let compute_flags ppxsetup prj =
  Clflags.load !initial_clflags;
  Warnings.restore !initial_warnings;
  let process_flags spec flags =
    let failures = ref [] in
    let rec loop ?(current=(ref 0)) flags =
      try Arg.parse_argv ~current flags spec (fun flg -> raise (Arg.Bad flg)) "" with
      | Arg.Bad _ ->
        Logger.notify "project flags" "unknown flag: %s" flags.(!current);
        failures := (flags.(!current), Arg.Bad flags.(!current)) :: !failures ;
        loop ~current flags
      | Arg.Help _ -> (* ignore *)
        loop ~current flags
    in
    loop flags ;
    !failures
  in
  let process_flags_list lst =
    List.fold_left lst ~init:[] ~f:(fun acc lst ->
        let flags = Array.of_list ("merlin" :: lst) in
        List.rev_append (process_flags Clflags.arg_spec flags) acc
      )
  in
  let dfails = process_flags_list (Dot_merlin.config prj.dot_merlin).Dot_merlin.flags in
  let dfails = List.rev_append (process_flags (Main_args.flags @ Clflags.arg_spec) Sys.argv) dfails in
  let ufails = process_flags_list prj.user_config.Dot_merlin.flags in
  Clflags.ppx := Ppxsetup.union !Clflags.ppx ppxsetup;
  dfails, ufails, Clflags.save (), Warnings.backup ()

let config prj =
  let dot_config = Dot_merlin.config prj.dot_merlin in
  match prj.config with
  | Some config when Dot_merlin.same config.dot_config dot_config -> config
  | None | Some _ ->
    incr prj.version_stamp;
    let dfails0, ufails0, pkgpaths, ppxsetup = compute_packages prj in
    let dfails1, ufails1, flags, warnings = compute_flags ppxsetup prj in
    let open Dot_merlin in
    let user_config = prj.user_config in
    let stdlib =
      if !Clflags.no_std_include then []
      else
        [if user_config.stdlib =
            empty_config.stdlib
         then dot_config.stdlib
         else user_config.stdlib]
    in
    let clean list = List.rev (List.filter_dup list) in
    let suffixes =
        clean (user_config.suffixes @
        dot_config.suffixes)
    and source_path =
      user_config.source_path @
      dot_config.source_path @
      pkgpaths
    and build_path =
      user_config.cmi_path @
      user_config.build_path @
      dot_config.cmi_path @
      dot_config.build_path @
      pkgpaths @
      !Clflags.include_dirs @
      stdlib
    and cmt_path =
      user_config.cmt_path @
      user_config.Dot_merlin.build_path @
      dot_config.cmt_path @
      dot_config.build_path @
      pkgpaths @
      !Clflags.include_dirs @
      stdlib
    in
    let extensions = Extension.from
        ~extensions:(user_config.extensions @ dot_config.extensions)
        ~packages:(user_config.packages @ dot_config.packages)
    in
    let keywords = Extension.keywords extensions in
    let config = {
        dot_config;
        warnings; flags;
        extensions; suffixes; keywords;
        source_path; cmt_path; build_path;
        dot_failures = dfails0 @ dfails1;
        user_failures = ufails0 @ ufails1;
      }
    in
    prj.config <- Some config;
    config

let source_path p = p.local_path @ (config p).source_path
let build_path  p = p.local_path @ (config p).build_path
let cmt_path    p = p.local_path @ (config p).cmt_path

let global_modules p = modules_in_path ~ext:".cmi" (build_path p)

let set_local_path project path =
  project.local_path <- path

let get_flags project = [
  "user", project.user_config.Dot_merlin.flags;
  "cmd line", [ List.tl @@ Array.to_list Sys.argv ];
  ".merlin", (Dot_merlin.config project.dot_merlin).Dot_merlin.flags;
]<commit_msg>temporary fix for #590, regression from #435<commit_after>(* {{{ COPYING *(

  This file is part of Merlin, an helper for ocaml editors

  Copyright (C) 2013 - 2015  <NAME>  <frederic.bour(_)lakaban.net>
                             <NAME>  <refis.thomas(_)gmail.com>
                             <NAME>  <simon.castellan(_)iuwt.fr>

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation the
  rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
  sell copies of the Software, and to permit persons to whom the Software is
  furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  The Software is provided "as is", without warranty of any kind, express or
  implied, including but not limited to the warranties of merchantability,
  fitness for a particular purpose and noninfringement. In no event shall
  the authors or copyright holders be liable for any claim, damages or other
  liability, whether in an action of contract, tort or otherwise, arising
  from, out of or in connection with the software or the use or other dealings
  in the Software.

)* }}} *)

open Std

(* Copy global state after initialization *)
let initial_warnings = ref (Warnings.backup ())
let initial_clflags = ref (Clflags.save ())

let initialized () =
  initial_warnings := Warnings.backup ();
  initial_clflags := Clflags.save ()

type config = {
  dot_config    : Dot_merlin.config;
  flags         : Clflags.config;
  warnings      : Warnings.state;
  keywords      : Merlin_lexer.keywords;
  extensions    : Extension.set;
  suffixes      : (string * string) list;

  source_path    : string list;
  cmt_path       : string list;
  build_path     : string list;

  dot_failures  : (string * exn) list;
  user_failures : (string * exn) list;
}

type t = {
  dot_merlin          : Dot_merlin.t;
  version_stamp       : int ref;
  mutable user_config : Dot_merlin.config;
  mutable local_path  : string list;
  mutable config      : config option;
}

let compute_packages prj =
  let `Failures dfails, dpaths, dppxs =
    Dot_merlin.path_of_packages (Dot_merlin.config prj.dot_merlin)
  and `Failures ufails, upaths, uppxs =
    Dot_merlin.path_of_packages prj.user_config
  in
  dfails, ufails, upaths @ dpaths, Ppxsetup.union uppxs dppxs

let compute_flags ppxsetup prj =
  Clflags.load !initial_clflags;
  Warnings.restore !initial_warnings;
  let process_flags spec flags =
    let failures = ref [] in
    let rec loop ?(current=(ref 0)) flags =
      try Arg.parse_argv ~current flags spec (fun flg -> raise (Arg.Bad flg)) "" with
      | Arg.Bad _ ->
        Logger.notify "project flags" "unknown flag: %s" flags.(!current);
        failures := (flags.(!current), Arg.Bad flags.(!current)) :: !failures ;
        loop ~current flags
      | Arg.Help _ -> (* ignore *)
        loop ~current flags
    in
    loop flags ;
    !failures
  in
  let process_flags_list lst =
    List.fold_left lst ~init:[] ~f:(fun acc lst ->
        let flags = Array.of_list ("merlin" :: lst) in
        List.rev_append (process_flags Clflags.arg_spec flags) acc
      )
  in
  let dfails = process_flags_list (Dot_merlin.config prj.dot_merlin).Dot_merlin.flags in
  let dfails = List.rev_append (process_flags (Main_args.flags @ Clflags.arg_spec) Sys.argv) dfails in
  let ufails = process_flags_list prj.user_config.Dot_merlin.flags in
  Clflags.ppx := Ppxsetup.union !Clflags.ppx ppxsetup;
  dfails, ufails, Clflags.save (), Warnings.backup ()

let config prj =
  let dot_config = Dot_merlin.config prj.dot_merlin in
  match prj.config with
  | Some config when Dot_merlin.same config.dot_config dot_config -> config
  | None | Some _ ->
    incr prj.version_stamp;
    let dfails0, ufails0, pkgpaths, ppxsetup = compute_packages prj in
    let dfails1, ufails1, flags, warnings = compute_flags ppxsetup prj in
    let open Dot_merlin in
    let user_config = prj.user_config in
    let stdlib =
      if !Clflags.no_std_include then []
      else
        [if user_config.stdlib =
            empty_config.stdlib
         then dot_config.stdlib
         else user_config.stdlib]
    in
    let clean list = List.rev (List.filter_dup list) in
    let suffixes =
        clean (user_config.suffixes @
        dot_config.suffixes)
    and source_path =
      user_config.source_path @
      dot_config.source_path @
      pkgpaths
    and build_path =
      user_config.cmi_path @
      user_config.build_path @
      dot_config.cmi_path @
      dot_config.build_path @
      pkgpaths @
      !Clflags.include_dirs @
      stdlib
    and cmt_path =
      user_config.cmt_path @
      user_config.Dot_merlin.build_path @
      dot_config.cmt_path @
      dot_config.build_path @
      pkgpaths @
      !Clflags.include_dirs @
      stdlib
    in
    let extensions = Extension.from
        ~extensions:(user_config.extensions @ dot_config.extensions)
        ~packages:(user_config.packages @ dot_config.packages)
    in
    let keywords = Extension.keywords extensions in
    let config = {
        dot_config;
        warnings; flags;
        extensions; suffixes; keywords;
        source_path; cmt_path; build_path;
        dot_failures = dfails0 @ dfails1;
        user_failures = ufails0 @ ufails1;
      }
    in
    prj.config <- Some config;
    config

let source_path p = p.local_path @ (config p).source_path
let build_path  p = p.local_path @ (config p).build_path
let cmt_path    p = p.local_path @ (config p).cmt_path

let global_modules p = modules_in_path ~ext:".cmi" (build_path p)

let set_local_path project path =
  project.local_path <- path;
  begin match path with
  | [] -> ()
  | dir :: _ ->
    try Sys.chdir dir
    with _ -> ()
  end


let get_flags project = [
  "user", project.user_config.Dot_merlin.flags;
  "cmd line", [ List.tl @@ Array.to_list Sys.argv ];
  ".merlin", (Dot_merlin.config project.dot_merlin).Dot_merlin.flags;
]
{'fraction_non_alphanumeric': 0.08399573875276571, 'fraction_numerical': 0.0032778824879128084, 'mean_word_length': 2.963624553426437, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 30, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3685399', 'n_tokens_mistral': 3974, 'n_tokens_neox': 3854, 'n_words': 1150}