    {- Language/Haskell/TH/Desugar/Sweeten.hs

    (c) Richard Eisenberg 2013
    rae@cs.brynmawr.edu

    Converts desugared TH back into real TH.
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TemplateHaskell #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Language.Haskell.TH.Desugar.Sweeten
    -- Copyright   :  (C) 2014 Richard Eisenberg
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  Ryan Scott
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- The functions in this module convert desugared Template Haskell back into
    -- proper Template Haskell.
    --
    ----------------------------------------------------------------------------

    module Language.Haskell.TH.Desugar.Sweeten (
      expToTH, matchToTH, patToTH, decsToTH, decToTH,
      letDecToTH, typeToTH,

      conToTH, foreignToTH, pragmaToTH, ruleBndrToTH,
      clauseToTH, tvbToTH, cxtToTH, predToTH, derivClauseToTH,
    #if __GLASGOW_HASKELL__ >= 801
      patSynDirToTH,
    #endif

      typeArgToTH
      ) where

    import Prelude hiding (exp)
    import Control.Arrow

    import Language.Haskell.TH hiding (cxt)

    import Language.Haskell.TH.Desugar.AST
    import Language.Haskell.TH.Desugar.Core (DTypeArg(..))
    import Language.Haskell.TH.Desugar.Util

    import Data.Maybe ( maybeToList, mapMaybe )

    expToTH :: DExp -> Exp
    expToTH :: DExp -> Exp
    expToTH (DVarE n :: Name
    n)            = Name -> Exp
    VarE Name
    n
    expToTH (DConE n :: Name
    n)            = Name -> Exp
    ConE Name
    n
    expToTH (DLitE l :: Lit
    l)            = Lit -> Exp
    LitE Lit
    l
    expToTH (DAppE e1 :: DExp
    e1 e2 :: DExp
    e2)        = Exp -> Exp -> Exp
    AppE (DExp -> Exp
    expToTH DExp
    e1) (DExp -> Exp
    expToTH DExp
    e2)
    expToTH (DLamE names :: [Name]
    names exp :: DExp
    exp)    = [Pat] -> Exp -> Exp
    LamE ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    names) (DExp -> Exp
    expToTH DExp
    exp)
    expToTH (DCaseE exp :: DExp
    exp matches :: [DMatch]
    matches) = Exp -> [Match] -> Exp
    CaseE (DExp -> Exp
    expToTH DExp
    exp) ((DMatch -> Match) -> [DMatch] -> [Match]
    forall a b. (a -> b) -> [a] -> [b]
    map DMatch -> Match
    matchToTH [DMatch]
    matches)
    expToTH (DLetE decs :: [DLetDec]
    decs exp :: DExp
    exp)     = [Dec] -> Exp -> Exp
    LetE ((DLetDec -> Maybe Dec) -> [DLetDec] -> [Dec]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DLetDec -> Maybe Dec
    letDecToTH [DLetDec]
    decs) (DExp -> Exp
    expToTH DExp
    exp)
    expToTH (DSigE exp :: DExp
    exp ty :: DType
    ty)       = Exp -> Type -> Exp
    SigE (DExp -> Exp
    expToTH DExp
    exp) (DType -> Type
    typeToTH DType
    ty)
    #if __GLASGOW_HASKELL__ < 709
    expToTH (DStaticE _)         = error "Static expressions supported only in GHC 7.10+"
    #else
    expToTH (DStaticE exp :: DExp
    exp)       = Exp -> Exp
    StaticE (DExp -> Exp
    expToTH DExp
    exp)
    #endif
    #if __GLASGOW_HASKELL__ >= 801
    expToTH (DAppTypeE exp :: DExp
    exp ty :: DType
    ty)   = Exp -> Type -> Exp
    AppTypeE (DExp -> Exp
    expToTH DExp
    exp) (DType -> Type
    typeToTH DType
    ty)
    #else
    -- In the event that we're on a version of Template Haskell without support for
    -- type applications, we will simply drop the applied type.
    expToTH (DAppTypeE exp _)    = expToTH exp
    #endif

    matchToTH :: DMatch -> Match
    matchToTH :: DMatch -> Match
    matchToTH (DMatch pat :: DPat
    pat exp :: DExp
    exp) = Pat -> Body -> [Dec] -> Match
    Match (DPat -> Pat
    patToTH DPat
    pat) (Exp -> Body
    NormalB (DExp -> Exp
    expToTH DExp
    exp)) []

    patToTH :: DPat -> Pat
    patToTH :: DPat -> Pat
    patToTH (DLitP lit :: Lit
    lit)    = Lit -> Pat
    LitP Lit
    lit
    patToTH (DVarP n :: Name
    n)      = Name -> Pat
    VarP Name
    n
    patToTH (DConP n :: Name
    n pats :: [DPat]
    pats) = Name -> [Pat] -> Pat
    ConP Name
    n ((DPat -> Pat) -> [DPat] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map DPat -> Pat
    patToTH [DPat]
    pats)
    patToTH (DTildeP pat :: DPat
    pat)  = Pat -> Pat
    TildeP (DPat -> Pat
    patToTH DPat
    pat)
    patToTH (DBangP pat :: DPat
    pat)   = Pat -> Pat
    BangP (DPat -> Pat
    patToTH DPat
    pat)
    patToTH (DSigP pat :: DPat
    pat ty :: DType
    ty) = Pat -> Type -> Pat
    SigP (DPat -> Pat
    patToTH DPat
    pat) (DType -> Type
    typeToTH DType
    ty)
    patToTH DWildP         = Pat
    WildP

    decsToTH :: [DDec] -> [Dec]
    decsToTH :: [DDec] -> [Dec]
    decsToTH = (DDec -> [Dec]) -> [DDec] -> [Dec]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DDec -> [Dec]
    decToTH

    -- | This returns a list of @Dec@s because GHC 7.6.3 does not have
    -- a one-to-one mapping between 'DDec' and @Dec@.
    decToTH :: DDec -> [Dec]
    decToTH :: DDec -> [Dec]
    decToTH (DLetDec d :: DLetDec
    d) = Maybe Dec -> [Dec]
    forall a. Maybe a -> [a]
    maybeToList (DLetDec -> Maybe Dec
    letDecToTH DLetDec
    d)
    decToTH (DDataD Data cxt :: DCxt
    cxt n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs _mk :: Maybe DType
    _mk cons :: [DCon]
    cons derivings :: [DDerivClause]
    derivings) =
    #if __GLASGOW_HASKELL__ > 710
      [Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD (DCxt -> Cxt
    cxtToTH DCxt
    cxt) Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DType -> Type
    typeToTH Maybe DType
    _mk) ((DCon -> Con) -> [DCon] -> [Con]
    forall a b. (a -> b) -> [a] -> [b]
    map DCon -> Con
    conToTH [DCon]
    cons)
             ((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DDerivClause -> [DerivClause]
    derivClauseToTH [DDerivClause]
    derivings)]
    #else
      [DataD (cxtToTH cxt) n (map tvbToTH tvbs) (map conToTH cons)
             (map derivingToTH derivings)]
    #endif
    decToTH (DDataD Newtype cxt :: DCxt
    cxt n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs _mk :: Maybe DType
    _mk [con :: DCon
    con] derivings :: [DDerivClause]
    derivings) =
    #if __GLASGOW_HASKELL__ > 710
      [Cxt
    -> Name -> [TyVarBndr] -> Maybe Type -> Con -> [DerivClause] -> Dec
    NewtypeD (DCxt -> Cxt
    cxtToTH DCxt
    cxt) Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DType -> Type
    typeToTH Maybe DType
    _mk) (DCon -> Con
    conToTH DCon
    con)
                ((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DDerivClause -> [DerivClause]
    derivClauseToTH [DDerivClause]
    derivings)]
    #else
      [NewtypeD (cxtToTH cxt) n (map tvbToTH tvbs) (conToTH con)
                (map derivingToTH derivings)]
    #endif
    decToTH (DTySynD n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs ty :: DType
    ty) = [Name -> [TyVarBndr] -> Type -> Dec
    TySynD Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) (DType -> Type
    typeToTH DType
    ty)]
    decToTH (DClassD cxt :: DCxt
    cxt n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs fds :: [FunDep]
    fds decs :: [DDec]
    decs) =
      [Cxt -> Name -> [TyVarBndr] -> [FunDep] -> [Dec] -> Dec
    ClassD (DCxt -> Cxt
    cxtToTH DCxt
    cxt) Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) [FunDep]
    fds ([DDec] -> [Dec]
    decsToTH [DDec]
    decs)]
    decToTH (DInstanceD over :: Maybe Overlap
    over mtvbs :: Maybe [DTyVarBndr]
    mtvbs _cxt :: DCxt
    _cxt _ty :: DType
    _ty decs :: [DDec]
    decs) =
      [Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
    instanceDToTH Maybe Overlap
    over DCxt
    cxt' DType
    ty' [DDec]
    decs]
      where
      (cxt' :: DCxt
    cxt', ty' :: DType
    ty') = case Maybe [DTyVarBndr]
    mtvbs of
                      Nothing    -> (DCxt
    _cxt, DType
    _ty)
                      Just _tvbs :: [DTyVarBndr]
    _tvbs ->
    #if __GLASGOW_HASKELL__ < 800 || __GLASGOW_HASKELL__ >= 802
                                    ([], [DTyVarBndr] -> DCxt -> DType -> DType
    DForallT [DTyVarBndr]
    _tvbs DCxt
    _cxt DType
    _ty)
    #else
                                    -- See #117
                                    error $ "Explicit foralls in instance declarations "
                                         ++ "are broken on GHC 8.0."
    #endif
    decToTH (DForeignD f :: DForeign
    f) = [Foreign -> Dec
    ForeignD (DForeign -> Foreign
    foreignToTH DForeign
    f)]
    #if __GLASGOW_HASKELL__ > 710
    decToTH (DOpenTypeFamilyD (DTypeFamilyHead n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs frs :: DFamilyResultSig
    frs ann :: Maybe InjectivityAnn
    ann)) =
      [TypeFamilyHead -> Dec
    OpenTypeFamilyD (Name
    -> [TyVarBndr]
    -> FamilyResultSig
    -> Maybe InjectivityAnn
    -> TypeFamilyHead
    TypeFamilyHead Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) (DFamilyResultSig -> FamilyResultSig
    frsToTH DFamilyResultSig
    frs) Maybe InjectivityAnn
    ann)]
    #else
    decToTH (DOpenTypeFamilyD (DTypeFamilyHead n tvbs frs _ann)) =
      [FamilyD TypeFam n (map tvbToTH tvbs) (frsToTH frs)]
    #endif
    decToTH (DDataFamilyD n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs mk :: Maybe DType
    mk) =
    #if __GLASGOW_HASKELL__ > 710
      [Name -> [TyVarBndr] -> Maybe Type -> Dec
    DataFamilyD Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DType -> Type
    typeToTH Maybe DType
    mk)]
    #else
      [FamilyD DataFam n (map tvbToTH tvbs) (fmap typeToTH mk)]
    #endif
    decToTH (DDataInstD nd :: NewOrData
    nd cxt :: DCxt
    cxt mtvbs :: Maybe [DTyVarBndr]
    mtvbs lhs :: DType
    lhs mk :: Maybe DType
    mk cons :: [DCon]
    cons derivings :: [DDerivClause]
    derivings) =
      let ndc :: DNewOrDataCons
    ndc = case (NewOrData
    nd, [DCon]
    cons) of
                  (Newtype, [con :: DCon
    con]) -> DCon -> DNewOrDataCons
    DNewtypeCon DCon
    con
                  (Newtype, _)     -> [Char] -> DNewOrDataCons
    forall a. HasCallStack => [Char] -> a
    error "Newtype that doesn't have only one constructor"
                  (Data,    _)     -> [DCon] -> DNewOrDataCons
    DDataCons [DCon]
    cons
      in DNewOrDataCons
    -> DCxt
    -> Maybe [DTyVarBndr]
    -> DType
    -> Maybe DType
    -> [DDerivClause]
    -> [Dec]
    dataInstDecToTH DNewOrDataCons
    ndc DCxt
    cxt Maybe [DTyVarBndr]
    mtvbs DType
    lhs Maybe DType
    mk [DDerivClause]
    derivings
    #if __GLASGOW_HASKELL__ >= 807
    decToTH (DTySynInstD eqn :: DTySynEqn
    eqn) = [TySynEqn -> Dec
    TySynInstD ((Name, TySynEqn) -> TySynEqn
    forall a b. (a, b) -> b
    snd ((Name, TySynEqn) -> TySynEqn) -> (Name, TySynEqn) -> TySynEqn
    forall a b. (a -> b) -> a -> b
    $ DTySynEqn -> (Name, TySynEqn)
    tySynEqnToTH DTySynEqn
    eqn)]
    #else
    decToTH (DTySynInstD eqn) =
      let (n, eqn') = tySynEqnToTH eqn in
      [TySynInstD n eqn']
    #endif
    #if __GLASGOW_HASKELL__ > 710
    decToTH (DClosedTypeFamilyD (DTypeFamilyHead n :: Name
    n tvbs :: [DTyVarBndr]
    tvbs frs :: DFamilyResultSig
    frs ann :: Maybe InjectivityAnn
    ann) eqns :: [DTySynEqn]
    eqns) =
      [TypeFamilyHead -> [TySynEqn] -> Dec
    ClosedTypeFamilyD (Name
    -> [TyVarBndr]
    -> FamilyResultSig
    -> Maybe InjectivityAnn
    -> TypeFamilyHead
    TypeFamilyHead Name
    n ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) (DFamilyResultSig -> FamilyResultSig
    frsToTH DFamilyResultSig
    frs) Maybe InjectivityAnn
    ann)
                         ((DTySynEqn -> TySynEqn) -> [DTySynEqn] -> [TySynEqn]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name, TySynEqn) -> TySynEqn
    forall a b. (a, b) -> b
    snd ((Name, TySynEqn) -> TySynEqn)
    -> (DTySynEqn -> (Name, TySynEqn)) -> DTySynEqn -> TySynEqn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DTySynEqn -> (Name, TySynEqn)
    tySynEqnToTH) [DTySynEqn]
    eqns)
      ]
    #else
    decToTH (DClosedTypeFamilyD (DTypeFamilyHead n tvbs frs _ann) eqns) =
      [ClosedTypeFamilyD n (map tvbToTH tvbs) (frsToTH frs) (map (snd . tySynEqnToTH) eqns)]
    #endif
    decToTH (DRoleAnnotD n :: Name
    n roles :: [Role]
    roles) = [Name -> [Role] -> Dec
    RoleAnnotD Name
    n [Role]
    roles]
    decToTH (DStandaloneDerivD mds :: Maybe DDerivStrategy
    mds mtvbs :: Maybe [DTyVarBndr]
    mtvbs _cxt :: DCxt
    _cxt _ty :: DType
    _ty) =
      [Maybe DDerivStrategy -> DCxt -> DType -> Dec
    standaloneDerivDToTH Maybe DDerivStrategy
    mds DCxt
    cxt' DType
    ty']
      where
      (cxt' :: DCxt
    cxt', ty' :: DType
    ty') = case Maybe [DTyVarBndr]
    mtvbs of
                      Nothing    -> (DCxt
    _cxt, DType
    _ty)
                      Just _tvbs :: [DTyVarBndr]
    _tvbs ->
    #if __GLASGOW_HASKELL__ < 710 || __GLASGOW_HASKELL__ >= 802
                                    ([], [DTyVarBndr] -> DCxt -> DType -> DType
    DForallT [DTyVarBndr]
    _tvbs DCxt
    _cxt DType
    _ty)
    #else
                                    -- See #117
                                    error $ "Explicit foralls in standalone deriving declarations "
                                         ++ "are broken on GHC 7.10 and 8.0."
    #endif
    #if __GLASGOW_HASKELL__ < 709
    decToTH (DDefaultSigD {})      =
      error "Default method signatures supported only in GHC 7.10+"
    #else
    decToTH (DDefaultSigD n :: Name
    n ty :: DType
    ty)        = [Name -> Type -> Dec
    DefaultSigD Name
    n (DType -> Type
    typeToTH DType
    ty)]
    #endif
    #if __GLASGOW_HASKELL__ >= 801
    decToTH (DPatSynD n :: Name
    n args :: PatSynArgs
    args dir :: DPatSynDir
    dir pat :: DPat
    pat) = [Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
    PatSynD Name
    n PatSynArgs
    args (DPatSynDir -> PatSynDir
    patSynDirToTH DPatSynDir
    dir) (DPat -> Pat
    patToTH DPat
    pat)]
    decToTH (DPatSynSigD n :: Name
    n ty :: DType
    ty)        = [Name -> Type -> Dec
    PatSynSigD Name
    n (DType -> Type
    typeToTH DType
    ty)]
    #else
    decToTH dec
      | DPatSynD{}    <- dec = patSynErr
      | DPatSynSigD{} <- dec = patSynErr
      where
        patSynErr = error "Pattern synonyms supported only in GHC 8.2+"
    #endif
    decToTH _ = [Char] -> [Dec]
    forall a. HasCallStack => [Char] -> a
    error "Newtype declaration without exactly 1 constructor."

    -- | Indicates whether something is a newtype or data type, bundling its
    -- constructor(s) along with it.
    data DNewOrDataCons
      = DNewtypeCon DCon
      | DDataCons   [DCon]

    -- | Sweeten a 'DDataInstD'.
    dataInstDecToTH :: DNewOrDataCons -> DCxt -> Maybe [DTyVarBndr] -> DType
                    -> Maybe DKind -> [DDerivClause] -> [Dec]
    dataInstDecToTH :: DNewOrDataCons
    -> DCxt
    -> Maybe [DTyVarBndr]
    -> DType
    -> Maybe DType
    -> [DDerivClause]
    -> [Dec]
    dataInstDecToTH ndc :: DNewOrDataCons
    ndc cxt :: DCxt
    cxt _mtvbs :: Maybe [DTyVarBndr]
    _mtvbs lhs :: DType
    lhs _mk :: Maybe DType
    _mk derivings :: [DDerivClause]
    derivings =
      case DNewOrDataCons
    ndc of
        DNewtypeCon con :: DCon
    con ->
    #if __GLASGOW_HASKELL__ >= 807
          [Cxt
    -> Maybe [TyVarBndr]
    -> Type
    -> Maybe Type
    -> Con
    -> [DerivClause]
    -> Dec
    NewtypeInstD (DCxt -> Cxt
    cxtToTH DCxt
    cxt) (([DTyVarBndr] -> [TyVarBndr])
    -> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndr -> TyVarBndr
    tvbToTH) Maybe [DTyVarBndr]
    _mtvbs) (DType -> Type
    typeToTH DType
    lhs)
                        ((DType -> Type) -> Maybe DType -> Maybe Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DType -> Type
    typeToTH Maybe DType
    _mk) (DCon -> Con
    conToTH DCon
    con)
                        ((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DDerivClause -> [DerivClause]
    derivClauseToTH [DDerivClause]
    derivings)]
    #elif __GLASGOW_HASKELL__ > 710
          [NewtypeInstD (cxtToTH cxt) _n _lhs_args (fmap typeToTH _mk) (conToTH con)
                        (concatMap derivClauseToTH derivings)]
    #else
          [NewtypeInstD (cxtToTH cxt) _n _lhs_args (conToTH con)
                        (map derivingToTH derivings)]
    #endif

        DDataCons cons :: [DCon]
    cons ->
    #if __GLASGOW_HASKELL__ >= 807
          [Cxt
    -> Maybe [TyVarBndr]
    -> Type
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataInstD (DCxt -> Cxt
    cxtToTH DCxt
    cxt) (([DTyVarBndr] -> [TyVarBndr])
    -> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndr -> TyVarBndr
    tvbToTH) Maybe [DTyVarBndr]
    _mtvbs) (DType -> Type
    typeToTH DType
    lhs)
                     ((DType -> Type) -> Maybe DType -> Maybe Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DType -> Type
    typeToTH Maybe DType
    _mk) ((DCon -> Con) -> [DCon] -> [Con]
    forall a b. (a -> b) -> [a] -> [b]
    map DCon -> Con
    conToTH [DCon]
    cons)
                     ((DDerivClause -> [DerivClause]) -> [DDerivClause] -> [DerivClause]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DDerivClause -> [DerivClause]
    derivClauseToTH [DDerivClause]
    derivings)]
    #elif __GLASGOW_HASKELL__ > 710
          [DataInstD (cxtToTH cxt) _n _lhs_args (fmap typeToTH _mk) (map conToTH cons)
                     (concatMap derivClauseToTH derivings)]
    #else
          [DataInstD (cxtToTH cxt) _n _lhs_args (map conToTH cons)
                     (map derivingToTH derivings)]
    #endif
      where
        _lhs' :: Type
    _lhs' = DType -> Type
    typeToTH DType
    lhs
        (_n :: Name
    _n, _lhs_args :: Cxt
    _lhs_args) =
          case Type -> (Type, [TypeArg])
    unfoldType Type
    _lhs' of
            (ConT n :: Name
    n, lhs_args :: [TypeArg]
    lhs_args) -> (Name
    n, [TypeArg] -> Cxt
    filterTANormals [TypeArg]
    lhs_args)
            (_, _) -> [Char] -> (Name, Cxt)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (Name, Cxt)) -> [Char] -> (Name, Cxt)
    forall a b. (a -> b) -> a -> b
    $ "Illegal data instance LHS: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall a. Ppr a => a -> [Char]
    pprint Type
    _lhs'

    #if __GLASGOW_HASKELL__ > 710
    frsToTH :: DFamilyResultSig -> FamilyResultSig
    frsToTH :: DFamilyResultSig -> FamilyResultSig
    frsToTH DNoSig          = FamilyResultSig
    NoSig
    frsToTH (DKindSig k :: DType
    k)    = Type -> FamilyResultSig
    KindSig (DType -> Type
    typeToTH DType
    k)
    frsToTH (DTyVarSig tvb :: DTyVarBndr
    tvb) = TyVarBndr -> FamilyResultSig
    TyVarSig (DTyVarBndr -> TyVarBndr
    tvbToTH DTyVarBndr
    tvb)
    #else
    frsToTH :: DFamilyResultSig -> Maybe Kind
    frsToTH DNoSig                      = Nothing
    frsToTH (DKindSig k)                = Just (typeToTH k)
    frsToTH (DTyVarSig (DPlainTV _))    = Nothing
    frsToTH (DTyVarSig (DKindedTV _ k)) = Just (typeToTH k)
    #endif

    #if __GLASGOW_HASKELL__ <= 710
    derivingToTH :: DDerivClause -> Name
    derivingToTH (DDerivClause _ [DConT nm]) = nm
    derivingToTH p =
      error ("Template Haskell in GHC < 8.0 only allows simple derivings: " ++ show p)
    #endif

    -- | Note: This can currently only return a 'Nothing' if the 'DLetDec' is a pragma which
    -- is not supported by the GHC version being used.
    letDecToTH :: DLetDec -> Maybe Dec
    letDecToTH :: DLetDec -> Maybe Dec
    letDecToTH (DFunD name :: Name
    name clauses :: [DClause]
    clauses) = Dec -> Maybe Dec
    forall a. a -> Maybe a
    Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> [Clause] -> Dec
    FunD Name
    name ((DClause -> Clause) -> [DClause] -> [Clause]
    forall a b. (a -> b) -> [a] -> [b]
    map DClause -> Clause
    clauseToTH [DClause]
    clauses)
    letDecToTH (DValD pat :: DPat
    pat exp :: DExp
    exp)      = Dec -> Maybe Dec
    forall a. a -> Maybe a
    Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
    forall a b. (a -> b) -> a -> b
    $ Pat -> Body -> [Dec] -> Dec
    ValD (DPat -> Pat
    patToTH DPat
    pat) (Exp -> Body
    NormalB (DExp -> Exp
    expToTH DExp
    exp)) []
    letDecToTH (DSigD name :: Name
    name ty :: DType
    ty)      = Dec -> Maybe Dec
    forall a. a -> Maybe a
    Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
    forall a b. (a -> b) -> a -> b
    $ Name -> Type -> Dec
    SigD Name
    name (DType -> Type
    typeToTH DType
    ty)
    letDecToTH (DInfixD f :: Fixity
    f name :: Name
    name)     = Dec -> Maybe Dec
    forall a. a -> Maybe a
    Just (Dec -> Maybe Dec) -> Dec -> Maybe Dec
    forall a b. (a -> b) -> a -> b
    $ Fixity -> Name -> Dec
    InfixD Fixity
    f Name
    name
    letDecToTH (DPragmaD prag :: DPragma
    prag)      = (Pragma -> Dec) -> Maybe Pragma -> Maybe Dec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pragma -> Dec
    PragmaD (DPragma -> Maybe Pragma
    pragmaToTH DPragma
    prag)

    conToTH :: DCon -> Con
    #if __GLASGOW_HASKELL__ > 710
    conToTH :: DCon -> Con
    conToTH (DCon [] [] n :: Name
    n (DNormalC _ stys :: [DBangType]
    stys) rty :: DType
    rty) =
      [Name] -> [BangType] -> Type -> Con
    GadtC [Name
    n] ((DBangType -> BangType) -> [DBangType] -> [BangType]
    forall a b. (a -> b) -> [a] -> [b]
    map ((DType -> Type) -> DBangType -> BangType
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second DType -> Type
    typeToTH) [DBangType]
    stys) (DType -> Type
    typeToTH DType
    rty)
    conToTH (DCon [] [] n :: Name
    n (DRecC vstys :: [DVarBangType]
    vstys) rty :: DType
    rty) =
      [Name] -> [VarBangType] -> Type -> Con
    RecGadtC [Name
    n] ((DVarBangType -> VarBangType) -> [DVarBangType] -> [VarBangType]
    forall a b. (a -> b) -> [a] -> [b]
    map ((DType -> Type) -> DVarBangType -> VarBangType
    forall a b c d. (a -> b) -> (c, d, a) -> (c, d, b)
    thirdOf3 DType -> Type
    typeToTH) [DVarBangType]
    vstys) (DType -> Type
    typeToTH DType
    rty)
    #else
    conToTH (DCon [] [] n (DNormalC True [sty1, sty2]) _) =
      InfixC ((bangToStrict *** typeToTH) sty1) n ((bangToStrict *** typeToTH) sty2)
    -- Note: it's possible that someone could pass in a DNormalC value that
    -- erroneously claims that it's declared infix (e.g., if has more than two
    -- fields), but we will fall back on NormalC in such a scenario.
    conToTH (DCon [] [] n (DNormalC _ stys) _) =
      NormalC n (map (bangToStrict *** typeToTH) stys)
    conToTH (DCon [] [] n (DRecC vstys) _) =
      RecC n (map (\(v,b,t) -> (v,bangToStrict b,typeToTH t)) vstys)
    #endif
    #if __GLASGOW_HASKELL__ > 710
    -- On GHC 8.0 or later, we sweeten every constructor to GADT syntax, so it is
    -- perfectly OK to put all of the quantified type variables
    -- (both universal and existential) in a ForallC.
    conToTH (DCon tvbs :: [DTyVarBndr]
    tvbs cxt :: DCxt
    cxt n :: Name
    n fields :: DConFields
    fields rty :: DType
    rty) =
      [TyVarBndr] -> Cxt -> Con -> Con
    ForallC ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) (DCxt -> Cxt
    cxtToTH DCxt
    cxt) (DCon -> Con
    conToTH (DCon -> Con) -> DCon -> Con
    forall a b. (a -> b) -> a -> b
    $ [DTyVarBndr] -> DCxt -> Name -> DConFields -> DType -> DCon
    DCon [] [] Name
    n DConFields
    fields DType
    rty)
    #else
    -- On GHCs earlier than 8.0, we must be careful, since the only time ForallC is
    -- used is when there are either:
    --
    -- 1. Any existentially quantified type variables
    -- 2. A constructor context
    --
    -- If neither of these conditions hold, then we needn't put a ForallC at the
    -- front, since it would be completely pointless (you'd end up with things like
    -- @data Foo = forall. MkFoo@!).
    conToTH (DCon tvbs cxt n fields rty)
      | null ex_tvbs && null cxt
      = con'
      | otherwise
      = ForallC ex_tvbs (cxtToTH cxt) con'
      where
        -- Fortunately, on old GHCs, it's especially easy to distinguish between
        -- universally and existentially quantified type variables. When desugaring
        -- a ForallC, we just stick all of the universals (from the datatype
        -- definition) at the front of the @forall@. Therefore, it suffices to
        -- count the number of type variables in the return type and drop that many
        -- variables from the @forall@ in the ForallC, leaving only the
        -- existentials.
        ex_tvbs :: [TyVarBndr]
        ex_tvbs = map tvbToTH $ drop num_univ_tvs tvbs

        num_univ_tvs :: Int
        num_univ_tvs = go rty
          where
            go :: DType -> Int
            go (DAppT t1 t2) = go t1 + go t2
            go (DSigT t _)   = go t
            go (DVarT {})    = 1
            go (DConT {})    = 0
            go DArrowT       = 0
            go (DLitT {})    = 0
            -- These won't show up on pre-8.0 GHCs
            go (DForallT {})  = error "`forall` type used in GADT return type"
            go DWildCardT     = 0
            go (DAppKindT {}) = 0

        con' :: Con
        con' = conToTH $ DCon [] [] n fields rty
    #endif

    instanceDToTH :: Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
    instanceDToTH :: Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
    instanceDToTH _over :: Maybe Overlap
    _over cxt :: DCxt
    cxt ty :: DType
    ty decs :: [DDec]
    decs =
      Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
    InstanceD
    #if __GLASGOW_HASKELL__ >= 800
                Maybe Overlap
    _over
    #endif
                (DCxt -> Cxt
    cxtToTH DCxt
    cxt) (DType -> Type
    typeToTH DType
    ty) ([DDec] -> [Dec]
    decsToTH [DDec]
    decs)

    standaloneDerivDToTH :: Maybe DDerivStrategy -> DCxt -> DType -> Dec
    #if __GLASGOW_HASKELL__ >= 710
    standaloneDerivDToTH :: Maybe DDerivStrategy -> DCxt -> DType -> Dec
    standaloneDerivDToTH _mds :: Maybe DDerivStrategy
    _mds cxt :: DCxt
    cxt ty :: DType
    ty =
      Maybe DerivStrategy -> Cxt -> Type -> Dec
    StandaloneDerivD
    #if __GLASGOW_HASKELL__ >= 802
                       ((DDerivStrategy -> DerivStrategy)
    -> Maybe DDerivStrategy -> Maybe DerivStrategy
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DDerivStrategy -> DerivStrategy
    derivStrategyToTH Maybe DDerivStrategy
    _mds)
    #endif
                       (DCxt -> Cxt
    cxtToTH DCxt
    cxt) (DType -> Type
    typeToTH DType
    ty)
    #else
    standaloneDerivDToTH _ _ _ = error "Standalone deriving supported only in GHC 7.10+"
    #endif

    foreignToTH :: DForeign -> Foreign
    foreignToTH :: DForeign -> Foreign
    foreignToTH (DImportF cc :: Callconv
    cc safety :: Safety
    safety str :: [Char]
    str n :: Name
    n ty :: DType
    ty) =
      Callconv -> Safety -> [Char] -> Name -> Type -> Foreign
    ImportF Callconv
    cc Safety
    safety [Char]
    str Name
    n (DType -> Type
    typeToTH DType
    ty)
    foreignToTH (DExportF cc :: Callconv
    cc str :: [Char]
    str n :: Name
    n ty :: DType
    ty) = Callconv -> [Char] -> Name -> Type -> Foreign
    ExportF Callconv
    cc [Char]
    str Name
    n (DType -> Type
    typeToTH DType
    ty)

    pragmaToTH :: DPragma -> Maybe Pragma
    pragmaToTH :: DPragma -> Maybe Pragma
    pragmaToTH (DInlineP n :: Name
    n inl :: Inline
    inl rm :: RuleMatch
    rm phases :: Phases
    phases) = Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ Name -> Inline -> RuleMatch -> Phases -> Pragma
    InlineP Name
    n Inline
    inl RuleMatch
    rm Phases
    phases
    pragmaToTH (DSpecialiseP n :: Name
    n ty :: DType
    ty m_inl :: Maybe Inline
    m_inl phases :: Phases
    phases) =
      Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ Name -> Type -> Maybe Inline -> Phases -> Pragma
    SpecialiseP Name
    n (DType -> Type
    typeToTH DType
    ty) Maybe Inline
    m_inl Phases
    phases
    pragmaToTH (DSpecialiseInstP ty :: DType
    ty) = Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ Type -> Pragma
    SpecialiseInstP (DType -> Type
    typeToTH DType
    ty)
    #if __GLASGOW_HASKELL__ >= 807
    pragmaToTH (DRuleP str :: [Char]
    str mtvbs :: Maybe [DTyVarBndr]
    mtvbs rbs :: [DRuleBndr]
    rbs lhs :: DExp
    lhs rhs :: DExp
    rhs phases :: Phases
    phases) =
      Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ [Char]
    -> Maybe [TyVarBndr]
    -> [RuleBndr]
    -> Exp
    -> Exp
    -> Phases
    -> Pragma
    RuleP [Char]
    str (([DTyVarBndr] -> [TyVarBndr])
    -> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndr -> TyVarBndr
    tvbToTH) Maybe [DTyVarBndr]
    mtvbs) ((DRuleBndr -> RuleBndr) -> [DRuleBndr] -> [RuleBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DRuleBndr -> RuleBndr
    ruleBndrToTH [DRuleBndr]
    rbs)
                   (DExp -> Exp
    expToTH DExp
    lhs) (DExp -> Exp
    expToTH DExp
    rhs) Phases
    phases
    #else
    pragmaToTH (DRuleP str _ rbs lhs rhs phases) =
      Just $ RuleP str (map ruleBndrToTH rbs) (expToTH lhs) (expToTH rhs) phases
    #endif
    pragmaToTH (DAnnP target :: AnnTarget
    target exp :: DExp
    exp) = Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ AnnTarget -> Exp -> Pragma
    AnnP AnnTarget
    target (DExp -> Exp
    expToTH DExp
    exp)
    #if __GLASGOW_HASKELL__ < 709
    pragmaToTH (DLineP {}) = Nothing
    #else
    pragmaToTH (DLineP n :: Int
    n str :: [Char]
    str) = Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ Int -> [Char] -> Pragma
    LineP Int
    n [Char]
    str
    #endif
    #if __GLASGOW_HASKELL__ < 801
    pragmaToTH (DCompleteP {}) = Nothing
    #else
    pragmaToTH (DCompleteP cls :: [Name]
    cls mty :: Maybe Name
    mty) = Pragma -> Maybe Pragma
    forall a. a -> Maybe a
    Just (Pragma -> Maybe Pragma) -> Pragma -> Maybe Pragma
    forall a b. (a -> b) -> a -> b
    $ [Name] -> Maybe Name -> Pragma
    CompleteP [Name]
    cls Maybe Name
    mty
    #endif

    ruleBndrToTH :: DRuleBndr -> RuleBndr
    ruleBndrToTH :: DRuleBndr -> RuleBndr
    ruleBndrToTH (DRuleVar n :: Name
    n) = Name -> RuleBndr
    RuleVar Name
    n
    ruleBndrToTH (DTypedRuleVar n :: Name
    n ty :: DType
    ty) = Name -> Type -> RuleBndr
    TypedRuleVar Name
    n (DType -> Type
    typeToTH DType
    ty)

    #if __GLASGOW_HASKELL__ >= 807
    -- | It's convenient to also return a 'Name' here, since some call sites make
    -- use of it.
    tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
    tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
    tySynEqnToTH (DTySynEqn tvbs :: Maybe [DTyVarBndr]
    tvbs lhs :: DType
    lhs rhs :: DType
    rhs) =
      let lhs' :: Type
    lhs' = DType -> Type
    typeToTH DType
    lhs in
      case Type -> (Type, [TypeArg])
    unfoldType Type
    lhs' of
        (ConT n :: Name
    n, _lhs_args :: [TypeArg]
    _lhs_args) -> (Name
    n, Maybe [TyVarBndr] -> Type -> Type -> TySynEqn
    TySynEqn (([DTyVarBndr] -> [TyVarBndr])
    -> Maybe [DTyVarBndr] -> Maybe [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndr -> TyVarBndr
    tvbToTH) Maybe [DTyVarBndr]
    tvbs) Type
    lhs' (DType -> Type
    typeToTH DType
    rhs))
        (_, _) -> [Char] -> (Name, TySynEqn)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (Name, TySynEqn)) -> [Char] -> (Name, TySynEqn)
    forall a b. (a -> b) -> a -> b
    $ "Illegal type instance LHS: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [Char]
    forall a. Ppr a => a -> [Char]
    pprint Type
    lhs'
    #else
    tySynEqnToTH :: DTySynEqn -> (Name, TySynEqn)
    tySynEqnToTH (DTySynEqn _ lhs rhs) =
      let lhs' = typeToTH lhs in
      case unfoldType lhs' of
        (ConT n, lhs_args) -> (n, TySynEqn (filterTANormals lhs_args) (typeToTH rhs))
        (_, _) -> error $ "Illegal type instance LHS: " ++ pprint lhs'
    #endif

    clauseToTH :: DClause -> Clause
    clauseToTH :: DClause -> Clause
    clauseToTH (DClause pats :: [DPat]
    pats exp :: DExp
    exp) = [Pat] -> Body -> [Dec] -> Clause
    Clause ((DPat -> Pat) -> [DPat] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map DPat -> Pat
    patToTH [DPat]
    pats) (Exp -> Body
    NormalB (DExp -> Exp
    expToTH DExp
    exp)) []

    typeToTH :: DType -> Type
    typeToTH :: DType -> Type
    typeToTH (DForallT tvbs :: [DTyVarBndr]
    tvbs cxt :: DCxt
    cxt ty :: DType
    ty) = [TyVarBndr] -> Cxt -> Type -> Type
    ForallT ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) ((DType -> Type) -> DCxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH DCxt
    cxt) (DType -> Type
    typeToTH DType
    ty)
    typeToTH (DAppT t1 :: DType
    t1 t2 :: DType
    t2)          = Type -> Type -> Type
    AppT (DType -> Type
    typeToTH DType
    t1) (DType -> Type
    typeToTH DType
    t2)
    typeToTH (DSigT ty :: DType
    ty ki :: DType
    ki)          = Type -> Type -> Type
    SigT (DType -> Type
    typeToTH DType
    ty) (DType -> Type
    typeToTH DType
    ki)
    typeToTH (DVarT n :: Name
    n)              = Name -> Type
    VarT Name
    n
    typeToTH (DConT n :: Name
    n)              = Name -> Type
    tyconToTH Name
    n
    typeToTH DArrowT                = Type
    ArrowT
    typeToTH (DLitT lit :: TyLit
    lit)            = TyLit -> Type
    LitT TyLit
    lit
    #if __GLASGOW_HASKELL__ > 710
    typeToTH DWildCardT = Type
    WildCardT
    #else
    typeToTH DWildCardT = error "Wildcards supported only in GHC 8.0+"
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    typeToTH (DAppKindT t :: DType
    t k :: DType
    k)        = Type -> Type -> Type
    AppKindT (DType -> Type
    typeToTH DType
    t) (DType -> Type
    typeToTH DType
    k)
    #else
    -- In the event that we're on a version of Template Haskell without support for
    -- kind applications, we will simply drop the applied kind.
    typeToTH (DAppKindT t _)        = typeToTH t
    #endif

    tvbToTH :: DTyVarBndr -> TyVarBndr
    tvbToTH :: DTyVarBndr -> TyVarBndr
    tvbToTH (DPlainTV n :: Name
    n)           = Name -> TyVarBndr
    PlainTV Name
    n
    tvbToTH (DKindedTV n :: Name
    n k :: DType
    k)        = Name -> Type -> TyVarBndr
    KindedTV Name
    n (DType -> Type
    typeToTH DType
    k)

    cxtToTH :: DCxt -> Cxt
    cxtToTH :: DCxt -> Cxt
    cxtToTH = (DType -> Type) -> DCxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH

    #if __GLASGOW_HASKELL__ >= 801
    derivClauseToTH :: DDerivClause -> [DerivClause]
    derivClauseToTH :: DDerivClause -> [DerivClause]
    derivClauseToTH (DDerivClause mds :: Maybe DDerivStrategy
    mds cxt :: DCxt
    cxt) =
      [Maybe DerivStrategy -> Cxt -> DerivClause
    DerivClause ((DDerivStrategy -> DerivStrategy)
    -> Maybe DDerivStrategy -> Maybe DerivStrategy
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DDerivStrategy -> DerivStrategy
    derivStrategyToTH Maybe DDerivStrategy
    mds) (DCxt -> Cxt
    cxtToTH DCxt
    cxt)]
    #else
    derivClauseToTH :: DDerivClause -> Cxt
    derivClauseToTH (DDerivClause _ cxt) = cxtToTH cxt
    #endif

    #if __GLASGOW_HASKELL__ >= 801
    derivStrategyToTH :: DDerivStrategy -> DerivStrategy
    derivStrategyToTH :: DDerivStrategy -> DerivStrategy
    derivStrategyToTH DStockStrategy    = DerivStrategy
    StockStrategy
    derivStrategyToTH DAnyclassStrategy = DerivStrategy
    AnyclassStrategy
    derivStrategyToTH DNewtypeStrategy  = DerivStrategy
    NewtypeStrategy
    #if __GLASGOW_HASKELL__ >= 805
    derivStrategyToTH (DViaStrategy ty :: DType
    ty) = Type -> DerivStrategy
    ViaStrategy (DType -> Type
    typeToTH DType
    ty)
    #else
    derivStrategyToTH (DViaStrategy _)  = error "DerivingVia supported only in GHC 8.6+"
    #endif
    #endif

    #if __GLASGOW_HASKELL__ >= 801
    patSynDirToTH :: DPatSynDir -> PatSynDir
    patSynDirToTH :: DPatSynDir -> PatSynDir
    patSynDirToTH DUnidir              = PatSynDir
    Unidir
    patSynDirToTH DImplBidir           = PatSynDir
    ImplBidir
    patSynDirToTH (DExplBidir clauses :: [DClause]
    clauses) = [Clause] -> PatSynDir
    ExplBidir ((DClause -> Clause) -> [DClause] -> [Clause]
    forall a b. (a -> b) -> [a] -> [b]
    map DClause -> Clause
    clauseToTH [DClause]
    clauses)
    #endif

    predToTH :: DPred -> Pred
    #if __GLASGOW_HASKELL__ < 709
    predToTH = go []
      where
        go acc (DAppT p t) = go (typeToTH t : acc) p
        -- In the event that we're on a version of Template Haskell without support
        -- for kind applications, we will simply drop the applied kind.
        go acc (DAppKindT t _) = go acc t
        go acc (DSigT p _) = go acc                p  -- this shouldn't happen.
        go acc (DConT n)
          | nameBase n == "~"
          , [t1, t2] <- acc
          = EqualP t1 t2
          | otherwise
          = ClassP n acc
        go _   (DVarT _)
          = error "Template Haskell in GHC <= 7.8 does not support variable constraints."
        go _ DWildCardT
          = error "Wildcards supported only in GHC 8.0+"
        go _ (DForallT {})
          = error "Quantified constraints supported only in GHC 8.6+"
        go _ DArrowT
          = error "(->) spotted at head of a constraint"
        go _ (DLitT {})
          = error "Type-level literal spotted at head of a constraint"
    #else
    predToTH :: DType -> Type
    predToTH (DAppT p :: DType
    p t :: DType
    t) = Type -> Type -> Type
    AppT (DType -> Type
    predToTH DType
    p) (DType -> Type
    typeToTH DType
    t)
    predToTH (DSigT p :: DType
    p k :: DType
    k) = Type -> Type -> Type
    SigT (DType -> Type
    predToTH DType
    p) (DType -> Type
    typeToTH DType
    k)
    predToTH (DVarT n :: Name
    n)   = Name -> Type
    VarT Name
    n
    predToTH (DConT n :: Name
    n)   = DType -> Type
    typeToTH (Name -> DType
    DConT Name
    n)
    predToTH DArrowT     = Type
    ArrowT
    predToTH (DLitT lit :: TyLit
    lit) = TyLit -> Type
    LitT TyLit
    lit
    #if __GLASGOW_HASKELL__ > 710
    predToTH DWildCardT  = Type
    WildCardT
    #else
    predToTH DWildCardT  = error "Wildcards supported only in GHC 8.0+"
    #endif
    #if __GLASGOW_HASKELL__ >= 805
    predToTH (DForallT tvbs :: [DTyVarBndr]
    tvbs cxt :: DCxt
    cxt p :: DType
    p) =
      [TyVarBndr] -> Cxt -> Type -> Type
    ForallT ((DTyVarBndr -> TyVarBndr) -> [DTyVarBndr] -> [TyVarBndr]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> TyVarBndr
    tvbToTH [DTyVarBndr]
    tvbs) ((DType -> Type) -> DCxt -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH DCxt
    cxt) (DType -> Type
    predToTH DType
    p)
    #else
    predToTH (DForallT {}) = error "Quantified constraints supported only in GHC 8.6+"
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    predToTH (DAppKindT p :: DType
    p k :: DType
    k) = Type -> Type -> Type
    AppKindT (DType -> Type
    predToTH DType
    p) (DType -> Type
    typeToTH DType
    k)
    #else
    -- In the event that we're on a version of Template Haskell without support for
    -- kind applications, we will simply drop the applied kind.
    predToTH (DAppKindT p _) = predToTH p
    #endif
    #endif

    tyconToTH :: Name -> Type
    tyconToTH :: Name -> Type
    tyconToTH n :: Name
    n
      | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''(->)                 = Type
    ArrowT -- Work around Trac #14888
      | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''[]                   = Type
    ListT
    #if __GLASGOW_HASKELL__ >= 709
      | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''(~)                  = Type
    EqualityT
    #endif
      | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == '[]                    = Type
    PromotedNilT
      | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == '(:)                   = Type
    PromotedConsT
      | Just deg :: Int
    deg <- Name -> Maybe Int
    tupleNameDegree_maybe Name
    n
                                    = if Name -> Bool
    isDataName Name
    n
    #if __GLASGOW_HASKELL__ >= 805
                                      then Int -> Type
    PromotedTupleT Int
    deg
    #else
                                      then PromotedT n -- Work around Trac #14843
    #endif
                                      else Int -> Type
    TupleT Int
    deg
      | Just deg :: Int
    deg <- Name -> Maybe Int
    unboxedTupleNameDegree_maybe Name
    n = Int -> Type
    UnboxedTupleT Int
    deg
    #if __GLASGOW_HASKELL__ >= 801
      | Just deg :: Int
    deg <- Name -> Maybe Int
    unboxedSumNameDegree_maybe Name
    n   = Int -> Type
    UnboxedSumT Int
    deg
    #endif
      | Bool
    otherwise                   = Name -> Type
    ConT Name
    n

    typeArgToTH :: DTypeArg -> TypeArg
    typeArgToTH :: DTypeArg -> TypeArg
    typeArgToTH (DTANormal t :: DType
    t) = Type -> TypeArg
    TANormal (DType -> Type
    typeToTH DType
    t)
    typeArgToTH (DTyArg k :: DType
    k)    = Type -> TypeArg
    TyArg    (DType -> Type
    typeToTH DType
    k)

    #if __GLASGOW_HASKELL__ <= 710
    -- | Convert a 'Bang' to a 'Strict'
    bangToStrict :: Bang -> Strict
    bangToStrict (Bang SourceUnpack _) = Unpacked
    bangToStrict (Bang _ SourceStrict) = IsStrict
    bangToStrict (Bang _ _)            = NotStrict
    #endif