(*
 * Copyright (c) Meta Platforms, Inc. and affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)

module Ast = Flow_ast
open Typed_ast_utils

type 'a result =
  | FailureNoMatch
  | FailureUnparseable of Loc.t * Type.t * string
  | Success of Loc.t * 'a

let concretize_loc_pairs pair_list =
  Base.List.map ~f:(fun (loc, x) -> (ALoc.to_loc_exn loc, x)) pair_list

let sort_loc_pairs pair_list = List.sort (fun (a, _) (b, _) -> Loc.compare a b) pair_list

let result_of_normalizer_error loc scheme err =
  let msg = Ty_normalizer.error_to_string err in
  FailureUnparseable (loc, scheme.Type.TypeScheme.type_, msg)

let type_at_pos_type
    ~cx ~file ~file_sig ~omit_targ_defaults ~verbose_normalizer ~max_depth ~typed_ast loc :
    Ty.type_at_pos_result result =
  match find_type_at_pos_annotation cx typed_ast loc with
  | None -> FailureNoMatch
  | Some (loc, scheme) ->
    let genv = Ty_normalizer_env.mk_genv ~cx ~file ~file_sig ~typed_ast in
    let from_scheme evaluate_type_destructors =
      Ty_normalizer.from_scheme
        ~options:
          {
            Ty_normalizer_env.expand_internal_types = false;
            flag_shadowed_type_params = false;
            preserve_inferred_literal_types = false;
            evaluate_type_destructors;
            optimize_types = true;
            omit_targ_defaults;
            merge_bot_and_any_kinds = true;
            verbose_normalizer;
            max_depth = Some max_depth;
          }
        ~genv
        scheme
    in
    let unevaluated = from_scheme Ty_normalizer_env.EvaluateNone in
    let evaluated =
      (* We need to roll back caches and errors, because server state persists
         through IDE requests. If evaluation results in new errors, future
         requests at the same location should also result in "new" errors. *)
      Context.run_and_rolled_back_cache cx (fun () ->
          let errors = Context.errors cx in
          let evaluated = from_scheme Ty_normalizer_env.EvaluateAll in
          let errors' = Context.errors cx in
          Context.reset_errors cx errors;
          if Flow_error.ErrorSet.equal errors errors' then
            Some evaluated
          else
            None
      )
    in
    begin
      match (unevaluated, evaluated) with
      | (Ok unevaluated, Some (Ok evaluated)) ->
        Success (loc, { Ty.unevaluated; evaluated = Some evaluated })
      | (Ok unevaluated, _) -> Success (loc, { Ty.unevaluated; evaluated = None })
      | (Error err, _) -> result_of_normalizer_error loc scheme err
    end

let dump_types ~printer ~evaluate_type_destructors cx file_sig typed_ast =
  let options =
    { Ty_normalizer_env.default_options with Ty_normalizer_env.evaluate_type_destructors }
  in
  let file = Context.file cx in
  let genv = Ty_normalizer_env.mk_genv ~cx ~file ~typed_ast ~file_sig in
  let result =
    Ty_normalizer.from_schemes ~options ~genv (Typed_ast_utils.typed_ast_to_list typed_ast)
  in
  let print_ok = function
    | (l, Ok t) -> Some (l, printer t)
    | _ -> None
  in
  Base.List.filter_map result ~f:print_ok |> concretize_loc_pairs |> sort_loc_pairs

let insert_type_normalize
    ~cx ?(file = Context.file cx) ~file_sig ~omit_targ_defaults ~typed_ast loc scheme :
    Ty.elt result =
  let options =
    {
      Ty_normalizer_env.expand_internal_types = false;
      (* Shadowed type parameters won't be valid for type insertion *)
      flag_shadowed_type_params = true;
      (* We eventually want to elimitate literal types, so let's not expose them here. *)
      preserve_inferred_literal_types = false;
      (* Utility types won't are not serialized so it may be worth evaluating them away
       * if we find them in the resulting Ty.t. The trade off is that types might get
       * larger. *)
      evaluate_type_destructors = Ty_normalizer_env.EvaluateNone;
      (* Optimize types is false because Insert_types manually calls the simplifier with
         a custom comparison operation *)
      optimize_types = false;
      omit_targ_defaults;
      merge_bot_and_any_kinds = true;
      verbose_normalizer = false;
      max_depth = None;
    }
  in
  let genv = Ty_normalizer_env.mk_genv ~cx ~file ~file_sig ~typed_ast in
  match Ty_normalizer.from_scheme ~options ~genv scheme with
  | Ok elt -> Success (loc, elt)
  | Error err -> result_of_normalizer_error loc scheme err
