Safe Haskell | None |
---|---|
Language | Haskell2010 |
Unit manipulation
Synopsis
- module GHC.Unit.Info
- data UnitState = UnitState {
- unitInfoMap :: UnitInfoMap
- preloadClosure :: PreloadUnitClosure
- packageNameMap :: Map PackageName IndefUnitId
- wireMap :: Map UnitId UnitId
- unwireMap :: Map UnitId UnitId
- preloadUnits :: [UnitId]
- explicitUnits :: [Unit]
- moduleNameProvidersMap :: !ModuleNameProvidersMap
- pluginModuleNameProvidersMap :: !ModuleNameProvidersMap
- requirementContext :: Map ModuleName [InstantiatedModule]
- allowVirtualUnits :: !Bool
- data UnitDatabase unit = UnitDatabase {
- unitDatabasePath :: FilePath
- unitDatabaseUnits :: [GenUnitInfo unit]
- emptyUnitState :: UnitState
- initUnits :: DynFlags -> IO DynFlags
- readUnitDatabases :: (Int -> SDoc -> IO ()) -> UnitConfig -> IO [UnitDatabase UnitId]
- readUnitDatabase :: (Int -> SDoc -> IO ()) -> UnitConfig -> FilePath -> IO (UnitDatabase UnitId)
- getUnitDbRefs :: UnitConfig -> IO [PkgDbRef]
- resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe FilePath)
- listUnitInfo :: UnitState -> [UnitInfo]
- lookupUnit :: UnitState -> Unit -> Maybe UnitInfo
- lookupUnit' :: Bool -> UnitInfoMap -> PreloadUnitClosure -> Unit -> Maybe UnitInfo
- unsafeLookupUnit :: HasDebugCallStack => UnitState -> Unit -> UnitInfo
- lookupUnitId :: UnitState -> UnitId -> Maybe UnitInfo
- lookupUnitId' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
- unsafeLookupUnitId :: HasDebugCallStack => UnitState -> UnitId -> UnitInfo
- lookupPackageName :: UnitState -> PackageName -> Maybe IndefUnitId
- improveUnit :: UnitState -> Unit -> Unit
- searchPackageId :: UnitState -> PackageId -> [UnitInfo]
- displayUnitId :: UnitState -> UnitId -> Maybe String
- listVisibleModuleNames :: UnitState -> [ModuleName]
- lookupModuleInAllUnits :: UnitState -> ModuleName -> [(Module, UnitInfo)]
- lookupModuleWithSuggestions :: UnitState -> ModuleName -> Maybe FastString -> LookupResult
- lookupPluginModuleWithSuggestions :: UnitState -> ModuleName -> Maybe FastString -> LookupResult
- data LookupResult
- = LookupFound Module UnitInfo
- | LookupMultiple [(Module, ModuleOrigin)]
- | LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]
- | LookupUnusable [(Module, ModuleOrigin)]
- | LookupNotFound [ModuleSuggestion]
- data ModuleSuggestion
- data ModuleOrigin
- data UnusableUnitReason
- pprReason :: SDoc -> UnusableUnitReason -> SDoc
- getUnitIncludePath :: DynFlags -> [UnitId] -> IO [String]
- getUnitLibraryPath :: DynFlags -> [UnitId] -> IO [String]
- getUnitLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String])
- getUnitExtraCcOpts :: DynFlags -> [UnitId] -> IO [String]
- getUnitFrameworkPath :: DynFlags -> [UnitId] -> IO [String]
- getUnitFrameworks :: DynFlags -> [UnitId] -> IO [String]
- getPreloadUnitsAnd :: DynFlags -> [UnitId] -> IO [UnitInfo]
- collectArchives :: DynFlags -> UnitInfo -> IO [FilePath]
- collectIncludeDirs :: [UnitInfo] -> [FilePath]
- collectLibraryPaths :: DynFlags -> [UnitInfo] -> [FilePath]
- collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String])
- packageHsLibs :: DynFlags -> UnitInfo -> [String]
- getLibs :: DynFlags -> [UnitId] -> IO [(String, String)]
- type ShHoleSubst = ModuleNameEnv Module
- renameHoleUnit :: UnitState -> ShHoleSubst -> Unit -> Unit
- renameHoleModule :: UnitState -> ShHoleSubst -> Module -> Module
- renameHoleUnit' :: UnitInfoMap -> PreloadUnitClosure -> ShHoleSubst -> Unit -> Unit
- renameHoleModule' :: UnitInfoMap -> PreloadUnitClosure -> ShHoleSubst -> Module -> Module
- instUnitToUnit :: UnitState -> InstantiatedUnit -> Unit
- instModuleToModule :: UnitState -> InstantiatedModule -> Module
- mkIndefUnitId :: UnitState -> FastString -> IndefUnitId
- updateIndefUnitId :: UnitState -> IndefUnitId -> IndefUnitId
- unwireUnit :: UnitState -> Unit -> Unit
- pprFlag :: PackageFlag -> SDoc
- pprUnits :: UnitState -> SDoc
- pprUnitsSimple :: UnitState -> SDoc
- pprModuleMap :: ModuleNameProvidersMap -> SDoc
- homeUnitIsIndefinite :: DynFlags -> Bool
- homeUnitIsDefinite :: DynFlags -> Bool
Documentation
module GHC.Unit.Info
Reading the package config, and processing cmdline args
UnitState | |
|
data UnitDatabase unit Source #
Unit database
UnitDatabase | |
|
initUnits :: DynFlags -> IO DynFlags Source #
Read the unit database files, and sets up various internal tables of
unit information, according to the unit-related flags on the
command-line (-package
, -hide-package
etc.)
initUnits
can be called again subsequently after updating the
packageFlags
field of the DynFlags
, and it will update the
unitState
in DynFlags
.
readUnitDatabases :: (Int -> SDoc -> IO ()) -> UnitConfig -> IO [UnitDatabase UnitId] Source #
readUnitDatabase :: (Int -> SDoc -> IO ()) -> UnitConfig -> FilePath -> IO (UnitDatabase UnitId) Source #
getUnitDbRefs :: UnitConfig -> IO [PkgDbRef] Source #
resolveUnitDatabase :: UnitConfig -> PkgDbRef -> IO (Maybe FilePath) Source #
Return the path of a package database from a PkgDbRef
. Return Nothing
when the user database filepath is expected but the latter doesn't exist.
NB: This logic is reimplemented in Cabal, so if you change it, make sure you update Cabal. (Or, better yet, dump it in the compiler info so Cabal can use the info.)
listUnitInfo :: UnitState -> [UnitInfo] Source #
Get a list of entries from the unit database. NB: be careful with this function, although all units in this map are "visible", this does not imply that the exposed-modules of the unit are available (they may have been thinned or renamed).
Querying the package config
lookupUnit :: UnitState -> Unit -> Maybe UnitInfo Source #
Find the unit we know about with the given unit, if any
unsafeLookupUnit :: HasDebugCallStack => UnitState -> Unit -> UnitInfo Source #
Looks up the given unit in the unit state, panicing if it is not found
lookupUnitId :: UnitState -> UnitId -> Maybe UnitInfo Source #
Find the unit we know about with the given unit id, if any
lookupUnitId' :: UnitInfoMap -> UnitId -> Maybe UnitInfo Source #
Find the unit we know about with the given unit id, if any
unsafeLookupUnitId :: HasDebugCallStack => UnitState -> UnitId -> UnitInfo Source #
Looks up the given unit id in the unit state, panicing if it is not found
lookupPackageName :: UnitState -> PackageName -> Maybe IndefUnitId Source #
Find the unit we know about with the given package name (e.g. foo
), if any
(NB: there might be a locally defined unit name which overrides this)
improveUnit :: UnitState -> Unit -> Unit Source #
Given a fully instantiated GenInstantiatedUnit
, improve it into a
RealUnit
if we can find it in the package database.
searchPackageId :: UnitState -> PackageId -> [UnitInfo] Source #
Search for units with a given package ID (e.g. "foo-0.1")
listVisibleModuleNames :: UnitState -> [ModuleName] Source #
lookupModuleInAllUnits :: UnitState -> ModuleName -> [(Module, UnitInfo)] Source #
Takes a ModuleName
, and if the module is in any package returns
list of modules which take that name.
lookupPluginModuleWithSuggestions :: UnitState -> ModuleName -> Maybe FastString -> LookupResult Source #
data LookupResult Source #
The result of performing a lookup
LookupFound Module UnitInfo | Found the module uniquely, nothing else to do |
LookupMultiple [(Module, ModuleOrigin)] | Multiple modules with the same name in scope |
LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)] | No modules found, but there were some hidden ones with an exact name match. First is due to package hidden, second is due to module being hidden |
LookupUnusable [(Module, ModuleOrigin)] | No modules found, but there were some unusable ones with an exact name match |
LookupNotFound [ModuleSuggestion] | Nothing found, here are some suggested different names |
data ModuleSuggestion Source #
data ModuleOrigin Source #
Unit state is all stored in DynFlags
, including the details of
all units, which units are exposed, and which modules they
provide.
The unit state is computed by initUnits
, and kept in DynFlags.
It is influenced by various command-line flags:
-package <pkg>
and-package-id <pkg>
cause<pkg>
to become exposed. If-hide-all-packages
was not specified, these commands also cause all other packages with the same name to become hidden.-hide-package <pkg>
causes<pkg>
to become hidden.- (there are a few more flags, check below for their semantics)
The unit state has the following properties.
- Let
exposedUnits
be the set of packages thus exposed. LetdepExposedUnits
be the transitive closure fromexposedUnits
of their dependencies. - When searching for a module from a preload import declaration,
only the exposed modules in
exposedUnits
are valid. - When searching for a module from an implicit import, all modules
from
depExposedUnits
are valid. - When linking in a compilation manager mode, we link in packages the
program depends on (the compiler knows this list by the
time it gets to the link step). Also, we link in all packages
which were mentioned with preload
-package
flags on the command-line, or are a transitive dependency of same, or are "base"/"rts". The reason for this is that we might need packages which don't contain any Haskell modules, and therefore won't be discovered by the normal mechanism of dependency tracking.
Given a module name, there may be multiple ways it came into scope, possibly simultaneously. This data type tracks all the possible ways it could have come into scope. Warning: don't use the record functions, they're partial!
ModHidden | Module is hidden, and thus never will be available for import. (But maybe the user didn't realize), so we'll still keep track of these modules.) |
ModUnusable UnusableUnitReason | Module is unavailable because the package is unusable. |
ModOrigin | Module is public, and could have come from some places. |
|
Instances
Semigroup ModuleOrigin # | |
Defined in GHC.Unit.State (<>) :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin Source # sconcat :: NonEmpty ModuleOrigin -> ModuleOrigin Source # stimes :: Integral b => b -> ModuleOrigin -> ModuleOrigin Source # | |
Monoid ModuleOrigin # | |
Defined in GHC.Unit.State mempty :: ModuleOrigin Source # mappend :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin Source # mconcat :: [ModuleOrigin] -> ModuleOrigin Source # | |
Outputable ModuleOrigin # | |
Defined in GHC.Unit.State |
data UnusableUnitReason Source #
The reason why a unit is unusable.
IgnoredWithFlag | We ignored it explicitly using |
BrokenDependencies [UnitId] | This unit transitively depends on a unit that was never present in any of the provided databases. |
CyclicDependencies [UnitId] | This unit transitively depends on a unit involved in a cycle.
Note that the list of |
IgnoredDependencies [UnitId] | This unit transitively depends on a unit which was ignored. |
ShadowedDependencies [UnitId] | This unit transitively depends on a unit which was shadowed by an ABI-incompatible unit. |
Instances
Outputable UnusableUnitReason # | |
Defined in GHC.Unit.State |
Inspecting the set of packages in scope
getUnitIncludePath :: DynFlags -> [UnitId] -> IO [String] Source #
Find all the include directories in these and the preload packages
getUnitLibraryPath :: DynFlags -> [UnitId] -> IO [String] Source #
Find all the library paths in these and the preload packages
getUnitLinkOpts :: DynFlags -> [UnitId] -> IO ([String], [String], [String]) Source #
Find all the link options in these and the preload packages, returning (package hs lib options, extra library options, other flags)
getUnitExtraCcOpts :: DynFlags -> [UnitId] -> IO [String] Source #
Find all the C-compiler options in these and the preload packages
getUnitFrameworkPath :: DynFlags -> [UnitId] -> IO [String] Source #
Find all the package framework paths in these and the preload packages
getUnitFrameworks :: DynFlags -> [UnitId] -> IO [String] Source #
Find all the package frameworks in these and the preload packages
getPreloadUnitsAnd :: DynFlags -> [UnitId] -> IO [UnitInfo] Source #
Lookup UnitInfo
for every preload unit, for every unit used to
instantiate the current unit, and for every unit explicitly passed in the
given list of UnitId.
collectIncludeDirs :: [UnitInfo] -> [FilePath] Source #
Module hole substitution
type ShHoleSubst = ModuleNameEnv Module Source #
Substitution on module variables, mapping module names to module identifiers.
renameHoleUnit :: UnitState -> ShHoleSubst -> Unit -> Unit Source #
Substitutes holes in a Unit
, suitable for renaming when
an include occurs; see Note [Representation of module/name variable].
p[A=<A>]
maps to p[A=<B>]
with A=<B>
.
renameHoleModule :: UnitState -> ShHoleSubst -> Module -> Module Source #
Substitutes holes in a GenModule
. NOT suitable for being called
directly on a nameModule
, see Note [Representation of module/name variable].
p[A=<A>]:B
maps to p[A=q():A]:B
with A=q():A
;
similarly, <A>
maps to q():A
.
renameHoleUnit' :: UnitInfoMap -> PreloadUnitClosure -> ShHoleSubst -> Unit -> Unit Source #
Like 'renameHoleUnit, but requires only ClosureUnitInfoMap
so it can be used by GHC.Unit.State.
renameHoleModule' :: UnitInfoMap -> PreloadUnitClosure -> ShHoleSubst -> Module -> Module Source #
Like renameHoleModule
, but requires only ClosureUnitInfoMap
so it can be used by GHC.Unit.State.
instUnitToUnit :: UnitState -> InstantiatedUnit -> Unit Source #
Check the database to see if we already have an installed unit that
corresponds to the given GenInstantiatedUnit
.
Return a UnitId
which either wraps the GenInstantiatedUnit
unchanged or
references a matching installed unit.
See Note [VirtUnit to RealUnit improvement]
instModuleToModule :: UnitState -> InstantiatedModule -> Module Source #
Injects an InstantiatedModule
to GenModule
(see also
instUnitToUnit
.
Utils
mkIndefUnitId :: UnitState -> FastString -> IndefUnitId Source #
updateIndefUnitId :: UnitState -> IndefUnitId -> IndefUnitId Source #
Update component ID details from the database
pprFlag :: PackageFlag -> SDoc Source #
pprUnitsSimple :: UnitState -> SDoc Source #
Show simplified unit info.
The idea is to only print package id, and any information that might be different from the package databases (exposure, trust)
pprModuleMap :: ModuleNameProvidersMap -> SDoc Source #
Show the mapping of modules to where they come from.
homeUnitIsIndefinite :: DynFlags -> Bool Source #
A little utility to tell if the home unit is indefinite (if it is not, we should never use on-the-fly renaming.)
homeUnitIsDefinite :: DynFlags -> Bool Source #
A little utility to tell if the home unit is definite (if it is, we should never use on-the-fly renaming.)