module TypeLet.Plugin.NameResolution (
ResolvedNames(..)
, resolveNames
) where
import TypeLet.Plugin.GhcTcPluginAPI
data ResolvedNames = ResolvedNames {
ResolvedNames -> Class
clsEqual :: Class
, ResolvedNames -> Class
clsLet :: Class
}
instance Outputable ResolvedNames where
ppr :: ResolvedNames -> SDoc
ppr ResolvedNames{Class
clsLet :: Class
clsEqual :: Class
clsLet :: ResolvedNames -> Class
clsEqual :: ResolvedNames -> Class
..} = [SDoc] -> SDoc
vcat [
String -> SDoc
text String
"ResolvedNames {"
, Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [
String -> SDoc
text String
"clsEqual =" SDoc -> SDoc -> SDoc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
clsEqual
, String -> SDoc
text String
"clsLet =" SDoc -> SDoc -> SDoc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
clsLet
]
, String -> SDoc
text String
"}"
]
resolveNames :: TcPluginM 'Init ResolvedNames
resolveNames :: TcPluginM 'Init ResolvedNames
resolveNames = do
Module
m <- do FindResult
r <- ModuleName -> PkgQual -> TcPluginM 'Init FindResult
forall (m :: * -> *).
MonadTcPlugin m =>
ModuleName -> PkgQual -> m FindResult
findImportedModule ModuleName
typeletMod (UnitId -> PkgQual
OtherPkg UnitId
typeletUnitId)
case FindResult
r of
Found ModLocation
_ Module
m -> Module -> TcPluginM 'Init Module
forall (m :: * -> *) a. Monad m => a -> m a
return Module
m
FindResult
_otherwise -> String -> TcPluginM 'Init Module
forall a. String -> a
panic (String -> TcPluginM 'Init Module)
-> String -> TcPluginM 'Init Module
forall a b. (a -> b) -> a -> b
$ String
"Could not find "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ SDoc -> String
showSDocUnsafe (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
typeletMod)
Class
clsEqual <- Name -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => Name -> m Class
tcLookupClass (Name -> TcPluginM 'Init Class)
-> TcPluginM 'Init Name -> TcPluginM 'Init Class
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM 'Init Name
forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
m (String -> OccName
mkTcOcc String
"Equal")
Class
clsLet <- Name -> TcPluginM 'Init Class
forall (m :: * -> *). MonadTcPlugin m => Name -> m Class
tcLookupClass (Name -> TcPluginM 'Init Class)
-> TcPluginM 'Init Name -> TcPluginM 'Init Class
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM 'Init Name
forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
m (String -> OccName
mkTcOcc String
"Let")
ResolvedNames -> TcPluginM 'Init ResolvedNames
forall (m :: * -> *) a. Monad m => a -> m a
return ResolvedNames :: Class -> Class -> ResolvedNames
ResolvedNames{Class
clsLet :: Class
clsEqual :: Class
clsLet :: Class
clsEqual :: Class
..}
where
typeletMod :: ModuleName
typeletMod :: ModuleName
typeletMod = String -> ModuleName
mkModuleName String
"TypeLet.UserAPI"
typeletUnitId :: UnitId
typeletUnitId :: UnitId
typeletUnitId = String -> UnitId
stringToUnitId String
"typelet"