{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module HsInspect.Index
( index,
PackageEntries,
)
where
import Avail (AvailInfo(..))
import BinIface (CheckHiWay(..), TraceBinIFaceReading(..), readBinIface)
import qualified ConLike as 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 qualified DataCon as GHC
import qualified DynFlags as GHC
import qualified GHC
import GHC.PackageDb
import qualified GHC.PackageDb as GHC
import HsInspect.Json ()
import HsInspect.Sexp
import HsInspect.Util
import qualified Id as GHC
import Module as GHC
import qualified Name as GHC
import Outputable (showPpr, showSDoc)
import qualified Outputable as GHC
import PackageConfig
import qualified PackageConfig as GHC
import Packages (explicitPackages, lookupPackage)
import qualified PatSyn as GHC
import TcEnv (tcLookup)
import TcRnMonad (initTcInteractive)
import qualified TcRnTypes as GHC
import qualified TyCon as GHC
index :: GHC.GhcMonad m => m [PackageEntries]
index :: m [PackageEntries]
index = do
DynFlags
dflags <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
let explicit :: [UnitId]
explicit = PackageState -> [UnitId]
explicitPackages (PackageState -> [UnitId]) -> PackageState -> [UnitId]
forall a b. (a -> b) -> a -> b
$ DynFlags -> PackageState
GHC.pkgState DynFlags
dflags
pkgcfgs :: [PackageConfig]
pkgcfgs = Maybe PackageConfig -> [PackageConfig]
forall a. Maybe a -> [a]
maybeToList (Maybe PackageConfig -> [PackageConfig])
-> (UnitId -> Maybe PackageConfig) -> UnitId -> [PackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags (UnitId -> [PackageConfig]) -> [UnitId] -> [PackageConfig]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [UnitId]
explicit
[PackageEntries]
deps <- (PackageConfig -> m PackageEntries)
-> [PackageConfig] -> m [PackageEntries]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse PackageConfig -> m PackageEntries
forall (m :: * -> *).
GhcMonad m =>
PackageConfig -> m PackageEntries
getPkgSymbols [PackageConfig]
pkgcfgs
m ()
forall (m :: * -> *). GhcMonad m => m ()
loadCompiledModules
let unitid :: UnitId
unitid = DynFlags -> UnitId
GHC.thisPackage DynFlags
dflags
dirs :: [String]
dirs = Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ DynFlags -> Maybe String
GHC.hiDir DynFlags
dflags
Set ModuleName
home_mods <- m (Set ModuleName)
forall (m :: * -> *). GhcMonad m => m (Set ModuleName)
getTargetModules
PackageEntries
home_entries <- UnitId
-> Bool
-> [String]
-> Set ModuleName
-> [String]
-> m PackageEntries
forall (m :: * -> *).
GhcMonad m =>
UnitId
-> Bool
-> [String]
-> Set ModuleName
-> [String]
-> m PackageEntries
getSymbols UnitId
unitid Bool
True [] Set ModuleName
home_mods [String]
dirs
[PackageEntries] -> m [PackageEntries]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageEntries] -> m [PackageEntries])
-> [PackageEntries] -> m [PackageEntries]
forall a b. (a -> b) -> a -> b
$ PackageEntries
home_entries PackageEntries -> [PackageEntries] -> [PackageEntries]
forall a. a -> [a] -> [a]
: [PackageEntries]
deps
loadCompiledModules :: GHC.GhcMonad m => m ()
loadCompiledModules :: m ()
loadCompiledModules = do
DynFlags
dflags <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
case DynFlags -> Maybe String
GHC.hiDir DynFlags
dflags of
Maybe String
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
dir -> do
[Target]
compiled <- String -> m [Target]
forall (m :: * -> *). GhcMonad m => String -> m [Target]
getCompiledTargets String
dir
[Target] -> m ()
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
compiled
m SuccessFlag -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m SuccessFlag -> m ())
-> (LoadHowMuch -> m SuccessFlag) -> LoadHowMuch -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadHowMuch -> m SuccessFlag
forall (m :: * -> *). GhcMonad m => LoadHowMuch -> m SuccessFlag
GHC.load (LoadHowMuch -> m ()) -> LoadHowMuch -> m ()
forall a b. (a -> b) -> a -> b
$ LoadHowMuch
GHC.LoadAllTargets
getCompiledTargets :: GHC.GhcMonad m => FilePath -> m [GHC.Target]
getCompiledTargets :: String -> m [Target]
getCompiledTargets String
dir = do
Set ModuleName
provided <- m (Set ModuleName)
forall (m :: * -> *). GhcMonad m => m (Set ModuleName)
getTargetModules
[String]
his <- IO [String] -> m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
walkSuffix String
".hi" String
dir
[Module]
modules <- [Maybe Module] -> [Module]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Module] -> [Module]) -> m [Maybe Module] -> m [Module]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m (Maybe Module)) -> [String] -> m [Maybe Module]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String
-> (ModIface -> TcRnIf TcGblEnv TcLclEnv Module)
-> m (Maybe Module))
-> (ModIface -> TcRnIf TcGblEnv TcLclEnv Module)
-> String
-> m (Maybe Module)
forall a b c. (a -> b -> c) -> b -> a -> c
flip String
-> (ModIface -> TcRnIf TcGblEnv TcLclEnv Module)
-> m (Maybe Module)
forall (m :: * -> *) a.
GhcMonad m =>
String -> (ModIface -> TcRnIf TcGblEnv TcLclEnv a) -> m (Maybe a)
withHi (Module -> TcRnIf TcGblEnv TcLclEnv Module
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Module -> TcRnIf TcGblEnv TcLclEnv Module)
-> (ModIface -> Module)
-> ModIface
-> TcRnIf TcGblEnv TcLclEnv Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
GHC.mi_module)) [String]
his
let toTarget :: ModuleName -> Maybe Target
toTarget ModuleName
m =
if ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ModuleName
m Set ModuleName
provided
then Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TargetId -> Bool -> Maybe (InputFileBuffer, UTCTime) -> Target
GHC.Target (ModuleName -> TargetId
GHC.TargetModule ModuleName
m) Bool
True Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
Nothing
else Maybe Target
forall a. Maybe a
Nothing
[Target] -> m [Target]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Target] -> m [Target]) -> [Target] -> m [Target]
forall a b. (a -> b) -> a -> b
$ (Module -> Maybe Target) -> [Module] -> [Target]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleName -> Maybe Target
toTarget (ModuleName -> Maybe Target)
-> (Module -> ModuleName) -> Module -> Maybe Target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
moduleName) [Module]
modules
withHi :: GHC.GhcMonad m => FilePath -> (GHC.ModIface -> (GHC.TcRnIf GHC.TcGblEnv GHC.TcLclEnv) a) -> m (Maybe a)
withHi :: String -> (ModIface -> TcRnIf TcGblEnv TcLclEnv a) -> m (Maybe a)
withHi String
hi ModIface -> TcRnIf TcGblEnv TcLclEnv a
f = do
HscEnv
env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
GHC.getSession
(Messages
_, Maybe a
res) <- IO (Messages, Maybe a) -> m (Messages, Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Messages, Maybe a) -> m (Messages, Maybe a))
-> (TcRnIf TcGblEnv TcLclEnv a -> IO (Messages, Maybe a))
-> TcRnIf TcGblEnv TcLclEnv a
-> m (Messages, Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HscEnv -> TcRnIf TcGblEnv TcLclEnv a -> IO (Messages, Maybe a)
forall a. HscEnv -> TcM a -> IO (Messages, Maybe a)
initTcInteractive HscEnv
env (TcRnIf TcGblEnv TcLclEnv a -> m (Messages, Maybe a))
-> TcRnIf TcGblEnv TcLclEnv a -> m (Messages, Maybe a)
forall a b. (a -> b) -> a -> b
$ do
ModIface
iface <- CheckHiWay
-> TraceBinIFaceReading
-> String
-> TcRnIf TcGblEnv TcLclEnv ModIface
forall a b.
CheckHiWay -> TraceBinIFaceReading -> String -> TcRnIf a b ModIface
readBinIface CheckHiWay
IgnoreHiWay TraceBinIFaceReading
QuietBinIFaceReading String
hi
ModIface -> TcRnIf TcGblEnv TcLclEnv a
f ModIface
iface
Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
res
getPkgSymbols :: GHC.GhcMonad m => PackageConfig -> m PackageEntries
getPkgSymbols :: PackageConfig -> m PackageEntries
getPkgSymbols PackageConfig
pkg =
let unitid :: UnitId
unitid = PackageConfig -> UnitId
GHC.packageConfigId PackageConfig
pkg
inplace :: Bool
inplace = String
"-inplace" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` (UnitId -> String
GHC.unitIdString UnitId
unitid)
exposed :: Set ModuleName
exposed = [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ (ModuleName, Maybe Module) -> ModuleName
forall a b. (a, b) -> a
fst ((ModuleName, Maybe Module) -> ModuleName)
-> [(ModuleName, Maybe Module)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules PackageConfig
pkg
dirs :: [String]
dirs = (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
importDirs PackageConfig
pkg)
haddocks :: [String]
haddocks = PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
GHC.haddockHTMLs PackageConfig
pkg
in UnitId
-> Bool
-> [String]
-> Set ModuleName
-> [String]
-> m PackageEntries
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 => UnitId -> Bool -> [FilePath] -> Set GHC.ModuleName -> [FilePath] -> m PackageEntries
getSymbols :: 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 = IO [String] -> m [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> m [String]) -> IO [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> IO [String]
walkSuffix String
".hi" String
dir
[String]
his <- [[String]] -> [String]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[String]] -> [String]) -> m [[String]] -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m [String]) -> [String] -> m [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> m [String]
forall (m :: * -> *). MonadIO m => String -> m [String]
findHis [String]
dirs
DynFlags
dflags <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags
let srcid :: Maybe SourcePackageId
srcid = PackageConfig -> SourcePackageId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgid
sourcePackageId (PackageConfig -> SourcePackageId)
-> Maybe PackageConfig -> Maybe SourcePackageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags UnitId
unitid
[(Module, [(Maybe Module, TcTyThing)])]
symbols <- [Maybe (Module, [(Maybe Module, TcTyThing)])]
-> [(Module, [(Maybe Module, TcTyThing)])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Module, [(Maybe Module, TcTyThing)])]
-> [(Module, [(Maybe Module, TcTyThing)])])
-> m [Maybe (Module, [(Maybe Module, TcTyThing)])]
-> m [(Module, [(Maybe Module, TcTyThing)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> [String] -> m [Maybe (Module, [(Maybe Module, TcTyThing)])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Set ModuleName
-> String -> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall (m :: * -> *).
GhcMonad m =>
Set ModuleName
-> String -> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
hiToSymbols Set ModuleName
exposed) [String]
his
let entries :: [ModuleEntries]
entries = [ModuleEntries] -> [ModuleEntries]
forall a. Ord a => [a] -> [a]
sort ([ModuleEntries] -> [ModuleEntries])
-> [ModuleEntries] -> [ModuleEntries]
forall a b. (a -> b) -> a -> b
$ (Module -> [(Maybe Module, TcTyThing)] -> ModuleEntries)
-> (Module, [(Maybe Module, TcTyThing)]) -> ModuleEntries
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Module -> [(Maybe Module, TcTyThing)] -> ModuleEntries
mkEntries ((Module, [(Maybe Module, TcTyThing)]) -> ModuleEntries)
-> [(Module, [(Maybe Module, TcTyThing)])] -> [ModuleEntries]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Module, [(Maybe Module, TcTyThing)])]
symbols
mkEntries :: Module -> [(Maybe Module, TcTyThing)] -> ModuleEntries
mkEntries Module
m [(Maybe Module, TcTyThing)]
things = ModuleName -> [Entry] -> ModuleEntries
ModuleEntries (Module -> ModuleName
moduleName Module
m) ([Entry] -> [Entry]
forall a. Ord a => [a] -> [a]
sort ([Entry] -> [Entry]) -> [Entry] -> [Entry]
forall a b. (a -> b) -> a -> b
$ [(Maybe Module, TcTyThing)] -> [Entry]
renderThings [(Maybe Module, TcTyThing)]
things)
renderThings :: [(Maybe Module, TcTyThing)] -> [Entry]
renderThings [(Maybe Module, TcTyThing)]
things = [Maybe Entry] -> [Entry]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Entry] -> [Entry]) -> [Maybe Entry] -> [Entry]
forall a b. (a -> b) -> a -> b
$ ((Maybe Module -> TcTyThing -> Maybe Entry)
-> (Maybe Module, TcTyThing) -> Maybe Entry
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Maybe Module -> TcTyThing -> Maybe Entry)
-> (Maybe Module, TcTyThing) -> Maybe Entry)
-> (Maybe Module -> TcTyThing -> Maybe Entry)
-> (Maybe Module, TcTyThing)
-> Maybe Entry
forall a b. (a -> b) -> a -> b
$ DynFlags -> UnitId -> Maybe Module -> TcTyThing -> Maybe Entry
tyrender DynFlags
dflags UnitId
unitid) ((Maybe Module, TcTyThing) -> Maybe Entry)
-> [(Maybe Module, TcTyThing)] -> [Maybe Entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Module, TcTyThing)]
things
PackageEntries -> m PackageEntries
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PackageEntries -> m PackageEntries)
-> PackageEntries -> m PackageEntries
forall a b. (a -> b) -> a -> b
$ Maybe SourcePackageId
-> Bool -> [ModuleEntries] -> Haddocks -> PackageEntries
PackageEntries Maybe SourcePackageId
srcid Bool
inplace [ModuleEntries]
entries (String -> Text
T.pack (String -> Text) -> [String] -> Haddocks
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 :: Set ModuleName
-> String -> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
hiToSymbols Set ModuleName
exposed String
hi = (Maybe (Maybe (Module, [(Maybe Module, TcTyThing)]))
-> Maybe (Module, [(Maybe Module, TcTyThing)])
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Module, [(Maybe Module, TcTyThing)]))
-> Maybe (Module, [(Maybe Module, TcTyThing)]))
-> m (Maybe (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (Maybe (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> ((ModIface
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Maybe (Module, [(Maybe Module, TcTyThing)]))))
-> (ModIface
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> (ModIface
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Maybe (Module, [(Maybe Module, TcTyThing)])))
forall (m :: * -> *) a.
GhcMonad m =>
String -> (ModIface -> TcRnIf TcGblEnv TcLclEnv a) -> m (Maybe a)
withHi String
hi ((ModIface
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> (ModIface
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> m (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall a b. (a -> b) -> a -> b
$ \ModIface
iface -> do
let m :: Module
m = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
GHC.mi_module ModIface
iface
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Module -> ModuleName
GHC.moduleName Module
m) Set ModuleName
exposed
then Maybe (Module, [(Maybe Module, TcTyThing)])
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Module, [(Maybe Module, TcTyThing)])
forall a. Maybe a
Nothing
else do
let thing :: AvailInfo
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)]
thing (Avail Name
name) = (Name -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing))
-> [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Name -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
tcLookup' [Name
name]
thing (AvailTC Name
_ [Name]
members [FieldLabel]
_) = (Name -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing))
-> [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Name -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
tcLookup' [Name]
members
reexport :: Name -> Maybe Module
reexport Name
name = do
Module
modl <- Name -> Maybe Module
GHC.nameModule_maybe Name
name
if Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
modl then Maybe Module
forall a. Maybe a
Nothing else Module -> Maybe Module
forall a. a -> Maybe a
Just Module
modl
tcLookup' :: Name -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
tcLookup' Name
name = (Name -> Maybe Module
reexport Name
name,) (TcTyThing -> (Maybe Module, TcTyThing))
-> IOEnv (Env TcGblEnv TcLclEnv) TcTyThing
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe Module, TcTyThing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IOEnv (Env TcGblEnv TcLclEnv) TcTyThing
tcLookup Name
name
[(Maybe Module, TcTyThing)]
things <- [[(Maybe Module, TcTyThing)]] -> [(Maybe Module, TcTyThing)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Maybe Module, TcTyThing)]] -> [(Maybe Module, TcTyThing)])
-> IOEnv (Env TcGblEnv TcLclEnv) [[(Maybe Module, TcTyThing)]]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AvailInfo
-> IOEnv (Env TcGblEnv TcLclEnv) [(Maybe Module, TcTyThing)])
-> [AvailInfo]
-> IOEnv (Env TcGblEnv TcLclEnv) [[(Maybe Module, TcTyThing)]]
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 (ModIface -> [AvailInfo]
forall (phase :: ModIfacePhase). ModIface_ phase -> [AvailInfo]
GHC.mi_exports ModIface
iface)
Maybe (Module, [(Maybe Module, TcTyThing)])
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Module, [(Maybe Module, TcTyThing)])
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> ((Module, [(Maybe Module, TcTyThing)])
-> Maybe (Module, [(Maybe Module, TcTyThing)]))
-> (Module, [(Maybe Module, TcTyThing)])
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Module, [(Maybe Module, TcTyThing)])
-> Maybe (Module, [(Maybe Module, TcTyThing)])
forall a. a -> Maybe a
Just ((Module, [(Maybe Module, TcTyThing)])
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)])))
-> (Module, [(Maybe Module, TcTyThing)])
-> TcRnIf
TcGblEnv TcLclEnv (Maybe (Module, [(Maybe Module, TcTyThing)]))
forall a b. (a -> b) -> a -> b
$ (Module
m, [(Maybe Module, TcTyThing)]
things)
tyrender :: GHC.DynFlags -> UnitId -> Maybe GHC.Module -> GHC.TcTyThing -> Maybe Entry
tyrender :: DynFlags -> UnitId -> Maybe Module -> TcTyThing -> Maybe Entry
tyrender DynFlags
dflags UnitId
unitid Maybe Module
m' (GHC.AGlobal TyThing
thing) =
let
m :: Maybe Exported
m = DynFlags -> UnitId -> Module -> Exported
mkExported DynFlags
dflags UnitId
unitid (Module -> Exported) -> Maybe Module -> Maybe Exported
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Module
m'
shw :: GHC.Outputable m => m -> Text
shw :: m -> Text
shw = String -> Text
T.pack (String -> Text) -> (m -> String) -> m -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> m -> String
forall a. Outputable a => DynFlags -> a -> String
showPpr DynFlags
dflags
in case TyThing
thing of
(GHC.AnId Id
var) -> Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
IdEntry Maybe Exported
m
(Name -> Text
forall m. Outputable m => m -> Text
shw (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Id -> Name
GHC.idName Id
var)
(Kind -> Text
forall m. Outputable m => m -> Text
shw (Kind -> Text) -> Kind -> Text
forall a b. (a -> b) -> a -> b
$ Id -> Kind
GHC.idType Id
var)
(GHC.AConLike (GHC.RealDataCon DataCon
dc)) -> Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
ConEntry Maybe Exported
m
(Name -> Text
forall m. Outputable m => m -> Text
shw (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
forall a. NamedThing a => a -> Name
GHC.getName DataCon
dc)
(Kind -> Text
forall m. Outputable m => m -> Text
shw (Kind -> Text) -> Kind -> Text
forall a b. (a -> b) -> a -> b
$ DataCon -> Kind
GHC.dataConUserType DataCon
dc)
(GHC.AConLike (GHC.PatSynCon PatSyn
ps)) -> Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
PatSynEntry Maybe Exported
m
(Name -> Text
forall m. Outputable m => m -> Text
shw (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ PatSyn -> Name
forall a. NamedThing a => a -> Name
GHC.getName PatSyn
ps)
(String -> Text
T.pack (String -> Text) -> (SDoc -> String) -> SDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> Text) -> SDoc -> Text
forall a b. (a -> b) -> a -> b
$ PatSyn -> SDoc
GHC.pprPatSynType PatSyn
ps )
(GHC.ATyCon TyCon
tc) -> Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> Entry -> Maybe Entry
forall a b. (a -> b) -> a -> b
$ Maybe Exported -> Text -> Text -> Entry
TyConEntry Maybe Exported
m
(Name -> Text
forall m. Outputable m => m -> Text
shw (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
GHC.tyConName TyCon
tc)
(TyConFlavour -> Text
forall m. Outputable m => m -> Text
shw (TyConFlavour -> Text) -> TyConFlavour -> Text
forall a b. (a -> b) -> a -> b
$ TyCon -> TyConFlavour
GHC.tyConFlavour TyCon
tc)
TyThing
_ -> Maybe Entry
forall a. Maybe a
Nothing
tyrender DynFlags
_ UnitId
_ Maybe Module
_ TcTyThing
_ = Maybe Entry
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
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
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
Eq Entry
-> (Entry -> Entry -> Ordering)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Entry)
-> (Entry -> Entry -> Entry)
-> Ord 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
$cp1Ord :: Eq Entry
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 ([(Sexp, Sexp)] -> Sexp) -> [(Sexp, Sexp)] -> Sexp
forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"id") (Sexp, Sexp) -> [(Sexp, Sexp)] -> [(Sexp, Sexp)]
forall a. a -> [a] -> [a]
: [(Sexp
"export", Maybe Exported -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"name", Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"type", Text -> Sexp
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 ([(Sexp, Sexp)] -> Sexp) -> [(Sexp, Sexp)] -> Sexp
forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"con") (Sexp, Sexp) -> [(Sexp, Sexp)] -> [(Sexp, Sexp)]
forall a. a -> [a] -> [a]
: [(Sexp
"export", Maybe Exported -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"name", Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"type", Text -> Sexp
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 ([(Sexp, Sexp)] -> Sexp) -> [(Sexp, Sexp)] -> Sexp
forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"pat") (Sexp, Sexp) -> [(Sexp, Sexp)] -> [(Sexp, Sexp)]
forall a. a -> [a] -> [a]
: [(Sexp
"export", Maybe Exported -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"name", Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"type", Text -> Sexp
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 ([(Sexp, Sexp)] -> Sexp) -> [(Sexp, Sexp)] -> Sexp
forall a b. (a -> b) -> a -> b
$ (Sexp
"class", Sexp
"tycon") (Sexp, Sexp) -> [(Sexp, Sexp)] -> [(Sexp, Sexp)]
forall a. a -> [a] -> [a]
: [(Sexp
"export", Maybe Exported -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe Exported
p_1_1), (Sexp
"type", Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_2), (Sexp
"flavour", Text -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Text
p_1_3)]
data ModuleEntries = ModuleEntries GHC.ModuleName [Entry]
deriving (ModuleEntries -> ModuleEntries -> Bool
(ModuleEntries -> ModuleEntries -> Bool)
-> (ModuleEntries -> ModuleEntries -> Bool) -> Eq ModuleEntries
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
Eq ModuleEntries
-> (ModuleEntries -> ModuleEntries -> Ordering)
-> (ModuleEntries -> ModuleEntries -> Bool)
-> (ModuleEntries -> ModuleEntries -> Bool)
-> (ModuleEntries -> ModuleEntries -> Bool)
-> (ModuleEntries -> ModuleEntries -> Bool)
-> (ModuleEntries -> ModuleEntries -> ModuleEntries)
-> (ModuleEntries -> ModuleEntries -> ModuleEntries)
-> Ord 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
$cp1Ord :: Eq ModuleEntries
Ord)
instance ToSexp ModuleEntries where
toSexp :: ModuleEntries -> Sexp
toSexp (ModuleEntries ModuleName
p_1_1 [Entry]
p_1_2) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"module", ModuleName -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp ModuleName
p_1_1), (Sexp
"ids", [Entry] -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp [Entry]
p_1_2)]
type Haddocks = [Text]
data PackageEntries = PackageEntries (Maybe SourcePackageId) Bool [ModuleEntries] Haddocks
instance ToSexp PackageEntries where
toSexp :: PackageEntries -> Sexp
toSexp (PackageEntries Maybe SourcePackageId
p_1_1 Bool
p_1_2 [ModuleEntries]
p_1_3 Haddocks
p_1_4) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"srcid", Maybe SourcePackageId -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe SourcePackageId
p_1_1), (Sexp
"inplace", Bool -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Bool
p_1_2), (Sexp
"modules", [ModuleEntries] -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp [ModuleEntries]
p_1_3), (Sexp
"haddocks", Haddocks -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Haddocks
p_1_4)]
data Exported = Exported (Maybe SourcePackageId) GHC.ModuleName
deriving (Exported -> Exported -> Bool
(Exported -> Exported -> Bool)
-> (Exported -> Exported -> Bool) -> Eq Exported
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
Eq Exported
-> (Exported -> Exported -> Ordering)
-> (Exported -> Exported -> Bool)
-> (Exported -> Exported -> Bool)
-> (Exported -> Exported -> Bool)
-> (Exported -> Exported -> Bool)
-> (Exported -> Exported -> Exported)
-> (Exported -> Exported -> Exported)
-> Ord 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
$cp1Ord :: Eq Exported
Ord)
instance ToSexp Exported where
toSexp :: Exported -> Sexp
toSexp (Exported Maybe SourcePackageId
p_1_1 ModuleName
p_1_2) = [(Sexp, Sexp)] -> Sexp
alist [(Sexp
"srcid", Maybe SourcePackageId -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp Maybe SourcePackageId
p_1_1), (Sexp
"module", ModuleName -> Sexp
forall a. ToSexp a => a -> Sexp
toSexp ModuleName
p_1_2)]
mkExported :: GHC.DynFlags -> UnitId -> Module -> Exported
mkExported :: DynFlags -> UnitId -> Module -> Exported
mkExported DynFlags
dflags UnitId
unitid Module
m =
let unitid' :: UnitId
unitid' = Module -> UnitId
moduleUnitId Module
m
in Maybe SourcePackageId -> ModuleName -> Exported
Exported
(if UnitId
unitid UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
unitid'
then Maybe SourcePackageId
forall a. Maybe a
Nothing
else PackageConfig -> SourcePackageId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgid
sourcePackageId (PackageConfig -> SourcePackageId)
-> Maybe PackageConfig -> Maybe SourcePackageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags UnitId
unitid')
(Module -> ModuleName
moduleName Module
m)