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
clsEqual :: ResolvedNames -> Class
clsLet :: ResolvedNames -> Class
clsEqual :: Class
clsLet :: Class
..} = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ResolvedNames {"
      , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"clsEqual =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
clsEqual
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"clsLet   =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
clsLet
          ]
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"}"
      ]

resolveNames :: TcPluginM 'Init ResolvedNames
resolveNames :: TcPluginM 'Init ResolvedNames
resolveNames = do
    PkgQual
pkgQual <- ModuleName -> Maybe FastString -> TcPluginM 'Init PkgQual
forall (m :: * -> *).
MonadTcPlugin m =>
ModuleName -> Maybe FastString -> m PkgQual
resolveImport ModuleName
typeletMod (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (FastString -> Maybe FastString) -> FastString -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"typelet")
    Module
modl    <- do FindResult
res <- ModuleName -> PkgQual -> TcPluginM 'Init FindResult
forall (m :: * -> *).
MonadTcPlugin m =>
ModuleName -> PkgQual -> m FindResult
findImportedModule ModuleName
typeletMod PkgQual
pkgQual
                  case FindResult
res of
                    Found ModLocation
_ Module
m  -> Module -> TcPluginM 'Init Module
forall a. a -> TcPluginM 'Init a
forall (m :: * -> *) a. Monad m => a -> m a
return Module
m
                    FindResult
_otherwise -> String -> TcPluginM 'Init Module
forall a. HasCallStack => String -> a
panic (String -> TcPluginM 'Init Module)
-> String -> TcPluginM 'Init Module
forall a b. (a -> b) -> a -> b
$ String
"resolveNames: 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
modl (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
modl (String -> OccName
mkTcOcc String
"Let")
    ResolvedNames -> TcPluginM 'Init ResolvedNames
forall a. a -> TcPluginM 'Init a
forall (m :: * -> *) a. Monad m => a -> m a
return ResolvedNames{Class
clsEqual :: Class
clsLet :: Class
clsEqual :: Class
clsLet :: Class
..}
  where
    typeletMod :: ModuleName
    typeletMod :: ModuleName
typeletMod = String -> ModuleName
mkModuleName String
"TypeLet.UserAPI"