    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE TemplateHaskellQuotes #-}
    {-# LANGUAGE TypeSynonymInstances #-}

    {-# OPTIONS_GHC -Wno-orphans #-}

    module Language.Haskell.TH.Lift
      ( deriveLift
      , deriveLiftMany
      , deriveLift'
      , deriveLiftMany'
      , makeLift
      , makeLift'
      , Lift(..)
      ) where

    import Control.Monad ((<=<), zipWithM)

    import Data.Char (ord)
    import Data.Maybe (catMaybes)

    import GHC.Base (unpackCString#)
    import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))
    import GHC.Prim (Addr#, Char#, Double#, Float#, Int#, Word#)

    import Language.Haskell.TH
    import Language.Haskell.TH.Datatype as Datatype
    import qualified Language.Haskell.TH.Lib as Lib (starK)
    import Language.Haskell.TH.Lift.Internal
    import Language.Haskell.TH.Syntax

    -- | Derive a 'Lift' instance for the given datatype.
    --
    -- Note that 'deriveLift' uses a very simple technique for inferring the
    -- instance context: it simply takes all visible type variables from the data
    -- type declaration and adds a 'Lift' constraint for each one. For instance,
    -- in the following example:
    --
    -- @
    -- data Foo a b = ...
    -- $(deriveLift ''Foo)
    -- @
    --
    -- The following instance would be generated:
    --
    -- @
    -- instance (Lift a, Lift b) => Lift (Foo a b) where ...
    -- @
    --
    -- This will not work in all situations, however. For instance, there could
    -- conceivably be type variables that are not of the appropriate kind. For
    -- these other situations, the 'makeLift' function can provide a more
    -- fine-grained approach that allows specifying the instance context precisely.
    deriveLift :: Name -> Q [Dec]
    deriveLift :: Name -> Q [Dec]
    deriveLift Name
    name = do
      roles <- Name -> Q [Role]
    reifyDatatypeRoles Name
    name
      info <- reifyDatatype name
      fmap (:[]) $ deriveLiftOne roles info

    -- | Derive 'Lift' instances for many datatypes.
    deriveLiftMany :: [Name] -> Q [Dec]
    deriveLiftMany :: [Name] -> Q [Dec]
    deriveLiftMany [Name]
    names = do
      roles <- (Name -> Q [Role]) -> [Name] -> Q [[Role]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Name -> Q [Role]
    reifyDatatypeRoles [Name]
    names
      infos <- mapM reifyDatatype names
      mapM (uncurry deriveLiftOne) $ zip roles infos

    -- | Obtain 'Info' values through a custom reification function. This is useful
    -- when generating instances for datatypes that have not yet been declared.
    deriveLift' :: [Role] -> Info -> Q [Dec]
    deriveLift' :: [Role] -> Info -> Q [Dec]
    deriveLift' [Role]
    roles = (Dec -> [Dec]) -> Q Dec -> Q [Dec]
    forall a b. (a -> b) -> Q a -> Q b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Dec -> [Dec] -> [Dec]
    forall a. a -> [a] -> [a]
    :[]) (Q Dec -> Q [Dec])
    -> (DatatypeInfo -> Q Dec) -> DatatypeInfo -> Q [Dec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Role] -> DatatypeInfo -> Q Dec
    deriveLiftOne [Role]
    roles (DatatypeInfo -> Q [Dec])
    -> (Info -> Q DatatypeInfo) -> Info -> Q [Dec]
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Info -> Q DatatypeInfo
    normalizeInfo

    deriveLiftMany' :: [([Role], Info)] -> Q [Dec]
    deriveLiftMany' :: [([Role], Info)] -> Q [Dec]
    deriveLiftMany' = (([Role], Info) -> Q Dec) -> [([Role], Info)] -> Q [Dec]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\([Role]
    rs, Info
    i) -> [Role] -> DatatypeInfo -> Q Dec
    deriveLiftOne [Role]
    rs (DatatypeInfo -> Q Dec) -> Q DatatypeInfo -> Q Dec
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Info -> Q DatatypeInfo
    normalizeInfo Info
    i)

    -- | Generates a lambda expresson which behaves like 'lift' (without requiring
    -- a 'Lift' instance). Example:
    --
    -- @
    -- newtype Fix f = In { out :: f (Fix f) }
    --
    -- instance Lift (f (Fix f)) => Lift (Fix f) where
    --   lift = $(makeLift ''Fix)
    -- @
    --
    -- This can be useful when 'deriveLift' is not clever enough to infer the
    -- correct instance context, such as in the example above.
    makeLift :: Name -> Q Exp
    makeLift :: Name -> Q Exp
    makeLift = DatatypeInfo -> Q Exp
    makeLiftInternal (DatatypeInfo -> Q Exp)
    -> (Name -> Q DatatypeInfo) -> Name -> Q Exp
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Name -> Q DatatypeInfo
    reifyDatatype

    -- | Like 'makeLift', but using a custom reification function.
    makeLift' :: Info -> Q Exp
    makeLift' :: Info -> Q Exp
    makeLift' = DatatypeInfo -> Q Exp
    makeLiftInternal (DatatypeInfo -> Q Exp)
    -> (Info -> Q DatatypeInfo) -> Info -> Q Exp
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Info -> Q DatatypeInfo
    normalizeInfo

    makeLiftInternal :: DatatypeInfo -> Q Exp
    makeLiftInternal :: DatatypeInfo -> Q Exp
    makeLiftInternal DatatypeInfo
    i = DatatypeInfo
    -> (Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q Exp) -> Q Exp
    forall a.
    DatatypeInfo
    -> (Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q a) -> Q a
    withInfo DatatypeInfo
    i ((Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q Exp) -> Q Exp)
    -> (Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q Exp) -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ \Cxt
    _ Name
    n Cxt
    _ [ConstructorInfo]
    cons -> Name -> [ConstructorInfo] -> Q Exp
    makeLiftOne Name
    n [ConstructorInfo]
    cons

    deriveLiftOne :: [Role] -> DatatypeInfo -> Q Dec
    deriveLiftOne :: [Role] -> DatatypeInfo -> Q Dec
    deriveLiftOne [Role]
    roles DatatypeInfo
    i = DatatypeInfo
    -> (Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q Dec) -> Q Dec
    forall a.
    DatatypeInfo
    -> (Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q a) -> Q a
    withInfo DatatypeInfo
    i Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q Dec
    liftInstance
      where
        liftInstance :: Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q Dec
    liftInstance Cxt
    dcx Name
    n Cxt
    tys [ConstructorInfo]
    cons = do
          -- roles <- reifyDatatypeRoles n
          -- Compute the set of phantom variables.
          let phtys :: Cxt
    phtys = [Maybe Type] -> Cxt
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Type] -> Cxt) -> [Maybe Type] -> Cxt
    forall a b. (a -> b) -> a -> b
    $
                (Type -> Role -> Maybe Type) -> Cxt -> [Role] -> [Maybe Type]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Type
    t Role
    role -> if Role
    role Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    PhantomR then Type -> Maybe Type
    forall a. a -> Maybe a
    Just Type
    t else Maybe Type
    forall a. Maybe a
    Nothing)
                        Cxt
    tys
                        [Role]
    roles
          _x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "x"
          instanceD (ctxt dcx phtys tys)
                    (conT ''Lift `appT` typ n tys)
                    [ funD 'lift [clause [] (normalB (makeLiftOne n cons)) []]
    #if MIN_VERSION_template_haskell(2,16,0)
                    , let rhs = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'unsafeSpliceCoerce Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE`
                                  (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'lift Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    _x) in
                      funD 'liftTyped [clause [varP _x] (normalB rhs) []]
    #endif
                    ]
        typ :: Name -> Cxt -> m Type
    typ Name
    n = (m Type -> m Type -> m Type) -> m Type -> [m Type] -> m Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl m Type -> m Type -> m Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    appT (Name -> m Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT Name
    n) ([m Type] -> m Type) -> (Cxt -> [m Type]) -> Cxt -> m Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> m Type) -> Cxt -> [m Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> m Type
    forall {m :: * -> *}. Monad m => Type -> m Type
    unKind
        -- Only consider *-kinded type variables for now. Furthermore, filter out
        -- type variables that are obviously phantom.
        ctxt :: Cxt -> t Type -> Cxt -> f Cxt
    ctxt Cxt
    dcx t Type
    phtys =
            (Cxt -> Cxt) -> f Cxt -> f Cxt
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Cxt
    dcx Cxt -> Cxt -> Cxt
    forall a. [a] -> [a] -> [a]
    ++) (f Cxt -> f Cxt) -> (Cxt -> f Cxt) -> Cxt -> f Cxt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [f Type] -> f Cxt
    forall (m :: * -> *). Quote m => [m Type] -> m Cxt
    cxt ([f Type] -> f Cxt) -> (Cxt -> [f Type]) -> Cxt -> f Cxt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> [f Type]) -> Cxt -> [f Type]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Type -> [f Type]
    forall {m :: * -> *}. Quote m => Type -> [m Type]
    liftPred (Cxt -> [f Type]) -> (Cxt -> Cxt) -> Cxt -> [f Type]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Type -> Bool) -> Cxt -> Cxt
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Type -> t Type -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` t Type
    phtys)
        liftPred :: Type -> [m Type]
    liftPred Type
    ty =
          case Type
    ty of
            SigT Type
    t Type
    k
              | Type
    k Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    Lib.starK -> Type -> [m Type]
    forall {m :: * -> *}. Quote m => Type -> [m Type]
    mkLift Type
    t
              | Bool
    otherwise      -> []
            Type
    _                  -> Type -> [m Type]
    forall {m :: * -> *}. Quote m => Type -> [m Type]
    mkLift Type
    ty
        mkLift :: Type -> [m Type]
    mkLift Type
    ty = [Name -> m Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT ''Lift m Type -> m Type -> m Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` (Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty)]
        unKind :: Type -> m Type
    unKind (SigT Type
    t Type
    k)
          | Type
    k Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    Lib.starK = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t
        unKind Type
    t           = Type -> m Type
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t

    makeLiftOne :: Name -> [ConstructorInfo] -> Q Exp
    makeLiftOne :: Name -> [ConstructorInfo] -> Q Exp
    makeLiftOne Name
    n [ConstructorInfo]
    cons = do
      e <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "e"
      lam1E (varP e) $ caseE (varE e) $ consMatches n cons

    consMatches :: Name -> [ConstructorInfo] -> [Q Match]
    consMatches :: Name -> [ConstructorInfo] -> [Q Match]
    consMatches Name
    n [] = [Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    e) []]
      where
        e :: Q Exp
    e = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'errorQuoteExp Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE`
                 (String -> Q Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    stringE (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ String
    "Can't lift value of empty datatype " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    n)
    consMatches Name
    _ [ConstructorInfo]
    cons = (ConstructorInfo -> [Q Match]) -> [ConstructorInfo] -> [Q Match]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ConstructorInfo -> [Q Match]
    doCons [ConstructorInfo]
    cons

    doCons :: ConstructorInfo -> [Q Match]
    doCons :: ConstructorInfo -> [Q Match]
    doCons (ConstructorInfo { constructorName :: ConstructorInfo -> Name
    constructorName    = Name
    c
                            , constructorFields :: ConstructorInfo -> Cxt
    constructorFields  = Cxt
    ts
                            , constructorVariant :: ConstructorInfo -> ConstructorVariant
    constructorVariant = ConstructorVariant
    variant
                            }) = (Q Match -> [Q Match] -> [Q Match]
    forall a. a -> [a] -> [a]
    :[]) (Q Match -> [Q Match]) -> Q Match -> [Q Match]
    forall a b. (a -> b) -> a -> b
    $ do
        ns <- (Type -> Int -> Q Name) -> Cxt -> [Int] -> Q [Name]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (\Type
    _ Int
    i -> String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName (Char
    'x'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Int -> String
    forall a. Show a => a -> String
    show (Int
    i :: Int))) Cxt
    ts [Int
    0..]
        let con = [| conE c |]
        case (variant, ns, ts) of
          (ConstructorVariant
    InfixConstructor, [Name
    x0, Name
    x1], [Type
    t0, Type
    t1]) ->
            let e :: Q Exp
    e = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'infixApp Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Type -> Q Exp
    liftVar Name
    x0 Type
    t0 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    con Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Type -> Q Exp
    liftVar Name
    x1 Type
    t1
            in Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Q Pat -> Name -> Q Pat -> Q Pat
    forall (m :: * -> *). Quote m => m Pat -> Name -> m Pat -> m Pat
    infixP (Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    x0) Name
    c (Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    x1)) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    e) []
          (ConstructorVariant
    _, [Name]
    _, Cxt
    _) ->
            let e :: Q Exp
    e = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\Q Exp
    e1 Q Exp
    e2 -> Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'appE Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    e1 Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Q Exp
    e2) Q Exp
    con ([Q Exp] -> Q Exp) -> [Q Exp] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (Name -> Type -> Q Exp) -> [Name] -> Cxt -> [Q Exp]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Name -> Type -> Q Exp
    liftVar [Name]
    ns Cxt
    ts
            in Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (Name -> [Q Pat] -> Q Pat
    forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
    conP Name
    c ((Name -> Q Pat) -> [Name] -> [Q Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP [Name]
    ns)) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    e) []

    -- Reify the roles of a data type. Note that the argument Name may correspond
    -- to that of a data family instance constructor, so we need to go through
    -- reifyDatatype to determine what the parent data family Name is.
    reifyDatatypeRoles :: Name -> Q [Role]
    reifyDatatypeRoles :: Name -> Q [Role]
    reifyDatatypeRoles Name
    n = do
      DatatypeInfo { datatypeName = dn } <- Name -> Q DatatypeInfo
    reifyDatatype Name
    n
      qReifyRoles dn

    liftVar :: Name -> Type -> Q Exp
    liftVar :: Name -> Type -> Q Exp
    liftVar Name
    varName (ConT Name
    tyName)
      | Name
    tyName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Addr#   = [Q Exp] -> Q Exp
    apps
        [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'litE, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'stringPrimL
        , Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'map Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE`
            Q Exp -> Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
    infixApp (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'fromIntegral) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE '(.)) (Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'ord)
        , Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'unpackCString# ]
      | Name
    tyName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Char#   = [Q Exp] -> Q Exp
    apps [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'litE, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'charPrimL, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE 'C# ]
      | Name
    tyName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Double# = [Q Exp] -> Q Exp
    apps [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'litE, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'doublePrimL, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'toRational, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE 'D# ]
      | Name
    tyName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Float#  = [Q Exp] -> Q Exp
    apps [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'litE, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'floatPrimL,  Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'toRational, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE 'F# ]
      | Name
    tyName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Int#    = [Q Exp] -> Q Exp
    apps [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'litE, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'intPrimL,    Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'toInteger,  Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE 'I# ]
      | Name
    tyName Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Word#   = [Q Exp] -> Q Exp
    apps [ Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'litE, Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'wordPrimL,   Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'toInteger,  Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE 'W# ]

      where
        apps :: [Q Exp] -> Q Exp
    apps  = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE Q Exp
    var

        var :: Q Exp
        var :: Q Exp
    var = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    varName

    liftVar Name
    varName Type
    _ = Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE 'lift Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Name -> Q Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE Name
    varName

    withInfo :: DatatypeInfo
             -> (Cxt -> Name -> [Type] -> [ConstructorInfo] -> Q a)
             -> Q a
    withInfo :: forall a.
    DatatypeInfo
    -> (Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q a) -> Q a
    withInfo DatatypeInfo
    i Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q a
    f = case DatatypeInfo
    i of
        DatatypeInfo { datatypeContext :: DatatypeInfo -> Cxt
    datatypeContext   = Cxt
    dcx
                     , datatypeName :: DatatypeInfo -> Name
    datatypeName      = Name
    n
                     , datatypeInstTypes :: DatatypeInfo -> Cxt
    datatypeInstTypes = Cxt
    vs
                     , datatypeCons :: DatatypeInfo -> [ConstructorInfo]
    datatypeCons      = [ConstructorInfo]
    cons
                     , datatypeVariant :: DatatypeInfo -> DatatypeVariant
    datatypeVariant   = DatatypeVariant
    variant
                     } -> do
          case DatatypeVariant
    variant of
            DatatypeVariant
    Datatype.TypeData -> Name -> Q ()
    forall a. Name -> Q a
    typeDataError Name
    n
            DatatypeVariant
    _ -> () -> Q ()
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Cxt -> Name -> Cxt -> [ConstructorInfo] -> Q a
    f Cxt
    dcx Name
    n Cxt
    vs [ConstructorInfo]
    cons

    -- | We cannot define implementations for @lift@ at the term level for
    -- @type data@ declarations, which only exist at the type level.
    typeDataError :: Name -> Q a
    typeDataError :: forall a. Name -> Q a
    typeDataError Name
    dataName = String -> Q a
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
      (String -> Q a) -> (String -> String) -> String -> Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "Cannot derive instance for ‘"
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString (Name -> String
    nameBase Name
    dataName)
      (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    showString String
    "‘, which is a ‘type data‘ declaration"
      (String -> Q a) -> String -> Q a
    forall a b. (a -> b) -> a -> b
    $ String
    ""

    #if !MIN_VERSION_template_haskell(2,23,0)
    instance Lift Name where
      lift :: forall (m :: * -> *). Quote m => Name -> m Exp
    lift (Name OccName
    occName NameFlavour
    nameFlavour) = [| Name occName nameFlavour |]
    # if MIN_VERSION_template_haskell(2,16,0)
      liftTyped :: forall (m :: * -> *). Quote m => Name -> Code m Name
    liftTyped = m Exp -> Code m Name
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeSpliceCoerce (m Exp -> Code m Name) -> (Name -> m Exp) -> Name -> Code m Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => Name -> m Exp
    lift
    # endif

    instance Lift OccName where
      lift :: forall (m :: * -> *). Quote m => OccName -> m Exp
    lift OccName
    n = [| mkOccName |] m Exp -> m Exp -> m Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` String -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    lift (OccName -> String
    occString OccName
    n)
    # if MIN_VERSION_template_haskell(2,16,0)
      liftTyped :: forall (m :: * -> *). Quote m => OccName -> Code m OccName
    liftTyped = m Exp -> Code m OccName
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeSpliceCoerce (m Exp -> Code m OccName)
    -> (OccName -> m Exp) -> OccName -> Code m OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OccName -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => OccName -> m Exp
    lift
    # endif

    instance Lift PkgName where
      lift :: forall (m :: * -> *). Quote m => PkgName -> m Exp
    lift PkgName
    n = [| mkPkgName |] m Exp -> m Exp -> m Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` String -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    lift (PkgName -> String
    pkgString PkgName
    n)
    # if MIN_VERSION_template_haskell(2,16,0)
      liftTyped :: forall (m :: * -> *). Quote m => PkgName -> Code m PkgName
    liftTyped = m Exp -> Code m PkgName
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeSpliceCoerce (m Exp -> Code m PkgName)
    -> (PkgName -> m Exp) -> PkgName -> Code m PkgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PkgName -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => PkgName -> m Exp
    lift
    # endif

    instance Lift ModName where
      lift :: forall (m :: * -> *). Quote m => ModName -> m Exp
    lift ModName
    n = [| mkModName |] m Exp -> m Exp -> m Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` String -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    lift (ModName -> String
    modString ModName
    n)
    # if MIN_VERSION_template_haskell(2,16,0)
      liftTyped :: forall (m :: * -> *). Quote m => ModName -> Code m ModName
    liftTyped = m Exp -> Code m ModName
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeSpliceCoerce (m Exp -> Code m ModName)
    -> (ModName -> m Exp) -> ModName -> Code m ModName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModName -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => ModName -> m Exp
    lift
    # endif

    instance Lift NameFlavour where
      lift :: forall (m :: * -> *). Quote m => NameFlavour -> m Exp
    lift NameFlavour
    NameS = [| NameS |]
      lift (NameQ ModName
    modnam) = [| NameQ modnam |]
      lift (NameU Integer
    i) = [| NameU i |]
      lift (NameL Integer
    i) = [| NameL i |]
      lift (NameG NameSpace
    nameSpace' PkgName
    pkgName ModName
    modnam)
       = [| NameG nameSpace' pkgName modnam |]
    # if MIN_VERSION_template_haskell(2,16,0)
      liftTyped :: forall (m :: * -> *). Quote m => NameFlavour -> Code m NameFlavour
    liftTyped = m Exp -> Code m NameFlavour
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeSpliceCoerce (m Exp -> Code m NameFlavour)
    -> (NameFlavour -> m Exp) -> NameFlavour -> Code m NameFlavour
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameFlavour -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => NameFlavour -> m Exp
    lift
    # endif

    instance Lift NameSpace where
      lift :: forall (m :: * -> *). Quote m => NameSpace -> m Exp
    lift NameSpace
    VarName = [| VarName |]
      lift NameSpace
    DataName = [| DataName |]
      lift NameSpace
    TcClsName = [| TcClsName |]
    # if MIN_VERSION_template_haskell(2,21,0)
      lift (FldName String
    parent) = [| FldName parent |]
    # endif
    # if MIN_VERSION_template_haskell(2,16,0)
      liftTyped :: forall (m :: * -> *). Quote m => NameSpace -> Code m NameSpace
    liftTyped = m Exp -> Code m NameSpace
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeSpliceCoerce (m Exp -> Code m NameSpace)
    -> (NameSpace -> m Exp) -> NameSpace -> Code m NameSpace
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NameSpace -> m Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => NameSpace -> m Exp
    lift
    # endif
    #endif