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 forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat [
            String -> SDoc
text String
"clsEqual =" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Class
clsEqual
          , String -> SDoc
text String
"clsLet   =" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Class
clsLet
          ]
      , String -> SDoc
text String
"}"
      ]

resolveNames :: TcPluginM 'Init ResolvedNames
resolveNames :: TcPluginM 'Init ResolvedNames
resolveNames = do
    PkgQual
pkgQual <- forall (m :: * -> *).
MonadTcPlugin m =>
ModuleName -> Maybe FastString -> m PkgQual
resolveImport ModuleName
typeletMod (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"typelet")
    Module
modl    <- do FindResult
res <- forall (m :: * -> *).
MonadTcPlugin m =>
ModuleName -> PkgQual -> m FindResult
findImportedModule ModuleName
typeletMod PkgQual
pkgQual
                  case FindResult
res of
                    Found ModLocation
_ Module
m  -> forall (m :: * -> *) a. Monad m => a -> m a
return Module
m
                    FindResult
_otherwise -> forall a. String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"resolveNames: could not find "
                                       forall a. [a] -> [a] -> [a]
++ SDoc -> String
showSDocUnsafe (forall a. Outputable a => a -> SDoc
ppr ModuleName
typeletMod)

    -- Constraints handled by the plugin

    Class
clsEqual <- forall (m :: * -> *). MonadTcPlugin m => Name -> m Class
tcLookupClass forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
modl (String -> OccName
mkTcOcc String
"Equal")
    Class
clsLet   <- forall (m :: * -> *). MonadTcPlugin m => Name -> m Class
tcLookupClass forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
modl (String -> OccName
mkTcOcc String
"Let")
    forall (m :: * -> *) a. Monad m => a -> m a
return ResolvedNames{Class
clsLet :: Class
clsEqual :: Class
clsLet :: Class
clsEqual :: Class
..}
  where
    typeletMod :: ModuleName
    typeletMod :: ModuleName
typeletMod = String -> ModuleName
mkModuleName String
"TypeLet.UserAPI"