{-# LANGUAGE DataKinds #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE CPP #-} module Debug.Breakpoint.GhcFacade ( module Ghc , liftedRepName , mkLexicalFastString , fromLexicalFastString , collectHsBindBinders' , collectPatBinders' , mkWildValBinder' , pprTypeForUser' , showSDocOneLine' , findImportedModule' , findPluginModule' , pattern HsLet' , pattern OverLit' , pattern CDictCan' ) where #if MIN_VERSION_ghc(9,6,0) import GHC.Driver.Plugins as Ghc hiding (TcPlugin) import GHC.Hs.Extension as Ghc import Language.Haskell.Syntax as Ghc import GHC.Tc.Types as Ghc hiding (DefaultingPlugin) import qualified GHC.Tc.Plugin as Plugin import GHC.Parser.Annotation as Ghc import GHC.Types.SrcLoc as Ghc import GHC.Types.Name as Ghc import GHC.Iface.Env as Ghc import GHC.Unit.Finder as Ghc import GHC.Unit.Types as Ghc import GHC.Tc.Utils.Monad as Ghc hiding (TcPlugin, DefaultingPlugin) import GHC.Data.FastString as Ghc import GHC.Hs.Utils as Ghc import GHC.Types.Unique.Set as Ghc import GHC.Utils.Outputable as Ghc import GHC.Hs.Binds as Ghc import GHC.Data.Bag as Ghc import GHC.Types.Basic as Ghc import GHC.Types.Name.Env as Ghc import GHC.Builtin.Names as Ghc import GHC.Builtin.Types as Ghc import GHC.Core.TyCo.Rep as Ghc import GHC.Tc.Types.Constraint as Ghc import GHC.Core.Make as Ghc import GHC.Tc.Types.Evidence as Ghc import GHC.Types.Id as Ghc import GHC.Core.InstEnv as Ghc import GHC.Core.Class as Ghc hiding (FunDep) import GHC.Tc.Utils.TcType as Ghc import GHC.Core.Type as Ghc import GHC.Core.TyCon as Ghc import GHC.Types.TyThing.Ppr as Ghc import GHC.Hs.Expr as Ghc import GHC.Types.PkgQual as Ghc import GHC.Tc.Types.Origin as Ghc #elif MIN_VERSION_ghc(9,4,0) import GHC.Driver.Plugins as Ghc hiding (TcPlugin) import GHC.Hs.Extension as Ghc import Language.Haskell.Syntax as Ghc import GHC.Tc.Types as Ghc hiding (DefaultingPlugin) import qualified GHC.Tc.Plugin as Plugin import GHC.Parser.Annotation as Ghc import GHC.Types.SrcLoc as Ghc import GHC.Types.Name as Ghc import GHC.Iface.Env as Ghc import GHC.Unit.Finder as Ghc import GHC.Unit.Types as Ghc import GHC.Unit.Module.Name as Ghc import GHC.Tc.Utils.Monad as Ghc hiding (TcPlugin, DefaultingPlugin) import GHC.Data.FastString as Ghc import GHC.Hs.Utils as Ghc import GHC.Types.Unique.Set as Ghc import GHC.Utils.Outputable as Ghc import GHC.Hs.Binds as Ghc import GHC.Data.Bag as Ghc import GHC.Types.Basic as Ghc import GHC.Types.Name.Env as Ghc import GHC.Builtin.Names as Ghc import GHC.Builtin.Types as Ghc import GHC.Core.TyCo.Rep as Ghc import GHC.Tc.Types.Constraint as Ghc import GHC.Core.Make as Ghc import GHC.Tc.Types.Evidence as Ghc import GHC.Types.Id as Ghc import GHC.Core.InstEnv as Ghc import GHC.Core.Class as Ghc hiding (FunDep) import GHC.Tc.Utils.TcType as Ghc import GHC.Core.Type as Ghc import GHC.Core.TyCon as Ghc import GHC.Types.TyThing.Ppr as Ghc import GHC.Hs.Expr as Ghc import GHC.Types.PkgQual as Ghc import GHC.Tc.Types.Origin as Ghc #endif liftedRepName :: Ghc.Name liftedRepName :: Name liftedRepName = TyCon -> Name forall a. NamedThing a => a -> Name Ghc.getName TyCon Ghc.liftedRepTyCon mkLexicalFastString :: Ghc.FastString -> Ghc.LexicalFastString fromLexicalFastString :: Ghc.LexicalFastString -> Ghc.FastString mkLexicalFastString :: FastString -> LexicalFastString mkLexicalFastString = FastString -> LexicalFastString Ghc.LexicalFastString fromLexicalFastString :: LexicalFastString -> FastString fromLexicalFastString (Ghc.LexicalFastString FastString fs) = FastString fs collectHsBindBinders' :: Ghc.HsBindLR Ghc.GhcRn idR -> [Ghc.Name] collectHsBindBinders' :: forall idR. HsBindLR GhcRn idR -> [Name] collectHsBindBinders' = CollectFlag GhcRn -> HsBindLR GhcRn idR -> [IdP GhcRn] forall p idR. CollectPass p => CollectFlag p -> HsBindLR p idR -> [IdP p] Ghc.collectHsBindBinders CollectFlag GhcRn forall p. CollectFlag p Ghc.CollNoDictBinders collectPatBinders' :: Ghc.LPat Ghc.GhcRn -> [Ghc.Name] collectPatBinders' :: LPat GhcRn -> [Name] collectPatBinders' = CollectFlag GhcRn -> LPat GhcRn -> [IdP GhcRn] forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p] Ghc.collectPatBinders CollectFlag GhcRn forall p. CollectFlag p Ghc.CollNoDictBinders mkWildValBinder' :: Ghc.Type -> Ghc.Id mkWildValBinder' :: Type -> Id mkWildValBinder' = Type -> Type -> Id Ghc.mkWildValBinder Type Ghc.oneDataConTy pprTypeForUser' :: Ghc.Type -> Ghc.SDoc pprTypeForUser' :: Type -> SDoc pprTypeForUser' = Type -> SDoc Ghc.pprSigmaType showSDocOneLine' :: Ghc.SDoc -> String showSDocOneLine' :: SDoc -> String showSDocOneLine' = SDocContext -> SDoc -> String Ghc.showSDocOneLine SDocContext Ghc.defaultSDocContext findImportedModule' :: Ghc.ModuleName -> Ghc.TcPluginM Module findImportedModule' :: ModuleName -> TcPluginM Module findImportedModule' ModuleName modName = ModuleName -> PkgQual -> TcPluginM FindResult Plugin.findImportedModule ModuleName modName PkgQual Ghc.NoPkgQual TcPluginM FindResult -> (FindResult -> TcPluginM Module) -> TcPluginM Module forall a b. TcPluginM a -> (a -> TcPluginM b) -> TcPluginM b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Found ModLocation _ Module m -> Module -> TcPluginM Module forall a. a -> TcPluginM a forall (f :: * -> *) a. Applicative f => a -> f a pure Module m FindResult _ -> String -> TcPluginM Module forall a. String -> TcPluginM a forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Could not find module!" findPluginModule' :: Ghc.ModuleName -> Ghc.TcM Ghc.FindResult #if MIN_VERSION_ghc(9,4,0) findPluginModule' :: ModuleName -> TcM FindResult findPluginModule' ModuleName modName = TcPluginM FindResult -> TcM FindResult forall a. TcPluginM a -> TcM a Ghc.runTcPluginM (TcPluginM FindResult -> TcM FindResult) -> TcPluginM FindResult -> TcM FindResult forall a b. (a -> b) -> a -> b $ ModuleName -> PkgQual -> TcPluginM FindResult Plugin.findImportedModule ModuleName modName PkgQual Ghc.NoPkgQual #else findPluginModule' modName = do hscEnv <- Ghc.getTopEnv liftIO $ Ghc.findPluginModule hscEnv modName #endif type LetToken = #if MIN_VERSION_ghc(9,10,0) () #else Ghc.LHsToken "let" Ghc.GhcRn #endif type InToken = #if MIN_VERSION_ghc(9,10,0) () #else Ghc.LHsToken "in" Ghc.GhcRn #endif pattern HsLet' :: Ghc.XLet Ghc.GhcRn -> LetToken -> Ghc.HsLocalBinds Ghc.GhcRn -> InToken -> Ghc.LHsExpr Ghc.GhcRn -> Ghc.HsExpr Ghc.GhcRn #if MIN_VERSION_ghc(9,10,0) hsLetShim :: x -> (x, (), ()) hsLetShim x = (x, (), ()) pattern HsLet' x letToken lbinds inToken expr <- Ghc.HsLet (hsLetShim -> (x, letToken, inToken)) lbinds expr where HsLet' x () binds () expr = Ghc.HsLet x binds expr #else pattern $mHsLet' :: forall {r}. HsExpr GhcRn -> (XLet GhcRn -> LetToken -> HsLocalBinds GhcRn -> InToken -> LHsExpr GhcRn -> r) -> ((# #) -> r) -> r $bHsLet' :: XLet GhcRn -> LetToken -> HsLocalBinds GhcRn -> InToken -> LHsExpr GhcRn -> HsExpr GhcRn HsLet' x letToken lbinds inToken expr <- Ghc.HsLet x letToken lbinds inToken expr where HsLet' XLet GhcRn x LetToken letToken HsLocalBinds GhcRn binds InToken inToken LHsExpr GhcRn expr = XLet GhcRn -> LetToken -> HsLocalBinds GhcRn -> InToken -> LHsExpr GhcRn -> HsExpr GhcRn forall p. XLet p -> LHsToken "let" p -> HsLocalBinds p -> LHsToken "in" p -> LHsExpr p -> HsExpr p Ghc.HsLet XLet GhcRn x LetToken letToken HsLocalBinds GhcRn binds InToken inToken LHsExpr GhcRn expr #endif pattern OverLit' :: Ghc.OverLitVal -> Ghc.HsOverLit Ghc.GhcRn pattern $mOverLit' :: forall {r}. HsOverLit GhcRn -> (OverLitVal -> r) -> ((# #) -> r) -> r OverLit' lit <- Ghc.OverLit _ lit pattern CDictCan' :: Ghc.CtEvidence -> Ghc.Class -> [Ghc.Xi] -> Ghc.Ct pattern $mCDictCan' :: forall {r}. Ct -> (CtEvidence -> Class -> [Type] -> r) -> ((# #) -> r) -> r CDictCan' diEv diCls diTys #if MIN_VERSION_ghc(9,8,0) <- Ghc.CDictCan (Ghc.DictCt diEv diCls diTys _) #else <- Ghc.CDictCan { Ghc.cc_ev = diEv, Ghc.cc_class = diCls, Ghc.cc_tyargs = diTys } #endif