{-# Language CPP, DeriveDataTypeable #-}

#if MIN_VERSION_base(4,4,0)
#define HAS_GENERICS
{-# Language DeriveGeneric #-}
#endif

#if MIN_VERSION_template_haskell(2,12,0)
{-# Language Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# Language Trustworthy #-}
#endif

{-|
Module      : Language.Haskell.TH.Datatype.TyVarBndr
Description : Backwards-compatible type variable binders
Copyright   : Eric Mertens 2020
License     : ISC
Maintainer  : emertens@gmail.com

This module provides a backwards-compatible API for constructing and
manipulating 'TyVarBndr's across multiple versions of the @template-haskell@
package.

-}
module Language.Haskell.TH.Datatype.TyVarBndr (
    -- * @TyVarBndr@-related types
    TyVarBndr_
  , TyVarBndrUnit
  , TyVarBndrSpec
  , Specificity(..)

    -- * Constructing @TyVarBndr@s
    -- ** @flag@-polymorphic
  , plainTVFlag
  , kindedTVFlag
    -- ** @TyVarBndrUnit@
  , plainTV
  , kindedTV
    -- ** @TyVarBndrSpec@
  , plainTVInferred
  , plainTVSpecified
  , kindedTVInferred
  , kindedTVSpecified

    -- * Constructing @Specificity@
  , inferredSpec
  , specifiedSpec

    -- * Modifying @TyVarBndr@s
  , elimTV
  , mapTV
  , mapTVName
  , mapTVFlag
  , mapTVKind
  , traverseTV
  , traverseTVName
  , traverseTVFlag
  , traverseTVKind
  , mapMTV
  , mapMTVName
  , mapMTVFlag
  , mapMTVKind
  , changeTVFlags

    -- * Properties of @TyVarBndr@s
  , tvName
  , tvKind
  ) where

import Control.Applicative
import Control.Monad
import Data.Data (Typeable, Data)
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax

#ifdef HAS_GENERICS
import GHC.Generics (Generic)
#endif

-- | A type synonym for 'TyVarBndr'. This is the recommended way to refer to
-- 'TyVarBndr's if you wish to achieve backwards compatibility with older
-- versions of @template-haskell@, where 'TyVarBndr' lacked a @flag@ type
-- parameter representing its specificity (if it has one).
#if MIN_VERSION_template_haskell(2,17,0)
type TyVarBndr_ flag = TyVarBndr flag
#else
type TyVarBndr_ flag = TyVarBndr

-- | A 'TyVarBndr' where the specificity is irrelevant. This is used for
-- 'TyVarBndr's that do not interact with visible type application.
type TyVarBndrUnit = TyVarBndr

-- | A 'TyVarBndr' with an explicit 'Specificity'. This is used for
-- 'TyVarBndr's that interact with visible type application.
type TyVarBndrSpec = TyVarBndr

-- | Determines how a 'TyVarBndr' interacts with visible type application.
data Specificity
  = SpecifiedSpec -- ^ @a@. Eligible for visible type application.
  | InferredSpec  -- ^ @{a}@. Not eligible for visible type application.
  deriving (Int -> Specificity -> ShowS
[Specificity] -> ShowS
Specificity -> String
(Int -> Specificity -> ShowS)
-> (Specificity -> String)
-> ([Specificity] -> ShowS)
-> Show Specificity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Specificity] -> ShowS
$cshowList :: [Specificity] -> ShowS
show :: Specificity -> String
$cshow :: Specificity -> String
showsPrec :: Int -> Specificity -> ShowS
$cshowsPrec :: Int -> Specificity -> ShowS
Show, Specificity -> Specificity -> Bool
(Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool) -> Eq Specificity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Specificity -> Specificity -> Bool
$c/= :: Specificity -> Specificity -> Bool
== :: Specificity -> Specificity -> Bool
$c== :: Specificity -> Specificity -> Bool
Eq, Eq Specificity
Eq Specificity
-> (Specificity -> Specificity -> Ordering)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Bool)
-> (Specificity -> Specificity -> Specificity)
-> (Specificity -> Specificity -> Specificity)
-> Ord Specificity
Specificity -> Specificity -> Bool
Specificity -> Specificity -> Ordering
Specificity -> Specificity -> Specificity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Specificity -> Specificity -> Specificity
$cmin :: Specificity -> Specificity -> Specificity
max :: Specificity -> Specificity -> Specificity
$cmax :: Specificity -> Specificity -> Specificity
>= :: Specificity -> Specificity -> Bool
$c>= :: Specificity -> Specificity -> Bool
> :: Specificity -> Specificity -> Bool
$c> :: Specificity -> Specificity -> Bool
<= :: Specificity -> Specificity -> Bool
$c<= :: Specificity -> Specificity -> Bool
< :: Specificity -> Specificity -> Bool
$c< :: Specificity -> Specificity -> Bool
compare :: Specificity -> Specificity -> Ordering
$ccompare :: Specificity -> Specificity -> Ordering
$cp1Ord :: Eq Specificity
Ord, Typeable, Typeable Specificity
DataType
Constr
Typeable Specificity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Specificity -> c Specificity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Specificity)
-> (Specificity -> Constr)
-> (Specificity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Specificity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Specificity))
-> ((forall b. Data b => b -> b) -> Specificity -> Specificity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Specificity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Specificity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Specificity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Specificity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Specificity -> m Specificity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Specificity -> m Specificity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Specificity -> m Specificity)
-> Data Specificity
Specificity -> DataType
Specificity -> Constr
(forall b. Data b => b -> b) -> Specificity -> Specificity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specificity -> c Specificity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specificity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Specificity -> u
forall u. (forall d. Data d => d -> u) -> Specificity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Specificity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Specificity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Specificity -> m Specificity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Specificity -> m Specificity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specificity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specificity -> c Specificity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Specificity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Specificity)
$cInferredSpec :: Constr
$cSpecifiedSpec :: Constr
$tSpecificity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Specificity -> m Specificity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Specificity -> m Specificity
gmapMp :: (forall d. Data d => d -> m d) -> Specificity -> m Specificity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Specificity -> m Specificity
gmapM :: (forall d. Data d => d -> m d) -> Specificity -> m Specificity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Specificity -> m Specificity
gmapQi :: Int -> (forall d. Data d => d -> u) -> Specificity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Specificity -> u
gmapQ :: (forall d. Data d => d -> u) -> Specificity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Specificity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Specificity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Specificity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Specificity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Specificity -> r
gmapT :: (forall b. Data b => b -> b) -> Specificity -> Specificity
$cgmapT :: (forall b. Data b => b -> b) -> Specificity -> Specificity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Specificity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Specificity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Specificity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Specificity)
dataTypeOf :: Specificity -> DataType
$cdataTypeOf :: Specificity -> DataType
toConstr :: Specificity -> Constr
$ctoConstr :: Specificity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specificity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Specificity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specificity -> c Specificity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Specificity -> c Specificity
$cp1Data :: Typeable Specificity
Data
#ifdef HAS_GENERICS
           ,(forall x. Specificity -> Rep Specificity x)
-> (forall x. Rep Specificity x -> Specificity)
-> Generic Specificity
forall x. Rep Specificity x -> Specificity
forall x. Specificity -> Rep Specificity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Specificity x -> Specificity
$cfrom :: forall x. Specificity -> Rep Specificity x
Generic
#endif
           )

inferredSpec :: Specificity
inferredSpec :: Specificity
inferredSpec = Specificity
InferredSpec

specifiedSpec :: Specificity
specifiedSpec :: Specificity
specifiedSpec = Specificity
SpecifiedSpec
#endif

-- | Construct a 'PlainTV' with the given @flag@.
plainTVFlag :: Name -> flag -> TyVarBndr_ flag
#if MIN_VERSION_template_haskell(2,17,0)
plainTVFlag = PlainTV
#else
plainTVFlag :: Name -> flag -> TyVarBndr_ flag
plainTVFlag Name
n flag
_ = Name -> TyVarBndr_ flag
PlainTV Name
n
#endif

-- | Construct a 'PlainTV' with an 'InferredSpec'.
plainTVInferred :: Name -> TyVarBndrSpec
plainTVInferred :: Name -> TyVarBndr_ flag
plainTVInferred Name
n = Name -> Specificity -> TyVarBndr_ flag
forall flag. Name -> flag -> TyVarBndr_ flag
plainTVFlag Name
n Specificity
InferredSpec

-- | Construct a 'PlainTV' with a 'SpecifiedSpec'.
plainTVSpecified :: Name -> TyVarBndrSpec
plainTVSpecified :: Name -> TyVarBndr_ flag
plainTVSpecified Name
n = Name -> Specificity -> TyVarBndr_ flag
forall flag. Name -> flag -> TyVarBndr_ flag
plainTVFlag Name
n Specificity
SpecifiedSpec

-- | Construct a 'KindedTV' with the given @flag@.
kindedTVFlag :: Name -> flag -> Kind -> TyVarBndr_ flag
#if MIN_VERSION_template_haskell(2,17,0)
kindedTVFlag = KindedTV
#else
kindedTVFlag :: Name -> flag -> Kind -> TyVarBndr_ flag
kindedTVFlag Name
n flag
_ Kind
kind = Name -> Kind -> TyVarBndr_ flag
KindedTV Name
n Kind
kind
#endif

-- | Construct a 'KindedTV' with an 'InferredSpec'.
kindedTVInferred :: Name -> Kind -> TyVarBndrSpec
kindedTVInferred :: Name -> Kind -> TyVarBndr_ flag
kindedTVInferred Name
n Kind
k = Name -> Specificity -> Kind -> TyVarBndr_ flag
forall flag. Name -> flag -> Kind -> TyVarBndr_ flag
kindedTVFlag Name
n Specificity
InferredSpec Kind
k

-- | Construct a 'KindedTV' with a 'SpecifiedSpec'.
kindedTVSpecified :: Name -> Kind -> TyVarBndrSpec
kindedTVSpecified :: Name -> Kind -> TyVarBndr_ flag
kindedTVSpecified Name
n Kind
k = Name -> Specificity -> Kind -> TyVarBndr_ flag
forall flag. Name -> flag -> Kind -> TyVarBndr_ flag
kindedTVFlag Name
n Specificity
SpecifiedSpec Kind
k

-- | Case analysis for a 'TyVarBndr'. If the value is a @'PlainTV' n _@, apply
-- the first function to @n@; if it is @'KindedTV' n _ k@, apply the second
-- function to @n@ and @k@.
elimTV :: (Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
#if MIN_VERSION_template_haskell(2,17,0)
elimTV ptv _ktv (PlainTV n _)    = ptv n
elimTV _ptv ktv (KindedTV n _ k) = ktv n k
#else
elimTV :: (Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV Name -> r
ptv Name -> Kind -> r
_ktv (PlainTV Name
n)    = Name -> r
ptv Name
n
elimTV Name -> r
_ptv Name -> Kind -> r
ktv (KindedTV Name
n Kind
k) = Name -> Kind -> r
ktv Name
n Kind
k
#endif

-- | Map over the components of a 'TyVarBndr'.
mapTV :: (Name -> Name) -> (flag -> flag') -> (Kind -> Kind)
      -> TyVarBndr_ flag -> TyVarBndr_ flag'
#if MIN_VERSION_template_haskell(2,17,0)
mapTV fn fflag _fkind (PlainTV  n flag)      = PlainTV  (fn n) (fflag flag)
mapTV fn fflag  fkind (KindedTV n flag kind) = KindedTV (fn n) (fflag flag) (fkind kind)
#else
mapTV :: (Name -> Name)
-> (flag -> flag')
-> (Kind -> Kind)
-> TyVarBndr_ flag
-> TyVarBndr_ flag
mapTV Name -> Name
fn flag -> flag'
_fflag Kind -> Kind
_fkind (PlainTV  Name
n)      = Name -> TyVarBndr_ flag
PlainTV  (Name -> Name
fn Name
n)
mapTV Name -> Name
fn flag -> flag'
_fflag  Kind -> Kind
fkind (KindedTV Name
n Kind
kind) = Name -> Kind -> TyVarBndr_ flag
KindedTV (Name -> Name
fn Name
n) (Kind -> Kind
fkind Kind
kind)
#endif

-- | Map over the 'Name' of a 'TyVarBndr'.
mapTVName :: (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVName :: (Name -> Name) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVName Name -> Name
fname = (Name -> Name)
-> (Any -> Any)
-> (Kind -> Kind)
-> TyVarBndr_ flag
-> TyVarBndr_ flag
forall flag flag'.
(Name -> Name)
-> (flag -> flag')
-> (Kind -> Kind)
-> TyVarBndr_ flag
-> TyVarBndr_ flag
mapTV Name -> Name
fname Any -> Any
forall a. a -> a
id Kind -> Kind
forall a. a -> a
id

-- | Map over the @flag@ of a 'TyVarBndr'.
mapTVFlag :: (flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag'
#if MIN_VERSION_template_haskell(2,17,0)
mapTVFlag = fmap
#else
mapTVFlag :: (flag -> flag') -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVFlag flag -> flag'
_ = TyVarBndr_ flag -> TyVarBndr_ flag
forall a. a -> a
id
#endif

-- | Map over the 'Kind' of a 'TyVarBndr'.
mapTVKind :: (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind :: (Kind -> Kind) -> TyVarBndr_ flag -> TyVarBndr_ flag
mapTVKind Kind -> Kind
fkind = (Name -> Name)
-> (Any -> Any)
-> (Kind -> Kind)
-> TyVarBndr_ flag
-> TyVarBndr_ flag
forall flag flag'.
(Name -> Name)
-> (flag -> flag')
-> (Kind -> Kind)
-> TyVarBndr_ flag
-> TyVarBndr_ flag
mapTV Name -> Name
forall a. a -> a
id Any -> Any
forall a. a -> a
id Kind -> Kind
fkind

-- | Traverse the components of a 'TyVarBndr'.
traverseTV :: Applicative f
           => (Name -> f Name) -> (flag -> f flag') -> (Kind -> f Kind)
           -> TyVarBndr_ flag -> f (TyVarBndr_ flag')
#if MIN_VERSION_template_haskell(2,17,0)
traverseTV fn fflag _fkind (PlainTV n flag) =
  liftA2 PlainTV (fn n) (fflag flag)
traverseTV fn fflag fkind (KindedTV n flag kind) =
  liftA3 KindedTV (fn n) (fflag flag) (fkind kind)
#else
traverseTV :: (Name -> f Name)
-> (flag -> f flag')
-> (Kind -> f Kind)
-> TyVarBndr_ flag
-> f (TyVarBndr_ flag)
traverseTV Name -> f Name
fn flag -> f flag'
_fflag Kind -> f Kind
_fkind (PlainTV Name
n) =
  Name -> TyVarBndr_ flag
PlainTV (Name -> TyVarBndr_ flag) -> f Name -> f (TyVarBndr_ flag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
fn Name
n
traverseTV Name -> f Name
fn flag -> f flag'
_fflag Kind -> f Kind
fkind (KindedTV Name
n Kind
kind) =
  (Name -> Kind -> TyVarBndr_ flag)
-> f Name -> f Kind -> f (TyVarBndr_ flag)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Name -> Kind -> TyVarBndr_ flag
KindedTV (Name -> f Name
fn Name
n) (Kind -> f Kind
fkind Kind
kind)
#endif

-- | Traverse the 'Name' of a 'TyVarBndr'.
traverseTVName :: Functor f
               => (Name -> f Name)
               -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
#if MIN_VERSION_template_haskell(2,17,0)
traverseTVName fn (PlainTV n flag) =
  (\n' -> PlainTV n' flag) <$> fn n
traverseTVName fn (KindedTV n flag kind) =
  (\n' -> KindedTV n' flag kind) <$> fn n
#else
traverseTVName :: (Name -> f Name) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
traverseTVName Name -> f Name
fn (PlainTV Name
n) =
  Name -> TyVarBndr_ flag
PlainTV (Name -> TyVarBndr_ flag) -> f Name -> f (TyVarBndr_ flag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
fn Name
n
traverseTVName Name -> f Name
fn (KindedTV Name
n Kind
kind) =
  (\Name
n' -> Name -> Kind -> TyVarBndr_ flag
KindedTV Name
n' Kind
kind) (Name -> TyVarBndr_ flag) -> f Name -> f (TyVarBndr_ flag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> f Name
fn Name
n
#endif

-- | Traverse the @flag@ of a 'TyVarBndr'.
traverseTVFlag :: Applicative f
               => (flag -> f flag')
               -> TyVarBndr_ flag -> f (TyVarBndr_ flag')
#if MIN_VERSION_template_haskell(2,17,0)
traverseTVFlag fflag (PlainTV n flag) =
  PlainTV n <$> fflag flag
traverseTVFlag fflag (KindedTV n flag kind) =
  (\flag' -> KindedTV n flag' kind) <$> fflag flag
#else
traverseTVFlag :: (flag -> f flag') -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
traverseTVFlag flag -> f flag'
_ = TyVarBndr_ flag -> f (TyVarBndr_ flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
#endif

-- | Traverse the 'Kind' of a 'TyVarBndr'.
traverseTVKind :: Applicative f
               => (Kind -> f Kind)
               -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
#if MIN_VERSION_template_haskell(2,17,0)
traverseTVKind _fkind tvb@PlainTV{} =
  pure tvb
traverseTVKind fkind (KindedTV n flag kind) =
  KindedTV n flag <$> fkind kind
#else
traverseTVKind :: (Kind -> f Kind) -> TyVarBndr_ flag -> f (TyVarBndr_ flag)
traverseTVKind Kind -> f Kind
_fkind tvb :: TyVarBndr_ flag
tvb@PlainTV{} =
  TyVarBndr_ flag -> f (TyVarBndr_ flag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TyVarBndr_ flag
tvb
traverseTVKind Kind -> f Kind
fkind (KindedTV Name
n Kind
kind) =
  Name -> Kind -> TyVarBndr_ flag
KindedTV Name
n (Kind -> TyVarBndr_ flag) -> f Kind -> f (TyVarBndr_ flag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Kind -> f Kind
fkind Kind
kind
#endif

-- | Map over the components of a 'TyVarBndr' in a monadic fashion.
--
-- This is the same as 'traverseTV', but with a 'Monad' constraint. This is
-- mainly useful for use with old versions of @base@ where 'Applicative' was
-- not a superclass of 'Monad'.
mapMTV :: Monad m
       => (Name -> m Name) -> (flag -> m flag') -> (Kind -> m Kind)
       -> TyVarBndr_ flag -> m (TyVarBndr_ flag')
#if MIN_VERSION_template_haskell(2,17,0)
mapMTV fn fflag _fkind (PlainTV n flag) =
  liftM2 PlainTV (fn n) (fflag flag)
mapMTV fn fflag fkind (KindedTV n flag kind) =
  liftM3 KindedTV (fn n) (fflag flag) (fkind kind)
#else
mapMTV :: (Name -> m Name)
-> (flag -> m flag')
-> (Kind -> m Kind)
-> TyVarBndr_ flag
-> m (TyVarBndr_ flag)
mapMTV Name -> m Name
fn flag -> m flag'
_fflag Kind -> m Kind
_fkind (PlainTV Name
n) =
  (Name -> TyVarBndr_ flag) -> m Name -> m (TyVarBndr_ flag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Name -> TyVarBndr_ flag
PlainTV (Name -> m Name
fn Name
n)
mapMTV Name -> m Name
fn flag -> m flag'
_fflag Kind -> m Kind
fkind (KindedTV Name
n Kind
kind) =
  (Name -> Kind -> TyVarBndr_ flag)
-> m Name -> m Kind -> m (TyVarBndr_ flag)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Name -> Kind -> TyVarBndr_ flag
KindedTV (Name -> m Name
fn Name
n) (Kind -> m Kind
fkind Kind
kind)
#endif

-- | Map over the 'Name' of a 'TyVarBndr' in a monadic fashion.
--
-- This is the same as 'traverseTVName', but with a 'Monad' constraint. This is
-- mainly useful for use with old versions of @base@ where 'Applicative' was
-- not a superclass of 'Monad'.
mapMTVName :: Monad m
           => (Name -> m Name)
           -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
#if MIN_VERSION_template_haskell(2,17,0)
mapMTVName fn (PlainTV n flag) =
  liftM (\n' -> PlainTV n' flag) (fn n)
mapMTVName fn (KindedTV n flag kind) =
  liftM (\n' -> KindedTV n' flag kind) (fn n)
#else
mapMTVName :: (Name -> m Name) -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
mapMTVName Name -> m Name
fn (PlainTV Name
n) =
  (Name -> TyVarBndr_ flag) -> m Name -> m (TyVarBndr_ flag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Name -> TyVarBndr_ flag
PlainTV (Name -> m Name
fn Name
n)
mapMTVName Name -> m Name
fn (KindedTV Name
n Kind
kind) =
  (Name -> TyVarBndr_ flag) -> m Name -> m (TyVarBndr_ flag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\Name
n' -> Name -> Kind -> TyVarBndr_ flag
KindedTV Name
n' Kind
kind) (Name -> m Name
fn Name
n)
#endif

-- | Map over the @flag@ of a 'TyVarBndr' in a monadic fashion.
--
-- This is the same as 'traverseTVFlag', but with a 'Monad' constraint. This is
-- mainly useful for use with old versions of @base@ where 'Applicative' was
-- not a superclass of 'Monad'.
mapMTVFlag :: Monad m
           => (flag -> m flag')
           -> TyVarBndr_ flag -> m (TyVarBndr_ flag')
#if MIN_VERSION_template_haskell(2,17,0)
mapMTVFlag fflag (PlainTV n flag) =
  liftM (PlainTV n) (fflag flag)
mapMTVFlag fflag (KindedTV n flag kind) =
  liftM (\flag' -> KindedTV n flag' kind) (fflag flag)
#else
mapMTVFlag :: (flag -> m flag') -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
mapMTVFlag flag -> m flag'
_ = TyVarBndr_ flag -> m (TyVarBndr_ flag)
forall (m :: * -> *) a. Monad m => a -> m a
return
#endif

-- | Map over the 'Kind' of a 'TyVarBndr' in a monadic fashion.
--
-- This is the same as 'traverseTVKind', but with a 'Monad' constraint. This is
-- mainly useful for use with old versions of @base@ where 'Applicative' was
-- not a superclass of 'Monad'.
mapMTVKind :: Monad m
           => (Kind -> m Kind)
           -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
#if MIN_VERSION_template_haskell(2,17,0)
mapMTVKind _fkind tvb@PlainTV{} =
  return tvb
mapMTVKind fkind (KindedTV n flag kind) =
  liftM (KindedTV n flag) (fkind kind)
#else
mapMTVKind :: (Kind -> m Kind) -> TyVarBndr_ flag -> m (TyVarBndr_ flag)
mapMTVKind Kind -> m Kind
_fkind tvb :: TyVarBndr_ flag
tvb@PlainTV{} =
  TyVarBndr_ flag -> m (TyVarBndr_ flag)
forall (m :: * -> *) a. Monad m => a -> m a
return TyVarBndr_ flag
tvb
mapMTVKind Kind -> m Kind
fkind (KindedTV Name
n Kind
kind) =
  (Kind -> TyVarBndr_ flag) -> m Kind -> m (TyVarBndr_ flag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Name -> Kind -> TyVarBndr_ flag
KindedTV Name
n) (Kind -> m Kind
fkind Kind
kind)
#endif

-- | Set the flag in a list of 'TyVarBndr's. This is often useful in contexts
-- where one needs to re-use a list of 'TyVarBndr's from one flag setting to
-- another flag setting. For example, in order to re-use the 'TyVarBndr's bound
-- by a 'DataD' in a 'ForallT', one can do the following:
--
-- @
-- case x of
--   'DataD' _ _ tvbs _ _ _ ->
--     'ForallT' ('changeTVFlags' 'SpecifiedSpec' tvbs) ...
-- @
changeTVFlags :: newFlag -> [TyVarBndr_ oldFlag] -> [TyVarBndr_ newFlag]
#if MIN_VERSION_template_haskell(2,17,0)
changeTVFlags newFlag = map (newFlag <$)
#else
changeTVFlags :: newFlag -> [TyVarBndr_ flag] -> [TyVarBndr_ flag]
changeTVFlags newFlag
_ = [TyVarBndr_ flag] -> [TyVarBndr_ flag]
forall a. a -> a
id
#endif

-- | Extract the type variable name from a 'TyVarBndr', ignoring the
-- kind signature if one exists.
tvName :: TyVarBndr_ flag -> Name
tvName :: TyVarBndr_ flag -> Name
tvName = (Name -> Name) -> (Name -> Kind -> Name) -> TyVarBndr_ flag -> Name
forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV Name -> Name
forall a. a -> a
id (\Name
n Kind
_ -> Name
n)

-- | Extract the kind from a 'TyVarBndr'. Assumes 'PlainTV' has kind @*@.
tvKind :: TyVarBndr_ flag -> Kind
tvKind :: TyVarBndr_ flag -> Kind
tvKind = (Name -> Kind) -> (Name -> Kind -> Kind) -> TyVarBndr_ flag -> Kind
forall r flag.
(Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r
elimTV (\Name
_ -> Kind
starK) (\Name
_ Kind
k -> Kind
k)