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

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

-- ghc
#if __GLASGOW_HASKELL__ >= 900
import GHC.Tc.Types (TcM, TcPluginM)
import GHC.Utils.Outputable
import qualified GHC.Plugins as GHC
import qualified GHC.Iface.Env as GHC (lookupOrig)
import GHC.Driver.Finder (findImportedModule, FindResult(Found))
import GHC.Data.FastString (mkFastString)
import GHC.Unit.Module (Module)
import GHC.Unit.Module.Name (mkModuleName)
import GHC (Name)
#else
import TcRnTypes (TcM, TcPluginM)
import Outputable
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)
#endif

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