{-# LANGUAGE RecordWildCards #-}
module Overloaded.Plugin.Names (
    -- * Names
    Names (..),
    getNames,
    -- * CatNames
    CatNames (..),
    getCatNames,
    -- * RrdNames
    RdrNames (..),
    getRdrNames,
    -- * VarName
    VarName (..),
    lookupVarName,
    lookupTypeName,
    -- * RdrName
    mkRdrName,
    -- * Selected modules
    ghcRecordsCompatMN,
    overloadedConstructorsMN,
    ) where

import Control.Monad.IO.Class (MonadIO (..))

import Overloaded.Plugin.Diagnostics

import qualified GHC.Compat.All  as GHC
import           GHC.Compat.Expr

data Names = Names
    { Names -> Name
fromStringName     :: GHC.Name
    , Names -> Name
fromSymbolName     :: GHC.Name
    , Names -> Name
fromNumeralName    :: GHC.Name
    , Names -> Name
fromNaturalName    :: GHC.Name
    , Names -> Name
fromCharName       :: GHC.Name
    , Names -> Name
nilName            :: GHC.Name
    , Names -> Name
consName           :: GHC.Name
    , Names -> Name
ifteName           :: GHC.Name
    , Names -> Name
unitName           :: GHC.Name
    , Names -> Name
fromLabelName      :: GHC.Name
    , Names -> Name
fromTypeNatName    :: GHC.Name
    , Names -> Name
fromTypeSymbolName :: GHC.Name
    , Names -> Name
fmapName           :: GHC.Name
    , Names -> Name
pureName           :: GHC.Name
    , Names -> Name
apName             :: GHC.Name
    , Names -> Name
birdName           :: GHC.Name
    , Names -> Name
voidName           :: GHC.Name
    , Names -> Name
composeName        :: GHC.Name
    , Names -> Name
doPureName         :: GHC.Name
    , Names -> Name
doThenName         :: GHC.Name
    , Names -> Name
doBindName         :: GHC.Name
    , Names -> Name
conLeftName        :: GHC.Name
    , Names -> Name
conRightName       :: GHC.Name
    , Names -> Name
codeFromLabelName  :: GHC.Name
    , Names -> Name
codeFromStringName :: GHC.Name
    , Names -> CatNames
catNames           :: CatNames
    }

data RdrNames = RdrNames
    { RdrNames -> RdrName
dollarName         :: GHC.RdrName
    , RdrNames -> RdrName
buildName          :: GHC.RdrName
    }

data CatNames = CatNames
    { CatNames -> Name
catIdentityName    :: GHC.Name
    , CatNames -> Name
catComposeName     :: GHC.Name
    , CatNames -> Name
catTerminalName    :: GHC.Name
    , CatNames -> Name
catProj1Name       :: GHC.Name
    , CatNames -> Name
catProj2Name       :: GHC.Name
    , CatNames -> Name
catFanoutName      :: GHC.Name
    , CatNames -> Name
catInlName         :: GHC.Name
    , CatNames -> Name
catInrName         :: GHC.Name
    , CatNames -> Name
catFaninName       :: GHC.Name
    , CatNames -> Name
catDistrName       :: GHC.Name
    , CatNames -> Name
catEvalName        :: GHC.Name
    }

getNames :: GHC.DynFlags -> GHC.HscEnv -> GHC.TcM Names
getNames :: DynFlags -> HscEnv -> TcM Names
getNames DynFlags
dflags HscEnv
env = do
    Name
fromStringName  <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
dataStringMN String
"fromString"
    Name
fromSymbolName  <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedSymbolsMN String
"fromSymbol"
    Name
fromNumeralName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedNumeralsMN String
"fromNumeral"
    Name
fromNaturalName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedNaturalsMN String
"fromNatural"
    Name
fromCharName    <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedCharsMN String
"fromChar"
    Name
nilName         <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedListsMN String
"nil"
    Name
unitName        <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedListsMN String
"nil"
    Name
consName        <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedListsMN String
"cons"
    Name
ifteName        <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedIfMN String
"ifte"
    Name
fromLabelName   <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
ghcOverloadedLabelsMN String
"fromLabel"

    Name
fromTypeNatName    <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env ModuleName
overloadedTypeNatsMN String
"FromNat"
    Name
fromTypeSymbolName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env ModuleName
overloadedTypeSymbolsMN String
"FromTypeSymbol"

    Name
fmapName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
ghcBaseMN String
"fmap"
    Name
pureName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
ghcBaseMN String
"pure"
    Name
apName   <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
ghcBaseMN String
"<*>"
    Name
birdName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
ghcBaseMN String
"<*"
    Name
voidName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
dataFunctorMN String
"void"

    Name
composeName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
ghcBaseMN String
"."

    Name
doPureName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env ModuleName
overloadedDoMN String
"Pure"
    Name
doBindName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env ModuleName
overloadedDoMN String
"Bind"
    Name
doThenName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env ModuleName
overloadedDoMN String
"Then"

    Name
conLeftName  <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupNameDataCon DynFlags
dflags HscEnv
env ModuleName
dataEitherMN String
"Left"
    Name
conRightName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupNameDataCon DynFlags
dflags HscEnv
env ModuleName
dataEitherMN String
"Right"

    Name
codeFromLabelName  <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedCodeLabelsMN  String
"codeFromLabel"
    Name
codeFromStringName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedCodeStringsMN String
"codeFromString"


    CatNames
catNames <- DynFlags -> HscEnv -> ModuleName -> TcM CatNames
getCatNames DynFlags
dflags HscEnv
env ModuleName
overloadedCategoriesMN

    Names -> TcM Names
forall (m :: * -> *) a. Monad m => a -> m a
return Names :: Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> CatNames
-> Names
Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doThenName :: Name
doBindName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
ifteName :: Name
consName :: Name
unitName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
..}

getRdrNames :: GHC.DynFlags -> GHC.HscEnv -> GHC.Hsc RdrNames
getRdrNames :: DynFlags -> HscEnv -> Hsc RdrNames
getRdrNames DynFlags
dflags HscEnv
env = do
    let dollarName :: RdrName
dollarName = Name -> RdrName
GHC.Exact Name
GHC.dollarName
    RdrName
buildName <- Name -> RdrName
GHC.Exact (Name -> RdrName) -> Hsc Name -> Hsc RdrName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> HscEnv -> ModuleName -> String -> Hsc Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
overloadedConstructorsMN String
"build"

    RdrNames -> Hsc RdrNames
forall (m :: * -> *) a. Monad m => a -> m a
return RdrNames :: RdrName -> RdrName -> RdrNames
RdrNames {RdrName
buildName :: RdrName
dollarName :: RdrName
buildName :: RdrName
dollarName :: RdrName
..}

getCatNames :: GHC.DynFlags -> GHC.HscEnv -> GHC.ModuleName -> GHC.TcM CatNames
getCatNames :: DynFlags -> HscEnv -> ModuleName -> TcM CatNames
getCatNames DynFlags
dflags HscEnv
env ModuleName
module_ = do
    Name
catIdentityName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"identity"
    Name
catComposeName  <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"%%"
    Name
catProj1Name    <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"proj1"
    Name
catProj2Name    <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"proj2"
    Name
catFanoutName   <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"fanout"
    Name
catInlName      <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"inl"
    Name
catInrName      <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"inr"
    Name
catFaninName    <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"fanin"
    Name
catDistrName    <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"distr"
    Name
catEvalName     <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"eval"
    Name
catTerminalName <- DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
module_ String
"terminal"

    CatNames -> TcM CatNames
forall (m :: * -> *) a. Monad m => a -> m a
return CatNames :: Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> Name
-> CatNames
CatNames {Name
catTerminalName :: Name
catEvalName :: Name
catDistrName :: Name
catFaninName :: Name
catInrName :: Name
catInlName :: Name
catFanoutName :: Name
catProj2Name :: Name
catProj1Name :: Name
catComposeName :: Name
catIdentityName :: Name
catEvalName :: Name
catDistrName :: Name
catFaninName :: Name
catInrName :: Name
catInlName :: Name
catFanoutName :: Name
catProj2Name :: Name
catProj1Name :: Name
catTerminalName :: Name
catComposeName :: Name
catIdentityName :: Name
..}

lookupName :: MonadIO m => GHC.DynFlags -> GHC.HscEnv -> GHC.ModuleName -> String -> m GHC.Name
lookupName :: DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env ModuleName
mn String
vn = IO Name -> m Name
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Name -> m Name) -> IO Name -> m Name
forall a b. (a -> b) -> a -> b
$ do
    FindResult
res <- HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
GHC.findImportedModule HscEnv
env ModuleName
mn Maybe FastString
forall a. Maybe a
Nothing
    case FindResult
res of
        GHC.Found ModLocation
_ Module
md -> HscEnv -> Module -> OccName -> IO Name
GHC.lookupOrigIO HscEnv
env Module
md (String -> OccName
GHC.mkVarOcc String
vn)
        FindResult
_              -> do
            DynFlags -> SrcSpan -> SDoc -> IO ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
putError DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
GHC.text String
"Cannot find module" SDoc -> SDoc -> SDoc
GHC.<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr ModuleName
mn
            String -> IO Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"panic!"

lookupNameDataCon :: GHC.DynFlags -> GHC.HscEnv -> GHC.ModuleName -> String -> GHC.TcM GHC.Name
lookupNameDataCon :: DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupNameDataCon DynFlags
dflags HscEnv
env ModuleName
mn String
vn = do
    FindResult
res <-  IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult)
-> IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
GHC.findImportedModule HscEnv
env ModuleName
mn Maybe FastString
forall a. Maybe a
Nothing
    case FindResult
res of
        GHC.Found ModLocation
_ Module
md -> Module -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a b. Module -> OccName -> TcRnIf a b Name
GHC.lookupOrig Module
md (String -> OccName
GHC.mkDataOcc String
vn)
        FindResult
_              -> do
            DynFlags -> SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
putError DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
GHC.text String
"Cannot find module" SDoc -> SDoc -> SDoc
GHC.<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr ModuleName
mn
            String -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"panic!"

lookupName' :: GHC.DynFlags -> GHC.HscEnv -> GHC.ModuleName -> String -> GHC.TcM GHC.Name
lookupName' :: DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env ModuleName
mn String
vn = do
    FindResult
res <-  IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult)
-> IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
GHC.findImportedModule HscEnv
env ModuleName
mn Maybe FastString
forall a. Maybe a
Nothing
    case FindResult
res of
        GHC.Found ModLocation
_ Module
md -> Module -> OccName -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall a b. Module -> OccName -> TcRnIf a b Name
GHC.lookupOrig Module
md (String -> OccName
GHC.mkTcOcc String
vn)
        FindResult
_              -> do
            DynFlags -> SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
putError DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
GHC.text String
"Cannot find module" SDoc -> SDoc -> SDoc
GHC.<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr ModuleName
mn
            String -> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"panic!"

-- | Module name and variable name
data VarName = VN String String
  deriving (VarName -> VarName -> Bool
(VarName -> VarName -> Bool)
-> (VarName -> VarName -> Bool) -> Eq VarName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarName -> VarName -> Bool
$c/= :: VarName -> VarName -> Bool
== :: VarName -> VarName -> Bool
$c== :: VarName -> VarName -> Bool
Eq, Int -> VarName -> ShowS
[VarName] -> ShowS
VarName -> String
(Int -> VarName -> ShowS)
-> (VarName -> String) -> ([VarName] -> ShowS) -> Show VarName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarName] -> ShowS
$cshowList :: [VarName] -> ShowS
show :: VarName -> String
$cshow :: VarName -> String
showsPrec :: Int -> VarName -> ShowS
$cshowsPrec :: Int -> VarName -> ShowS
Show)

lookupVarName :: GHC.DynFlags -> GHC.HscEnv -> VarName -> GHC.TcM GHC.Name
lookupVarName :: DynFlags -> HscEnv -> VarName -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupVarName DynFlags
dflags HscEnv
env (VN String
vn String
mn) = DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
forall (m :: * -> *).
MonadIO m =>
DynFlags -> HscEnv -> ModuleName -> String -> m Name
lookupName DynFlags
dflags HscEnv
env (String -> ModuleName
GHC.mkModuleName String
vn) String
mn

lookupTypeName :: GHC.DynFlags -> GHC.HscEnv -> VarName -> GHC.TcM GHC.Name
lookupTypeName :: DynFlags -> HscEnv -> VarName -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupTypeName DynFlags
dflags HscEnv
env (VN String
vn String
mn) = DynFlags
-> HscEnv
-> ModuleName
-> String
-> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupName' DynFlags
dflags HscEnv
env (String -> ModuleName
GHC.mkModuleName String
vn) String
mn

-- TODO: ignores module
mkRdrName :: VarName -> GHC.RdrName
mkRdrName :: VarName -> RdrName
mkRdrName (VN String
_ String
rn) = OccName -> RdrName
GHC.Unqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ String -> OccName
GHC.mkVarOcc String
rn

-------------------------------------------------------------------------------
-- ModuleNames
-------------------------------------------------------------------------------

dataStringMN :: GHC.ModuleName
dataStringMN :: ModuleName
dataStringMN =  String -> ModuleName
GHC.mkModuleName String
"Data.String"

overloadedCharsMN :: GHC.ModuleName
overloadedCharsMN :: ModuleName
overloadedCharsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Chars"

overloadedSymbolsMN :: GHC.ModuleName
overloadedSymbolsMN :: ModuleName
overloadedSymbolsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Symbols"

overloadedNaturalsMN :: GHC.ModuleName
overloadedNaturalsMN :: ModuleName
overloadedNaturalsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Naturals"

overloadedNumeralsMN :: GHC.ModuleName
overloadedNumeralsMN :: ModuleName
overloadedNumeralsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Numerals"

overloadedListsMN :: GHC.ModuleName
overloadedListsMN :: ModuleName
overloadedListsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Lists"

overloadedIfMN :: GHC.ModuleName
overloadedIfMN :: ModuleName
overloadedIfMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.If"

overloadedDoMN :: GHC.ModuleName
overloadedDoMN :: ModuleName
overloadedDoMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Do"

overloadedCategoriesMN :: GHC.ModuleName
overloadedCategoriesMN :: ModuleName
overloadedCategoriesMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Categories"

ghcOverloadedLabelsMN :: GHC.ModuleName
ghcOverloadedLabelsMN :: ModuleName
ghcOverloadedLabelsMN =  String -> ModuleName
GHC.mkModuleName String
"GHC.OverloadedLabels"

overloadedCodeLabelsMN :: GHC.ModuleName
overloadedCodeLabelsMN :: ModuleName
overloadedCodeLabelsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.CodeLabels"

overloadedCodeStringsMN :: GHC.ModuleName
overloadedCodeStringsMN :: ModuleName
overloadedCodeStringsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.CodeStrings"

overloadedTypeNatsMN :: GHC.ModuleName
overloadedTypeNatsMN :: ModuleName
overloadedTypeNatsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.TypeNats"

overloadedTypeSymbolsMN :: GHC.ModuleName
overloadedTypeSymbolsMN :: ModuleName
overloadedTypeSymbolsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.TypeSymbols"

overloadedConstructorsMN :: GHC.ModuleName
overloadedConstructorsMN :: ModuleName
overloadedConstructorsMN =  String -> ModuleName
GHC.mkModuleName String
"Overloaded.Constructors"

ghcRecordsCompatMN :: GHC.ModuleName
ghcRecordsCompatMN :: ModuleName
ghcRecordsCompatMN =  String -> ModuleName
GHC.mkModuleName String
"GHC.Records.Compat"

ghcBaseMN :: GHC.ModuleName
ghcBaseMN :: ModuleName
ghcBaseMN = String -> ModuleName
GHC.mkModuleName String
"GHC.Base"

dataFunctorMN :: GHC.ModuleName
dataFunctorMN :: ModuleName
dataFunctorMN = String -> ModuleName
GHC.mkModuleName String
"Data.Functor"

dataEitherMN :: GHC.ModuleName
dataEitherMN :: ModuleName
dataEitherMN = String -> ModuleName
GHC.mkModuleName String
"Data.Either"