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)

    -- Constraints handled by the plugin

    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"