(**************************************************************************)
(*                                                                        *)
(*    Copyright 2012-2020 OCamlPro                                        *)
(*    Copyright 2012 INRIA                                                *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

let log fmt = OpamConsole.log "CONFIG" fmt
let slog = OpamConsole.slog

open OpamParserTypes.FullPos
open OpamTypesBase
open OpamStateTypes

(* List all the available variables *)
let list t ns =
  log "config-list";
  if ns = [] then () else
  let list_vars name =
    try
      let nv = OpamSwitchState.get_package t name in
      let pkg_vars =
        try
          let opam = OpamSwitchState.opam t nv in
          let env = OpamPackageVar.resolve ~opam t in
          OpamStd.List.filter_map (fun (vname, desc) ->
              let v = OpamVariable.(Full.create name (of_string vname)) in
              try
                let c = OpamFilter.ident_string env (OpamFilter.ident_of_var v) in
                Some (v, c, desc)
              with Failure _ -> None)
            OpamPackageVar.package_variable_names
        with Not_found -> []
      in
      let conf_vars =
        try
          let conf = OpamSwitchState.package_config t name in
          List.map (fun (v,c) ->
              OpamVariable.Full.create name v,
              OpamVariable.string_of_variable_contents c,
              "")
            (OpamFile.Dot_config.bindings conf)
        with Not_found -> []
      in
      pkg_vars @ conf_vars
    with Not_found ->
      OpamConsole.error "Package %s not found, skipping"
        (OpamPackage.Name.to_string name);
      []
  in
  let vars = List.flatten (List.map list_vars ns) in
  let (%) s col = OpamConsole.colorise col s in
  List.map (fun (variable, value, descr) -> [
        OpamVariable.Full.to_string variable % `bold;
        value % `blue;
        if descr = "" then "" else "# "^descr;
      ]) vars |>
  OpamStd.Format.align_table |>
  OpamConsole.print_table stdout ~sep:" "

let possibly_unix_path_env_value k v =
  if k = "PATH" then
    (Lazy.force OpamSystem.get_cygpath_path_transform) ~pathlist:true v
  else v

let rec print_env output = function
  | [] -> ()
  | (k, v, comment) :: r ->
    if OpamConsole.verbose () then
      OpamStd.Option.iter (Printf.ksprintf output ": %s;\n") comment;
    if not (List.exists (fun (k1, _, _) -> k = k1) r) || OpamConsole.verbose ()
    then (
      let v' = possibly_unix_path_env_value k v in
      Printf.ksprintf output "%s='%s'; export %s;\n"
        k (OpamStd.Env.escape_single_quotes v') k);
    print_env output r

let rec print_csh_env output = function
  | [] -> ()
  | (k, v, comment) :: r ->
    if OpamConsole.verbose () then
      OpamStd.Option.iter (Printf.ksprintf output ": %s;\n") comment;
    if not (List.exists (fun (k1, _, _) -> k = k1) r) || OpamConsole.verbose ()
    then (
      let v' = possibly_unix_path_env_value k v in
      Printf.ksprintf output "setenv %s '%s';\n"
        k (OpamStd.Env.escape_single_quotes v'));
    print_csh_env output r

let rec print_pwsh_env output = function
  | [] -> ()
  | (k, v, _) :: r ->
    if not (List.exists (fun (k1, _, _) -> k = k1) r) || OpamConsole.verbose ()
    then
      Printf.ksprintf output "$env:%s = '%s'\n"
        k (OpamStd.Env.escape_powershell v);
    print_pwsh_env output r

let print_cmd_env output env =
  let rec aux = function
    | [] -> ()
    | (k, v, _) :: r ->
      if not (List.exists (fun (k1, _, _) -> k = k1) r) || OpamConsole.verbose ()
      then begin
        let is_special = function
        | '(' | ')' | '!' | '^' | '%' | '"' | '<' | '>' | '|' -> true
        | _ -> false
        in
        if OpamCompat.String.(exists is_special v || exists is_special k) then
          Printf.ksprintf output "set \"%s=%s\"\n" k v
        else
          Printf.ksprintf output "set %s=%s\n" k v
      end;
      aux r
  in
  aux env

let print_sexp_env output env =
  let rec aux = function
    | [] -> ()
    | (k, v, _) :: r ->
      if not (List.exists (fun (k1, _, _) -> k = k1) r) then
        Printf.ksprintf output "  (%S %S)\n" k v;
      aux r
  in
  output "(\n";
  aux env;
  output ")\n"

let rec print_fish_env output env =
  let set_arr_cmd ?(modf=fun x -> x) k v =
    let v = modf @@ OpamStd.String.split v ':' in
    Printf.ksprintf output "set -gx %s %s;\n" k
      (OpamStd.List.concat_map " "
         (fun v ->
            Printf.sprintf "'%s'"
              (OpamStd.Env.escape_single_quotes ~using_backslashes:true v))
         v)
  in
  (* set manpath if and only if fish version >= 2.7 *)
  let manpath_cmd v =
    Printf.ksprintf output "%s" (
      (* test for existence of `argparse` builtin, introduced in fish 2.7 .
       * use `grep' instead of `builtin string match' so that old fish versions do not
       *     produce unwanted error messages on stderr.
       * use `grep' inside a `/bin/sh' fragment so that nothing is written to stdout or
       *     stderr if `grep' does not exist. *)
      "builtin -n | /bin/sh -c 'grep -q \\'^argparse$\\'' 1>/dev/null 2>/dev/null; and "
    ) ;
    let modf = function | x::v' -> (":"^x)::v' | v -> v in
    set_arr_cmd ~modf "MANPATH" v in
  match env with
  | [] -> ()
  | (k, v, _) :: r ->
    if not (List.exists (fun (k1, _, _) -> k = k1) r) then
      (match k with
       | "PATH" | "CDPATH" ->
         (* This function assumes that `v` does not include any variable
          * expansions and that the directory names are written in full. See the
          * opamState.ml for details *)
         let v' = possibly_unix_path_env_value k v in
         set_arr_cmd k v'
       | "MANPATH" ->
         manpath_cmd v
       | _ ->
         Printf.ksprintf output "set -gx %s '%s';\n"
           k (OpamStd.Env.escape_single_quotes ~using_backslashes:true v));
    print_fish_env output r

let with_binary_mode oc k =
  let file_descr = Unix.dup (Unix.descr_of_out_channel oc) in
  Fun.protect ~finally:(fun () -> Unix.close file_descr) @@ fun () ->
    let oc = Unix.out_channel_of_descr file_descr in
    set_binary_mode_out oc true;
    k oc

let print_without_cr s =
  with_binary_mode stdout @@ fun stdout ->
    output_string stdout s;
    flush stdout

let print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env =
  let env = (env : OpamTypes.env :> (string * string * string option) list) in
  let output_normally = OpamConsole.msg "%s" in
  let never_with_cr =
    if Sys.win32 && not OpamStd.Sys.tty_out then
      print_without_cr
    else
      output_normally
  in
  if sexp then
    print_sexp_env output_normally env
  else if csh then
    print_csh_env never_with_cr env
  else if fish then
    print_fish_env never_with_cr env
  else if pwsh then
    print_pwsh_env output_normally env
  else if cmd then
    print_cmd_env output_normally env
  else
    print_env never_with_cr env

let check_writeable l =
  let map_writeable ({OpamTypes.envu_op; _} as update) =
    match envu_op with
    | Eq | PlusEq | EqPlus | ColonEq | EqColon | EqPlusEq as envu_op ->
      {update with envu_op}
    | Cygwin ->
      OpamSystem.internal_error
        "Attempt to write an internal environment change"
  in
  List.map map_writeable l

let regenerate_env ~set_opamroot ~set_opamswitch ~force_path
    gt switch env_file =
  OpamSwitchState.with_ `Lock_none ~switch gt @@ fun st ->
  let upd =
    OpamEnv.updates ~set_opamroot ~set_opamswitch ~force_path st
  in
  if not (OpamCoreConfig.(!r.safe_mode)) then
    (let _, st =
       OpamSwitchState.with_write_lock st @@ fun st ->
       (OpamFile.Environment.write env_file (check_writeable upd)), st
     in OpamSwitchState.drop st);
  upd

let load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path
    gt switch env_file =
  let upd =
    OpamEnv.get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path
      gt.root switch
  in
  let environment_opam_switch_prefix =
    OpamStd.List.find_map_opt (function
        | OpamTypes.{ envu_var = "OPAM_SWITCH_PREFIX";
                      envu_op = Eq;
                      envu_value; _} ->
          Some envu_value
        | _ -> None)
      upd
    |> OpamStd.Option.default ""
  in
  let actual_opam_switch_prefix =
    OpamFilename.Dir.to_string (OpamPath.Switch.root gt.root switch)
  in
  if environment_opam_switch_prefix <> actual_opam_switch_prefix then
    (log "Switch has moved from %s to %s"
       environment_opam_switch_prefix actual_opam_switch_prefix;
     log "Regenerating environment file";
     regenerate_env ~set_opamroot ~set_opamswitch ~force_path
       gt switch env_file)
  else upd

(* Returns [Some file] where [file] contains [updates]. [hash] should be
   [OpamEnv.hash_env_updates updates] and [n] should initially be [0]. If for
   whatever reason the file cannot be created, returns [None]. *)
let  write_last_env_file gt updates =
  let updates = check_writeable updates in
  let temp_dir = OpamPath.last_env gt.root in
  let hash = OpamEnv.hash_env_updates updates in
  let rec aux  n =
    (* The principal aim here is not to spam /tmp with gazillions of files, but
       also to be sure that the file present has the correct content. [n] is used
       to avoid content collisions. If an existing file is used, it is touched as
       this is used on Windows to allow garbage collection. *)
    let trial = "env-" ^ hash ^ "-" ^ string_of_int n in
    let target = OpamFilename.Op.(temp_dir // trial) in
    if OpamFilename.exists target then
      (* File already exists - check its content *)
      let target_hash =
        OpamFile.make target
        |> OpamFile.Environment.read_opt
        |> Option.map OpamEnv.hash_env_updates
      in
      if target_hash = Some hash then Some target else
        (* Content collision/corruption, so try with higher [n] *)
        aux (succ n)
    else
    try
      (* Environment files are written atomically *)
      OpamFile.Environment.write (OpamFile.make target) updates;
      (* File should now exist with the correct content *)
      aux n
    with e -> OpamStd.Exn.fatal e; None
  in
  aux 0

let ensure_env_aux ?(base=[]) ?(set_opamroot=false) ?(set_opamswitch=false)
    ?(force_path=true) gt switch =
  let env_file = OpamPath.Switch.environment gt.root switch in
  let updates =
    if OpamFile.exists env_file then
      load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path
        gt switch env_file
    else begin
      log "Missing environment file, regenerate it";
      regenerate_env ~set_opamroot ~set_opamswitch ~force_path
        gt switch env_file
    end
  in
  let open OpamTypes in
  let updates =
    List.filter (fun upd ->
        not (String.equal upd.envu_var "OPAM_LAST_ENV"))
      updates
  in
  let last_env_file =
    write_last_env_file gt
      (* We remove OPAMSWITCH & OPAMROOT as they are not supposed
         to be reverted *)
      (List.filter (fun upd ->
           not ((String.equal upd.envu_var "OPAMSWITCH")
                || (String.equal upd.envu_var "OPAMROOT")))
          updates)
  in
  let updates =
    OpamStd.Option.map_default (fun target ->
        (env_update_resolved "OPAM_LAST_ENV" Eq
           (OpamFilename.to_string target))
        ::updates)
      updates last_env_file
  in
  OpamEnv.add base updates

let ensure_env gt switch =
  ignore (ensure_env_aux gt switch)

let env gt switch ?(set_opamroot=false) ?(set_opamswitch=false)
    ~csh ~sexp ~fish ~pwsh ~cmd ~inplace_path =
  log "config-env";
  let opamroot_not_current =
    let current = gt.root in
    let default = OpamStateConfig.(default.root_dir) in
    match OpamStateConfig.E.root () with
    | None -> current <> default
    | Some r -> OpamFilename.Dir.of_string r <> current
  in
  let opamswitch_not_current =
    let default =
      OpamStd.Option.Op.(++)
        (OpamStateConfig.get_current_switch_from_cwd gt.root)
        (OpamFile.Config.switch gt.config)
    in
    match OpamStateConfig.E.switch () with
    | None | Some "" ->
      Some (OpamStateConfig.resolve_local_switch gt.root switch) <> default
    | Some s ->
      OpamStateConfig.resolve_local_switch gt.root (OpamSwitch.of_string s) <>
      OpamStateConfig.resolve_local_switch gt.root switch
  in
  if opamroot_not_current && not set_opamroot then
    OpamConsole.note
      "To make opam select %s as its root in the current shell, add %s or set \
       %s"
      (OpamFilename.Dir.to_string gt.root)
      (OpamConsole.colorise `bold "--set-root")
      (OpamConsole.colorise `bold "OPAMROOT");
  if opamswitch_not_current && not set_opamswitch then
    OpamConsole.note
      "To make opam select the switch %s in the current shell, add %s or set \
       %s"
      (OpamSwitch.to_string switch)
      (OpamConsole.colorise `bold "--set-switch")
      (OpamConsole.colorise `bold "OPAMSWITCH");
  let force_path = not inplace_path in
  let env =
    ensure_env_aux ~set_opamroot ~set_opamswitch ~force_path gt switch
  in
  print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env
[@@ocaml.warning "-16"]

let subst gt fs =
  log "config-substitute";
  OpamSwitchState.with_ `Lock_none gt @@ fun st ->
  List.iter
    (OpamFilter.expand_interpolations_in_file (OpamPackageVar.resolve st))
    fs

let expand gt str =
  log "config-expand";
  OpamSwitchState.with_ `Lock_none gt @@ fun st ->
  OpamConsole.msg "%s\n"
    (OpamFilter.expand_string ~default:(fun _ -> "")
       (OpamPackageVar.resolve st) str)

let exec gt ~set_opamroot ~set_opamswitch ~inplace_path ~no_switch command =
  log "config-exec command=%a" (slog (String.concat " ")) command;
  let switch = OpamStateConfig.get_switch () in
  let st_lazy = lazy (
    let rt = OpamRepositoryState.load `Lock_none gt in
    OpamSwitchState.load `Lock_none gt rt switch
  ) in
  let env =
    let base = List.map (fun (v,va) -> v,va,None) (OpamStd.Env.list ()) in
    if no_switch then
      let revert = OpamEnv.add [] [] in
      List.map (fun ((var, _, _) as base) ->
          match List.find_opt (fun (v,_,_) -> OpamStd.Env.Name.equal v var) revert with
          | Some reverted -> reverted
          | None -> base) base
    else
      ensure_env_aux ~base ~set_opamroot ~set_opamswitch
                     ~force_path:(not inplace_path) gt switch
  in
  let env = OpamTypesBase.env_array env in
  let resolve var =
    OpamPackageVar.resolve (Lazy.force st_lazy) var
  in
  let cmd, args =
    match
      List.map (OpamFilter.expand_string ~default:(fun _ -> "") resolve) command
    with
    | []        -> OpamSystem.internal_error "Empty command"
    | h::_ as l -> h, Array.of_list l
  in
  (* it's OK not to release [st_lazy] since we are certain everything will be
     cleaned up anyway *)
  match OpamSystem.resolve_command ~env cmd with
  | Some cmd -> raise (OpamStd.Sys.Exec (cmd, args, env))
  | None ->
    OpamConsole.error "Command not found '%s'" cmd;
    raise (OpamStd.Sys.Exit 127)


(** Options and Variables settings *)

(** Option settings *)

(* For function that takes two config and update (add or remove) elements in a
   field. Used for appending or deleting element in config file fields *)
type 'config fld_updater =  ('config -> 'config -> 'config)

(* Only some field can be modifiied. [Modifiable] is for user modifiable
   field, [InModifiable] for fields that can only be modified from inner opam
   code (see [set_var_global]).
   First argument is the addition function, the second the remove one. *)
type 'config fld_policy =
  | Atomic
  | Atomic_pp of ('config -> 'config)
  | Modifiable of 'config fld_updater * 'config fld_updater
  | InModifiable of 'config fld_updater * 'config fld_updater

(* "Configuration" of the [set_opt] function. As modification can be on global
   or config switch, on normal fields and sections, adding, removing, or
   overwritng values, this record type permits to aggregate all needed inputs.
   See [set_opt_global] and [set_opt_switch]. *)
type 'config confset =
  {
    stg_fields: (string * ('config, value) OpamPp.field_parser) list;
    (* Config file fields: field name and parser *)
    stg_allwd_fields:
      (string * 'config fld_policy * ('config -> 'config)) list;
    (* Config file updatable fields: field name, update policy, and function to
       revert the given field in config file *)
    stg_sections:
      (string * ('config, (string option * opamfile_item list) list)
         OpamPp.field_parser) list;
    (* Same as [stg_field] but for sections *)
    stg_allwd_sections:
      ((string * 'config fld_policy * ('config -> 'config)) list);
    (* Same as [stg_allwd_fields] but for sections *)
    stg_config: 'config;
    (* The config *)
    stg_write_config: 'config -> unit;
    (* Function to write the config file *)
    stg_doc: string;
    (* Global or switch specification, used to print final user message *)
  }

type whole_op =
  [ `Overwrite of string
  | `Revert ]

type append_op =
  [ `Add of string
  | `Remove of string ]

type update_op =
  [ append_op  | whole_op ]

let parse_update fv =
  let reg =
    Re.(compile @@ seq [
        group @@ seq [
          wordc;
          opt @@ (seq [ rep @@ alt [ wordc ; char '-' ; char ':' ]; wordc ])
        ];
        (opt @@ seq [
            (group @@ (alt [
                 str "+=";
                 str "-=";
                 str "==";
                 char '=';
               ]));
            opt @@ (group @@ rep1 any)
          ]);
      ])
  in
  let grs = Re.exec reg fv in
  let var = Re.Group.get grs 1 in
  let value =
    try
      let value =
        OpamStd.Option.of_Not_found (fun () -> Re.Group.get grs 3) ()
      in
      match Re.Group.get grs 2, value with
      | "+=", Some value -> `Add value
      | "-=", Some value -> `Remove value
      | ("=" | "=="), Some value -> `Overwrite value
      | ("=" | "=="), None -> `Revert
      | ("+=" | "-="), None -> raise (Invalid_argument "parse_update: rhs needed")
      | _, _ -> raise (Invalid_argument "parse_update: illegal operator")
    with Not_found ->  raise (Invalid_argument "parse_update: operator needed")
  in
  var, value

let whole_of_update_op = function
  | #whole_op as w -> w
  | _ -> raise Not_found

let parse_whole fv =
  let v, upd = parse_update fv in
  try v, (whole_of_update_op upd)
  with Not_found -> raise (Invalid_argument "parse_whole: append operator")

let global_doc = "global configuration"
let switch_doc switch =
  Printf.sprintf "switch %s"
    (OpamConsole.colorise `bold (OpamSwitch.to_string switch))

let no_self_variable_error () =
  OpamConsole.error_and_exit `Bad_arguments
    "Self variables (`_:`) are not valid here";

module OpamParser = OpamParser.FullPos
module OpamPrinter = OpamPrinter.FullPos

(* General setting option function. Takes the [field] to update, the [value]
   operation, [conf] the configuration according the config file (['config
   confest]). If [inner] is set, it allows the modification of [InModifiable]
   fields *)
let set_opt ?(inner=false) field value conf =
  let wrap allowed all parse =
    List.map (fun (field, pp) ->
        match OpamStd.List.find_opt (fun (x,_,_) -> x = field) allowed with
        | None -> field, None
        | Some (_, modd, default) ->
          let parse elem config =
            OpamPp.parse ~pos:OpamTypesBase.pos_null pp
              (config, Some (parse elem))
          in
          field,
          Some (parse, modd, default)
      ) all
  in
  let fields =
    (wrap conf.stg_allwd_fields conf.stg_fields
       (fun str_value ->
          OpamParser.value_from_string str_value "<command-line>"))
    @ (wrap conf.stg_allwd_sections conf.stg_sections
         (fun str_value ->
            [None,
             (OpamParser.string str_value "<command-line>").file_contents]))
  in
  let new_config =
    match OpamStd.List.assoc_opt String.equal field fields, value with
    | None, _ ->
      OpamConsole.error
        "There is no option named '%s'. The allowed options are:"
        (OpamConsole.colorise `underline field);
      OpamConsole.print_table stderr ~sep:" "
        (OpamStd.Format.as_aligned_table
           (OpamStd.List.filter_map
              (function fl, Some _ -> Some fl | _ -> None)
              fields));
      OpamStd.Sys.exit_because `Bad_arguments
    | Some None, _ ->
      OpamConsole.error_and_exit `Bad_arguments
        "Field %s is not modifiable" (OpamConsole.colorise `underline field)
    | Some (Some (_, Atomic, _)), (#append_op as ar) ->
      OpamConsole.error_and_exit `Bad_arguments
        "Field %s can't be %s" (OpamConsole.colorise `underline field)
        (match ar with `Add _ -> "appended" | `Remove _ -> "substracted")
    | Some (Some (_, InModifiable (_,_), _)), (#append_op as ar) when not inner ->
      OpamConsole.error_and_exit `Bad_arguments
        "Field %s can't be directly %s, use `opam var` instead"
        (OpamConsole.colorise `underline field)
        (match ar with `Add _ -> "appended to"
                     | `Remove _ -> "substracted from")
    | Some (Some (_, _, set_default)), `Revert ->
      set_default conf.stg_config
    | Some (Some (parse, fix_app, _)),
      ((`Add v | `Remove v | `Overwrite v) as req_value) ->
      (try
         let updf v = parse v conf.stg_config in
         match req_value, fix_app with
         | `Add value, (Modifiable (add, _) | InModifiable (add, _))  ->
           add (updf value) conf.stg_config
         | `Remove value, (Modifiable (_, rem) | InModifiable (_, rem)) ->
           rem (updf value) conf.stg_config
         | `Overwrite value, Atomic_pp pp ->
           pp @@ parse value conf.stg_config
         | `Overwrite value, _ -> (updf value)
         | _, (Atomic | Atomic_pp _) -> assert false
       with
       | (OpamPp.Bad_format (_,_) | Parsing.Parse_error) as e ->
         OpamConsole.error_and_exit `Bad_arguments
           "Parse error on the value of %s '%s': %s"
           (OpamConsole.colorise `underline field) v
           (OpamPp.string_of_bad_format e))
  in
  if conf.stg_config = new_config then
    OpamConsole.msg "No modification in %s\n" conf.stg_doc
  else
    (conf.stg_write_config new_config;
     OpamConsole.msg "%s field %s in %s\n"
       (match value with
        | `Add value ->  Printf.sprintf "Added '%s' to" value
        | `Remove value ->  Printf.sprintf "Removed '%s' from" value
        | `Overwrite value -> Printf.sprintf "Set to '%s' the" value
        | `Revert -> "Reverted")
       (OpamConsole.colorise `underline field)
       conf.stg_doc);
  new_config

let allwd_wrappers wdef wrappers with_wrappers  =
  let open OpamFile in
  List.map (fun (n, set, get) ->
      n,
      Modifiable (
        (fun nc c ->
           let w = wrappers c in
           let nw = wrappers nc in
           with_wrappers (set (get nw @ get w) w) c),
        (fun nc c ->
           let w = wrappers c in
           let nw = wrappers nc in
           let n_cmd =
             List.filter (fun cmd ->
                 None = OpamStd.List.find_opt (fun cmd' -> cmd = cmd') (get nw))
               (get w)
           in
           with_wrappers (set n_cmd w) c)
      ),
      fun c -> with_wrappers (set (get wdef) (wrappers c)) c)
    [
      "pre-build-commands",
      Wrappers.with_pre_build, Wrappers.pre_build;
      "pre-install-commands",
      Wrappers.with_pre_install, Wrappers.pre_install;
      "pre-remove-commands",
      Wrappers.with_pre_remove, Wrappers.pre_remove;
      "pre-session-commands",
      Wrappers.with_pre_session, Wrappers.pre_session;
      "wrap-build-commands",
      Wrappers.with_wrap_build, Wrappers.wrap_build;
      "wrap-install-commands",
      Wrappers.with_wrap_install, Wrappers.wrap_install;
      "wrap-remove-commands",
      Wrappers.with_pre_remove, Wrappers.pre_remove;
      "post-build-commands",
      Wrappers.with_post_build, Wrappers.post_build;
      "post-install-commands",
      Wrappers.with_post_install, Wrappers.post_install;
      "post-remove-commands",
      Wrappers.with_post_remove, Wrappers.post_remove;
      "post-session-commands",
      Wrappers.with_post_session, Wrappers.post_session;
    ]

let switch_allowed_fields, switch_allowed_sections =
  let allowed_fields =
    lazy (
      OpamFile.Switch_config.(
        [
          ("synopsis", Atomic,
           fun t -> { t with synopsis = empty.synopsis });
          ("setenv", Modifiable (
              (fun nc c -> { c with env = nc.env @ c.env }),
              (fun nc c ->
                 let open OpamTypes in
                 let env =
                   List.filter
                     (fun { envu_var = var; envu_op = op;
                            envu_value = value; envu_comment = _;
                            envu_rewrite = _ } ->
                       None =
                       OpamStd.List.find_opt
                         (fun { envu_var = var'; envu_op = op';
                                envu_value = value'; envu_comment = _;
                                envu_rewrite = _ } ->
                           String.equal var var'
                           && (op : [> euok_writeable ] env_update_op_kind) = op'
                           && String.equal value value')
                         nc.env) c.env
                 in
                 { c with env })),
           fun t -> { t with env = empty.env });
          "depext-bypass", OpamSysPkg.Set.Op.(Modifiable (
              (fun nc c ->
                 { c with depext_bypass = nc.depext_bypass ++ c.depext_bypass }),
              (fun nc c ->
                 { c with depext_bypass = c.depext_bypass -- nc.depext_bypass })
            )),
          (fun t -> { t with depext_bypass = empty.depext_bypass });
        ] @ allwd_wrappers empty.wrappers wrappers
          (fun wrappers t -> { t with wrappers })))
  in
  let allowed_sections =
    let rem_elem new_elems elems =
      List.filter (fun n -> not (List.mem n new_elems)) elems
    in
    lazy (
      OpamFile.Switch_config.([
          ("variables", InModifiable (
              (fun nc c -> { c with variables = nc.variables @ c.variables }),
              (fun nc c ->
                 { c with variables = rem_elem nc.variables c.variables })),
           (fun c -> { c with variables = empty.variables }));
        ]))
  in
  (fun () -> Lazy.force allowed_fields),
  fun () -> Lazy.force allowed_sections

let confset_switch gt switch switch_config =
  let config_f = OpamPath.Switch.switch_config gt.root switch in
  let write new_config = OpamFile.Switch_config.write config_f new_config in
  { stg_fields = OpamFile.Switch_config.fields;
    stg_allwd_fields = switch_allowed_fields ();
    stg_sections = OpamFile.Switch_config.sections;
    stg_allwd_sections = switch_allowed_sections ();
    stg_config = switch_config;
    stg_write_config = write;
    stg_doc = switch_doc switch
  }

let with_switch ~display gt lock_kind st k =
  match st with
  | Some st -> k st.switch st.switch_config
  | None ->
    match OpamStateConfig.get_switch_opt () with
    | None ->
      OpamConsole.error_and_exit `Configuration_error "No switch selected"
    | Some switch ->
      let switch_config =
        if lock_kind = `Lock_write then
          match OpamStateConfig.Switch.read_opt ~lock_kind gt switch with
          | Some c -> c
          | exception (OpamPp.Bad_version _ as e) ->
            OpamFormatUpgrade.hard_upgrade_from_2_1_intermediates gt.root;
            raise e
          | None -> OpamFile.Switch_config.empty
        else
          OpamStateConfig.Switch.safe_load ~lock_kind gt switch
      in
      let lock_file = OpamPath.Switch.lock gt.root switch in
      if switch_config = OpamFile.Switch_config.empty then
        if display then
          OpamConsole.error "switch %s not found, display default values"
            (OpamSwitch.to_string switch)
        else
          OpamConsole.error_and_exit `Bad_arguments
            "The selected switch %s is not installed"
            (OpamSwitch.to_string switch);
      OpamFilename.with_flock lock_kind lock_file @@ fun _ ->
      k switch switch_config

let set_opt_switch_t ?inner gt switch switch_config field value =
  set_opt ?inner field value (confset_switch gt switch switch_config)

let set_opt_switch gt ?st field value =
  with_switch ~display:false gt `Lock_write st @@ fun sw swc ->
  let switch_config = set_opt_switch_t ~inner:false gt sw swc field value in
  OpamStd.Option.map (fun st -> { st with switch_config }) st

let global_allowed_fields, global_allowed_sections =
  let allowed_fields =
    lazy (
      let open OpamStd.Option.Op in
      let open OpamFile in
      let in_config = OpamInitDefaults.init_config () in
      let wrapper_init = InitConfig.wrappers in_config in
      let upd_vars get set =
        (fun nc c ->  set (get nc @ get c) c),
        (fun nc c ->
           let gv = get nc in
           set (List.filter (fun (k,v,_) ->
               None = OpamStd.List.find_opt (fun (k',v',_) -> k = k' && v = v') gv)
               (get c)) c)
      in
      [
        "download-command", Atomic,
        Config.with_dl_tool_opt
          (InitConfig.dl_tool in_config ++ Config.dl_tool Config.empty);
        "download-jobs", Atomic,
        Config.with_dl_jobs
          (InitConfig.dl_jobs in_config +! Config.dl_jobs Config.empty);
        "jobs", Atomic,
        Config.with_jobs_opt
          (InitConfig.jobs in_config ++ Config.jobs Config.empty);
        "archive-mirrors", Modifiable (
          (fun nc c ->
             Config.with_dl_cache (Config.dl_cache nc @ Config.dl_cache c) c),
          (fun nc c ->
             let to_remove = Config.dl_cache nc in
             let dl_cache =
               List.filter (fun url ->
                   None = OpamStd.List.find_opt (OpamUrl.equal url) to_remove)
                 (Config.dl_cache c)
             in
             Config.with_dl_cache dl_cache c)),
        Config.with_dl_cache
          (InitConfig.dl_cache in_config @ Config.dl_cache Config.empty);
        "best-effort-prefix-criteria", Atomic,
        Config.with_best_effort_prefix_opt
          (Config.best_effort_prefix Config.empty);
        "solver", Atomic,
        Config.with_solver_opt
          (InitConfig.solver in_config ++ Config.solver Config.empty);
        "global-variables",
        (let add, rem =
           upd_vars Config.global_variables Config.with_global_variables
         in
         InModifiable (add, rem)),
        Config.with_global_variables (InitConfig.global_variables in_config);
        "eval-variables",
        (let add, rem =
           upd_vars Config.eval_variables Config.with_eval_variables
         in
         InModifiable (add, rem)),
        Config.with_eval_variables (InitConfig.eval_variables in_config);
        "repository-validation-command", Atomic,
        Config.with_validation_hook_opt (Config.validation_hook Config.empty);
        "depext", Atomic,
        Config.with_depext (Config.depext Config.empty);
        "depext-run-installs", Atomic,
        Config.with_depext_run_installs
          (Config.depext_run_installs Config.empty);
        "depext-cannot-install", Atomic,
        Config.with_depext_cannot_install
          (Config.depext_cannot_install Config.empty);
        "depext-bypass", OpamSysPkg.Set.Op.(Modifiable (
            (fun nc c -> Config.with_depext_bypass
                (Config.depext_bypass nc ++ Config.depext_bypass c) c),
            (fun nc c -> Config.with_depext_bypass
                (Config.depext_bypass c -- Config.depext_bypass nc) c)
          )),
        Config.with_depext_bypass (Config.depext_bypass Config.empty);
        "sys-pkg-manager-cmd", Modifiable (
            (fun nc c -> Config.with_sys_pkg_manager_cmd
                (OpamStd.String.Map.union (fun nc _c -> nc)
                (Config.sys_pkg_manager_cmd nc) (Config.sys_pkg_manager_cmd c)) c),
            (fun nc c ->
               let to_remove = OpamStd.String.Map.keys (Config.sys_pkg_manager_cmd nc) in
               let nmap =
                 List.fold_left (fun map key ->
                     OpamStd.String.Map.remove key map)
                   (Config.sys_pkg_manager_cmd c) to_remove
               in
               Config.with_sys_pkg_manager_cmd nmap c)
          ),
        Config.with_sys_pkg_manager_cmd (Config.sys_pkg_manager_cmd Config.empty);
        "swh-fallback", Atomic,
        Config.with_swh_fallback (Config.swh_fallback Config.empty);
        "git-location", Atomic_pp
          (fun c ->
             OpamStd.Option.iter (fun git_location ->
                 if OpamSystem.bin_contains_bash
                     (OpamFilename.Dir.to_string git_location) then
                   OpamConsole.error_and_exit `False
                     "Found a bash in given git bin directory,\
                      which is dangerous!")
               (Config.git_location c);
             c),
        Config.with_git_location_opt
          (InitConfig.git_location in_config ++ Config.git_location Config.empty);
      ] @ List.map (fun f ->
          f, Atomic, Config.with_criteria
            (Config.criteria Config.empty))
        [ "solver-criteria";
          "solver-upgrade-criteria";
          "solver-fixup-criteria" ]
      @ allwd_wrappers wrapper_init Config.wrappers Config.with_wrappers
    )
  in
  (fun () -> Lazy.force allowed_fields),
  fun () -> []

let confset_global gt =
  let write new_config = OpamGlobalState.write {gt with config = new_config} in
  { stg_fields = OpamFile.Config.fields;
    stg_allwd_fields = global_allowed_fields ();
    stg_sections = [];
    stg_allwd_sections = global_allowed_sections ();
    stg_config = gt.config;
    stg_write_config = write;
    stg_doc = global_doc;
  }

let set_opt_global_t ?inner gt field value =
  let config =
    set_opt ?inner field value (confset_global gt)
  in
  { gt with config }

let set_opt_global = set_opt_global_t ~inner:false

(** Variable settings *)

(* "Configuration" of the [set_var] function. As these modification can be on
   global and switch config, this record aggregates all needed inputs. *)
type ('var,'config) var_confset =
  {
    stv_vars: 'var list;
    (* Variables list *)
    stv_find: 'var -> bool;
    (* Find function embedding a wanted var *)
    stv_config: 'config;
    (* State to use *)
    stv_varstr: string -> string;
    (* [stv_vars value] returns the string of the variable with the new value.
       It is used to give the overall value to [set_opt] functions. *)
    stv_set_opt: 'config -> update_op -> 'config;
    (* The [set_opt] function call [stv_set_opt state var_value] *)
    stv_remove_elem: 'var list -> 'config -> 'config;
    (* As variable can't be duplicated, a function to remove it from the list *)
    stv_write: 'config -> unit;
    (* Write the config file *)
    stv_doc: string;
    (* Global or switch specification, used to print final user message *)
  }

let set_var var value conf =
  let conf = conf (OpamVariable.Full.variable var) in
  let global_vars = conf.stv_vars in
  let rest = List.filter (fun v -> not (conf.stv_find v)) global_vars in
  let config = conf.stv_remove_elem rest conf.stv_config in
  match value with
  | `Overwrite value -> conf.stv_set_opt config (`Add (conf.stv_varstr value))
  | `Revert ->
    (* only write, as the var is already removed *)
    if config = conf.stv_config then
      OpamConsole.msg "No modification in %s\n" conf.stv_doc
    else
      (conf.stv_write config;
       OpamConsole.msg "Removed variable %s in %s\n"
         (OpamConsole.colorise `underline (OpamVariable.Full.to_string var))
         conf.stv_doc);
    config

let set_var_global gt svar value =
  let var = OpamVariable.Full.of_string svar in
  match OpamVariable.Full.scope var with
  | Global ->
    let config =
      set_var var value @@
      fun var ->
      let global_vars = OpamFile.Config.global_variables gt.config in
      { stv_vars = global_vars;
        stv_find = (fun (k,_,_) -> k = var);
        stv_config = gt.config;
        stv_varstr = (fun v ->
            OpamPrinter.Normalise.value (nullify_pos @@ List (nullify_pos @@ [
                nullify_pos @@ Ident (OpamVariable.to_string var);
                nullify_pos @@ String v;
                nullify_pos @@ String "Set through 'opam var'"
              ])));
        stv_set_opt = (fun config value ->
            let gt =
              set_opt_global_t ~inner:true { gt with config }
                "global-variables" value
            in gt.config);
        stv_remove_elem = (fun rest config ->
            OpamFile.Config.with_global_variables rest config
            |> OpamFile.Config.with_eval_variables
              (List.filter (fun (k,_,_) -> k <> var)
                 (OpamFile.Config.eval_variables config)));
        stv_write = (fun config -> OpamGlobalState.write { gt with config });
        stv_doc = global_doc;
      } in
    { gt with config }
  | Self -> no_self_variable_error ()
  | Package _ ->
    OpamConsole.error_and_exit `Bad_arguments
      "Package variables are read-only and \
       cannot be updated using `opam var --global`"


let set_var_switch gt ?st svar value =
  let var = OpamVariable.Full.of_string svar in
  let var_confset switch switch_config var =
    let switch_vars = switch_config.OpamFile.Switch_config.variables in
    { stv_vars = switch_vars;
      stv_find = (fun (k,_) -> k = var);
      stv_config = switch_config;
      stv_varstr = (fun v ->
          OpamStd.String.remove_suffix ~suffix:"\n" @@
          OpamPrinter.Normalise.items
            [ nullify_pos @@ Variable
                (nullify_pos @@ OpamVariable.to_string var,
                 nullify_pos @@ String v)]);
      stv_set_opt = (fun swc value ->
          set_opt_switch_t ~inner:true gt switch swc "variables" value);
      stv_remove_elem = (fun rest switch_config ->
          { switch_config with variables = rest });
      stv_write = (fun swc ->
          OpamFile.Switch_config.write
            (OpamPath.Switch.switch_config gt.root switch) swc);
      stv_doc = switch_doc switch;
    } in
  let switch_config =
    with_switch ~display:false gt `Lock_write st @@ fun sw swc ->
    match OpamVariable.Full.scope var with
    | Global -> set_var var value (var_confset sw swc)
    | Self -> no_self_variable_error ()
    | Package n ->
      OpamConsole.error_and_exit `Bad_arguments
        "%sPackage variables are read-only and \
         cannot be updated using `opam var --global`"
        (if OpamPackage.package_of_name_opt
            (OpamStateConfig.Switch.safe_read_selections
               ~lock_kind:`Lock_read gt sw).sel_installed n = None then
           Printf.sprintf "Package %s is not installed. "
             (OpamPackage.Name.to_string n)
         else "")
  in
  OpamStd.Option.map (fun st -> { st with switch_config }) st

(** Option and var list display *)

let print_fields fields =
  let fields =
    List.sort (fun (x,_) (x',_) -> compare x x') fields
    |> List.map (fun (name, value) ->
        let value = match value with
          | None -> "{}"
          | Some value -> (OpamPrinter.Normalise.value value)
        in
        [
          OpamConsole.colorise `bold name ;
          OpamConsole.colorise `blue value
        ])
  in
  OpamConsole.print_table stdout ~sep:"  "
    (OpamStd.Format.align_table fields)

let find_field field name_value =
  match OpamStd.List.find_opt (fun (name, _) -> name = field) name_value with
  | None -> (field, None)
  | Some (name, value) -> (name, Some value)

let find_section section name_value =
  let sections =
    List.find_all (fun (name, _) ->
        match OpamStd.String.cut_at name '.' with
        | None -> false
        | Some (name,_) -> name = section)
      name_value
  in
  match sections with
  | [] -> [section, None]
  | section -> List.map (fun (n,v) -> n, Some v) section

let options_list_t to_list conf =
  let name_value = to_list conf.stg_config in
  let fields =
    OpamStd.List.filter_map (fun (field, policy, _) ->
        match policy with
        | InModifiable _ -> None
        | _ -> Some (find_field field name_value))
      conf.stg_allwd_fields
  in
  let sections =
    OpamStd.List.filter_map (fun (field, policy, _) ->
        match policy with
        | InModifiable _ -> None
        | _ -> Some (find_section field name_value))
      conf.stg_allwd_sections
    |> List.flatten
  in
  print_fields (fields @ sections)

let options_list_switch ?st gt =
  with_switch ~display:true gt `Lock_none st @@ fun sw swc ->
  options_list_t OpamFile.Switch_config.to_list (confset_switch gt sw swc)

let options_list_global gt =
  options_list_t OpamFile.Config.to_list (confset_global gt)

let options_list ?st gt =
  OpamConsole.header_msg "Global configuration";
  options_list_global gt;
  let switch_header = OpamConsole.header_msg "Switch configuration%s" in
  match OpamStateConfig.get_switch_opt () with
  | None ->
    switch_header "";
    OpamConsole.msg "No switch installed\n"
  | Some switch ->
    switch_header (Printf.sprintf " (%s)" (OpamSwitch.to_string switch));
    options_list_switch ?st gt

let vars_list_global gt =
  let (%) s col = OpamConsole.colorise col s in
  let all_global_vars =
    List.fold_left (fun acc (v,doc) ->
        OpamVariable.Map.add (OpamVariable.of_string v) doc acc)
      OpamVariable.Map.empty
      OpamPackageVar.global_variable_names
  in
  let all_global_vars =
    OpamVariable.Map.union (fun _ x -> x)
      all_global_vars
      (OpamVariable.Map.map snd gt.global_variables)
  in
  let env = OpamPackageVar.resolve_global gt in
  List.map (fun (var, doc) ->
      let content =
        OpamFilter.ident_string env ~default:"" ([],var,None)
      in
      let doc =
        if doc = OpamGlobalState.inferred_from_system then
          match OpamStd.Option.Op.(
              OpamVariable.Map.find_opt var gt.global_variables
              >>| fst
              >>= Lazy.force) with
          | Some c
            when (OpamVariable.string_of_variable_contents c) <> content ->
            "Set through local opam config or env"
          | _ -> doc
        else doc
      in
      [
        OpamVariable.to_string var % `bold;
        content % `blue;
        "#"; doc
      ])
    (List.sort (fun (x,_) (x',_) -> compare x x')
       (OpamVariable.Map.bindings all_global_vars)) |>
  OpamStd.Format.align_table |>
  OpamConsole.print_table stdout ~sep:" "

let vars_list_switch ?st gt =
  let (%) s col = OpamConsole.colorise col s in
  let switch, config =
    match st with
    | Some st -> st.switch, st.switch_config
    | None ->
      let switch = OpamStateConfig.get_switch () in
      switch,
      OpamStateConfig.Switch.safe_load ~lock_kind:`Lock_read gt switch
  in
  List.map (fun stdpath -> [
        OpamTypesBase.string_of_std_path stdpath % `bold;
        OpamPath.Switch.get_stdpath gt.root switch config stdpath |>
        OpamFilename.Dir.to_string |>
        OpamConsole.colorise `blue
      ])
    OpamTypesBase.all_std_paths @
  List.map (fun (var,value) -> [
        OpamVariable.to_string var % `bold;
        OpamVariable.string_of_variable_contents value % `blue;
      ])
    (List.sort (fun (x,_) (x',_) -> compare x' x)
       config.OpamFile.Switch_config.variables) |>
  OpamStd.Format.align_table |>
  OpamConsole.print_table stdout ~sep:" "

let vars_list ?st gt =
  let (%) s col = OpamConsole.colorise col s in
  OpamConsole.header_msg "Global opam variables";
  vars_list_global gt;
  OpamConsole.header_msg "Configuration variables from the current switch";
  (match OpamStateConfig.get_switch_opt () with
  | None -> OpamConsole.msg "No switch installed\n"
  | Some _ -> vars_list_switch ?st gt);
  OpamConsole.header_msg "Package variables ('opam var --package PKG' to show)";
  List.map (fun (var, doc) -> [
        ("PKG:"^var) % `bold;
        "";
        "#";doc
      ])
    OpamPackageVar.package_variable_names |>
  OpamStd.Format.align_table |>
  OpamConsole.print_table stdout ~sep:" "

(* Specified option/var display *)

let option_show to_list conf field =
  match OpamStd.List.assoc_opt String.equal field conf.stg_fields with
  | Some pp ->
    (match OpamPp.print pp conf.stg_config with
     | _, Some value ->
       OpamConsole.msg "%s\n" (OpamPrinter.Normalise.value value)
     | _, None -> ())
  | None ->
    if OpamStd.List.mem_assoc String.equal field conf.stg_sections then
      let name_value = to_list conf.stg_config in
      let sections =
        OpamStd.List.filter_map (fun (name, v) ->
            match OpamStd.String.cut_at name '.' with
            | Some (name,elem) when name = field ->
              Some [ elem; OpamPrinter.Normalise.value v ]
            | _ -> None
          ) name_value
      in
      OpamConsole.print_table stdout ~sep:"  "
        (OpamStd.Format.align_table sections)
    else
      OpamConsole.error_and_exit `Not_found
        "Field or section %s not found" field

let option_show_switch gt ?st field =
  with_switch ~display:true gt `Lock_none st @@ fun sw swc ->
  option_show OpamFile.Switch_config.to_list (confset_switch gt sw swc) field

let option_show_global gt field =
  option_show OpamFile.Config.to_list (confset_global gt) field

let var_show_t resolve gt ?switch v =
  let var = OpamVariable.Full.of_string v in
  if OpamVariable.Full.scope var = OpamVariable.Full.Self then
    no_self_variable_error ();
  match resolve var with
  | Some c ->
    OpamConsole.msg "%s\n" (OpamVariable.string_of_variable_contents c)
  | None ->
    OpamConsole.error_and_exit `Not_found "Variable %s not found in %s%s" v
      (match switch with
       | None -> "the global configuration"
       | Some switch -> "switch " ^ (OpamSwitch.to_string switch))
      (match switch, OpamVariable.Full.scope var with
       | Some switch, Package n ->
         if OpamPackage.package_of_name_opt
             (OpamStateConfig.Switch.safe_read_selections
                ~lock_kind:`Lock_read gt switch).sel_installed n = None then
           Printf.sprintf "; package %s is not installed in this switch"
             (OpamPackage.Name.to_string n)
         else ""
       | _ -> "")

let is_switch_defined_var switch_config v =
  OpamFile.Switch_config.variable switch_config
    (OpamVariable.of_string v) <> None
  || (try let _path = OpamTypesBase.std_path_of_string v in true
      with Failure _ -> false)
  || OpamStd.String.contains_char v ':'

let var_switch_raw gt v =
  match OpamStateConfig.get_switch_opt () with
  | Some switch ->
    let switch_config =
      OpamStateConfig.Switch.safe_load ~lock_kind:`Lock_read gt switch
    in
    let rsc =
      if is_switch_defined_var switch_config v then
        OpamPackageVar.resolve_switch_raw gt switch switch_config
          (OpamVariable.Full.of_string v)
      else None
    in
    (match rsc with
     | Some c ->
       OpamConsole.msg "%s\n" (OpamVariable.string_of_variable_contents c);
       rsc
     | None -> None)
  | None -> None

let var_show_switch gt ?st v =
  if var_switch_raw gt v = None then
    let resolve_switch st =
      if is_switch_defined_var st.switch_config v then
        var_show_t (OpamPackageVar.resolve st) gt ~switch:st.switch v
      else
        OpamConsole.error_and_exit `Not_found
          "Variable %s not found in switch %s"
          v (OpamSwitch.to_string st.switch)
    in
    match st with
    | Some st -> resolve_switch st
    | None -> OpamSwitchState.with_ `Lock_none gt resolve_switch

let var_show_global gt f = var_show_t (OpamPackageVar.resolve_global gt) gt f

let var_show gt v =
  if var_switch_raw gt v = None then
    let resolve, switch =
      match OpamStateConfig.get_switch_opt () with
      | None -> OpamPackageVar.resolve_global gt, None
      | Some switch ->
        OpamSwitchState.with_ `Lock_none ~switch gt @@ fun st ->
        let resolve = (OpamPackageVar.resolve st ?opam:None ?local:None) in
        resolve,
        if is_switch_defined_var st.switch_config v then Some st.switch else None
    in
    var_show_t resolve gt ?switch v

(* detect scope *)
let get_scope field =
  let field =
    try fst (parse_update field)
    with Invalid_argument _ -> field
  in
  let find l = OpamStd.List.find_opt (fun (f,_) -> f = field) l in
  if OpamStateConfig.get_switch_opt () <> None
  && (find OpamFile.Switch_config.fields <> None
      || find OpamFile.Switch_config.sections <> None) then
    `Switch
  else if find OpamFile.Config.fields <> None then
    `Global
  else `None field
