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

    -- | Defines a utility function for deriving 'Quasi' instances for monad
    -- transformer data types.
    module Language.Haskell.TH.Instances.Internal
      ( deriveQuasiTrans
      , Proxy2
      ) where

    import qualified Control.Monad.Trans as MTL (lift)
    import Language.Haskell.TH.Lib
    import Language.Haskell.TH.Ppr (pprint)
    import Language.Haskell.TH.Syntax

    deriveQuasiTrans ::
         Q Type  -- ^ The instance head. For example, this might be of the form:
                 --
                 --   > [t| forall r m. Quasi m => Proxy2 (ReaderT r m) |]
                 --
                 --   Why use 'Proxy2' instead of 'Quasi'? Sadly, GHC 7.0/7.2 will
                 --   not accept it if you use the latter due to old TH bugs, so we
                 --   use 'Proxy2' as an ugly workaround.
      -> Q Exp   -- ^ The implementation of 'qRecover'
      -> Q [Dec] -- ^ The 'Quasi' instance declaration
    deriveQuasiTrans :: Q Type -> Q Exp -> Q [Dec]
    deriveQuasiTrans Q Type
    qInstHead Q Exp
    qRecoverExpr = do
      Type
    instHead    <- Q Type
    qInstHead
      let (Cxt
    instCxt, Type
    mangledInstTy) = Type -> (Cxt, Type)
    decomposeType Type
    instHead
          qInstCxt :: Q Cxt
    qInstCxt = Cxt -> Q Cxt
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Cxt
    instCxt
          qInstTy :: Q Type
    qInstTy  = case Type
    mangledInstTy of
                       ConT Name
    proxy2 `AppT` Type
    instTy
                         |  Name
    proxy2 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''Proxy2
                         -> Name -> Q Type
    forall (m :: * -> *). Quote m => Name -> m Type
    conT ''Quasi Q Type -> Q Type -> Q Type
    forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
    `appT` Type -> Q Type
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    instTy
                       Type
    _ -> String -> Q Type
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Q Type) -> String -> Q Type
    forall a b. (a -> b) -> a -> b
    $ String
    "Unexpected type " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    mangledInstTy
      Dec
    instDec <- Q Cxt -> Q Type -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Cxt -> m Type -> [m Dec] -> m Dec
    instanceD Q Cxt
    qInstCxt Q Type
    qInstTy [Q Dec]
    qInstMethDecs
      [Dec] -> Q [Dec]
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Dec
    instDec]
      where
        decomposeType :: Type -> (Cxt, Type)
        decomposeType :: Type -> (Cxt, Type)
    decomposeType (ForallT [TyVarBndr Specificity]
    _tvbs Cxt
    ctxt Type
    ty) = (Cxt
    ctxt, Type
    ty)
        decomposeType Type
    ty                      = ([],   Type
    ty)

        qInstMethDecs :: [Q Dec]
        qInstMethDecs :: [Q Dec]
    qInstMethDecs =
          let instMeths :: [(Name, Q Exp)]
              instMeths :: [(Name, Q Exp)]
    instMeths =
                [ -- qRecover is different for each instance
                  ('qRecover,            Q Exp
    qRecoverExpr)

                  -- The remaining methods are straightforward
                , ('qNewName,            [| MTL.lift . qNewName |])
                , ('qReport,             [| \a b -> MTL.lift $ qReport a b |])
                , ('qReify,              [| MTL.lift . qReify |])
                , ('qLocation,           [| MTL.lift qLocation |])
                , ('qRunIO,              [| MTL.lift . qRunIO |])
    #if MIN_VERSION_template_haskell(2,7,0)
                , ('qReifyInstances,     [| \a b -> MTL.lift $ qReifyInstances a b |])
                , ('qLookupName,         [| \a b -> MTL.lift $ qLookupName a b |])
                , ('qAddDependentFile,   [| MTL.lift . qAddDependentFile |])
    # if MIN_VERSION_template_haskell(2,9,0)
                , ('qReifyRoles,         [| MTL.lift . qReifyRoles |])
                , ('qReifyAnnotations,   [| MTL.lift . qReifyAnnotations |])
                , ('qReifyModule,        [| MTL.lift . qReifyModule |])
                , ('qAddTopDecls,        [| MTL.lift . qAddTopDecls |])
                , ('qAddModFinalizer,    [| MTL.lift . qAddModFinalizer |])
                , ('qGetQ,               [| MTL.lift qGetQ |])
                , ('qPutQ,               [| MTL.lift . qPutQ |])
    # endif
    # if MIN_VERSION_template_haskell(2,11,0)
                , ('qReifyFixity,        [| MTL.lift . qReifyFixity |])
                , ('qReifyConStrictness, [| MTL.lift . qReifyConStrictness |])
                , ('qIsExtEnabled,       [| MTL.lift . qIsExtEnabled |])
                , ('qExtsEnabled,        [| MTL.lift qExtsEnabled |])
    # endif
    #elif MIN_VERSION_template_haskell(2,5,0)
                , ('qClassInstances,     [| \a b -> MTL.lift $ qClassInstances a b |])
    #endif
    #if MIN_VERSION_template_haskell(2,14,0)
                , ('qAddForeignFilePath, [| \a b -> MTL.lift $ qAddForeignFilePath a b |])
                , ('qAddTempFile,        [| MTL.lift . qAddTempFile |])
    #elif MIN_VERSION_template_haskell(2,12,0)
                , ('qAddForeignFile,     [| \a b -> MTL.lift $ qAddForeignFile a b |])
    #endif
    #if MIN_VERSION_template_haskell(2,13,0)
                , ('qAddCorePlugin,      [| MTL.lift . qAddCorePlugin |])
    #endif
    #if MIN_VERSION_template_haskell(2,16,0)
                , ('qReifyType,          [| MTL.lift . qReifyType |])
    #endif
    #if MIN_VERSION_template_haskell(2,18,0)
                , ('qGetDoc,             [| MTL.lift . qGetDoc |])
                , ('qPutDoc,             [| \a b -> MTL.lift $ qPutDoc a b |])
    #endif
    #if MIN_VERSION_template_haskell(2,19,0)
                , ('qGetPackageRoot,     [| MTL.lift qGetPackageRoot |])
    #endif
                ]

              mkDec :: Name -> Q Exp -> Q Dec
              mkDec :: Name -> Q Exp -> Q Dec
    mkDec Name
    methName Q Exp
    methRhs = Q Pat -> Q Body -> [Q Dec] -> Q Dec
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Dec
    valD (Name -> Q Pat
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP Name
    methName) (Q Exp -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB Q Exp
    methRhs) []

          in ((Name, Q Exp) -> Q Dec) -> [(Name, Q Exp)] -> [Q Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> Q Exp -> Q Dec) -> (Name, Q Exp) -> Q Dec
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Name -> Q Exp -> Q Dec
    mkDec) [(Name, Q Exp)]
    instMeths

    -- | See the Haddocks for 'deriveQuasiTrans' for an explanation of why this
    -- type needs to exist.
    data Proxy2 (m :: * -> *)