(**
 * Copyright (c) 2013-present, Facebook, Inc.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)
open Utils_js
open Type
open Reason
open Flow_js

type ('success, 'success_module) generic_t =
  | Success of 'success
  | SuccessModule of 'success_module
  | FailureNullishType
  | FailureAnyType
  | FailureUnhandledType of Type.t

type t = (
  (* Success *) (ALoc.t option * Type.t) SMap.t,
  (* SuccessModule *) (ALoc.t option * Type.t) SMap.t * (Type.t option)
) generic_t

let rec merge_type cx =
  let create_union rep =
    DefT (locationless_reason (RCustom "union"), UnionT rep)
  in

  function
  | DefT (_, NumT _), (DefT (_, NumT _) as t)
  | DefT (_, StrT _), (DefT (_, StrT _) as t)
  | DefT (_, BoolT _), (DefT (_, BoolT _) as t)
  | DefT (_, NullT), (DefT (_, NullT) as t)
  | DefT (_, VoidT), (DefT (_, VoidT) as t)
    -> t

  | (ObjProtoT _, (ObjProtoT _ as t))
     -> t

  | DefT (_, AnyT _), t | t, DefT (_, AnyT _) -> t

  | DefT (_, EmptyT), t | t, DefT (_, EmptyT) -> t
  | _, (DefT (_, MixedT _) as t) | (DefT (_, MixedT _) as t), _ -> t

  | DefT (_, NullT), (DefT (_, MaybeT _) as t) | (DefT (_, MaybeT _) as t), DefT (_, NullT)
  | DefT (_, VoidT), (DefT (_, MaybeT _) as t) | (DefT (_, MaybeT _) as t), DefT (_, VoidT)
    -> t

  | (DefT (_, FunT (_,_,ft1)) as fun1), (DefT (_, FunT (_,_,ft2)) as fun2) ->
      (* Functions with different number of parameters cannot be merged into a
       * single function type. Instead, we should turn them into a union *)
      let params =
        if List.length ft1.params <> List.length ft2.params then None else
        let params = List.map2 (fun (name1, t1) (name2, t2) ->
          (* TODO: How to merge param names? *)
          let name = match name1, name2 with
          | None, None -> None
          | Some name, _
          | _, Some name -> Some name
          in
          name, merge_type cx (t1, t2)
        ) ft1.params ft2.params in
        match ft1.rest_param, ft2.rest_param with
        | None, Some _
        | Some _, None -> None
        | None, None -> Some (params, None)
        | Some r1, Some r2 -> Some (params, Some (r1, r2))
      in
      begin match params with
      | None -> create_union (UnionRep.make fun1 fun2 [])
      | Some (params, rest_params) ->
          let params_names, tins = List.split params in
          let rest_param = match rest_params with
          | None -> None
          | Some ((name1, loc, rest_t1), (name2, _, rest_t2)) ->
            (* TODO: How to merge rest names and locs? *)
            let name = match name1, name2 with
            | None, None -> None
            | Some name, _
            | _, Some name -> Some name in
            Some (name, loc, merge_type cx (rest_t1, rest_t2))
          in
          let tout = merge_type cx (ft1.return_t, ft2.return_t) in
          let reason = locationless_reason (RCustom "function") in
          DefT (reason, FunT (
            dummy_static reason,
            dummy_prototype,
            mk_functiontype reason tins tout ~rest_param
              ~def_reason:reason ~params_names
          ))
      end

  | (DefT (_, ObjT o1) as t1), (DefT (_, ObjT o2) as t2) ->
    let map1 = Context.find_props cx o1.props_tmap in
    let map2 = Context.find_props cx o2.props_tmap in

    (* Create an intermediate map of booleans indicating whether two objects can
     * be merged, based on the properties in each map. *)
    let merge_map = SMap.merge (fun _ p1_opt p2_opt ->
      match p1_opt, p2_opt with
      | None, None -> None
      (* In general, even objects with disjoint key sets can not be merged due
       * to width subtyping. For example, {x:T} and {y:U} is not the same as
       * {x:T,y:U}, because {x,y} is a valid inhabitant of {x:T} and the type of
       * y may != U. However, if either object type is exact, disjointness is
       * sufficient. *)
      | Some _, None | None, Some _ -> Some (o1.flags.exact || o2.flags.exact)
      (* Covariant fields can be merged. *)
      | Some (Field (_, _, Positive)), Some (Field (_, _, Positive)) -> Some true
      (* Getters are covariant and thus can be merged. *)
      | Some (Get _), Some (Get _) -> Some true
      (* Anything else is can't be merged. *)
      | _ -> Some false
    ) map1 map2 in

    let merge_dict = match o1.dict_t, o2.dict_t with
    (* If neither object has an indexer, neither will the merged object. *)
    | None, None -> Some None
    (* If both objects covariant indexers, we can merge them. However, if the
     * key types are disjoint, the resulting dictionary is not useful. *)
    | Some {key = k1; value = v1; dict_polarity = Positive; _},
      Some {key = k2; value = v2; dict_polarity = Positive; _} ->
      (* TODO: How to merge indexer names? *)
      Some (Some {
        dict_name = None;
        key = create_intersection (InterRep.make k1 k2 []);
        value = merge_type cx (v1, v2);
        dict_polarity = Positive;
      })
    (* Don't merge objects with possibly incompatible indexers. *)
    | _ -> None
    in

    let merge_call = match o1.call_t, o2.call_t with
    | None, None -> Some None
    | Some _, None -> if o2.flags.exact then Some o1.call_t else None
    | None, Some _ -> if o1.flags.exact then Some o2.call_t else None
    | Some id1, Some id2 ->
      let c1 = Context.find_call cx id1 in
      let c2 = Context.find_call cx id2 in
      let id = Context.make_call_prop cx (create_union (UnionRep.make c1 c2 [])) in
      Some (Some id)
    in

    (* Only merge objects if every property can be merged. *)
    let should_merge = SMap.for_all (fun _ x -> x) merge_map in

    (* Don't merge objects with different prototypes. *)
    let should_merge = should_merge && o1.proto_t = o2.proto_t in

    (match should_merge, merge_dict, merge_call with
    | true, Some dict, Some call ->
      let map = SMap.merge (fun _ p1_opt p2_opt ->
        match p1_opt, p2_opt with
        (* Merge disjoint+exact objects. *)
        | Some t, None
        | None, Some t -> Some t
        (* Shouldn't happen, per merge_map above. *)
        | _ -> None
      ) map1 map2 in
      let id = Context.make_property_map cx map in
      let sealed = match o1.flags.sealed, o2.flags.sealed with
      | Sealed, Sealed -> Sealed
      | UnsealedInFile s1, UnsealedInFile s2 when s1 = s2 -> UnsealedInFile s1
      | _ -> UnsealedInFile None
      in
      let flags = {
        sealed;
        exact = o1.flags.exact && o2.flags.exact;
        frozen = o1.flags.frozen && o2.flags.frozen;
      } in
      let reason = locationless_reason (RCustom "object") in
      mk_object_def_type ~reason ~flags ~dict ~call id o1.proto_t
    | _ ->
      create_union (UnionRep.make t1 t2 []))

  | DefT (_, ArrT (ArrayAT (t1, ts1))),
    DefT (_, ArrT (ArrayAT (t2, ts2))) ->
    let tuple_types = match ts1, ts2 with
      | None, _
      | _, None -> None
      | Some ts1, Some ts2 -> Some (Core_list.map2_exn ~f:(merge_type cx |> curry) ts1 ts2) in

    DefT (locationless_reason (RCustom "array"),
      ArrT (ArrayAT( merge_type cx (t1, t2), tuple_types))
    )

  | DefT (_, ArrT (TupleAT (t1, ts1))),
    DefT (_, ArrT (TupleAT(t2, ts2))) when List.length ts1 = List.length ts2 ->

    DefT (locationless_reason (RCustom "tuple"),
      ArrT (TupleAT (merge_type cx (t1, t2),
        Core_list.map2_exn ~f:(merge_type cx |> curry) ts1 ts2)))

  | DefT (_, ArrT (ROArrayAT elemt1)),
    DefT (_, ArrT (ROArrayAT elemt2)) ->

    DefT (locationless_reason (RCustom "read only array"),
      ArrT (ROArrayAT (merge_type cx (elemt1, elemt2)))
    )

  | (DefT (_, MaybeT t1), DefT (_, MaybeT t2))
  | (DefT (_, MaybeT t1), t2)
  | (t1, DefT (_, MaybeT t2)) ->
      let t = merge_type cx (t1, t2) in
      let reason = locationless_reason (RMaybe (desc_of_t t)) in
      DefT (reason, MaybeT t)

  | DefT (_, UnionT rep1), DefT (_, UnionT rep2) ->
      create_union (UnionRep.rev_append rep1 rep2)

  | (DefT (_, UnionT rep), t)
  | (t, DefT (_, UnionT rep)) ->
      create_union (UnionRep.cons t rep)

  (* TODO: do we need to do anything special for merging Null with Void,
     Optional with other types, etc.? *)

  | (t1, t2) ->
      create_union (UnionRep.make t1 t2 [])

let instantiate_poly_t cx t = function
  | None -> (* nothing to do *) t
  | Some types -> match t with
      | DefT (_, PolyT (_, type_params, t_, _)) -> (
        try
          let subst_map = List.fold_left2 (fun acc {name; _} type_ ->
            SMap.add name type_ acc
          ) SMap.empty (Nel.to_list type_params) types in
          subst cx subst_map t_
        with _ ->
          prerr_endline "Instantiating poly type failed";
          t
      )
      | DefT (_, EmptyT)
      | DefT (_, MixedT _)
      | DefT (_, AnyT _)
      | DefT (_, (TypeT (_, DefT (_, AnyT _)))) ->
          t
      | _ ->
        assert_false ("unexpected args passed to instantiate_poly_t: " ^ (string_of_ctor t))

let intersect_members cx members =
  match members with
  | [] -> SMap.empty
  | _ ->
      let map = SMap.map (fun x -> [x]) (List.hd members) in
      let map = List.fold_left (fun acc x ->
          SMap.merge (fun _ tl t ->
              match (tl, t) with
              | (None, None)      -> None
              | (None, Some _)    -> None
              | (Some _, None)    -> None
              | (Some tl, Some t) -> Some (t :: tl)
            ) acc x
        ) map (List.tl members) in
      SMap.map (List.fold_left (fun (_, acc) (loc, t) ->
          (* Arbitrarily use the last location encountered *)
          loc, merge_type cx (acc, t)
      ) (None, Locationless.EmptyT.t)) map

and instantiate_type = function
  | ThisClassT (_, t) | DefT (_, ClassT t)
  | (DefT (_, AnyT _) as t) | DefT(_, TypeT (_, t)) | (DefT (_, EmptyT) as t) -> t
  | t -> "cannot instantiate non-class type " ^ string_of_ctor t |> assert_false

let possible_types_of_use cx = function
  | UseT (_, t) -> possible_types_of_type cx t
  | _ -> []

let string_of_extracted_type = function
  | Success t -> Printf.sprintf "Success (%s)" (Type.string_of_ctor t)
  | SuccessModule t -> Printf.sprintf "SuccessModule (%s)" (Type.string_of_ctor t)
  | FailureNullishType -> "FailureNullishType"
  | FailureAnyType -> "FailureAnyType"
  | FailureUnhandledType t -> Printf.sprintf "FailureUnhandledType (%s)" (Type.string_of_ctor t)

let to_command_result_aloc = function
  | Success map
  | SuccessModule (map, None) ->
      Ok map
  | SuccessModule (named_exports, Some cjs_export) ->
      Ok (SMap.add "default" (None, cjs_export) named_exports)
  | FailureNullishType ->
      Error "autocomplete on possibly null or undefined value"
  | FailureAnyType ->
      Error "not enough type information to autocomplete"
  | FailureUnhandledType t ->
      Error (spf
        "autocomplete on unexpected type of value %s (please file a task!)"
        (string_of_ctor t))

let loc_tmap_of_aloc_tmap = Option.map ~f:ALoc.to_loc |> map_fst |> SMap.map

let to_command_result = to_command_result_aloc %> Core_result.map ~f:loc_tmap_of_aloc_tmap

let find_props cx =
  Context.find_props cx %> SMap.filter (fun key _ ->
    (* Filter out keys that start with "$" *)
    not (String.length key >= 1 && key.[0] = '$'))

let resolve_tvar cx (_, id) =
  let ts = possible_types cx id in
  (* The list of types returned by possible_types is often empty, and the
     most common reason is that we don't have enough type coverage to
     resolve id. Thus, we take the unit of merging to be `any`. (Something
     similar happens when summarizing exports in ContextOptimizer.)

     In the future, we might report errors in some cases where
     possible_types returns an empty list: e.g., when we detect unreachable
     code, or even we don't have enough type coverage. Irrespective of these
     changes, the above decision would continue to make sense: as errors
     become stricter, type resolution should become even more lenient to
     improve failure tolerance.  *)
  List.fold_left (fun u t ->
    merge_type cx (t, u)
  ) (locationless_reason RAny |> Unsoundness.unresolved_any) ts

let rec resolve_type cx = function
  | OpenT tvar -> resolve_tvar cx tvar |> resolve_type cx
  | AnnotT (_, t, _) -> resolve_type cx t
  | MergedT (_, uses) ->
      begin match Core_list.(uses >>= possible_types_of_use cx) with
      (* The unit of intersection is normally mixed, but MergedT is hacky and empty
      fits better here *)
      | [] -> locationless_reason REmpty |> EmptyT.make
      | [x] -> x
      | x::y::ts -> InterRep.make x y ts |> create_intersection
      end
  | t -> t

let resolve_builtin_class cx ?trace = function
  | DefT (reason, BoolT _) ->
    get_builtin_type cx ?trace reason "Boolean" |> resolve_type cx
  | DefT (reason, NumT _) ->
    get_builtin_type cx ?trace reason "Number"  |> resolve_type cx
  | DefT (reason, StrT _) ->
    get_builtin_type cx ?trace reason "String"  |> resolve_type cx
  | DefT (reason, ArrT arrtype) ->
    let builtin, elemt = match arrtype with
    | ArrayAT (elemt, _) -> get_builtin cx ?trace "Array" reason, elemt
    | TupleAT (elemt, _)
    | ROArrayAT (elemt) -> get_builtin cx ?trace "$ReadOnlyArray" reason, elemt
    in
    let array_t = resolve_type cx builtin in
    Some [elemt] |> instantiate_poly_t cx array_t |> instantiate_type
  | t -> t

let rec extract_type cx this_t = match this_t with
  | DefT (_, MaybeT ty) ->
      extract_type cx ty
  | DefT (_, (NullT | VoidT))
  | InternalT (OptionalChainVoidT _) ->
      FailureNullishType
  | DefT (_, AnyT _) ->
      FailureAnyType
  | AnnotT (_, source_t, _) ->
    let source_t = resolve_type cx source_t in
    extract_type cx source_t
  | DefT (_, InstanceT _ ) as t ->
      Success t
  | DefT (_, ObjT _) as t ->
      Success t
  | ExactT (_, t) ->
      let t = resolve_type cx t in
      extract_type cx t
  | ModuleT _ as t ->
      SuccessModule t
  | ThisTypeAppT (_, c, _, ts_opt) ->
      let c = resolve_type cx c in
      let inst_t = instantiate_poly_t cx c ts_opt in
      let inst_t = instantiate_type inst_t in
      extract_type cx inst_t
  | DefT (_, TypeAppT (_, c, ts)) ->
      let c = resolve_type cx c in
      let inst_t = instantiate_poly_t cx c (Some ts) in
      let inst_t = instantiate_type inst_t in
      extract_type cx inst_t
  | DefT (_, PolyT (_, _, sub_type, _)) ->
      (* TODO: replace type parameters with stable/proper names? *)
      extract_type cx sub_type
  | ThisClassT (_, DefT (_, InstanceT (static, _, _, _)))
  | DefT (_, ClassT (DefT (_, InstanceT (static, _, _, _)))) ->
      let static_t = resolve_type cx static in
      extract_type cx static_t
  | DefT (_, FunT _) as t ->
      Success t
  | DefT (_, IntersectionT _ ) as t ->
      Success  t
  | DefT (_, UnionT _ ) as t ->
      Success t
  | DefT (reason, SingletonStrT _)
  | DefT (reason, StrT _) ->
      get_builtin_type cx reason "String"  |> extract_type cx
  | DefT (reason, SingletonNumT _)
  | DefT (reason, NumT _) ->
      get_builtin_type cx reason "Number"  |> extract_type cx
  | DefT (reason, SingletonBoolT _)
  | DefT (reason, BoolT _) ->
      get_builtin_type cx reason "Boolean" |> extract_type cx

  | DefT (reason, CharSetT _) ->
      get_builtin_type cx reason "String"  |> extract_type cx

  | DefT (_, IdxWrapper t) ->
      let t = resolve_type cx t in
      extract_type cx t

  | DefT (_, ReactAbstractComponentT _) as t ->
      Success t

  | ReposT (_, t)
  | InternalT (ReposUpperT (_, t)) ->
      extract_type cx t

  | OpaqueT (_, {underlying_t = Some t; _})
  | OpaqueT (_, {super_t = Some t; _})
    -> extract_type cx t

  | AnyWithLowerBoundT _
  | AnyWithUpperBoundT _
  | MergedT _
  | DefT (_, ArrT _)
  | BoundT _
  | InternalT (ChoiceKitT (_, _))
  | TypeDestructorTriggerT _
  | DefT (_, ClassT _)
  | CustomFunT (_, _)
  | MatchingPropT (_, _, _)
  | DefT (_, EmptyT)
  | EvalT (_, _, _)
  | ExistsT _
  | InternalT (ExtendsT _)
  | FunProtoApplyT _
  | FunProtoBindT _
  | FunProtoCallT _
  | FunProtoT _
  | KeysT (_, _)
  | DefT (_, MixedT _)
  | NullProtoT _
  | ObjProtoT _
  | OpaqueT _
  | OpenPredT (_, _, _, _)
  | OpenT _
  | DefT (_, OptionalT _)
  | ShapeT _
  | ThisClassT _
  | DefT (_, TypeT _)
    ->
      FailureUnhandledType this_t

let rec extract_members ?(exclude_proto_members=false) cx = function
  | FailureNullishType -> FailureNullishType
  | FailureAnyType -> FailureAnyType
  | FailureUnhandledType t -> FailureUnhandledType t
  | Success (DefT (_, InstanceT (_, super, _, {own_props; proto_props; _}))) ->
      let members = SMap.fold (fun x p acc ->
        (* TODO: It isn't currently possible to return two types for a given
         * property in autocomplete, so for now we just return the getter
         * type. *)
        let loc, t = match p with
          | Field (loc, t, _)
          | Get (loc, t)
          | Set (loc, t)
          (* arbitrarily use the location for the getter. maybe we can send both in the future *)
          | GetSet (loc, t, _, _)
          | Method (loc, t) ->
              (loc, t)
        in
        SMap.add x (loc, t) acc
      ) (find_props cx own_props) SMap.empty in
      if exclude_proto_members then Success members
      else
        (* TODO: own props should take precedence *)
        let members = SMap.fold (fun x p acc ->
            match Property.read_t p with
            | Some t ->
                let loc = Property.read_loc p in
                SMap.add x (loc, t) acc
            | None -> acc
          ) (find_props cx proto_props) members
        in
        let super_t = resolve_type cx super in
        let super_flds = extract_members_as_map ~exclude_proto_members cx super_t in
        Success (AugmentableSMap.augment super_flds ~with_bindings:members)
  | Success (DefT (_, ObjT {props_tmap = flds; proto_t = proto; _})) ->
      let proto_reason = reason_of_t proto in
      let rep = InterRep.make
        proto
        (get_builtin_type cx proto_reason "Object")
        []
      in
      let proto_t = resolve_type cx (DefT (proto_reason, IntersectionT rep)) in
      let prot_members =
        if exclude_proto_members then SMap.empty
        else extract_members_as_map ~exclude_proto_members cx proto_t
      in
      let members = SMap.fold (fun x p acc ->
        match Property.read_t p with
        | Some t ->
            let loc = Property.read_loc p in
            SMap.add x (loc, t) acc
        | None -> acc
      ) (find_props cx flds) SMap.empty in
      Success (AugmentableSMap.augment prot_members ~with_bindings:members)
  | SuccessModule (ModuleT (_, {exports_tmap; cjs_export; has_every_named_export = _;}, _)) ->
      let named_exports = Context.find_exports cx exports_tmap in
      let cjs_export =
        match cjs_export with
        | Some t -> Some (resolve_type cx t)
        | None -> None
      in
      SuccessModule (named_exports, cjs_export)
  | Success (DefT (_, FunT (static, proto, _))) ->
      let static_t = resolve_type cx static in
      let proto_t = resolve_type cx proto in
      let members = extract_members_as_map ~exclude_proto_members cx static_t in
      let prot_members = extract_members_as_map ~exclude_proto_members cx proto_t in
      Success (AugmentableSMap.augment prot_members ~with_bindings:members)
  | Success (DefT (_, IntersectionT rep)) ->
      (* Intersection type should autocomplete for every property of
         every type in the intersection *)
      let ts = InterRep.members rep in
      let ts = Core_list.map ~f:(resolve_type cx) ts in
      let members = Core_list.map ~f:(extract_members_as_map ~exclude_proto_members cx) ts in
      Success (List.fold_left (fun acc members ->
        AugmentableSMap.augment acc ~with_bindings:members
      ) SMap.empty members)
  | Success (DefT (_, UnionT rep)) ->
      (* Union type should autocomplete for only the properties that are in
      * every type in the intersection *)
      let ts = Core_list.map ~f:(resolve_type cx) (UnionRep.members rep) in
      let members = ts
        (* Although we'll ignore the any-ish and nullish members of the union *)
        |> List.filter (function
           | DefT (_, (AnyT _ | NullT | VoidT)) -> false
           | _ -> true
           )
        |> Core_list.map ~f:(extract_members_as_map ~exclude_proto_members cx)
        |> intersect_members cx in
      Success members
  | Success t | SuccessModule t ->
      FailureUnhandledType t

and extract ?exclude_proto_members cx = extract_type cx %> extract_members ?exclude_proto_members cx

and extract_members_as_map ~exclude_proto_members cx this_t =
  match extract ~exclude_proto_members cx this_t |> to_command_result_aloc with
  | Ok map -> map
  | Error _ -> SMap.empty
