-- | 'tcTopNormaliseNewTypeTF_maybe' gets rid of top-level newtypes,
-- potentially looking through newtype instances.
--
-- It is only used by the type inference engine (specifically, when
-- solving representational equality), and hence it is careful to unwrap
-- only if the relevant data constructor is in scope.  That's why
-- it get a GlobalRdrEnv argument.
--
-- It is careful not to unwrap data/newtype instances if it can't
-- continue unwrapping.  Such care is necessary for proper error
-- messages.
--
-- It does not look through type families.
-- It does not normalise arguments to a tycon.
--
-- Always produces a representational coercion.
tcTopNormaliseNewTypeTF_maybe :: FamInstEnvs
                              -> GlobalRdrEnv
                              -> Type
                              -> Maybe (TcCoercion, Type)
tcTopNormaliseNewTypeTF_maybe faminsts rdr_env ty
-- cf. FamInstEnv.topNormaliseType_maybe and Coercion.topNormaliseNewType_maybe
  = topNormaliseTypeX_maybe stepper ty
  where
    stepper = unwrap_newtype `composeSteppers` unwrap_newtype_instance

    -- For newtype instances we take a double step or nothing, so that
    -- we don't return the reprsentation type of the newtype instance,
    -- which would lead to terrible error messages
    unwrap_newtype_instance rec_nts tc tys
      | Just (tc', tys', co) <- tcLookupDataFamInst_maybe faminsts tc tys
      = modifyStepResultCo (co `mkTransCo`) $
        unwrap_newtype rec_nts tc' tys'
      | otherwise = NS_Done

    unwrap_newtype rec_nts tc tys
      | data_cons_in_scope tc
      = unwrapNewTypeStepper rec_nts tc tys

      | otherwise
      = NS_Done

    data_cons_in_scope :: TyCon -> Bool
    data_cons_in_scope tc
      = isWiredInName (tyConName tc) ||
        (not (isAbstractTyCon tc) && all in_scope data_con_names)
      where
        data_con_names = map dataConName (tyConDataCons tc)
        in_scope dc    = not $ null $ lookupGRE_Name rdr_env dc

{-
************************************************************************
*                                                                      *
        Extending the family instance environment
*                                                                      *
************************************************************************
-}

-- Add new locally-defined family instances
tcTopNormaliseNewTypeTF_maybe :: FamInstEnvs
                              -> GlobalRdrEnv
                              -> Type
                              -> Maybe (TcCoercion, Type)
tcTopNormaliseNewTypeTF_maybe faminsts rdr_env ty
-- cf. FamInstEnv.topNormaliseType_maybe and Coercion.topNormaliseNewType_maybe
  = topNormaliseTypeX_maybe stepper ty
  where
    stepper = unwrap_newtype `composeSteppers` unwrap_newtype_instance

    -- For newtype instances we take a double step or nothing, so that
    -- we don't return the reprsentation type of the newtype instance,
    -- which would lead to terrible error messages
    unwrap_newtype_instance rec_nts tc tys
      | Just (tc', tys', co) <- tcLookupDataFamInst_maybe faminsts tc tys
      = modifyStepResultCo (co `mkTransCo`) $
        unwrap_newtype rec_nts tc' tys'
      | otherwise = NS_Done

    unwrap_newtype rec_nts tc tys
      | data_cons_in_scope tc
      = unwrapNewTypeStepper rec_nts tc tys

      | otherwise
      = NS_Done

    data_cons_in_scope :: TyCon -> Bool
    data_cons_in_scope tc
      = isWiredInName (tyConName tc) ||
        (not (isAbstractTyCon tc) && all in_scope data_con_names)
      where
        data_con_names = map dataConName (tyConDataCons tc)
        in_scope dc    = not $ null $ lookupGRE_Name rdr_env dc

{-
************************************************************************
*                                                                      *
        Extending the family instance environment
*                                                                      *
************************************************************************
-}

-- Add new locally-defined family instances
tcTopNormaliseNewTypeTF_maybe faminsts rdr_env ty
-- cf. FamInstEnv.topNormaliseType_maybe and Coercion.topNormaliseNewType_maybe
  = topNormaliseTypeX_maybe stepper ty
  where
    stepper = unwrap_newtype `composeSteppers` unwrap_newtype_instance

    -- For newtype instances we take a double step or nothing, so that
    -- we don't return the reprsentation type of the newtype instance,
    -- which would lead to terrible error messages
    unwrap_newtype_instance rec_nts tc tys
      | Just (tc', tys', co) <- tcLookupDataFamInst_maybe faminsts tc tys
      = modifyStepResultCo (co `mkTransCo`) $
        unwrap_newtype rec_nts tc' tys'
      | otherwise = NS_Done

    unwrap_newtype rec_nts tc tys
      | data_cons_in_scope tc
      = unwrapNewTypeStepper rec_nts tc tys

      | otherwise
      = NS_Done

    data_cons_in_scope :: TyCon -> Bool
    data_cons_in_scope tc
      = isWiredInName (tyConName tc) ||
        (not (isAbstractTyCon tc) && all in_scope data_con_names)
      where
        data_con_names = map dataConName (tyConDataCons tc)
        in_scope dc    = not $ null $ lookupGRE_Name rdr_env dc

{-
************************************************************************
*                                                                      *
        Extending the family instance environment
*                                                                      *
************************************************************************
-}

-- Add new locally-defined family instances