{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module HsInspect.Index
( index,
PackageEntries,
)
where
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
import qualified GHC.Driver.Session as GHC
#endif
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
import qualified GHC.Data.ShortText as GHC
import qualified GHC.Driver.Env.Types as GHC
import qualified GHC.Driver.Ppr as GHC
import qualified GHC.Unit.Env as GHC
#endif
#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
import qualified GHC.Core.ConLike as GHC
import qualified GHC.Core.PatSyn as GHC
import qualified GHC.Core.TyCon as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Iface.Binary as GHC
import qualified GHC.Tc.Types as GHC
import qualified GHC.Tc.Utils.Env as GHC
import qualified GHC.Tc.Utils.Monad as GHC
import qualified GHC.Types.Avail as GHC
import qualified GHC.Types.Id as GHC
import qualified GHC.Types.Name as GHC
import qualified GHC.Unit.Database as GHC
import qualified GHC.Unit.State as GHC
import qualified GHC.Unit.Types as GHC
import qualified GHC.Utils.Outputable as GHC
#else
import qualified Avail as GHC
import qualified BinIface as GHC
import qualified ConLike as GHC
import qualified DynFlags as GHC
import qualified FastString as GHC
import qualified GHC.PackageDb as GHC
import qualified Id as GHC
import qualified Module as GHC
import qualified Name as GHC
import qualified Outputable as GHC
import qualified PackageConfig as GHC
import qualified Packages as GHC
import qualified PatSyn as GHC
import qualified TcEnv as GHC
import qualified TcRnMonad as GHC
import qualified TyCon as GHC
#endif
import qualified GHC
import Control.Monad
import Control.Monad.IO.Class
import Data.List (isInfixOf, sort)
import Data.Maybe (catMaybes, mapMaybe, maybeToList)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import HsInspect.Sexp
import HsInspect.Util
index :: GHC.GhcMonad m => m [PackageEntries]
index :: forall (m :: * -> *). GhcMonad m => m [PackageEntries]
index = do
DynFlags
dflags <- forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
let unarg as = fst <$> as
#elif MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
let unarg :: a -> a
unarg = forall a. a -> a
id
#endif
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
HscEnv
sess <- forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
let unit_state :: UnitState
unit_state = UnitEnv -> UnitState
GHC.ue_units forall a b. (a -> b) -> a -> b
$ HscEnv -> UnitEnv
GHC.hsc_unit_env HscEnv
sess
explicit :: [Unit]
explicit = UnitState -> [Unit]
GHC.explicitUnits UnitState
unit_state
pkgcfgs :: [UnitInfo]
pkgcfgs = forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitState -> Unit -> Maybe UnitInfo
GHC.lookupUnit UnitState
unit_state forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. a -> a
unarg [Unit]
explicit
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
let unit_state = GHC.unitState dflags
explicit = GHC.explicitUnits unit_state
pkgcfgs = maybeToList . GHC.lookupUnit unit_state =<< explicit
#else
let explicit = GHC.explicitPackages $ GHC.pkgState dflags
pkgcfgs = maybeToList . GHC.lookupPackage dflags =<< explicit
#endif
[PackageEntries]
deps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *). GhcMonad m => UnitInfo -> m PackageEntries
getPkgSymbols [UnitInfo]
pkgcfgs
forall (m :: * -> *). GhcMonad m => m ()
loadCompiledModules
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
let unitid :: UnitId
unitid = DynFlags -> UnitId
GHC.homeUnitId_ DynFlags
dflags
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
let unitid = GHC.homeUnitId dflags
#else
let unitid = GHC.thisPackage dflags
#endif
dirs :: [String]
dirs = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe String
GHC.hiDir DynFlags
dflags
Set ModuleName
home_mods <- forall (m :: * -> *). GhcMonad m => m (Set ModuleName)
getTargetModules
PackageEntries
home_entries <- forall (m :: * -> *).
GhcMonad m =>
UnitId
-> Bool
-> [String]
-> Set ModuleName
-> [String]
-> m PackageEntries
getSymbols UnitId
unitid Bool
True [] Set ModuleName
home_mods [String]
dirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PackageEntries
home_entries forall a. a -> [a] -> [a]
: [PackageEntries]
deps
loadCompiledModules :: GHC.GhcMonad m => m ()
loadCompiledModules :: forall (m :: * -> *). GhcMonad m => m ()
loadCompiledModules = do
DynFlags
dflags <- forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
case DynFlags -> Maybe String
GHC.hiDir DynFlags
dflags of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
dir -> do
[Target]
compiled <- forall (m :: * -> *). GhcMonad m => String -> m [Target]
getCompiledTargets String
dir
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
compiled
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load forall a b. (a -> b) -> a -> b
$ LoadHowMuch
GHC.LoadAllTargets
getCompiledTargets :: GHC.GhcMonad m => FilePath -> m [GHC.Target]
getCompiledTargets :: forall (m :: * -> *). GhcMonad m => String -> m [Target]
getCompiledTargets String
dir = do
Set ModuleName
provided <- forall (m :: * -> *). GhcMonad m => m (Set ModuleName)
getTargetModules
[String]
his <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
walkSuffix String
".hi" String
dir
[Module]
modules <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
GhcMonad m =>
String -> (ModIface -> TcRnIf TcGblEnv TcLclEnv a) -> m (Maybe a)
withHi (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase). ModIface_ phase -> Module
GHC.mi_module)) [String]
his
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
sess <- GHC.getSession
let unitid = GHC.ue_current_unit $ GHC.hsc_unit_env sess
mkTarget m = GHC.Target (GHC.TargetModule m) True unitid Nothing
#else
let mkTarget :: ModuleName -> Target
mkTarget ModuleName
m = TargetId -> Bool -> Maybe (InputFileBuffer, UTCTime) -> Target
GHC.Target (ModuleName -> TargetId
GHC.TargetModule ModuleName
m) Bool
True forall a. Maybe a
Nothing
#endif
toTarget :: ModuleName -> Maybe Target
toTarget ModuleName
m =
if forall a. Ord a => a -> Set a -> Bool
Set.member ModuleName
m Set ModuleName
provided
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ModuleName -> Target
mkTarget ModuleName
m
else forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleName -> Maybe Target
toTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName) [Module]
modules
withHi :: GHC.GhcMonad m => FilePath -> (GHC.ModIface -> (GHC.TcRnIf GHC.TcGblEnv GHC.TcLclEnv) a) -> m (Maybe a)
withHi :: forall (m :: * -> *) a.
GhcMonad m =>
String -> (ModIface -> TcRnIf TcGblEnv TcLclEnv a) -> m (Maybe a)
withHi String
hi ModIface -> TcRnIf TcGblEnv TcLclEnv a
f = do
HscEnv
env <- forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
dflags <- GHC.getSessionDynFlags
let profile = GHC.targetProfile dflags
name_cache = GHC.hsc_NC env
(_, res) <- liftIO $ do
iface <- GHC.readBinIface profile name_cache GHC.IgnoreHiWay GHC.QuietBinIFace hi
GHC.initTcInteractive env $ f iface
#elif MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
(Messages DecoratedSDoc
_, Maybe a
res) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HscEnv -> TcM a -> IO (Messages DecoratedSDoc, Maybe a)
GHC.initTcInteractive HscEnv
env forall a b. (a -> b) -> a -> b
$ do
ModIface
iface <- forall a b.
CheckHiWay -> TraceBinIFace -> String -> TcRnIf a b ModIface
GHC.readBinIface CheckHiWay
GHC.IgnoreHiWay TraceBinIFace
GHC.QuietBinIFace String
hi
ModIface -> TcRnIf TcGblEnv TcLclEnv a
f ModIface
iface
#else
(_, res) <- liftIO . GHC.initTcInteractive env $ do
iface <- GHC.readBinIface GHC.IgnoreHiWay GHC.QuietBinIFaceReading hi
f iface
#endif
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
res
#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
getPkgSymbols :: GHC.GhcMonad m => GHC.UnitInfo -> m PackageEntries
#else
getPkgSymbols :: GHC.GhcMonad m => GHC.PackageConfig -> m PackageEntries
#endif
getPkgSymbols :: forall (m :: * -> *). GhcMonad m => UnitInfo -> m PackageEntries
getPkgSymbols UnitInfo
pkg =
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
let exposed :: Set ModuleName
exposed = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
GHC.unitExposedModules UnitInfo
pkg
GHC.GenericUnitInfo {unitId :: forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
GHC.unitId = UnitId
unitid} = UnitInfo
pkg
dirs :: [String]
dirs = ShortText -> String
GHC.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
GHC.unitImportDirs UnitInfo
pkg)
haddocks :: [String]
haddocks = ShortText -> String
GHC.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [ShortText]
GHC.unitHaddockHTMLs UnitInfo
pkg
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
let exposed = Set.fromList $ fst <$> GHC.unitExposedModules pkg
GHC.GenericUnitInfo {GHC.unitId = unitid} = pkg
dirs = GHC.unitImportDirs pkg
haddocks = GHC.unitHaddockHTMLs pkg
#else
let exposed = Set.fromList $ fst <$> GHC.exposedModules pkg
unitid = GHC.packageConfigId pkg
dirs = (GHC.importDirs pkg)
haddocks = GHC.haddockHTMLs pkg
#endif
unit_string :: String
unit_string = UnitId -> String
GHC.unitIdString UnitId
unitid
inplace :: Bool
inplace = String
"-inplace" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
unit_string
in forall (m :: * -> *).
GhcMonad m =>
UnitId
-> Bool
-> [String]
-> Set ModuleName
-> [String]
-> m PackageEntries
getSymbols UnitId
unitid Bool
inplace [String]
haddocks Set ModuleName
exposed [String]
dirs
getSymbols :: GHC.GhcMonad m => GHC.UnitId -> Bool -> [FilePath] -> Set GHC.ModuleName -> [FilePath] -> m PackageEntries
getSymbols :: forall (m :: * -> *).
GhcMonad m =>
UnitId
-> Bool
-> [String]
-> Set ModuleName
-> [String]
-> m PackageEntries
getSymbols UnitId
unitid Bool
inplace [String]
haddocks Set ModuleName
exposed [String]
dirs = do
let findHis :: String -> m [String]
findHis String
dir = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
walkSuffix String
".hi" String
dir
[String]
his <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. MonadIO m => String -> m [String]
findHis [String]
dirs
DynFlags
dflags <- forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
HscEnv
sess <- forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
let unit_state :: UnitState
unit_state = UnitEnv -> UnitState
GHC.ue_units forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> UnitEnv
GHC.hsc_unit_env forall a b. (a -> b) -> a -> b
$ HscEnv
sess
findPid :: UnitId -> Maybe PackageId
findPid UnitId
unitid' = forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgid
GHC.unitPackageId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitState -> UnitId -> Maybe UnitInfo
GHC.lookupUnitId UnitState
unit_state UnitId
unitid'
findUnitId :: Module -> UnitId
findUnitId = Unit -> UnitId
GHC.toUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> unit
GHC.moduleUnit
mkPackageId :: PackageId -> PackageId
mkPackageId (GHC.PackageId FastString
fs) = Text -> PackageId
PackageId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FastString -> String
GHC.unpackFS FastString
fs
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
let unit_state = GHC.unitState dflags
findPid unitid' = GHC.unitPackageId <$> GHC.lookupUnitId unit_state unitid'
findUnitId = GHC.toUnitId . GHC.moduleUnit
mkPackageId (GHC.PackageId fs) = PackageId . T.pack $ GHC.unpackFS fs
#else
let findPid unitid' = GHC.sourcePackageId <$> GHC.lookupPackage dflags unitid'
findUnitId = GHC.moduleUnitId
mkPackageId (GHC.SourcePackageId fs) = PackageId . T.pack $ GHC.unpackFS fs
#endif
srcid :: Maybe PackageId
srcid = UnitId -> Maybe PackageId
findPid UnitId
unitid
[(Module, [(Maybe Module, TcTyThing)])]
symbols <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
GhcMonad m =>
Set ModuleName
-> String -> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
hiToSymbols Set ModuleName
exposed) [String]
his
let entries :: [ModuleEntries]
entries = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Module -> [(Maybe Module, TcTyThing)] -> ModuleEntries
mkEntries forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Module, [(Maybe Module, TcTyThing)])]
symbols
mkModuleName :: GHC.Module -> ModuleName
mkModuleName :: Module -> ModuleName
mkModuleName = Text -> ModuleName
ModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
GHC.moduleNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> ModuleName
GHC.moduleName
mkEntries :: Module -> [(Maybe Module, TcTyThing)] -> ModuleEntries
mkEntries Module
m [(Maybe Module, TcTyThing)]
things = ModuleName -> [Entry] -> ModuleEntries
ModuleEntries (Module -> ModuleName
mkModuleName Module
m) (forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [(Maybe Module, TcTyThing)] -> [Entry]
renderThings [(Maybe Module, TcTyThing)]
things)
mkExported :: Module -> Exported
mkExported Module
m =
let unitid' :: UnitId
unitid' = Module -> UnitId
findUnitId Module
m
pid :: Maybe PackageId
pid = if UnitId
unitid forall a. Eq a => a -> a -> Bool
== UnitId
unitid'
then forall a. Maybe a
Nothing
else UnitId -> Maybe PackageId
findPid UnitId
unitid'
in Maybe PackageId -> ModuleName -> Exported
Exported (PackageId -> PackageId
mkPackageId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PackageId
pid) (Module -> ModuleName
mkModuleName Module
m)
renderThings :: [(Maybe Module, TcTyThing)] -> [Entry]
renderThings [(Maybe Module, TcTyThing)]
things = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ (\(Maybe Module
mm, TcTyThing
thing) -> DynFlags -> Maybe Exported -> TcTyThing -> Maybe Entry
tyrender DynFlags
dflags (Module -> Exported
mkExported forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Module
mm) TcTyThing
thing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Module, TcTyThing)]
things
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe PackageId
-> Bool -> [ModuleEntries] -> Haddocks -> PackageEntries
PackageEntries (PackageId -> PackageId
mkPackageId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PackageId
srcid) Bool
inplace [ModuleEntries]
entries (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
haddocks)
hiToSymbols
:: GHC.GhcMonad m
=> Set GHC.ModuleName
-> FilePath
-> m (Maybe (GHC.Module, [(Maybe GHC.Module, GHC.TcTyThing)]))
hiToSymbols :: forall (m :: * -> *).
GhcMonad m =>
Set ModuleName
-> String -> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
hiToSymbols Set ModuleName
exposed String
hi = (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
GhcMonad m =>
String -> (ModIface -> TcRnIf TcGblEnv TcLclEnv a) -> m (Maybe a)
withHi String
hi forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
let m :: Module
m = forall (phase :: ModIfacePhase). ModIface_ phase -> Module
GHC.mi_module ModIface
iface
if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Bool
Set.member (forall unit. GenModule unit -> ModuleName
GHC.moduleName Module
m) Set ModuleName
exposed
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else do
let thing :: AvailInfo
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)]
thing (GHC.Avail GreName
name) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GreName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
tcLookup' [GreName
name]
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
thing (GHC.AvailTC Name
_ [GreName]
members) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse GreName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
tcLookup' [GreName]
members
#else
thing (GHC.AvailTC _ members _) = traverse tcLookup' members
#endif
reexport :: Name -> Maybe Module
reexport Name
name = do
Module
modl <- Name -> Maybe Module
GHC.nameModule_maybe Name
name
if Module
m forall a. Eq a => a -> a -> Bool
== Module
modl then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Module
modl
tcLookup' :: GreName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
tcLookup' GreName
name =
#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0)
let name' :: Name
name' = GreName -> Name
GHC.greNameMangledName GreName
name
#else
let name' = name
#endif
in (Name -> Maybe Module
reexport Name
name',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> TcM TcTyThing
GHC.tcLookup Name
name'
[(Maybe Module, TcTyThing)]
things <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse AvailInfo
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)]
thing (forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
GHC.mi_exports ModIface
iface)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Module
m, [(Maybe Module, TcTyThing)]
things)
tyrender :: GHC.DynFlags -> Maybe Exported -> GHC.TcTyThing -> Maybe Entry
tyrender :: DynFlags -> Maybe Exported -> TcTyThing -> Maybe Entry
tyrender DynFlags
dflags Maybe Exported
m (GHC.AGlobal TyThing
thing) =
let
shw :: GHC.Outputable o => o -> Text
shw :: forall o. Outputable o => o -> Text
shw = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => DynFlags -> a -> String
GHC.showPpr DynFlags
dflags
in case TyThing
thing of
(GHC.AnId Id
var) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
IdEntry Maybe Exported
m
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ Id -> Name
GHC.idName Id
var)
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ Id -> Kind
GHC.idType Id
var)
(GHC.AConLike (GHC.RealDataCon DataCon
dc)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
ConEntry Maybe Exported
m
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ forall a. NamedThing a => a -> Name
GHC.getName DataCon
dc)
#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ DataCon -> Kind
GHC.dataConWrapperType DataCon
dc)
#else
(shw $ GHC.dataConUserType dc)
#endif
(GHC.AConLike (GHC.PatSynCon PatSyn
ps)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
PatSynEntry Maybe Exported
m
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ forall a. NamedThing a => a -> Name
GHC.getName PatSyn
ps)
(String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
GHC.showSDoc DynFlags
dflags forall a b. (a -> b) -> a -> b
$ PatSyn -> SDoc
GHC.pprPatSynType PatSyn
ps )
(GHC.ATyCon TyCon
tc) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
TyConEntry Maybe Exported
m
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ TyCon -> Name
GHC.tyConName TyCon
tc)
(forall o. Outputable o => o -> Text
shw forall a b. (a -> b) -> a -> b
$ TyCon -> TyConFlavour
GHC.tyConFlavour TyCon
tc)
TyThing
_ -> forall a. Maybe a
Nothing
tyrender DynFlags
_ Maybe Exported
_ TcTyThing
_ = forall a. Maybe a
Nothing
data Entry = IdEntry (Maybe Exported) Text Text
| ConEntry (Maybe Exported) Text Text
| PatSynEntry (Maybe Exported) Text Text
| TyConEntry (Maybe Exported) Text Text
deriving (Entry -> Entry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq, Eq Entry
Entry -> Entry -> Bool
Entry -> Entry -> Ordering
Entry -> Entry -> Entry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Entry -> Entry -> Entry
$cmin :: Entry -> Entry -> Entry
max :: Entry -> Entry -> Entry
$cmax :: Entry -> Entry -> Entry
>= :: Entry -> Entry -> Bool
$c>= :: Entry -> Entry -> Bool
> :: Entry -> Entry -> Bool
$c> :: Entry -> Entry -> Bool
<= :: Entry -> Entry -> Bool
$c<= :: Entry -> Entry -> Bool
< :: Entry -> Entry -> Bool
$c< :: Entry -> Entry -> Bool
compare :: Entry -> Entry -> Ordering
$ccompare :: Entry -> Entry -> Ordering
Ord)
instance ToSexp Entry where
toSexp :: Entry -> Sexp
toSexp (IdEntry Maybe Exported
p_1_1 Text
p_1_2 Text
p_1_3) = [(Sexp, Sexp)] -> Sexp
alist forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"id") forall a. a -> [a] -> [a]
: [(Sexp
"export", forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"name", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"type", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]
toSexp (ConEntry Maybe Exported
p_1_1 Text
p_1_2 Text
p_1_3) = [(Sexp, Sexp)] -> Sexp
alist forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"con") forall a. a -> [a] -> [a]
: [(Sexp
"export", forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"name", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"type", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]
toSexp (PatSynEntry Maybe Exported
p_1_1 Text
p_1_2 Text
p_1_3) = [(Sexp, Sexp)] -> Sexp
alist forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"pat") forall a. a -> [a] -> [a]
: [(Sexp
"export", forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"name", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"type", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]
toSexp (TyConEntry Maybe Exported
p_1_1 Text
p_1_2 Text
p_1_3) = [(Sexp, Sexp)] -> Sexp
alist forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"tycon") forall a. a -> [a] -> [a]
: [(Sexp
"export", forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"type", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"flavour", forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]
data ModuleEntries = ModuleEntries ModuleName [Entry]
deriving (ModuleEntries -> ModuleEntries -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleEntries -> ModuleEntries -> Bool
$c/= :: ModuleEntries -> ModuleEntries -> Bool
== :: ModuleEntries -> ModuleEntries -> Bool
$c== :: ModuleEntries -> ModuleEntries -> Bool
Eq, Eq ModuleEntries
ModuleEntries -> ModuleEntries -> Bool
ModuleEntries -> ModuleEntries -> Ordering
ModuleEntries -> ModuleEntries -> ModuleEntries
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleEntries -> ModuleEntries -> ModuleEntries
$cmin :: ModuleEntries -> ModuleEntries -> ModuleEntries
max :: ModuleEntries -> ModuleEntries -> ModuleEntries
$cmax :: ModuleEntries -> ModuleEntries -> ModuleEntries
>= :: ModuleEntries -> ModuleEntries -> Bool
$c>= :: ModuleEntries -> ModuleEntries -> Bool
> :: ModuleEntries -> ModuleEntries -> Bool
$c> :: ModuleEntries -> ModuleEntries -> Bool
<= :: ModuleEntries -> ModuleEntries -> Bool
$c<= :: ModuleEntries -> ModuleEntries -> Bool
< :: ModuleEntries -> ModuleEntries -> Bool
$c< :: ModuleEntries -> ModuleEntries -> Bool
compare :: ModuleEntries -> ModuleEntries -> Ordering
$ccompare :: ModuleEntries -> ModuleEntries -> Ordering
Ord)
instance ToSexp ModuleEntries where
toSexp :: ModuleEntries -> Sexp
toSexp (ModuleEntries ModuleName
p_1_1 [Entry]
p_1_2) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"module", forall a. ToSexp a => a -> Sexp
toSexp ModuleName
p_1_1), (Sexp
"ids", forall a. ToSexp a => a -> Sexp
toSexp [Entry]
p_1_2)]
type Haddocks = [Text]
data PackageEntries = PackageEntries (Maybe PackageId) Bool [ModuleEntries] Haddocks
instance ToSexp PackageEntries where
toSexp :: PackageEntries -> Sexp
toSexp (PackageEntries Maybe PackageId
p_1_1 Bool
p_1_2 [ModuleEntries]
p_1_3 Haddocks
p_1_4) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"srcid", forall a. ToSexp a => a -> Sexp
toSexp Maybe PackageId
p_1_1), (Sexp
"inplace", forall a. ToSexp a => a -> Sexp
toSexp Bool
p_1_2), (Sexp
"modules", forall a. ToSexp a => a -> Sexp
toSexp [ModuleEntries]
p_1_3), (Sexp
"haddocks", forall a. ToSexp a => a -> Sexp
toSexp Haddocks
p_1_4)]
data Exported = Exported (Maybe PackageId) ModuleName
deriving (Exported -> Exported -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exported -> Exported -> Bool
$c/= :: Exported -> Exported -> Bool
== :: Exported -> Exported -> Bool
$c== :: Exported -> Exported -> Bool
Eq, Eq Exported
Exported -> Exported -> Bool
Exported -> Exported -> Ordering
Exported -> Exported -> Exported
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Exported -> Exported -> Exported
$cmin :: Exported -> Exported -> Exported
max :: Exported -> Exported -> Exported
$cmax :: Exported -> Exported -> Exported
>= :: Exported -> Exported -> Bool
$c>= :: Exported -> Exported -> Bool
> :: Exported -> Exported -> Bool
$c> :: Exported -> Exported -> Bool
<= :: Exported -> Exported -> Bool
$c<= :: Exported -> Exported -> Bool
< :: Exported -> Exported -> Bool
$c< :: Exported -> Exported -> Bool
compare :: Exported -> Exported -> Ordering
$ccompare :: Exported -> Exported -> Ordering
Ord)
instance ToSexp Exported where
toSexp :: Exported -> Sexp
toSexp (Exported Maybe PackageId
p_1_1 ModuleName
p_1_2) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"srcid", forall a. ToSexp a => a -> Sexp
toSexp Maybe PackageId
p_1_1), (Sexp
"module", forall a. ToSexp a => a -> Sexp
toSexp ModuleName
p_1_2)]
newtype ModuleName = ModuleName Text deriving (ModuleName -> ModuleName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleName -> ModuleName -> Bool
$c/= :: ModuleName -> ModuleName -> Bool
== :: ModuleName -> ModuleName -> Bool
$c== :: ModuleName -> ModuleName -> Bool
Eq, Eq ModuleName
ModuleName -> ModuleName -> Bool
ModuleName -> ModuleName -> Ordering
ModuleName -> ModuleName -> ModuleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModuleName -> ModuleName -> ModuleName
$cmin :: ModuleName -> ModuleName -> ModuleName
max :: ModuleName -> ModuleName -> ModuleName
$cmax :: ModuleName -> ModuleName -> ModuleName
>= :: ModuleName -> ModuleName -> Bool
$c>= :: ModuleName -> ModuleName -> Bool
> :: ModuleName -> ModuleName -> Bool
$c> :: ModuleName -> ModuleName -> Bool
<= :: ModuleName -> ModuleName -> Bool
$c<= :: ModuleName -> ModuleName -> Bool
< :: ModuleName -> ModuleName -> Bool
$c< :: ModuleName -> ModuleName -> Bool
compare :: ModuleName -> ModuleName -> Ordering
$ccompare :: ModuleName -> ModuleName -> Ordering
Ord, ModuleName -> Sexp
forall a. (a -> Sexp) -> ToSexp a
toSexp :: ModuleName -> Sexp
$ctoSexp :: ModuleName -> Sexp
ToSexp)
newtype PackageId = PackageId Text deriving (PackageId -> PackageId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageId -> PackageId -> Bool
$c/= :: PackageId -> PackageId -> Bool
== :: PackageId -> PackageId -> Bool
$c== :: PackageId -> PackageId -> Bool
Eq, Eq PackageId
PackageId -> PackageId -> Bool
PackageId -> PackageId -> Ordering
PackageId -> PackageId -> PackageId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageId -> PackageId -> PackageId
$cmin :: PackageId -> PackageId -> PackageId
max :: PackageId -> PackageId -> PackageId
$cmax :: PackageId -> PackageId -> PackageId
>= :: PackageId -> PackageId -> Bool
$c>= :: PackageId -> PackageId -> Bool
> :: PackageId -> PackageId -> Bool
$c> :: PackageId -> PackageId -> Bool
<= :: PackageId -> PackageId -> Bool
$c<= :: PackageId -> PackageId -> Bool
< :: PackageId -> PackageId -> Bool
$c< :: PackageId -> PackageId -> Bool
compare :: PackageId -> PackageId -> Ordering
$ccompare :: PackageId -> PackageId -> Ordering
Ord, PackageId -> Sexp
forall a. (a -> Sexp) -> ToSexp a
toSexp :: PackageId -> Sexp
$ctoSexp :: PackageId -> Sexp
ToSexp)