    {-# LANGUAGE TemplateHaskellQuotes #-}
    {-# LANGUAGE Unsafe #-}

    {-|
    Module:      Data.Bifunctor.TH.Internal
    Copyright:   (C) 2008-2016 Edward Kmett, (C) 2015-2016 Ryan Scott
    License:     BSD-style (see the file LICENSE)
    Maintainer:  Edward Kmett
    Portability: Template Haskell

    Template Haskell-related utilities.
    -}
    module Data.Bifunctor.TH.Internal where

    import           Control.Applicative
    import           Data.Bifunctor (Bifunctor(..))
    import           Data.Bifoldable (Bifoldable(..))
    import           Data.Bitraversable (Bitraversable(..))
    import           Data.Coerce (coerce)
    import           Data.Foldable (foldr')
    import qualified Data.List as List
    import qualified Data.Map as Map (singleton)
    import           Data.Map (Map)
    import           Data.Maybe (fromMaybe, mapMaybe)
    import           Data.Monoid (Dual(..), Endo(..))
    import qualified Data.Set as Set
    import           Data.Set (Set)

    import           Language.Haskell.TH.Datatype
    import           Language.Haskell.TH.Lib
    import           Language.Haskell.TH.Syntax

    -------------------------------------------------------------------------------
    -- Expanding type synonyms
    -------------------------------------------------------------------------------

    applySubstitutionKind :: Map Name Kind -> Type -> Type
    applySubstitutionKind :: Map Name Kind -> Kind -> Kind
    applySubstitutionKind = Map Name Kind -> Kind -> Kind
    forall a. TypeSubstitution a => Map Name Kind -> a -> a
    applySubstitution

    substNameWithKind :: Name -> Kind -> Type -> Type
    substNameWithKind :: Name -> Kind -> Kind -> Kind
    substNameWithKind Name
    n Kind
    k = Map Name Kind -> Kind -> Kind
    applySubstitutionKind (Name -> Kind -> Map Name Kind
    forall k a. k -> a -> Map k a
    Map.singleton Name
    n Kind
    k)

    substNamesWithKindStar :: [Name] -> Type -> Type
    substNamesWithKindStar :: [Name] -> Kind -> Kind
    substNamesWithKindStar [Name]
    ns Kind
    t = (Name -> Kind -> Kind) -> Kind -> [Name] -> Kind
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr' ((Name -> Kind -> Kind -> Kind) -> Kind -> Name -> Kind -> Kind
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Name -> Kind -> Kind -> Kind
    substNameWithKind Kind
    starK) Kind
    t [Name]
    ns

    -------------------------------------------------------------------------------
    -- Type-specialized const functions
    -------------------------------------------------------------------------------

    bimapConst :: p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
    bimapConst :: forall (p :: * -> * -> *) b d a c.
    p b d -> (a -> b) -> (c -> d) -> p a c -> p b d
    bimapConst = ((c -> d) -> p a c -> p b d)
    -> (a -> b) -> (c -> d) -> p a c -> p b d
    forall a b. a -> b -> a
    const (((c -> d) -> p a c -> p b d)
     -> (a -> b) -> (c -> d) -> p a c -> p b d)
    -> (p b d -> (c -> d) -> p a c -> p b d)
    -> p b d
    -> (a -> b)
    -> (c -> d)
    -> p a c
    -> p b d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p a c -> p b d) -> (c -> d) -> p a c -> p b d
    forall a b. a -> b -> a
    const ((p a c -> p b d) -> (c -> d) -> p a c -> p b d)
    -> (p b d -> p a c -> p b d) -> p b d -> (c -> d) -> p a c -> p b d
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . p b d -> p a c -> p b d
    forall a b. a -> b -> a
    const
    {-# INLINE bimapConst #-}

    bifoldrConst :: c -> (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
    bifoldrConst :: forall c a b (p :: * -> * -> *).
    c -> (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
    bifoldrConst = ((b -> c -> c) -> c -> p a b -> c)
    -> (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
    forall a b. a -> b -> a
    const (((b -> c -> c) -> c -> p a b -> c)
     -> (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c)
    -> (c -> (b -> c -> c) -> c -> p a b -> c)
    -> c
    -> (a -> c -> c)
    -> (b -> c -> c)
    -> c
    -> p a b
    -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (c -> p a b -> c) -> (b -> c -> c) -> c -> p a b -> c
    forall a b. a -> b -> a
    const ((c -> p a b -> c) -> (b -> c -> c) -> c -> p a b -> c)
    -> (c -> c -> p a b -> c) -> c -> (b -> c -> c) -> c -> p a b -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p a b -> c) -> c -> p a b -> c
    forall a b. a -> b -> a
    const ((p a b -> c) -> c -> p a b -> c)
    -> (c -> p a b -> c) -> c -> c -> p a b -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . c -> p a b -> c
    forall a b. a -> b -> a
    const
    {-# INLINE bifoldrConst #-}

    bifoldMapConst :: m -> (a -> m) -> (b -> m) -> p a b -> m
    bifoldMapConst :: forall m a b (p :: * -> * -> *).
    m -> (a -> m) -> (b -> m) -> p a b -> m
    bifoldMapConst = ((b -> m) -> p a b -> m) -> (a -> m) -> (b -> m) -> p a b -> m
    forall a b. a -> b -> a
    const (((b -> m) -> p a b -> m) -> (a -> m) -> (b -> m) -> p a b -> m)
    -> (m -> (b -> m) -> p a b -> m)
    -> m
    -> (a -> m)
    -> (b -> m)
    -> p a b
    -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (p a b -> m) -> (b -> m) -> p a b -> m
    forall a b. a -> b -> a
    const ((p a b -> m) -> (b -> m) -> p a b -> m)
    -> (m -> p a b -> m) -> m -> (b -> m) -> p a b -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m -> p a b -> m
    forall a b. a -> b -> a
    const
    {-# INLINE bifoldMapConst #-}

    bitraverseConst :: f (t c d) -> (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
    bitraverseConst :: forall (f :: * -> *) (t :: * -> * -> *) c d a b.
    f (t c d) -> (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
    bitraverseConst = ((b -> f d) -> t a b -> f (t c d))
    -> (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
    forall a b. a -> b -> a
    const (((b -> f d) -> t a b -> f (t c d))
     -> (a -> f c) -> (b -> f d) -> t a b -> f (t c d))
    -> (f (t c d) -> (b -> f d) -> t a b -> f (t c d))
    -> f (t c d)
    -> (a -> f c)
    -> (b -> f d)
    -> t a b
    -> f (t c d)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (t a b -> f (t c d)) -> (b -> f d) -> t a b -> f (t c d)
    forall a b. a -> b -> a
    const ((t a b -> f (t c d)) -> (b -> f d) -> t a b -> f (t c d))
    -> (f (t c d) -> t a b -> f (t c d))
    -> f (t c d)
    -> (b -> f d)
    -> t a b
    -> f (t c d)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . f (t c d) -> t a b -> f (t c d)
    forall a b. a -> b -> a
    const
    {-# INLINE bitraverseConst #-}

    -------------------------------------------------------------------------------
    -- StarKindStatus
    -------------------------------------------------------------------------------

    -- | Whether a type is not of kind *, is of kind *, or is a kind variable.
    data StarKindStatus = NotKindStar
                        | KindStar
                        | IsKindVar Name
      deriving StarKindStatus -> StarKindStatus -> Bool
    (StarKindStatus -> StarKindStatus -> Bool)
    -> (StarKindStatus -> StarKindStatus -> Bool) -> Eq StarKindStatus
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StarKindStatus -> StarKindStatus -> Bool
    == :: StarKindStatus -> StarKindStatus -> Bool
    $c/= :: StarKindStatus -> StarKindStatus -> Bool
    /= :: StarKindStatus -> StarKindStatus -> Bool
    Eq

    -- | Does a Type have kind * or k (for some kind variable k)?
    canRealizeKindStar :: Type -> StarKindStatus
    canRealizeKindStar :: Kind -> StarKindStatus
    canRealizeKindStar Kind
    t
      | Kind -> Bool
    hasKindStar Kind
    t = StarKindStatus
    KindStar
      | Bool
    otherwise = case Kind
    t of
                         SigT Kind
    _ (VarT Name
    k) -> Name -> StarKindStatus
    IsKindVar Name
    k
                         Kind
    _               -> StarKindStatus
    NotKindStar

    -- | Returns 'Just' the kind variable 'Name' of a 'StarKindStatus' if it exists.
    -- Otherwise, returns 'Nothing'.
    starKindStatusToName :: StarKindStatus -> Maybe Name
    starKindStatusToName :: StarKindStatus -> Maybe Name
    starKindStatusToName (IsKindVar Name
    n) = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
    starKindStatusToName StarKindStatus
    _             = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Concat together all of the StarKindStatuses that are IsKindVar and extract
    -- the kind variables' Names out.
    catKindVarNames :: [StarKindStatus] -> [Name]
    catKindVarNames :: [StarKindStatus] -> [Name]
    catKindVarNames = (StarKindStatus -> Maybe Name) -> [StarKindStatus] -> [Name]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe StarKindStatus -> Maybe Name
    starKindStatusToName

    -------------------------------------------------------------------------------
    -- Assorted utilities
    -------------------------------------------------------------------------------

    -- filterByList, filterByLists, and partitionByList taken from GHC (BSD3-licensed)

    -- | 'filterByList' takes a list of Bools and a list of some elements and
    -- filters out these elements for which the corresponding value in the list of
    -- Bools is False. This function does not check whether the lists have equal
    -- length.
    filterByList :: [Bool] -> [a] -> [a]
    filterByList :: forall a. [Bool] -> [a] -> [a]
    filterByList (Bool
    True:[Bool]
    bs)  (a
    x:[a]
    xs) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a]
    filterByList [Bool]
    bs [a]
    xs
    filterByList (Bool
    False:[Bool]
    bs) (a
    _:[a]
    xs) =     [Bool] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a]
    filterByList [Bool]
    bs [a]
    xs
    filterByList [Bool]
    _          [a]
    _      = []

    -- | 'filterByLists' takes a list of Bools and two lists as input, and
    -- outputs a new list consisting of elements from the last two input lists. For
    -- each Bool in the list, if it is 'True', then it takes an element from the
    -- former list. If it is 'False', it takes an element from the latter list.
    -- The elements taken correspond to the index of the Bool in its list.
    -- For example:
    --
    -- @
    -- filterByLists [True, False, True, False] \"abcd\" \"wxyz\" = \"axcz\"
    -- @
    --
    -- This function does not check whether the lists have equal length.
    filterByLists :: [Bool] -> [a] -> [a] -> [a]
    filterByLists :: forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists (Bool
    True:[Bool]
    bs)  (a
    x:[a]
    xs) (a
    _:[a]
    ys) = a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    bs [a]
    xs [a]
    ys
    filterByLists (Bool
    False:[Bool]
    bs) (a
    _:[a]
    xs) (a
    y:[a]
    ys) = a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [Bool] -> [a] -> [a] -> [a]
    forall a. [Bool] -> [a] -> [a] -> [a]
    filterByLists [Bool]
    bs [a]
    xs [a]
    ys
    filterByLists [Bool]
    _          [a]
    _      [a]
    _      = []

    -- | 'partitionByList' takes a list of Bools and a list of some elements and
    -- partitions the list according to the list of Bools. Elements corresponding
    -- to 'True' go to the left; elements corresponding to 'False' go to the right.
    -- For example, @partitionByList [True, False, True] [1,2,3] == ([1,3], [2])@
    -- This function does not check whether the lists have equal
    -- length.
    partitionByList :: [Bool] -> [a] -> ([a], [a])
    partitionByList :: forall a. [Bool] -> [a] -> ([a], [a])
    partitionByList = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    forall {a}. [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [] []
      where
        go :: [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [a]
    trues [a]
    falses (Bool
    True  : [Bool]
    bs) (a
    x : [a]
    xs) = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    trues) [a]
    falses [Bool]
    bs [a]
    xs
        go [a]
    trues [a]
    falses (Bool
    False : [Bool]
    bs) (a
    x : [a]
    xs) = [a] -> [a] -> [Bool] -> [a] -> ([a], [a])
    go [a]
    trues (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    falses) [Bool]
    bs [a]
    xs
        go [a]
    trues [a]
    falses [Bool]
    _ [a]
    _ = ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    trues, [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    falses)

    -- | Returns True if a Type has kind *.
    hasKindStar :: Type -> Bool
    hasKindStar :: Kind -> Bool
    hasKindStar VarT{}         = Bool
    True
    hasKindStar (SigT Kind
    _ Kind
    StarT) = Bool
    True
    hasKindStar Kind
    _              = Bool
    False

    -- Returns True is a kind is equal to *, or if it is a kind variable.
    isStarOrVar :: Kind -> Bool
    isStarOrVar :: Kind -> Bool
    isStarOrVar Kind
    StarT  = Bool
    True
    isStarOrVar VarT{} = Bool
    True
    isStarOrVar Kind
    _      = Bool
    False

    -- | @hasKindVarChain n kind@ Checks if @kind@ is of the form
    -- k_0 -> k_1 -> ... -> k_(n-1), where k0, k1, ..., and k_(n-1) can be * or
    -- kind variables.
    hasKindVarChain :: Int -> Type -> Maybe [Name]
    hasKindVarChain :: Int -> Kind -> Maybe [Name]
    hasKindVarChain Int
    kindArrows Kind
    t =
      let uk :: [Kind]
    uk = Kind -> [Kind]
    uncurryKind (Kind -> Kind
    tyKind Kind
    t)
      in if ([Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    uk Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    kindArrows) Bool -> Bool -> Bool
    && (Kind -> Bool) -> [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Kind -> Bool
    isStarOrVar [Kind]
    uk
            then [Name] -> Maybe [Name]
    forall a. a -> Maybe a
    Just ([Kind] -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables [Kind]
    uk)
            else Maybe [Name]
    forall a. Maybe a
    Nothing

    -- | If a Type is a SigT, returns its kind signature. Otherwise, return *.
    tyKind :: Type -> Kind
    tyKind :: Kind -> Kind
    tyKind (SigT Kind
    _ Kind
    k) = Kind
    k
    tyKind Kind
    _          = Kind
    starK

    -- | A mapping of type variable Names to their map function Names. For example, in a
    -- Bifunctor declaration, a TyVarMap might look like (a ~> f, b ~> g), where
    -- a and b are the last two type variables of the datatype, and f and g are the two
    -- functions which map their respective type variables.
    type TyVarMap = Map Name Name

    thd3 :: (a, b, c) -> c
    thd3 :: forall a b c. (a, b, c) -> c
    thd3 (a
    _, b
    _, c
    c) = c
    c

    unsnoc :: [a] -> Maybe ([a], a)
    unsnoc :: forall a. [a] -> Maybe ([a], a)
    unsnoc []     = Maybe ([a], a)
    forall a. Maybe a
    Nothing
    unsnoc (a
    x:[a]
    xs) = case [a] -> Maybe ([a], a)
    forall a. [a] -> Maybe ([a], a)
    unsnoc [a]
    xs of
                      Maybe ([a], a)
    Nothing    -> ([a], a) -> Maybe ([a], a)
    forall a. a -> Maybe a
    Just ([], a
    x)
                      Just ([a]
    a,a
    b) -> ([a], a) -> Maybe ([a], a)
    forall a. a -> Maybe a
    Just (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    a, a
    b)

    -- | Generate a list of fresh names with a common prefix, and numbered suffixes.
    newNameList :: String -> Int -> Q [Name]
    newNameList :: String -> Int -> Q [Name]
    newNameList String
    prefix Int
    n = (Int -> Q Name) -> [Int] -> Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (String -> Q Name) -> (Int -> String) -> Int -> Q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [Int
    1..Int
    n]

    -- | Applies a typeclass constraint to a type.
    applyClass :: Name -> Name -> Pred
    applyClass :: Name -> Name -> Kind
    applyClass Name
    con Name
    t = Kind -> Kind -> Kind
    AppT (Name -> Kind
    ConT Name
    con) (Name -> Kind
    VarT Name
    t)

    -- | Checks to see if the last types in a data family instance can be safely eta-
    -- reduced (i.e., dropped), given the other types. This checks for three conditions:
    --
    -- (1) All of the dropped types are type variables
    -- (2) All of the dropped types are distinct
    -- (3) None of the remaining types mention any of the dropped types
    canEtaReduce :: [Type] -> [Type] -> Bool
    canEtaReduce :: [Kind] -> [Kind] -> Bool
    canEtaReduce [Kind]
    remaining [Kind]
    dropped =
           (Kind -> Bool) -> [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Kind -> Bool
    isTyVar [Kind]
    dropped
        Bool -> Bool -> Bool
    && [Name] -> Bool
    forall a. Ord a => [a] -> Bool
    allDistinct [Name]
    droppedNames -- Make sure not to pass something of type [Type], since Type
                                    -- didn't have an Ord instance until template-haskell-2.10.0.0
        Bool -> Bool -> Bool
    && Bool -> Bool
    not ((Kind -> Bool) -> [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Kind -> [Name] -> Bool
    `mentionsName` [Name]
    droppedNames) [Kind]
    remaining)
      where
        droppedNames :: [Name]
        droppedNames :: [Name]
    droppedNames = (Kind -> Name) -> [Kind] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Kind -> Name
    varTToName [Kind]
    dropped

    -- | Extract Just the Name from a type variable. If the argument Type is not a
    -- type variable, return Nothing.
    varTToName_maybe :: Type -> Maybe Name
    varTToName_maybe :: Kind -> Maybe Name
    varTToName_maybe (VarT Name
    n)   = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    n
    varTToName_maybe (SigT Kind
    t Kind
    _) = Kind -> Maybe Name
    varTToName_maybe Kind
    t
    varTToName_maybe Kind
    _          = Maybe Name
    forall a. Maybe a
    Nothing

    -- | Extract the Name from a type variable. If the argument Type is not a
    -- type variable, throw an error.
    varTToName :: Type -> Name
    varTToName :: Kind -> Name
    varTToName = Name -> Maybe Name -> Name
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Name
    forall a. HasCallStack => String -> a
    error String
    "Not a type variable!") (Maybe Name -> Name) -> (Kind -> Maybe Name) -> Kind -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Kind -> Maybe Name
    varTToName_maybe

    -- | Peel off a kind signature from a Type (if it has one).
    unSigT :: Type -> Type
    unSigT :: Kind -> Kind
    unSigT (SigT Kind
    t Kind
    _) = Kind
    t
    unSigT Kind
    t          = Kind
    t

    -- | Is the given type a variable?
    isTyVar :: Type -> Bool
    isTyVar :: Kind -> Bool
    isTyVar (VarT Name
    _)   = Bool
    True
    isTyVar (SigT Kind
    t Kind
    _) = Kind -> Bool
    isTyVar Kind
    t
    isTyVar Kind
    _          = Bool
    False

    -- | Detect if a Name in a list of provided Names occurs as an argument to some
    -- type family. This makes an effort to exclude /oversaturated/ arguments to
    -- type families. For instance, if one declared the following type family:
    --
    -- @
    -- type family F a :: Type -> Type
    -- @
    --
    -- Then in the type @F a b@, we would consider @a@ to be an argument to @F@,
    -- but not @b@.
    isInTypeFamilyApp :: [Name] -> Type -> [Type] -> Q Bool
    isInTypeFamilyApp :: [Name] -> Kind -> [Kind] -> Q Bool
    isInTypeFamilyApp [Name]
    names Kind
    tyFun [Kind]
    tyArgs =
      case Kind
    tyFun of
        ConT Name
    tcName -> Name -> Q Bool
    go Name
    tcName
        Kind
    _           -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      where
        go :: Name -> Q Bool
        go :: Name -> Q Bool
    go Name
    tcName = do
          info <- Name -> Q Info
    reify Name
    tcName
          case info of
            FamilyI (OpenTypeFamilyD (TypeFamilyHead Name
    _ [TyVarBndr BndrVis]
    bndrs FamilyResultSig
    _ Maybe InjectivityAnn
    _)) [Dec]
    _
              -> [TyVarBndr BndrVis] -> Q Bool
    forall a. [a] -> Q Bool
    withinFirstArgs [TyVarBndr BndrVis]
    bndrs
            FamilyI (ClosedTypeFamilyD (TypeFamilyHead Name
    _ [TyVarBndr BndrVis]
    bndrs FamilyResultSig
    _ Maybe InjectivityAnn
    _) [TySynEqn]
    _) [Dec]
    _
              -> [TyVarBndr BndrVis] -> Q Bool
    forall a. [a] -> Q Bool
    withinFirstArgs [TyVarBndr BndrVis]
    bndrs
            Info
    _ -> Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
          where
            withinFirstArgs :: [a] -> Q Bool
            withinFirstArgs :: forall a. [a] -> Q Bool
    withinFirstArgs [a]
    bndrs =
              let firstArgs :: [Kind]
    firstArgs = Int -> [Kind] -> [Kind]
    forall a. Int -> [a] -> [a]
    take ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    bndrs) [Kind]
    tyArgs
                  argFVs :: [Name]
    argFVs    = [Kind] -> [Name]
    forall a. TypeSubstitution a => a -> [Name]
    freeVariables [Kind]
    firstArgs
              in Bool -> Q Bool
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Q Bool) -> Bool -> Q Bool
    forall a b. (a -> b) -> a -> b
    $ (Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    argFVs) [Name]
    names

    -- | Are all of the items in a list (which have an ordering) distinct?
    --
    -- This uses Set (as opposed to nub) for better asymptotic time complexity.
    allDistinct :: Ord a => [a] -> Bool
    allDistinct :: forall a. Ord a => [a] -> Bool
    allDistinct = Set a -> [a] -> Bool
    forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' Set a
    forall a. Set a
    Set.empty
      where
        allDistinct' :: Ord a => Set a -> [a] -> Bool
        allDistinct' :: forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' Set a
    uniqs (a
    x:[a]
    xs)
            | a
    x a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set a
    uniqs = Bool
    False
            | Bool
    otherwise            = Set a -> [a] -> Bool
    forall a. Ord a => Set a -> [a] -> Bool
    allDistinct' (a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    Set.insert a
    x Set a
    uniqs) [a]
    xs
        allDistinct' Set a
    _ [a]
    _           = Bool
    True

    -- | Does the given type mention any of the Names in the list?
    mentionsName :: Type -> [Name] -> Bool
    mentionsName :: Kind -> [Name] -> Bool
    mentionsName = Kind -> [Name] -> Bool
    go
      where
        go :: Type -> [Name] -> Bool
        go :: Kind -> [Name] -> Bool
    go (AppT Kind
    t1 Kind
    t2) [Name]
    names = Kind -> [Name] -> Bool
    go Kind
    t1 [Name]
    names Bool -> Bool -> Bool
    || Kind -> [Name] -> Bool
    go Kind
    t2 [Name]
    names
        go (SigT Kind
    t Kind
    k)   [Name]
    names = Kind -> [Name] -> Bool
    go Kind
    t  [Name]
    names Bool -> Bool -> Bool
    || Kind -> [Name] -> Bool
    go Kind
    k  [Name]
    names
        go (VarT Name
    n)     [Name]
    names = Name
    n Name -> [Name] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    names
        go Kind
    _            [Name]
    _     = Bool
    False

    -- | Does an instance predicate mention any of the Names in the list?
    predMentionsName :: Pred -> [Name] -> Bool
    predMentionsName :: Kind -> [Name] -> Bool
    predMentionsName = Kind -> [Name] -> Bool
    mentionsName

    -- | Construct a type via curried application.
    applyTy :: Type -> [Type] -> Type
    applyTy :: Kind -> [Kind] -> Kind
    applyTy = (Kind -> Kind -> Kind) -> Kind -> [Kind] -> Kind
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' Kind -> Kind -> Kind
    AppT

    -- | Fully applies a type constructor to its type variables.
    applyTyCon :: Name -> [Type] -> Type
    applyTyCon :: Name -> [Kind] -> Kind
    applyTyCon = Kind -> [Kind] -> Kind
    applyTy (Kind -> [Kind] -> Kind)
    -> (Name -> Kind) -> Name -> [Kind] -> Kind
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Kind
    ConT

    -- | Split an applied type into its individual components. For example, this:
    --
    -- @
    -- Either Int Char
    -- @
    --
    -- would split to this:
    --
    -- @
    -- [Either, Int, Char]
    -- @
    unapplyTy :: Type -> (Type, [Type])
    unapplyTy :: Kind -> (Kind, [Kind])
    unapplyTy Kind
    ty = Kind -> Kind -> [Kind] -> (Kind, [Kind])
    go Kind
    ty Kind
    ty []
      where
        go :: Type -> Type -> [Type] -> (Type, [Type])
        go :: Kind -> Kind -> [Kind] -> (Kind, [Kind])
    go Kind
    _      (AppT Kind
    ty1 Kind
    ty2)     [Kind]
    args = Kind -> Kind -> [Kind] -> (Kind, [Kind])
    go Kind
    ty1 Kind
    ty1 (Kind
    ty2Kind -> [Kind] -> [Kind]
    forall a. a -> [a] -> [a]
    :[Kind]
    args)
        go Kind
    origTy (SigT Kind
    ty' Kind
    _)       [Kind]
    args = Kind -> Kind -> [Kind] -> (Kind, [Kind])
    go Kind
    origTy Kind
    ty' [Kind]
    args
        go Kind
    origTy (InfixT Kind
    ty1 Name
    n Kind
    ty2) [Kind]
    args = Kind -> Kind -> [Kind] -> (Kind, [Kind])
    go Kind
    origTy (Name -> Kind
    ConT Name
    n Kind -> Kind -> Kind
    `AppT` Kind
    ty1 Kind -> Kind -> Kind
    `AppT` Kind
    ty2) [Kind]
    args
        go Kind
    origTy (ParensT Kind
    ty')      [Kind]
    args = Kind -> Kind -> [Kind] -> (Kind, [Kind])
    go Kind
    origTy Kind
    ty' [Kind]
    args
        go Kind
    origTy Kind
    _                  [Kind]
    args = (Kind
    origTy, [Kind]
    args)

    -- | Split a type signature by the arrows on its spine. For example, this:
    --
    -- @
    -- forall a b. (a ~ b) => (a -> b) -> Char -> ()
    -- @
    --
    -- would split to this:
    --
    -- @
    -- (a ~ b, [a -> b, Char, ()])
    -- @
    uncurryTy :: Type -> (Cxt, [Type])
    uncurryTy :: Kind -> ([Kind], [Kind])
    uncurryTy (AppT (AppT Kind
    ArrowT Kind
    t1) Kind
    t2) =
      let ([Kind]
    ctxt, [Kind]
    tys) = Kind -> ([Kind], [Kind])
    uncurryTy Kind
    t2
      in ([Kind]
    ctxt, Kind
    t1Kind -> [Kind] -> [Kind]
    forall a. a -> [a] -> [a]
    :[Kind]
    tys)
    uncurryTy (SigT Kind
    t Kind
    _) = Kind -> ([Kind], [Kind])
    uncurryTy Kind
    t
    uncurryTy (ForallT [TyVarBndr Specificity]
    _ [Kind]
    ctxt Kind
    t) =
      let ([Kind]
    ctxt', [Kind]
    tys) = Kind -> ([Kind], [Kind])
    uncurryTy Kind
    t
      in ([Kind]
    ctxt [Kind] -> [Kind] -> [Kind]
    forall a. [a] -> [a] -> [a]
    ++ [Kind]
    ctxt', [Kind]
    tys)
    uncurryTy Kind
    t = ([], [Kind
    t])

    -- | Like uncurryType, except on a kind level.
    uncurryKind :: Kind -> [Kind]
    uncurryKind :: Kind -> [Kind]
    uncurryKind = ([Kind], [Kind]) -> [Kind]
    forall a b. (a, b) -> b
    snd (([Kind], [Kind]) -> [Kind])
    -> (Kind -> ([Kind], [Kind])) -> Kind -> [Kind]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Kind -> ([Kind], [Kind])
    uncurryTy

    -------------------------------------------------------------------------------
    -- Quoted names
    -------------------------------------------------------------------------------

    bimapConstValName :: Name
    bimapConstValName :: Name
    bimapConstValName = 'bimapConst

    bifoldrConstValName :: Name
    bifoldrConstValName :: Name
    bifoldrConstValName = 'bifoldrConst

    bifoldMapConstValName :: Name
    bifoldMapConstValName :: Name
    bifoldMapConstValName = 'bifoldMapConst

    coerceValName :: Name
    coerceValName :: Name
    coerceValName = 'coerce

    bitraverseConstValName :: Name
    bitraverseConstValName :: Name
    bitraverseConstValName = 'bitraverseConst

    wrapMonadDataName :: Name
    wrapMonadDataName :: Name
    wrapMonadDataName = 'WrapMonad

    functorTypeName :: Name
    functorTypeName :: Name
    functorTypeName = ''Functor

    foldableTypeName :: Name
    foldableTypeName :: Name
    foldableTypeName = ''Foldable

    traversableTypeName :: Name
    traversableTypeName :: Name
    traversableTypeName = ''Traversable

    composeValName :: Name
    composeValName :: Name
    composeValName = '(.)

    idValName :: Name
    idValName :: Name
    idValName = 'id

    errorValName :: Name
    errorValName :: Name
    errorValName = 'error

    flipValName :: Name
    flipValName :: Name
    flipValName = 'flip

    fmapValName :: Name
    fmapValName :: Name
    fmapValName = 'fmap

    foldrValName :: Name
    foldrValName :: Name
    foldrValName = 'foldr

    foldMapValName :: Name
    foldMapValName :: Name
    foldMapValName = 'foldMap

    seqValName :: Name
    seqValName :: Name
    seqValName = 'seq

    traverseValName :: Name
    traverseValName :: Name
    traverseValName = 'traverse

    unwrapMonadValName :: Name
    unwrapMonadValName :: Name
    unwrapMonadValName = 'unwrapMonad

    bifunctorTypeName :: Name
    bifunctorTypeName :: Name
    bifunctorTypeName = ''Bifunctor

    bimapValName :: Name
    bimapValName :: Name
    bimapValName = 'bimap

    pureValName :: Name
    pureValName :: Name
    pureValName = 'pure

    apValName :: Name
    apValName :: Name
    apValName = '(<*>)

    liftA2ValName :: Name
    liftA2ValName :: Name
    liftA2ValName = 'liftA2

    mappendValName :: Name
    mappendValName :: Name
    mappendValName = 'mappend

    memptyValName :: Name
    memptyValName :: Name
    memptyValName = 'mempty

    bifoldableTypeName :: Name
    bifoldableTypeName :: Name
    bifoldableTypeName = ''Bifoldable

    bitraversableTypeName :: Name
    bitraversableTypeName :: Name
    bitraversableTypeName = ''Bitraversable

    bifoldrValName :: Name
    bifoldrValName :: Name
    bifoldrValName = 'bifoldr

    bifoldMapValName :: Name
    bifoldMapValName :: Name
    bifoldMapValName = 'bifoldMap

    bitraverseValName :: Name
    bitraverseValName :: Name
    bitraverseValName = 'bitraverse

    appEndoValName :: Name
    appEndoValName :: Name
    appEndoValName = 'appEndo

    dualDataName :: Name
    dualDataName :: Name
    dualDataName = 'Dual

    endoDataName :: Name
    endoDataName :: Name
    endoDataName = 'Endo

    getDualValName :: Name
    getDualValName :: Name
    getDualValName = 'getDual