{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Parsley.PluginUtils where

import qualified GHC.TcPluginM.Extra as TCPluginExtra (lookupName)

-- GHC API
import TcRnTypes (TcM, TcPluginM)
import Outputable

-- ghc
import qualified GhcPlugins as GHC
import qualified IfaceEnv as GHC (lookupOrig)
import Finder (findImportedModule, FindResult(Found))
import FastString (mkFastString)
import Module (Module, mkModuleName)
import Name (Name)
import Control.Monad.IO.Class ( liftIO )

class Monad m => Lookup m where
  lookupOrig :: Module -> GHC.OccName -> m Name

instance Lookup TcM where
  lookupOrig :: Module -> OccName -> TcM Name
lookupOrig = Module -> OccName -> TcM Name
forall a b. Module -> OccName -> TcRnIf a b Name
GHC.lookupOrig

instance Lookup TcPluginM where
  lookupOrig :: Module -> OccName -> TcPluginM Name
lookupOrig = Module -> OccName -> TcPluginM Name
TCPluginExtra.lookupName

pprTouch :: Outputable a => String -> a -> a
pprTouch :: String -> a -> a
pprTouch String
name a
x = String -> SDoc -> a -> a
forall a. String -> SDoc -> a -> a
pprTrace String
name (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
x) a
x

lookupNames :: (Lookup m, Traversable t) => Module -> t String -> m (t Name)
lookupNames :: Module -> t String -> m (t Name)
lookupNames = (String -> m Name) -> t String -> m (t Name)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> m Name) -> t String -> m (t Name))
-> (Module -> String -> m Name) -> Module -> t String -> m (t Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> String -> m Name
forall (m :: * -> *). Lookup m => Module -> String -> m Name
lookupName

lookupName :: Lookup m => Module -> String -> m Name
lookupName :: Module -> String -> m Name
lookupName Module
pm = Module -> OccName -> m Name
forall (m :: * -> *). Lookup m => Module -> OccName -> m Name
lookupOrig Module
pm (OccName -> m Name) -> (String -> OccName) -> String -> m Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OccName
GHC.mkVarOcc

lookupClass :: Lookup m => Module -> String -> m Name
lookupClass :: Module -> String -> m Name
lookupClass Module
pm = Module -> OccName -> m Name
forall (m :: * -> *). Lookup m => Module -> OccName -> m Name
lookupOrig Module
pm (OccName -> m Name) -> (String -> OccName) -> String -> m Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OccName
GHC.mkTcOcc

lookupIds :: Traversable t => Module -> t String -> TcM (t GHC.Id)
lookupIds :: Module -> t String -> TcM (t Id)
lookupIds = (String -> IOEnv (Env TcGblEnv TcLclEnv) Id)
-> t String -> TcM (t Id)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> IOEnv (Env TcGblEnv TcLclEnv) Id)
 -> t String -> TcM (t Id))
-> (Module -> String -> IOEnv (Env TcGblEnv TcLclEnv) Id)
-> Module
-> t String
-> TcM (t Id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> String -> IOEnv (Env TcGblEnv TcLclEnv) Id
lookupId

lookupId :: Module -> String -> TcM GHC.Id
lookupId :: Module -> String -> IOEnv (Env TcGblEnv TcLclEnv) Id
lookupId Module
pm String
name = Module -> String -> TcM Name
forall (m :: * -> *). Lookup m => Module -> String -> m Name
lookupName Module
pm String
name TcM Name
-> (Name -> IOEnv (Env TcGblEnv TcLclEnv) Id)
-> IOEnv (Env TcGblEnv TcLclEnv) Id
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> IOEnv (Env TcGblEnv TcLclEnv) Id
forall (m :: * -> *). MonadThings m => Name -> m Id
GHC.lookupId

lookupModule :: GHC.HscEnv -> String -> TcM Module
lookupModule :: HscEnv -> String -> TcM Module
lookupModule HscEnv
hscEnv String
modName = do
  Found ModLocation
_ Module
md <- IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hscEnv (String -> ModuleName
mkModuleName String
modName) Maybe FastString
forall a. Maybe a
Nothing)
  Module -> TcM Module
forall (m :: * -> *) a. Monad m => a -> m a
return Module
md

lookupModuleInPackage :: GHC.HscEnv -> String -> String -> TcM Module
lookupModuleInPackage :: HscEnv -> String -> String -> TcM Module
lookupModuleInPackage HscEnv
hscEnv String
package String
modName = do
  Found ModLocation
_ Module
md <- IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hscEnv (String -> ModuleName
mkModuleName String
modName) (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (String -> FastString
mkFastString String
package)))
  Module -> TcM Module
forall (m :: * -> *) a. Monad m => a -> m a
return Module
md