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

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

    Converts desugared TH back into real TH.
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TemplateHaskellQuotes #-}

    -----------------------------------------------------------------------------
    -- |
    -- 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 (Extension(..), cxt)
    import Language.Haskell.TH.Datatype.TyVarBndr

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

    expToTH :: DExp -> Exp
    expToTH :: DExp -> Exp
    expToTH (DVarE Name
    n)            = Name -> Exp
    VarE Name
    n
    expToTH (DConE Name
    n)            = Name -> Exp
    ConE Name
    n
    expToTH (DLitE Lit
    l)            = Lit -> Exp
    LitE Lit
    l
    expToTH (DAppE DExp
    e1 DExp
    e2)        = Exp -> Exp -> Exp
    AppE (DExp -> Exp
    expToTH DExp
    e1) (DExp -> Exp
    expToTH DExp
    e2)
    expToTH (DLamE [Name]
    names 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 DExp
    exp [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 [DLetDec]
    decs DExp
    exp)     = [Dec] -> Exp -> Exp
    LetE ((DLetDec -> Dec) -> [DLetDec] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map DLetDec -> Dec
    letDecToTH [DLetDec]
    decs) (DExp -> Exp
    expToTH DExp
    exp)
    expToTH (DSigE DExp
    exp DType
    ty)       = Exp -> Type -> Exp
    SigE (DExp -> Exp
    expToTH DExp
    exp) (DType -> Type
    typeToTH DType
    ty)
    expToTH (DStaticE DExp
    exp)       = Exp -> Exp
    StaticE (DExp -> Exp
    expToTH DExp
    exp)
    #if __GLASGOW_HASKELL__ >= 801
    expToTH (DAppTypeE DExp
    exp 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
    #if __GLASGOW_HASKELL__ >= 907
    expToTH (DTypedBracketE DExp
    exp) = Exp -> Exp
    TypedBracketE (DExp -> Exp
    expToTH DExp
    exp)
    expToTH (DTypedSpliceE DExp
    exp)  = Exp -> Exp
    TypedSpliceE (DExp -> Exp
    expToTH DExp
    exp)
    #else
    expToTH (DTypedBracketE {})  =
      error "Typed Template Haskell brackets supported only in GHC 9.8+"
    expToTH (DTypedSpliceE {})   =
      error "Typed Template Haskell splices supported only in GHC 9.8+"
    #endif
    #if __GLASGOW_HASKELL__ >= 909
    expToTH (DTypeE DType
    ty)          = Type -> Exp
    TypeE (DType -> Type
    typeToTH DType
    ty)
    #else
    expToTH (DTypeE {})          =
      error "Embedded type expressions supported only in GHC 9.10+"
    #endif

    matchToTH :: DMatch -> Match
    matchToTH :: DMatch -> Match
    matchToTH (DMatch DPat
    pat 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 -> Pat
    LitP Lit
    lit
    patToTH (DVarP Name
    n)           = Name -> Pat
    VarP Name
    n
    patToTH (DConP Name
    n [DType]
    _tys [DPat]
    pats) = Name -> [Type] -> [Pat] -> Pat
    ConP Name
    n
    #if __GLASGOW_HASKELL__ >= 901
                                       ((DType -> Type) -> [DType] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    typeToTH [DType]
    _tys)
    #endif
                                       ((DPat -> Pat) -> [DPat] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map DPat -> Pat
    patToTH [DPat]
    pats)
    patToTH (DTildeP DPat
    pat)       = Pat -> Pat
    TildeP (DPat -> Pat
    patToTH DPat
    pat)
    patToTH (DBangP DPat
    pat)        = Pat -> Pat
    BangP (DPat -> Pat
    patToTH DPat
    pat)
    patToTH (DSigP DPat
    pat DType
    ty)      = Pat -> Type -> Pat
    SigP (DPat -> Pat
    patToTH DPat
    pat) (DType -> Type
    typeToTH DType
    ty)
    patToTH DPat
    DWildP              = Pat
    WildP
    #if __GLASGOW_HASKELL__ >= 909
    patToTH (DTypeP DType
    ty)         = Type -> Pat
    TypeP (DType -> Type
    typeToTH DType
    ty)
    patToTH (DInvisP DType
    ty)        = Type -> Pat
    InvisP (DType -> Type
    typeToTH DType
    ty)
    #else
    patToTH (DTypeP {})         =
      error "Embedded type patterns supported only in GHC 9.10+"
    patToTH (DInvisP {})        =
      error "Invisible type patterns supported only in GHC 9.10+"
    #endif

    decsToTH :: [DDec] -> [Dec]
    decsToTH :: [DDec] -> [Dec]
    decsToTH = (DDec -> Dec) -> [DDec] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map 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 DLetDec
    d) = DLetDec -> Dec
    letDecToTH DLetDec
    d
    decToTH (DDataD DataFlavor
    Data [DType]
    cxt Name
    n [DTyVarBndrVis]
    tvbs Maybe DType
    _mk [DCon]
    cons [DDerivClause]
    derivings) =
      [Type]
    -> Name
    -> [TyVarBndr BndrVis]
    -> Maybe Type
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD ([DType] -> [Type]
    cxtToTH [DType]
    cxt) Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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)
    decToTH (DDataD DataFlavor
    Newtype [DType]
    cxt Name
    n [DTyVarBndrVis]
    tvbs Maybe DType
    _mk [DCon
    con] [DDerivClause]
    derivings) =
      [Type]
    -> Name
    -> [TyVarBndr BndrVis]
    -> Maybe Type
    -> Con
    -> [DerivClause]
    -> Dec
    NewtypeD ([DType] -> [Type]
    cxtToTH [DType]
    cxt) Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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)
    decToTH (DDataD DataFlavor
    Newtype [DType]
    _cxt Name
    _n [DTyVarBndrVis]
    _tvbs Maybe DType
    _mk [DCon]
    _cons [DDerivClause]
    _derivings) =
      [Char] -> Dec
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Newtype declaration without exactly 1 constructor."
    decToTH (DTySynD Name
    n [DTyVarBndrVis]
    tvbs DType
    ty) = Name -> [TyVarBndr BndrVis] -> Type -> Dec
    TySynD Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) (DType -> Type
    typeToTH DType
    ty)
    decToTH (DClassD [DType]
    cxt Name
    n [DTyVarBndrVis]
    tvbs [FunDep]
    fds [DDec]
    decs) =
      [Type] -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [Dec] -> Dec
    ClassD ([DType] -> [Type]
    cxtToTH [DType]
    cxt) Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) [FunDep]
    fds ([DDec] -> [Dec]
    decsToTH [DDec]
    decs)
    decToTH (DInstanceD Maybe Overlap
    over Maybe [DTyVarBndrUnit]
    _mtvbs [DType]
    cxt DType
    ty [DDec]
    decs) =
      -- We deliberately avoid sweetening _mtvbs. See #151.
      Maybe Overlap -> [DType] -> DType -> [DDec] -> Dec
    instanceDToTH Maybe Overlap
    over [DType]
    cxt DType
    ty [DDec]
    decs
    decToTH (DForeignD DForeign
    f) = Foreign -> Dec
    ForeignD (DForeign -> Foreign
    foreignToTH DForeign
    f)
    decToTH (DOpenTypeFamilyD (DTypeFamilyHead Name
    n [DTyVarBndrVis]
    tvbs DFamilyResultSig
    frs Maybe InjectivityAnn
    ann)) =
      TypeFamilyHead -> Dec
    OpenTypeFamilyD (Name
    -> [TyVarBndr BndrVis]
    -> FamilyResultSig
    -> Maybe InjectivityAnn
    -> TypeFamilyHead
    TypeFamilyHead Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) (DFamilyResultSig -> FamilyResultSig
    frsToTH DFamilyResultSig
    frs) Maybe InjectivityAnn
    ann)
    decToTH (DDataFamilyD Name
    n [DTyVarBndrVis]
    tvbs Maybe DType
    mk) =
      Name -> [TyVarBndr BndrVis] -> Maybe Type -> Dec
    DataFamilyD Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DType -> Type
    typeToTH Maybe DType
    mk)
    decToTH (DDataInstD DataFlavor
    nd [DType]
    cxt Maybe [DTyVarBndrUnit]
    mtvbs DType
    lhs Maybe DType
    mk [DCon]
    cons [DDerivClause]
    derivings) =
      let ndc :: DNewOrDataCons
    ndc = case (DataFlavor
    nd, [DCon]
    cons) of
                  (DataFlavor
    Newtype,  [DCon
    con]) -> DCon -> DNewOrDataCons
    DNewtypeCon DCon
    con
                  (DataFlavor
    Newtype,  [DCon]
    _)     -> [Char] -> DNewOrDataCons
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Newtype that doesn't have only one constructor"
                  (DataFlavor
    Data,     [DCon]
    _)     -> [DCon] -> DNewOrDataCons
    DDataCons [DCon]
    cons
                  (DataFlavor
    TypeData, [DCon]
    _)     -> [Char] -> DNewOrDataCons
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Data family instance that is combined with `type data`"
      in DNewOrDataCons
    -> [DType]
    -> Maybe [DTyVarBndrUnit]
    -> DType
    -> Maybe DType
    -> [DDerivClause]
    -> Dec
    dataInstDecToTH DNewOrDataCons
    ndc [DType]
    cxt Maybe [DTyVarBndrUnit]
    mtvbs DType
    lhs Maybe DType
    mk [DDerivClause]
    derivings
    #if __GLASGOW_HASKELL__ >= 807
    decToTH (DTySynInstD 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
    decToTH (DClosedTypeFamilyD (DTypeFamilyHead Name
    n [DTyVarBndrVis]
    tvbs DFamilyResultSig
    frs Maybe InjectivityAnn
    ann) [DTySynEqn]
    eqns) =
      TypeFamilyHead -> [TySynEqn] -> Dec
    ClosedTypeFamilyD (Name
    -> [TyVarBndr BndrVis]
    -> FamilyResultSig
    -> Maybe InjectivityAnn
    -> TypeFamilyHead
    TypeFamilyHead Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    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)
    decToTH (DRoleAnnotD Name
    n [Role]
    roles) = Name -> [Role] -> Dec
    RoleAnnotD Name
    n [Role]
    roles
    decToTH (DStandaloneDerivD Maybe DDerivStrategy
    mds Maybe [DTyVarBndrUnit]
    _mtvbs [DType]
    cxt DType
    ty) =
      -- We deliberately avoid sweetening _mtvbs. See #151.
      Maybe DDerivStrategy -> [DType] -> DType -> Dec
    standaloneDerivDToTH Maybe DDerivStrategy
    mds [DType]
    cxt DType
    ty
    decToTH (DDefaultSigD Name
    n DType
    ty)        = Name -> Type -> Dec
    DefaultSigD Name
    n (DType -> Type
    typeToTH DType
    ty)
    #if __GLASGOW_HASKELL__ >= 801
    decToTH (DPatSynD Name
    n PatSynArgs
    args DPatSynDir
    dir DPat
    pat) = Name -> PatSynArgs -> PatSynDir -> Pat -> Dec
    PatSynD Name
    n PatSynArgs
    args (DPatSynDir -> PatSynDir
    patSynDirToTH DPatSynDir
    dir) (DPat -> Pat
    patToTH DPat
    pat)
    decToTH (DPatSynSigD Name
    n DType
    ty)        = Name -> Type -> Dec
    PatSynSigD Name
    n (DType -> Type
    typeToTH DType
    ty)
    #else
    decToTH DPatSynD{}    = patSynErr
    decToTH DPatSynSigD{} = patSynErr
    #endif
    #if __GLASGOW_HASKELL__ >= 809
    decToTH (DKiSigD Name
    n DType
    ki) = Name -> Type -> Dec
    KiSigD Name
    n (DType -> Type
    typeToTH DType
    ki)
    #else
    decToTH (DKiSigD {})   =
      error "Standalone kind signatures supported only in GHC 8.10+"
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    decToTH (DDefaultD [DType]
    tys) = [Type] -> Dec
    DefaultD ((DType -> Type) -> [DType] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    typeToTH [DType]
    tys)
    #else
    decToTH (DDefaultD{})   =
      error "Default declarations supported only in GHC 9.4+"
    #endif
    #if __GLASGOW_HASKELL__ >= 906
    decToTH (DDataD DataFlavor
    TypeData [DType]
    _cxt Name
    n [DTyVarBndrVis]
    tvbs Maybe DType
    mk [DCon]
    cons [DDerivClause]
    _derivings) =
      -- NB: Due to the invariants on 'DDataD' and 'TypeData', _cxt and _derivings
      -- will be empty.
      Name -> [TyVarBndr BndrVis] -> Maybe Type -> [Con] -> Dec
    TypeDataD Name
    n ((DTyVarBndrVis -> TyVarBndr BndrVis)
    -> [DTyVarBndrVis] -> [TyVarBndr BndrVis]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrVis -> TyVarBndr BndrVis
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrVis]
    tvbs) ((DType -> Type) -> Maybe DType -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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)
    #else
    decToTH (DDataD TypeData _cxt _n _tvbs _mk _cons _derivings) =
      error "`type data` declarations supported only in GHC 9.6+"
    #endif

    #if __GLASGOW_HASKELL__ < 801
    patSynErr :: a
    patSynErr = error "Pattern synonyms supported only in GHC 8.2+"
    #endif

    -- | 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 [DTyVarBndrUnit] -> DType
                    -> Maybe DKind -> [DDerivClause] -> Dec
    dataInstDecToTH :: DNewOrDataCons
    -> [DType]
    -> Maybe [DTyVarBndrUnit]
    -> DType
    -> Maybe DType
    -> [DDerivClause]
    -> Dec
    dataInstDecToTH DNewOrDataCons
    ndc [DType]
    cxt Maybe [DTyVarBndrUnit]
    _mtvbs DType
    lhs Maybe DType
    _mk [DDerivClause]
    derivings =
      case DNewOrDataCons
    ndc of
        DNewtypeCon DCon
    con ->
    #if __GLASGOW_HASKELL__ >= 807
          [Type]
    -> Maybe [TyVarBndr ()]
    -> Type
    -> Maybe Type
    -> Con
    -> [DerivClause]
    -> Dec
    NewtypeInstD ([DType] -> [Type]
    cxtToTH [DType]
    cxt) (([DTyVarBndrUnit] -> [TyVarBndr ()])
    -> Maybe [DTyVarBndrUnit] -> Maybe [TyVarBndr ()]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndrUnit -> TyVarBndr ())
    -> [DTyVarBndrUnit] -> [TyVarBndr ()]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndrUnit -> TyVarBndr ()
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH) Maybe [DTyVarBndrUnit]
    _mtvbs) (DType -> Type
    typeToTH DType
    lhs)
                       ((DType -> Type) -> Maybe DType -> Maybe Type
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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
          NewtypeInstD (cxtToTH cxt) _n _lhs_args (fmap typeToTH _mk) (conToTH con)
                       (concatMap derivClauseToTH derivings)
    #endif

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

    frsToTH :: DFamilyResultSig -> FamilyResultSig
    frsToTH :: DFamilyResultSig -> FamilyResultSig
    frsToTH DFamilyResultSig
    DNoSig          = FamilyResultSig
    NoSig
    frsToTH (DKindSig DType
    k)    = Type -> FamilyResultSig
    KindSig (DType -> Type
    typeToTH DType
    k)
    frsToTH (DTyVarSig DTyVarBndrUnit
    tvb) = TyVarBndr () -> FamilyResultSig
    TyVarSig (DTyVarBndrUnit -> TyVarBndr ()
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH DTyVarBndrUnit
    tvb)

    -- | Sweeten a 'DLetDec'.
    letDecToTH :: DLetDec -> Dec
    letDecToTH :: DLetDec -> Dec
    letDecToTH (DFunD Name
    name [DClause]
    clauses) = 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 DPat
    pat DExp
    exp)      = Pat -> Body -> [Dec] -> Dec
    ValD (DPat -> Pat
    patToTH DPat
    pat) (Exp -> Body
    NormalB (DExp -> Exp
    expToTH DExp
    exp)) []
    letDecToTH (DSigD Name
    name DType
    ty)      = Name -> Type -> Dec
    SigD Name
    name (DType -> Type
    typeToTH DType
    ty)
    letDecToTH (DInfixD Fixity
    f NamespaceSpecifier
    _ns_spec Name
    name) =
      Fixity -> NamespaceSpecifier -> Name -> Dec
    InfixD Fixity
    f
    #if __GLASGOW_HASKELL__ >= 909
             NamespaceSpecifier
    _ns_spec
    #endif
             Name
    name
    letDecToTH (DPragmaD DPragma
    prag)      = Pragma -> Dec
    PragmaD (DPragma -> Pragma
    pragmaToTH DPragma
    prag)

    conToTH :: DCon -> Con
    conToTH :: DCon -> Con
    conToTH (DCon [] [] Name
    n (DNormalC DDeclaredInfix
    _ [DBangType]
    stys) 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 b c d. (b -> c) -> (d, b) -> (d, c)
    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 [] [] Name
    n (DRecC [DVarBangType]
    vstys) 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)
    -- 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 [DTyVarBndrSpec]
    tvbs [DType]
    cxt Name
    n DConFields
    fields DType
    rty) =
      [TyVarBndr Specificity] -> [Type] -> Con -> Con
    ForallC ((DTyVarBndrSpec -> TyVarBndr Specificity)
    -> [DTyVarBndrSpec] -> [TyVarBndr Specificity]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrSpec -> TyVarBndr Specificity
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrSpec]
    tvbs) ([DType] -> [Type]
    cxtToTH [DType]
    cxt) (DCon -> Con
    conToTH (DCon -> Con) -> DCon -> Con
    forall a b. (a -> b) -> a -> b
    $ [DTyVarBndrSpec] -> [DType] -> Name -> DConFields -> DType -> DCon
    DCon [] [] Name
    n DConFields
    fields DType
    rty)

    instanceDToTH :: Maybe Overlap -> DCxt -> DType -> [DDec] -> Dec
    instanceDToTH :: Maybe Overlap -> [DType] -> DType -> [DDec] -> Dec
    instanceDToTH Maybe Overlap
    over [DType]
    cxt DType
    ty [DDec]
    decs =
      Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    over ([DType] -> [Type]
    cxtToTH [DType]
    cxt) (DType -> Type
    typeToTH DType
    ty) ([DDec] -> [Dec]
    decsToTH [DDec]
    decs)

    standaloneDerivDToTH :: Maybe DDerivStrategy -> DCxt -> DType -> Dec
    standaloneDerivDToTH :: Maybe DDerivStrategy -> [DType] -> DType -> Dec
    standaloneDerivDToTH Maybe DDerivStrategy
    _mds [DType]
    cxt DType
    ty =
      Maybe DerivStrategy -> [Type] -> Type -> Dec
    StandaloneDerivD
    #if __GLASGOW_HASKELL__ >= 802
                       ((DDerivStrategy -> DerivStrategy)
    -> Maybe DDerivStrategy -> Maybe DerivStrategy
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DDerivStrategy -> DerivStrategy
    derivStrategyToTH Maybe DDerivStrategy
    _mds)
    #endif
                       ([DType] -> [Type]
    cxtToTH [DType]
    cxt) (DType -> Type
    typeToTH DType
    ty)

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

    pragmaToTH :: DPragma -> Pragma
    pragmaToTH :: DPragma -> Pragma
    pragmaToTH (DInlineP Name
    n Inline
    inl RuleMatch
    rm Phases
    phases) = Name -> Inline -> RuleMatch -> Phases -> Pragma
    InlineP Name
    n Inline
    inl RuleMatch
    rm Phases
    phases
    pragmaToTH (DSpecialiseP Name
    n DType
    ty Maybe Inline
    m_inl Phases
    phases) =
      Name -> Type -> Maybe Inline -> Phases -> Pragma
    SpecialiseP Name
    n (DType -> Type
    typeToTH DType
    ty) Maybe Inline
    m_inl Phases
    phases
    pragmaToTH (DSpecialiseInstP DType
    ty) = Type -> Pragma
    SpecialiseInstP (DType -> Type
    typeToTH DType
    ty)
    #if __GLASGOW_HASKELL__ >= 807
    pragmaToTH (DRuleP [Char]
    str Maybe [DTyVarBndrUnit]
    mtvbs [DRuleBndr]
    rbs DExp
    lhs DExp
    rhs Phases
    phases) =
      [Char]
    -> Maybe [TyVarBndr ()]
    -> [RuleBndr]
    -> Exp
    -> Exp
    -> Phases
    -> Pragma
    RuleP [Char]
    str (([DTyVarBndrUnit] -> [TyVarBndr ()])
    -> Maybe [DTyVarBndrUnit] -> Maybe [TyVarBndr ()]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndrUnit -> TyVarBndr ())
    -> [DTyVarBndrUnit] -> [TyVarBndr ()]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndrUnit -> TyVarBndr ()
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH) Maybe [DTyVarBndrUnit]
    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) =
      RuleP str (map ruleBndrToTH rbs) (expToTH lhs) (expToTH rhs) phases
    #endif
    pragmaToTH (DAnnP AnnTarget
    target DExp
    exp) = AnnTarget -> Exp -> Pragma
    AnnP AnnTarget
    target (DExp -> Exp
    expToTH DExp
    exp)
    pragmaToTH (DLineP Int
    n [Char]
    str) = Int -> [Char] -> Pragma
    LineP Int
    n [Char]
    str
    #if __GLASGOW_HASKELL__ < 801
    pragmaToTH (DCompleteP {}) = error "COMPLETE pragmas only supported in GHC 8.2+"
    #else
    pragmaToTH (DCompleteP [Name]
    cls Maybe Name
    mty) = [Name] -> Maybe Name -> Pragma
    CompleteP [Name]
    cls Maybe Name
    mty
    #endif
    #if __GLASGOW_HASKELL__ >= 903
    pragmaToTH (DOpaqueP Name
    n) = Name -> Pragma
    OpaqueP Name
    n
    #else
    pragmaToTH (DOpaqueP {}) = error "OPAQUE pragmas only supported in GHC 9.4+"
    #endif
    #if __GLASGOW_HASKELL__ >= 909
    pragmaToTH (DSCCP Name
    nm Maybe [Char]
    mstr) = Name -> Maybe [Char] -> Pragma
    SCCP Name
    nm Maybe [Char]
    mstr
    #else
    pragmaToTH (DSCCP {}) = error "SCCP pragmas only supported in GHC 9.10+"
    #endif

    ruleBndrToTH :: DRuleBndr -> RuleBndr
    ruleBndrToTH :: DRuleBndr -> RuleBndr
    ruleBndrToTH (DRuleVar Name
    n) = Name -> RuleBndr
    RuleVar Name
    n
    ruleBndrToTH (DTypedRuleVar Name
    n 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 Maybe [DTyVarBndrUnit]
    tvbs DType
    lhs DType
    rhs) =
      let lhs' :: Type
    lhs' = DType -> Type
    typeToTH DType
    lhs in
      case Type -> (Type, [TypeArg])
    unfoldType Type
    lhs' of
        (ConT Name
    n, [TypeArg]
    _lhs_args) -> (Name
    n, Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
    TySynEqn (([DTyVarBndrUnit] -> [TyVarBndr ()])
    -> Maybe [DTyVarBndrUnit] -> Maybe [TyVarBndr ()]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((DTyVarBndrUnit -> TyVarBndr ())
    -> [DTyVarBndrUnit] -> [TyVarBndr ()]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap DTyVarBndrUnit -> TyVarBndr ()
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH) Maybe [DTyVarBndrUnit]
    tvbs) Type
    lhs' (DType -> Type
    typeToTH DType
    rhs))
        (Type
    _, [TypeArg]
    _) -> [Char] -> (Name, TySynEqn)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (Name, TySynEqn)) -> [Char] -> (Name, TySynEqn)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "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 [DPat]
    pats 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
    -- We need a special case for DForallT ForallInvis followed by DConstrainedT
    -- so that we may collapse them into a single ForallT when sweetening.
    -- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core.
    typeToTH :: DType -> Type
    typeToTH (DForallT (DForallInvis [DTyVarBndrSpec]
    tvbs) (DConstrainedT [DType]
    ctxt DType
    ty)) =
      [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT ((DTyVarBndrSpec -> TyVarBndr Specificity)
    -> [DTyVarBndrSpec] -> [TyVarBndr Specificity]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrSpec -> TyVarBndr Specificity
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrSpec]
    tvbs) ((DType -> Type) -> [DType] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH [DType]
    ctxt) (DType -> Type
    typeToTH DType
    ty)
    typeToTH (DForallT DForallTelescope
    tele DType
    ty) =
      case DForallTelescope
    tele of
        DForallInvis  [DTyVarBndrSpec]
    tvbs -> [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT ((DTyVarBndrSpec -> TyVarBndr Specificity)
    -> [DTyVarBndrSpec] -> [TyVarBndr Specificity]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrSpec -> TyVarBndr Specificity
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrSpec]
    tvbs) [] Type
    ty'
        DForallVis   [DTyVarBndrUnit]
    _tvbs ->
    #if __GLASGOW_HASKELL__ >= 809
          [TyVarBndr ()] -> Type -> Type
    ForallVisT ((DTyVarBndrUnit -> TyVarBndr ())
    -> [DTyVarBndrUnit] -> [TyVarBndr ()]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrUnit -> TyVarBndr ()
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrUnit]
    _tvbs) Type
    ty'
    #else
          error "Visible dependent quantification supported only in GHC 8.10+"
    #endif
      where
        ty' :: Type
    ty'   = DType -> Type
    typeToTH DType
    ty
    typeToTH (DConstrainedT [DType]
    cxt DType
    ty) = [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT [] ((DType -> Type) -> [DType] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH [DType]
    cxt) (DType -> Type
    typeToTH DType
    ty)
    typeToTH (DAppT DType
    t1 DType
    t2)          = Type -> Type -> Type
    AppT (DType -> Type
    typeToTH DType
    t1) (DType -> Type
    typeToTH DType
    t2)
    typeToTH (DSigT DType
    ty DType
    ki)          = Type -> Type -> Type
    SigT (DType -> Type
    typeToTH DType
    ty) (DType -> Type
    typeToTH DType
    ki)
    typeToTH (DVarT Name
    n)              = Name -> Type
    VarT Name
    n
    typeToTH (DConT Name
    n)              = Name -> Type
    tyconToTH Name
    n
    typeToTH DType
    DArrowT                = Type
    ArrowT
    typeToTH (DLitT TyLit
    lit)            = TyLit -> Type
    LitT TyLit
    lit
    typeToTH DType
    DWildCardT = Type
    WildCardT
    #if __GLASGOW_HASKELL__ >= 807
    typeToTH (DAppKindT DType
    t 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 flag -> TyVarBndr_ flag
    tvbToTH :: forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH (DPlainTV Name
    n flag
    flag)    = Name -> flag -> TyVarBndr_ flag
    forall flag. Name -> flag -> TyVarBndr_ flag
    plainTVFlag Name
    n flag
    flag
    tvbToTH (DKindedTV Name
    n flag
    flag DType
    k) = Name -> flag -> Type -> TyVarBndr_ flag
    forall flag. Name -> flag -> Type -> TyVarBndr_ flag
    kindedTVFlag Name
    n flag
    flag (DType -> Type
    typeToTH DType
    k)

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

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

    #if __GLASGOW_HASKELL__ >= 801
    derivStrategyToTH :: DDerivStrategy -> DerivStrategy
    derivStrategyToTH :: DDerivStrategy -> DerivStrategy
    derivStrategyToTH DDerivStrategy
    DStockStrategy    = DerivStrategy
    StockStrategy
    derivStrategyToTH DDerivStrategy
    DAnyclassStrategy = DerivStrategy
    AnyclassStrategy
    derivStrategyToTH DDerivStrategy
    DNewtypeStrategy  = DerivStrategy
    NewtypeStrategy
    #if __GLASGOW_HASKELL__ >= 805
    derivStrategyToTH (DViaStrategy 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 DPatSynDir
    DUnidir              = PatSynDir
    Unidir
    patSynDirToTH DPatSynDir
    DImplBidir           = PatSynDir
    ImplBidir
    patSynDirToTH (DExplBidir [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
    predToTH :: DType -> Type
    predToTH (DAppT DType
    p DType
    t) = Type -> Type -> Type
    AppT (DType -> Type
    predToTH DType
    p) (DType -> Type
    typeToTH DType
    t)
    predToTH (DSigT DType
    p DType
    k) = Type -> Type -> Type
    SigT (DType -> Type
    predToTH DType
    p) (DType -> Type
    typeToTH DType
    k)
    predToTH (DVarT Name
    n)   = Name -> Type
    VarT Name
    n
    predToTH (DConT Name
    n)   = DType -> Type
    typeToTH (Name -> DType
    DConT Name
    n)
    predToTH DType
    DArrowT     = Type
    ArrowT
    predToTH (DLitT TyLit
    lit) = TyLit -> Type
    LitT TyLit
    lit
    predToTH DType
    DWildCardT  = Type
    WildCardT
    #if __GLASGOW_HASKELL__ >= 805
    -- We need a special case for DForallT ForallInvis followed by DConstrainedT
    -- so that we may collapse them into a single ForallT when sweetening.
    -- See Note [Desugaring and sweetening ForallT] in L.H.T.Desugar.Core.
    predToTH (DForallT (DForallInvis [DTyVarBndrSpec]
    tvbs) (DConstrainedT [DType]
    ctxt DType
    p)) =
      [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT ((DTyVarBndrSpec -> TyVarBndr Specificity)
    -> [DTyVarBndrSpec] -> [TyVarBndr Specificity]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrSpec -> TyVarBndr Specificity
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrSpec]
    tvbs) ((DType -> Type) -> [DType] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH [DType]
    ctxt) (DType -> Type
    predToTH DType
    p)
    predToTH (DForallT DForallTelescope
    tele DType
    p) =
      case DForallTelescope
    tele of
        DForallInvis [DTyVarBndrSpec]
    tvbs -> [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT ((DTyVarBndrSpec -> TyVarBndr Specificity)
    -> [DTyVarBndrSpec] -> [TyVarBndr Specificity]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndrSpec -> TyVarBndr Specificity
    forall flag. DTyVarBndr flag -> TyVarBndr_ flag
    tvbToTH [DTyVarBndrSpec]
    tvbs) [] (DType -> Type
    predToTH DType
    p)
        DForallVis [DTyVarBndrUnit]
    _      -> [Char] -> Type
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Visible dependent quantifier spotted at head of a constraint"
    predToTH (DConstrainedT [DType]
    cxt DType
    p) = [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT [] ((DType -> Type) -> [DType] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map DType -> Type
    predToTH [DType]
    cxt) (DType -> Type
    predToTH DType
    p)
    #else
    predToTH (DForallT {})      = error "Quantified constraints supported only in GHC 8.6+"
    predToTH (DConstrainedT {}) = error "Quantified constraints supported only in GHC 8.6+"
    #endif
    #if __GLASGOW_HASKELL__ >= 807
    predToTH (DAppKindT DType
    p 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

    tyconToTH :: Name -> Type
    tyconToTH :: Name -> Type
    tyconToTH Name
    n
      | Name
    n Name -> Name -> DDeclaredInfix
    forall a. Eq a => a -> a -> DDeclaredInfix
    == ''(->)                 = Type
    ArrowT -- Work around Trac #14888
      | Name
    n Name -> Name -> DDeclaredInfix
    forall a. Eq a => a -> a -> DDeclaredInfix
    == ''[]                   = Type
    ListT
      | Name
    n Name -> Name -> DDeclaredInfix
    forall a. Eq a => a -> a -> DDeclaredInfix
    == ''(~)                  = Type
    EqualityT
      | Name
    n Name -> Name -> DDeclaredInfix
    forall a. Eq a => a -> a -> DDeclaredInfix
    == '[]                    = Type
    PromotedNilT
      | Name
    n Name -> Name -> DDeclaredInfix
    forall a. Eq a => a -> a -> DDeclaredInfix
    == '(:)                   = Type
    PromotedConsT
      | Just Int
    deg <- Name -> Maybe Int
    tupleNameDegree_maybe Name
    n
                                    = if Name -> DDeclaredInfix
    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 Int
    deg <- Name -> Maybe Int
    unboxedTupleNameDegree_maybe Name
    n = Int -> Type
    UnboxedTupleT Int
    deg
    #if __GLASGOW_HASKELL__ >= 801
      | Just Int
    deg <- Name -> Maybe Int
    unboxedSumNameDegree_maybe Name
    n   = Int -> Type
    UnboxedSumT Int
    deg
    #endif
      | DDeclaredInfix
    otherwise                   = Name -> Type
    ConT Name
    n

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