{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns, FlexibleContexts #-}
module GHC.Unit.State (
module GHC.Unit.Info,
PackageState(..),
PackageDatabase (..),
UnitInfoMap,
emptyPackageState,
initPackages,
readPackageDatabases,
readPackageDatabase,
getPackageConfRefs,
resolvePackageDatabase,
listUnitInfoMap,
lookupUnit,
lookupUnit',
lookupInstalledPackage,
lookupPackageName,
improveUnit,
searchPackageId,
unsafeGetUnitInfo,
getInstalledPackageDetails,
displayUnitId,
listVisibleModuleNames,
lookupModuleInAllPackages,
lookupModuleWithSuggestions,
lookupPluginModuleWithSuggestions,
LookupResult(..),
ModuleSuggestion(..),
ModuleOrigin(..),
UnusablePackageReason(..),
pprReason,
getPackageIncludePath,
getPackageLibraryPath,
getPackageLinkOpts,
getPackageExtraCcOpts,
getPackageFrameworkPath,
getPackageFrameworks,
getPreloadPackagesAnd,
collectArchives,
collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
packageHsLibs, getLibs,
mkIndefUnitId,
updateIndefUnitId,
unwireUnit,
pprFlag,
pprPackages,
pprPackagesSimple,
pprModuleMap,
isIndefinite,
)
where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Unit.Database
import GHC.Unit.Info
import GHC.Unit.Types
import GHC.Unit.Module
import GHC.Unit.Subst
import GHC.Driver.Session
import GHC.Driver.Ways
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.Set
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Outputable as Outputable
import GHC.Data.Maybe
import System.Environment ( getEnv )
import GHC.Data.FastString
import GHC.Utils.Error ( debugTraceMsg, MsgDoc, dumpIfSet_dyn,
withTiming, DumpFormat (..) )
import GHC.Utils.Exception
import System.Directory
import System.FilePath as FilePath
import Control.Monad
import Data.Graph (stronglyConnComp, SCC(..))
import Data.Char ( toUpper )
import Data.List as List
import Data.Map (Map)
import Data.Set (Set)
import Data.Monoid (First(..))
import qualified Data.Semigroup as Semigroup
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapStrict
import qualified Data.Set as Set
data ModuleOrigin =
ModHidden
| ModUnusable UnusablePackageReason
| ModOrigin {
ModuleOrigin -> Maybe Bool
fromOrigPackage :: Maybe Bool
, ModuleOrigin -> [UnitInfo]
fromExposedReexport :: [UnitInfo]
, ModuleOrigin -> [UnitInfo]
fromHiddenReexport :: [UnitInfo]
, ModuleOrigin -> Bool
fromPackageFlag :: Bool
}
instance Outputable ModuleOrigin where
ppr :: ModuleOrigin -> MsgDoc
ppr ModuleOrigin
ModHidden = [Char] -> MsgDoc
text [Char]
"hidden module"
ppr (ModUnusable UnusablePackageReason
_) = [Char] -> MsgDoc
text [Char]
"unusable module"
ppr (ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
rhs Bool
f) = [MsgDoc] -> MsgDoc
sep (MsgDoc -> [MsgDoc] -> [MsgDoc]
punctuate MsgDoc
comma (
(case Maybe Bool
e of
Maybe Bool
Nothing -> []
Just Bool
False -> [[Char] -> MsgDoc
text [Char]
"hidden package"]
Just Bool
True -> [[Char] -> MsgDoc
text [Char]
"exposed package"]) [MsgDoc] -> [MsgDoc] -> [MsgDoc]
forall a. [a] -> [a] -> [a]
++
(if [UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [UnitInfo]
res
then []
else [[Char] -> MsgDoc
text [Char]
"reexport by" MsgDoc -> MsgDoc -> MsgDoc
<+>
[MsgDoc] -> MsgDoc
sep ((UnitInfo -> MsgDoc) -> [UnitInfo] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr (Unit -> MsgDoc) -> (UnitInfo -> Unit) -> UnitInfo -> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> Unit
mkUnit) [UnitInfo]
res)]) [MsgDoc] -> [MsgDoc] -> [MsgDoc]
forall a. [a] -> [a] -> [a]
++
(if [UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [UnitInfo]
rhs
then []
else [[Char] -> MsgDoc
text [Char]
"hidden reexport by" MsgDoc -> MsgDoc -> MsgDoc
<+>
[MsgDoc] -> MsgDoc
sep ((UnitInfo -> MsgDoc) -> [UnitInfo] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr (Unit -> MsgDoc) -> (UnitInfo -> Unit) -> UnitInfo -> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> Unit
mkUnit) [UnitInfo]
res)]) [MsgDoc] -> [MsgDoc] -> [MsgDoc]
forall a. [a] -> [a] -> [a]
++
(if Bool
f then [[Char] -> MsgDoc
text [Char]
"package flag"] else [])
))
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules Bool
e = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
e) [] [] Bool
False
fromReexportedModules :: Bool -> UnitInfo -> ModuleOrigin
fromReexportedModules :: Bool -> UnitInfo -> ModuleOrigin
fromReexportedModules Bool
True UnitInfo
pkg = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [UnitInfo
pkg] [] Bool
False
fromReexportedModules Bool
False UnitInfo
pkg = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [UnitInfo
pkg] Bool
False
fromFlag :: ModuleOrigin
fromFlag :: ModuleOrigin
fromFlag = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [] Bool
True
instance Semigroup ModuleOrigin where
ModOrigin Maybe Bool
e [UnitInfo]
res [UnitInfo]
rhs Bool
f <> :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin
<> ModOrigin Maybe Bool
e' [UnitInfo]
res' [UnitInfo]
rhs' Bool
f' =
Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin (Maybe Bool -> Maybe Bool -> Maybe Bool
forall {a}. Eq a => Maybe a -> Maybe a -> Maybe a
External instance of the constraint type Eq Bool
g Maybe Bool
e Maybe Bool
e') ([UnitInfo]
res [UnitInfo] -> [UnitInfo] -> [UnitInfo]
forall a. [a] -> [a] -> [a]
++ [UnitInfo]
res') ([UnitInfo]
rhs [UnitInfo] -> [UnitInfo] -> [UnitInfo]
forall a. [a] -> [a] -> [a]
++ [UnitInfo]
rhs') (Bool
f Bool -> Bool -> Bool
|| Bool
f')
where g :: Maybe a -> Maybe a -> Maybe a
g (Just a
b) (Just a
b')
| a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq a
== a
b' = a -> Maybe a
forall a. a -> Maybe a
Just a
b
| Bool
otherwise = [Char] -> Maybe a
forall a. [Char] -> a
panic [Char]
"ModOrigin: package both exposed/hidden"
g Maybe a
Nothing Maybe a
x = Maybe a
x
g Maybe a
x Maybe a
Nothing = Maybe a
x
ModuleOrigin
_x <> ModuleOrigin
_y = [Char] -> ModuleOrigin
forall a. [Char] -> a
panic [Char]
"ModOrigin: hidden module redefined"
instance Monoid ModuleOrigin where
mempty :: ModuleOrigin
mempty = Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [] Bool
False
mappend :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin
mappend = ModuleOrigin -> ModuleOrigin -> ModuleOrigin
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup ModuleOrigin
(Semigroup.<>)
originVisible :: ModuleOrigin -> Bool
originVisible :: ModuleOrigin -> Bool
originVisible ModuleOrigin
ModHidden = Bool
False
originVisible (ModUnusable UnusablePackageReason
_) = Bool
False
originVisible (ModOrigin Maybe Bool
b [UnitInfo]
res [UnitInfo]
_ Bool
f) = Maybe Bool
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
|| Bool -> Bool
not ([UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [UnitInfo]
res) Bool -> Bool -> Bool
|| Bool
f
originEmpty :: ModuleOrigin -> Bool
originEmpty :: ModuleOrigin -> Bool
originEmpty (ModOrigin Maybe Bool
Nothing [] [] Bool
False) = Bool
True
originEmpty ModuleOrigin
_ = Bool
False
data UnitInfoMap = UnitInfoMap
{ UnitInfoMap -> UniqDFM UnitInfo
unUnitInfoMap :: UniqDFM UnitInfo
, UnitInfoMap -> UniqSet UnitId
preloadClosure :: UniqSet UnitId
}
type VisibilityMap = Map Unit UnitVisibility
data UnitVisibility = UnitVisibility
{ UnitVisibility -> Bool
uv_expose_all :: Bool
, UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings :: [(ModuleName, ModuleName)]
, UnitVisibility -> First FastString
uv_package_name :: First FastString
, UnitVisibility -> Map ModuleName (Set InstantiatedModule)
uv_requirements :: Map ModuleName (Set InstantiatedModule)
, UnitVisibility -> Bool
uv_explicit :: Bool
}
instance Outputable UnitVisibility where
ppr :: UnitVisibility -> MsgDoc
ppr (UnitVisibility {
uv_expose_all :: UnitVisibility -> Bool
uv_expose_all = Bool
b,
uv_renamings :: UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings = [(ModuleName, ModuleName)]
rns,
uv_package_name :: UnitVisibility -> First FastString
uv_package_name = First Maybe FastString
mb_pn,
uv_requirements :: UnitVisibility -> Map ModuleName (Set InstantiatedModule)
uv_requirements = Map ModuleName (Set InstantiatedModule)
reqs,
uv_explicit :: UnitVisibility -> Bool
uv_explicit = Bool
explicit
}) = (Bool, [(ModuleName, ModuleName)], Maybe FastString,
Map ModuleName (Set InstantiatedModule), Bool)
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type forall a b c d e.
(Outputable a, Outputable b, Outputable c, Outputable d,
Outputable e) =>
Outputable (a, b, c, d, e)
External instance of the constraint type Outputable Bool
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type Outputable ModuleName
External instance of the constraint type Outputable ModuleName
External instance of the constraint type forall a. Outputable a => Outputable (Maybe a)
External instance of the constraint type Outputable FastString
External instance of the constraint type forall key elt.
(Outputable key, Outputable elt) =>
Outputable (Map key elt)
External instance of the constraint type Outputable ModuleName
External instance of the constraint type forall a. Outputable a => Outputable (Set a)
External instance of the constraint type Outputable InstantiatedModule
External instance of the constraint type Outputable Bool
ppr (Bool
b, [(ModuleName, ModuleName)]
rns, Maybe FastString
mb_pn, Map ModuleName (Set InstantiatedModule)
reqs, Bool
explicit)
instance Semigroup UnitVisibility where
UnitVisibility
uv1 <> :: UnitVisibility -> UnitVisibility -> UnitVisibility
<> UnitVisibility
uv2
= UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set InstantiatedModule)
-> Bool
-> UnitVisibility
UnitVisibility
{ uv_expose_all :: Bool
uv_expose_all = UnitVisibility -> Bool
uv_expose_all UnitVisibility
uv1 Bool -> Bool -> Bool
|| UnitVisibility -> Bool
uv_expose_all UnitVisibility
uv2
, uv_renamings :: [(ModuleName, ModuleName)]
uv_renamings = UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings UnitVisibility
uv1 [(ModuleName, ModuleName)]
-> [(ModuleName, ModuleName)] -> [(ModuleName, ModuleName)]
forall a. [a] -> [a] -> [a]
++ UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings UnitVisibility
uv2
, uv_package_name :: First FastString
uv_package_name = First FastString -> First FastString -> First FastString
forall a. Monoid a => a -> a -> a
External instance of the constraint type forall a. Monoid (First a)
mappend (UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv1) (UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv2)
, uv_requirements :: Map ModuleName (Set InstantiatedModule)
uv_requirements = (Set InstantiatedModule
-> Set InstantiatedModule -> Set InstantiatedModule)
-> Map ModuleName (Set InstantiatedModule)
-> Map ModuleName (Set InstantiatedModule)
-> Map ModuleName (Set InstantiatedModule)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
External instance of the constraint type Ord ModuleName
Map.unionWith Set InstantiatedModule
-> Set InstantiatedModule -> Set InstantiatedModule
forall a. Ord a => Set a -> Set a -> Set a
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type forall unit. Ord (GenInstantiatedUnit unit)
Set.union (UnitVisibility -> Map ModuleName (Set InstantiatedModule)
uv_requirements UnitVisibility
uv1) (UnitVisibility -> Map ModuleName (Set InstantiatedModule)
uv_requirements UnitVisibility
uv2)
, uv_explicit :: Bool
uv_explicit = UnitVisibility -> Bool
uv_explicit UnitVisibility
uv1 Bool -> Bool -> Bool
|| UnitVisibility -> Bool
uv_explicit UnitVisibility
uv2
}
instance Monoid UnitVisibility where
mempty :: UnitVisibility
mempty = UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set InstantiatedModule)
-> Bool
-> UnitVisibility
UnitVisibility
{ uv_expose_all :: Bool
uv_expose_all = Bool
False
, uv_renamings :: [(ModuleName, ModuleName)]
uv_renamings = []
, uv_package_name :: First FastString
uv_package_name = Maybe FastString -> First FastString
forall a. Maybe a -> First a
First Maybe FastString
forall a. Maybe a
Nothing
, uv_requirements :: Map ModuleName (Set InstantiatedModule)
uv_requirements = Map ModuleName (Set InstantiatedModule)
forall k a. Map k a
Map.empty
, uv_explicit :: Bool
uv_explicit = Bool
False
}
mappend :: UnitVisibility -> UnitVisibility -> UnitVisibility
mappend = UnitVisibility -> UnitVisibility -> UnitVisibility
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup UnitVisibility
(Semigroup.<>)
type WiredUnitId = DefUnitId
type PreloadUnitId = UnitId
type ModuleNameProvidersMap =
Map ModuleName (Map Module ModuleOrigin)
data PackageState = PackageState {
PackageState -> UnitInfoMap
unitInfoMap :: UnitInfoMap,
PackageState -> Map PackageName (Indefinite UnitId)
packageNameMap :: Map PackageName IndefUnitId,
PackageState -> Map (Definite UnitId) (Definite UnitId)
unwireMap :: Map WiredUnitId WiredUnitId,
PackageState -> [UnitId]
preloadPackages :: [PreloadUnitId],
PackageState -> [Unit]
explicitPackages :: [Unit],
PackageState -> ModuleNameProvidersMap
moduleNameProvidersMap :: !ModuleNameProvidersMap,
PackageState -> ModuleNameProvidersMap
pluginModuleNameProvidersMap :: !ModuleNameProvidersMap,
PackageState -> Map ModuleName [InstantiatedModule]
requirementContext :: Map ModuleName [InstantiatedModule]
}
emptyPackageState :: PackageState
emptyPackageState :: PackageState
emptyPackageState = PackageState :: UnitInfoMap
-> Map PackageName (Indefinite UnitId)
-> Map (Definite UnitId) (Definite UnitId)
-> [UnitId]
-> [Unit]
-> ModuleNameProvidersMap
-> ModuleNameProvidersMap
-> Map ModuleName [InstantiatedModule]
-> PackageState
PackageState {
unitInfoMap :: UnitInfoMap
unitInfoMap = UnitInfoMap
emptyUnitInfoMap,
packageNameMap :: Map PackageName (Indefinite UnitId)
packageNameMap = Map PackageName (Indefinite UnitId)
forall k a. Map k a
Map.empty,
unwireMap :: Map (Definite UnitId) (Definite UnitId)
unwireMap = Map (Definite UnitId) (Definite UnitId)
forall k a. Map k a
Map.empty,
preloadPackages :: [UnitId]
preloadPackages = [],
explicitPackages :: [Unit]
explicitPackages = [],
moduleNameProvidersMap :: ModuleNameProvidersMap
moduleNameProvidersMap = ModuleNameProvidersMap
forall k a. Map k a
Map.empty,
pluginModuleNameProvidersMap :: ModuleNameProvidersMap
pluginModuleNameProvidersMap = ModuleNameProvidersMap
forall k a. Map k a
Map.empty,
requirementContext :: Map ModuleName [InstantiatedModule]
requirementContext = Map ModuleName [InstantiatedModule]
forall k a. Map k a
Map.empty
}
data PackageDatabase unit = PackageDatabase
{ PackageDatabase unit -> [Char]
packageDatabasePath :: FilePath
, PackageDatabase unit -> [GenUnitInfo unit]
packageDatabaseUnits :: [GenUnitInfo unit]
}
type InstalledPackageIndex = Map UnitId UnitInfo
emptyUnitInfoMap :: UnitInfoMap
emptyUnitInfoMap :: UnitInfoMap
emptyUnitInfoMap = UniqDFM UnitInfo -> UniqSet UnitId -> UnitInfoMap
UnitInfoMap UniqDFM UnitInfo
forall elt. UniqDFM elt
emptyUDFM UniqSet UnitId
forall a. UniqSet a
emptyUniqSet
lookupUnit :: DynFlags -> Unit -> Maybe UnitInfo
lookupUnit :: DynFlags -> Unit -> Maybe UnitInfo
lookupUnit DynFlags
dflags = Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
lookupUnit' (DynFlags -> Bool
isIndefinite DynFlags
dflags) (PackageState -> UnitInfoMap
unitInfoMap (DynFlags -> PackageState
pkgState DynFlags
dflags))
lookupUnit' :: Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
lookupUnit' :: Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
lookupUnit' Bool
False (UnitInfoMap UniqDFM UnitInfo
pkg_map UniqSet UnitId
_) Unit
uid = UniqDFM UnitInfo -> Unit -> Maybe UnitInfo
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable Unit
lookupUDFM UniqDFM UnitInfo
pkg_map Unit
uid
lookupUnit' Bool
True m :: UnitInfoMap
m@(UnitInfoMap UniqDFM UnitInfo
pkg_map UniqSet UnitId
_) Unit
uid = case Unit
uid of
Unit
HoleUnit -> [Char] -> Maybe UnitInfo
forall a. HasCallStack => [Char] -> a
error [Char]
"Hole unit"
RealUnit Definite UnitId
_ -> UniqDFM UnitInfo -> Unit -> Maybe UnitInfo
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable Unit
lookupUDFM UniqDFM UnitInfo
pkg_map Unit
uid
VirtUnit GenInstantiatedUnit UnitId
i -> (UnitInfo -> UnitInfo) -> Maybe UnitInfo -> Maybe UnitInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap (UnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
renamePackage UnitInfoMap
m (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit UnitId
i))
(UniqDFM UnitInfo -> Indefinite UnitId -> Maybe UnitInfo
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
External instance of the constraint type forall unit. Uniquable unit => Uniquable (Indefinite unit)
External instance of the constraint type Uniquable UnitId
lookupUDFM UniqDFM UnitInfo
pkg_map (GenInstantiatedUnit UnitId -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf GenInstantiatedUnit UnitId
i))
lookupPackageName :: PackageState -> PackageName -> Maybe IndefUnitId
lookupPackageName :: PackageState -> PackageName -> Maybe (Indefinite UnitId)
lookupPackageName PackageState
pkgstate PackageName
n = PackageName
-> Map PackageName (Indefinite UnitId) -> Maybe (Indefinite UnitId)
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord PackageName
Map.lookup PackageName
n (PackageState -> Map PackageName (Indefinite UnitId)
packageNameMap PackageState
pkgstate)
searchPackageId :: PackageState -> PackageId -> [UnitInfo]
searchPackageId :: PackageState -> PackageId -> [UnitInfo]
searchPackageId PackageState
pkgstate PackageId
pid = (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PackageId
pid PackageId -> PackageId -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq PackageId
==) (PackageId -> Bool) -> (UnitInfo -> PackageId) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> PackageId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgid
unitPackageId)
(PackageState -> [UnitInfo]
listUnitInfoMap PackageState
pkgstate)
extendUnitInfoMap
:: UnitInfoMap -> [UnitInfo] -> UnitInfoMap
extendUnitInfoMap :: UnitInfoMap -> [UnitInfo] -> UnitInfoMap
extendUnitInfoMap (UnitInfoMap UniqDFM UnitInfo
pkg_map UniqSet UnitId
closure) [UnitInfo]
new_pkgs
= UniqDFM UnitInfo -> UniqSet UnitId -> UnitInfoMap
UnitInfoMap ((UniqDFM UnitInfo -> UnitInfo -> UniqDFM UnitInfo)
-> UniqDFM UnitInfo -> [UnitInfo] -> UniqDFM UnitInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' UniqDFM UnitInfo -> UnitInfo -> UniqDFM UnitInfo
add UniqDFM UnitInfo
pkg_map [UnitInfo]
new_pkgs) UniqSet UnitId
closure
where add :: UniqDFM UnitInfo -> UnitInfo -> UniqDFM UnitInfo
add UniqDFM UnitInfo
pkg_map UnitInfo
p = UniqDFM UnitInfo -> UnitId -> UnitInfo -> UniqDFM UnitInfo
forall key elt.
Uniquable key =>
UniqDFM elt -> key -> elt -> UniqDFM elt
External instance of the constraint type Uniquable UnitId
addToUDFM (UniqDFM UnitInfo -> Unit -> UnitInfo -> UniqDFM UnitInfo
forall key elt.
Uniquable key =>
UniqDFM elt -> key -> elt -> UniqDFM elt
External instance of the constraint type Uniquable Unit
addToUDFM UniqDFM UnitInfo
pkg_map (UnitInfo -> Unit
expandedUnitInfoId UnitInfo
p) UnitInfo
p)
(UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
p) UnitInfo
p
unsafeGetUnitInfo :: HasDebugCallStack => DynFlags -> Unit -> UnitInfo
unsafeGetUnitInfo :: DynFlags -> Unit -> UnitInfo
unsafeGetUnitInfo DynFlags
dflags Unit
pid =
case DynFlags -> Unit -> Maybe UnitInfo
lookupUnit DynFlags
dflags Unit
pid of
Just UnitInfo
config -> UnitInfo
config
Maybe UnitInfo
Nothing -> [Char] -> MsgDoc -> UnitInfo
forall a. HasCallStack => [Char] -> MsgDoc -> a
pprPanic [Char]
"unsafeGetUnitInfo" (Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr Unit
pid)
lookupInstalledPackage :: PackageState -> UnitId -> Maybe UnitInfo
lookupInstalledPackage :: PackageState -> UnitId -> Maybe UnitInfo
lookupInstalledPackage PackageState
pkgstate UnitId
uid = UnitInfoMap -> UnitId -> Maybe UnitInfo
lookupInstalledPackage' (PackageState -> UnitInfoMap
unitInfoMap PackageState
pkgstate) UnitId
uid
lookupInstalledPackage' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
lookupInstalledPackage' :: UnitInfoMap -> UnitId -> Maybe UnitInfo
lookupInstalledPackage' (UnitInfoMap UniqDFM UnitInfo
db UniqSet UnitId
_) UnitId
uid = UniqDFM UnitInfo -> UnitId -> Maybe UnitInfo
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable UnitId
lookupUDFM UniqDFM UnitInfo
db UnitId
uid
getInstalledPackageDetails :: HasDebugCallStack => PackageState -> UnitId -> UnitInfo
getInstalledPackageDetails :: PackageState -> UnitId -> UnitInfo
getInstalledPackageDetails PackageState
pkgstate UnitId
uid =
case PackageState -> UnitId -> Maybe UnitInfo
lookupInstalledPackage PackageState
pkgstate UnitId
uid of
Just UnitInfo
config -> UnitInfo
config
Maybe UnitInfo
Nothing -> [Char] -> MsgDoc -> UnitInfo
forall a. HasCallStack => [Char] -> MsgDoc -> a
pprPanic [Char]
"getInstalledPackageDetails" (UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr UnitId
uid)
listUnitInfoMap :: PackageState -> [UnitInfo]
listUnitInfoMap :: PackageState -> [UnitInfo]
listUnitInfoMap PackageState
pkgstate = UniqDFM UnitInfo -> [UnitInfo]
forall elt. UniqDFM elt -> [elt]
eltsUDFM UniqDFM UnitInfo
pkg_map
where
UnitInfoMap UniqDFM UnitInfo
pkg_map UniqSet UnitId
_ = PackageState -> UnitInfoMap
unitInfoMap PackageState
pkgstate
initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])
initPackages :: DynFlags -> IO (DynFlags, [UnitId])
initPackages DynFlags
dflags = DynFlags
-> MsgDoc
-> ((DynFlags, [UnitId]) -> ())
-> IO (DynFlags, [UnitId])
-> IO (DynFlags, [UnitId])
forall (m :: * -> *) a.
MonadIO m =>
DynFlags -> MsgDoc -> (a -> ()) -> m a -> m a
External instance of the constraint type MonadIO IO
withTiming DynFlags
dflags
([Char] -> MsgDoc
text [Char]
"initializing package database")
(DynFlags, [UnitId]) -> ()
forall {b}. (DynFlags, b) -> ()
forcePkgDb (IO (DynFlags, [UnitId]) -> IO (DynFlags, [UnitId]))
-> IO (DynFlags, [UnitId]) -> IO (DynFlags, [UnitId])
forall a b. (a -> b) -> a -> b
$ do
[PackageDatabase UnitId]
read_pkg_dbs <-
case DynFlags -> Maybe [PackageDatabase UnitId]
pkgDatabase DynFlags
dflags of
Maybe [PackageDatabase UnitId]
Nothing -> DynFlags -> IO [PackageDatabase UnitId]
readPackageDatabases DynFlags
dflags
Just [PackageDatabase UnitId]
dbs -> [PackageDatabase UnitId] -> IO [PackageDatabase UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [PackageDatabase UnitId]
dbs
let
distrust_all :: PackageDatabase UnitId -> PackageDatabase UnitId
distrust_all PackageDatabase UnitId
db = PackageDatabase UnitId
db { packageDatabaseUnits :: [UnitInfo]
packageDatabaseUnits = [UnitInfo] -> [UnitInfo]
distrustAllUnits (PackageDatabase UnitId -> [UnitInfo]
forall unit. PackageDatabase unit -> [GenUnitInfo unit]
packageDatabaseUnits PackageDatabase UnitId
db) }
pkg_dbs :: [PackageDatabase UnitId]
pkg_dbs
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DistrustAllPackages DynFlags
dflags = (PackageDatabase UnitId -> PackageDatabase UnitId)
-> [PackageDatabase UnitId] -> [PackageDatabase UnitId]
forall a b. (a -> b) -> [a] -> [b]
map PackageDatabase UnitId -> PackageDatabase UnitId
distrust_all [PackageDatabase UnitId]
read_pkg_dbs
| Bool
otherwise = [PackageDatabase UnitId]
read_pkg_dbs
(PackageState
pkg_state, [UnitId]
preload, Maybe [(ModuleName, Module)]
insts)
<- DynFlags
-> [PackageDatabase UnitId]
-> [UnitId]
-> IO (PackageState, [UnitId], Maybe [(ModuleName, Module)])
mkPackageState DynFlags
dflags [PackageDatabase UnitId]
pkg_dbs []
(DynFlags, [UnitId]) -> IO (DynFlags, [UnitId])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (DynFlags
dflags{ pkgDatabase :: Maybe [PackageDatabase UnitId]
pkgDatabase = [PackageDatabase UnitId] -> Maybe [PackageDatabase UnitId]
forall a. a -> Maybe a
Just [PackageDatabase UnitId]
read_pkg_dbs,
pkgState :: PackageState
pkgState = PackageState
pkg_state,
thisUnitIdInsts_ :: Maybe [(ModuleName, Module)]
thisUnitIdInsts_ = Maybe [(ModuleName, Module)]
insts },
[UnitId]
preload)
where
forcePkgDb :: (DynFlags, b) -> ()
forcePkgDb (DynFlags
dflags, b
_) = PackageState -> UnitInfoMap
unitInfoMap (DynFlags -> PackageState
pkgState DynFlags
dflags) UnitInfoMap -> () -> ()
`seq` ()
readPackageDatabases :: DynFlags -> IO [PackageDatabase UnitId]
readPackageDatabases :: DynFlags -> IO [PackageDatabase UnitId]
readPackageDatabases DynFlags
dflags = do
[PkgDbRef]
conf_refs <- DynFlags -> IO [PkgDbRef]
getPackageConfRefs DynFlags
dflags
[[Char]]
confs <- ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
External instance of the constraint type Monad IO
liftM [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe [Char]] -> IO [[Char]])
-> IO [Maybe [Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ (PkgDbRef -> IO (Maybe [Char])) -> [PkgDbRef] -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
mapM (DynFlags -> PkgDbRef -> IO (Maybe [Char])
resolvePackageDatabase DynFlags
dflags) [PkgDbRef]
conf_refs
([Char] -> IO (PackageDatabase UnitId))
-> [[Char]] -> IO [PackageDatabase UnitId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
mapM (DynFlags -> [Char] -> IO (PackageDatabase UnitId)
readPackageDatabase DynFlags
dflags) [[Char]]
confs
getPackageConfRefs :: DynFlags -> IO [PkgDbRef]
getPackageConfRefs :: DynFlags -> IO [PkgDbRef]
getPackageConfRefs DynFlags
dflags = do
let system_conf_refs :: [PkgDbRef]
system_conf_refs = [PkgDbRef
UserPkgDb, PkgDbRef
GlobalPkgDb]
Either IOException [Char]
e_pkg_path <- IO [Char] -> IO (Either IOException [Char])
forall a. IO a -> IO (Either IOException a)
tryIO ([Char] -> IO [Char]
getEnv ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (DynFlags -> [Char]
programName DynFlags
dflags) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_PACKAGE_PATH")
let base_conf_refs :: [PkgDbRef]
base_conf_refs = case Either IOException [Char]
e_pkg_path of
Left IOException
_ -> [PkgDbRef]
system_conf_refs
Right [Char]
path
| Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [Char]
path) Bool -> Bool -> Bool
&& Char -> Bool
isSearchPathSeparator ([Char] -> Char
forall a. [a] -> a
last [Char]
path)
-> ([Char] -> PkgDbRef) -> [[Char]] -> [PkgDbRef]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> PkgDbRef
PkgDbPath ([Char] -> [[Char]]
splitSearchPath ([Char] -> [Char]
forall a. [a] -> [a]
init [Char]
path)) [PkgDbRef] -> [PkgDbRef] -> [PkgDbRef]
forall a. [a] -> [a] -> [a]
++ [PkgDbRef]
system_conf_refs
| Bool
otherwise
-> ([Char] -> PkgDbRef) -> [[Char]] -> [PkgDbRef]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> PkgDbRef
PkgDbPath ([Char] -> [[Char]]
splitSearchPath [Char]
path)
[PkgDbRef] -> IO [PkgDbRef]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([PkgDbRef] -> IO [PkgDbRef]) -> [PkgDbRef] -> IO [PkgDbRef]
forall a b. (a -> b) -> a -> b
$ [PkgDbRef] -> [PkgDbRef]
forall a. [a] -> [a]
reverse ((PackageDBFlag -> [PkgDbRef] -> [PkgDbRef])
-> [PkgDbRef] -> [PackageDBFlag] -> [PkgDbRef]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr PackageDBFlag -> [PkgDbRef] -> [PkgDbRef]
doFlag [PkgDbRef]
base_conf_refs (DynFlags -> [PackageDBFlag]
packageDBFlags DynFlags
dflags))
where
doFlag :: PackageDBFlag -> [PkgDbRef] -> [PkgDbRef]
doFlag (PackageDB PkgDbRef
p) [PkgDbRef]
dbs = PkgDbRef
p PkgDbRef -> [PkgDbRef] -> [PkgDbRef]
forall a. a -> [a] -> [a]
: [PkgDbRef]
dbs
doFlag PackageDBFlag
NoUserPackageDB [PkgDbRef]
dbs = (PkgDbRef -> Bool) -> [PkgDbRef] -> [PkgDbRef]
forall a. (a -> Bool) -> [a] -> [a]
filter PkgDbRef -> Bool
isNotUser [PkgDbRef]
dbs
doFlag PackageDBFlag
NoGlobalPackageDB [PkgDbRef]
dbs = (PkgDbRef -> Bool) -> [PkgDbRef] -> [PkgDbRef]
forall a. (a -> Bool) -> [a] -> [a]
filter PkgDbRef -> Bool
isNotGlobal [PkgDbRef]
dbs
doFlag PackageDBFlag
ClearPackageDBs [PkgDbRef]
_ = []
isNotUser :: PkgDbRef -> Bool
isNotUser PkgDbRef
UserPkgDb = Bool
False
isNotUser PkgDbRef
_ = Bool
True
isNotGlobal :: PkgDbRef -> Bool
isNotGlobal PkgDbRef
GlobalPkgDb = Bool
False
isNotGlobal PkgDbRef
_ = Bool
True
resolvePackageDatabase :: DynFlags -> PkgDbRef -> IO (Maybe FilePath)
resolvePackageDatabase :: DynFlags -> PkgDbRef -> IO (Maybe [Char])
resolvePackageDatabase DynFlags
dflags PkgDbRef
GlobalPkgDb = Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (DynFlags -> [Char]
globalPackageDatabasePath DynFlags
dflags)
resolvePackageDatabase DynFlags
dflags PkgDbRef
UserPkgDb = MaybeT IO [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [Char] -> IO (Maybe [Char]))
-> MaybeT IO [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
[Char]
dir <- DynFlags -> MaybeT IO [Char]
versionedAppDir DynFlags
dflags
let pkgconf :: [Char]
pkgconf = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"package.conf.d"
Bool
exist <- IO Bool -> MaybeT IO Bool
forall a. IO a -> MaybeT IO a
tryMaybeT (IO Bool -> MaybeT IO Bool) -> IO Bool -> MaybeT IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist [Char]
pkgconf
if Bool
exist then [Char] -> MaybeT IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). Monad m => Monad (MaybeT m)
External instance of the constraint type Monad IO
return [Char]
pkgconf else MaybeT IO [Char]
forall (m :: * -> *) a. MonadPlus m => m a
External instance of the constraint type forall (m :: * -> *). Monad m => MonadPlus (MaybeT m)
External instance of the constraint type Monad IO
mzero
resolvePackageDatabase DynFlags
_ (PkgDbPath [Char]
name) = Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
name
readPackageDatabase :: DynFlags -> FilePath -> IO (PackageDatabase UnitId)
readPackageDatabase :: DynFlags -> [Char] -> IO (PackageDatabase UnitId)
readPackageDatabase DynFlags
dflags [Char]
conf_file = do
Bool
isdir <- [Char] -> IO Bool
doesDirectoryExist [Char]
conf_file
[DbUnitInfo]
proto_pkg_configs <-
if Bool
isdir
then [Char] -> IO [DbUnitInfo]
readDirStyleUnitInfo [Char]
conf_file
else do
Bool
isfile <- [Char] -> IO Bool
doesFileExist [Char]
conf_file
if Bool
isfile
then do
Maybe [DbUnitInfo]
mpkgs <- IO (Maybe [DbUnitInfo])
tryReadOldFileStyleUnitInfo
case Maybe [DbUnitInfo]
mpkgs of
Just [DbUnitInfo]
pkgs -> [DbUnitInfo] -> IO [DbUnitInfo]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [DbUnitInfo]
pkgs
Maybe [DbUnitInfo]
Nothing -> GhcException -> IO [DbUnitInfo]
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO [DbUnitInfo])
-> GhcException -> IO [DbUnitInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
InstallationError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$
[Char]
"ghc no longer supports single-file style package " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"databases (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
conf_file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
") use 'ghc-pkg init' to create the database with " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"the correct format."
else GhcException -> IO [DbUnitInfo]
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO [DbUnitInfo])
-> GhcException -> IO [DbUnitInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
InstallationError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$
[Char]
"can't find a package database at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
conf_file
let
conf_file' :: [Char]
conf_file' = [Char] -> [Char]
dropTrailingPathSeparator [Char]
conf_file
top_dir :: [Char]
top_dir = DynFlags -> [Char]
topDir DynFlags
dflags
pkgroot :: [Char]
pkgroot = [Char] -> [Char]
takeDirectory [Char]
conf_file'
pkg_configs1 :: [UnitInfo]
pkg_configs1 = (DbUnitInfo -> UnitInfo) -> [DbUnitInfo] -> [UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> UnitInfo -> UnitInfo
mungeUnitInfo [Char]
top_dir [Char]
pkgroot (UnitInfo -> UnitInfo)
-> (DbUnitInfo -> UnitInfo) -> DbUnitInfo -> UnitInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitKey -> UnitId)
-> (UnitId -> FastString) -> GenUnitInfo UnitKey -> UnitInfo
forall u v.
(u -> v) -> (v -> FastString) -> GenUnitInfo u -> GenUnitInfo v
mapUnitInfo (\(UnitKey FastString
x) -> FastString -> UnitId
UnitId FastString
x) UnitId -> FastString
unitIdFS (GenUnitInfo UnitKey -> UnitInfo)
-> (DbUnitInfo -> GenUnitInfo UnitKey) -> DbUnitInfo -> UnitInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DbUnitInfo -> GenUnitInfo UnitKey
mkUnitKeyInfo)
[DbUnitInfo]
proto_pkg_configs
PackageDatabase UnitId -> IO (PackageDatabase UnitId)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (PackageDatabase UnitId -> IO (PackageDatabase UnitId))
-> PackageDatabase UnitId -> IO (PackageDatabase UnitId)
forall a b. (a -> b) -> a -> b
$ [Char] -> [UnitInfo] -> PackageDatabase UnitId
forall unit. [Char] -> [GenUnitInfo unit] -> PackageDatabase unit
PackageDatabase [Char]
conf_file' [UnitInfo]
pkg_configs1
where
readDirStyleUnitInfo :: [Char] -> IO [DbUnitInfo]
readDirStyleUnitInfo [Char]
conf_dir = do
let filename :: [Char]
filename = [Char]
conf_dir [Char] -> [Char] -> [Char]
</> [Char]
"package.cache"
Bool
cache_exists <- [Char] -> IO Bool
doesFileExist [Char]
filename
if Bool
cache_exists
then do
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> MsgDoc
text [Char]
"Using binary package database:"
MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
filename
[Char] -> IO [DbUnitInfo]
readPackageDbForGhc [Char]
filename
else do
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> MsgDoc
text [Char]
"There is no package.cache in"
MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
conf_dir
MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
", checking if the database is empty"
Bool
db_empty <- ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
External instance of the constraint type Foldable []
all (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
External instance of the constraint type Eq Char
isSuffixOf [Char]
".conf")
([[Char]] -> Bool) -> IO [[Char]] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> [Char] -> IO [[Char]]
getDirectoryContents [Char]
conf_dir
if Bool
db_empty
then do
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> MsgDoc
text [Char]
"There are no .conf files in"
MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
conf_dir MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
", treating"
MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"package database as empty"
[DbUnitInfo] -> IO [DbUnitInfo]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return []
else do
GhcException -> IO [DbUnitInfo]
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO [DbUnitInfo])
-> GhcException -> IO [DbUnitInfo]
forall a b. (a -> b) -> a -> b
$ [Char] -> GhcException
InstallationError ([Char] -> GhcException) -> [Char] -> GhcException
forall a b. (a -> b) -> a -> b
$
[Char]
"there is no package.cache in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
conf_dir [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" even though package database is not empty"
tryReadOldFileStyleUnitInfo :: IO (Maybe [DbUnitInfo])
tryReadOldFileStyleUnitInfo = do
[Char]
content <- [Char] -> IO [Char]
readFile [Char]
conf_file IO [Char] -> (IOException -> IO [Char]) -> IO [Char]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return [Char]
""
if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
2 [Char]
content [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== [Char]
"[]"
then do
let conf_dir :: [Char]
conf_dir = [Char]
conf_file [Char] -> [Char] -> [Char]
<.> [Char]
"d"
Bool
direxists <- [Char] -> IO Bool
doesDirectoryExist [Char]
conf_dir
if Bool
direxists
then do DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 ([Char] -> MsgDoc
text [Char]
"Ignoring old file-style db and trying:" MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
conf_dir)
([DbUnitInfo] -> Maybe [DbUnitInfo])
-> IO [DbUnitInfo] -> IO (Maybe [DbUnitInfo])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
External instance of the constraint type Monad IO
liftM [DbUnitInfo] -> Maybe [DbUnitInfo]
forall a. a -> Maybe a
Just ([Char] -> IO [DbUnitInfo]
readDirStyleUnitInfo [Char]
conf_dir)
else Maybe [DbUnitInfo] -> IO (Maybe [DbUnitInfo])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([DbUnitInfo] -> Maybe [DbUnitInfo]
forall a. a -> Maybe a
Just [])
else Maybe [DbUnitInfo] -> IO (Maybe [DbUnitInfo])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe [DbUnitInfo]
forall a. Maybe a
Nothing
distrustAllUnits :: [UnitInfo] -> [UnitInfo]
distrustAllUnits :: [UnitInfo] -> [UnitInfo]
distrustAllUnits [UnitInfo]
pkgs = (UnitInfo -> UnitInfo) -> [UnitInfo] -> [UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> UnitInfo
forall {compid} {srcpkgid} {srcpkgname} {uid} {modulename} {mod}.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
distrust [UnitInfo]
pkgs
where
distrust :: GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
distrust GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
pkg = GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
pkg{ unitIsTrusted :: Bool
unitIsTrusted = Bool
False }
mungeUnitInfo :: FilePath -> FilePath
-> UnitInfo -> UnitInfo
mungeUnitInfo :: [Char] -> [Char] -> UnitInfo -> UnitInfo
mungeUnitInfo [Char]
top_dir [Char]
pkgroot =
UnitInfo -> UnitInfo
mungeDynLibFields
(UnitInfo -> UnitInfo)
-> (UnitInfo -> UnitInfo) -> UnitInfo -> UnitInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> UnitInfo -> UnitInfo
forall a b c d e f.
[Char]
-> [Char]
-> GenericUnitInfo a b c d e f
-> GenericUnitInfo a b c d e f
mungeUnitInfoPaths [Char]
top_dir [Char]
pkgroot
mungeDynLibFields :: UnitInfo -> UnitInfo
mungeDynLibFields :: UnitInfo -> UnitInfo
mungeDynLibFields UnitInfo
pkg =
UnitInfo
pkg {
unitLibraryDynDirs :: [[Char]]
unitLibraryDynDirs = case UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitLibraryDynDirs UnitInfo
pkg of
[] -> UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitLibraryDirs UnitInfo
pkg
[[Char]]
ds -> [[Char]]
ds
}
applyTrustFlag
:: DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [UnitInfo]
-> TrustFlag
-> IO [UnitInfo]
applyTrustFlag :: DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [UnitInfo]
-> TrustFlag
-> IO [UnitInfo]
applyTrustFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnusablePackages
unusable [UnitInfo]
pkgs TrustFlag
flag =
case TrustFlag
flag of
TrustPackage [Char]
str ->
case PackagePrecedenceIndex
-> PackageArg
-> [UnitInfo]
-> UnusablePackages
-> Either
[(UnitInfo, UnusablePackageReason)] ([UnitInfo], [UnitInfo])
selectPackages PackagePrecedenceIndex
prec_map ([Char] -> PackageArg
PackageArg [Char]
str) [UnitInfo]
pkgs UnusablePackages
unusable of
Left [(UnitInfo, UnusablePackageReason)]
ps -> DynFlags
-> TrustFlag
-> [(UnitInfo, UnusablePackageReason)]
-> IO [UnitInfo]
forall a.
DynFlags
-> TrustFlag -> [(UnitInfo, UnusablePackageReason)] -> IO a
trustFlagErr DynFlags
dflags TrustFlag
flag [(UnitInfo, UnusablePackageReason)]
ps
Right ([UnitInfo]
ps,[UnitInfo]
qs) -> [UnitInfo] -> IO [UnitInfo]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((UnitInfo -> UnitInfo) -> [UnitInfo] -> [UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> UnitInfo
forall {compid} {srcpkgid} {srcpkgname} {uid} {modulename} {mod}.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
trust [UnitInfo]
ps [UnitInfo] -> [UnitInfo] -> [UnitInfo]
forall a. [a] -> [a] -> [a]
++ [UnitInfo]
qs)
where trust :: GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
trust GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
p = GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
p {unitIsTrusted :: Bool
unitIsTrusted=Bool
True}
DistrustPackage [Char]
str ->
case PackagePrecedenceIndex
-> PackageArg
-> [UnitInfo]
-> UnusablePackages
-> Either
[(UnitInfo, UnusablePackageReason)] ([UnitInfo], [UnitInfo])
selectPackages PackagePrecedenceIndex
prec_map ([Char] -> PackageArg
PackageArg [Char]
str) [UnitInfo]
pkgs UnusablePackages
unusable of
Left [(UnitInfo, UnusablePackageReason)]
ps -> DynFlags
-> TrustFlag
-> [(UnitInfo, UnusablePackageReason)]
-> IO [UnitInfo]
forall a.
DynFlags
-> TrustFlag -> [(UnitInfo, UnusablePackageReason)] -> IO a
trustFlagErr DynFlags
dflags TrustFlag
flag [(UnitInfo, UnusablePackageReason)]
ps
Right ([UnitInfo]
ps,[UnitInfo]
qs) -> [UnitInfo] -> IO [UnitInfo]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([UnitInfo] -> [UnitInfo]
distrustAllUnits [UnitInfo]
ps [UnitInfo] -> [UnitInfo] -> [UnitInfo]
forall a. [a] -> [a] -> [a]
++ [UnitInfo]
qs)
isIndefinite :: DynFlags -> Bool
isIndefinite :: DynFlags -> Bool
isIndefinite DynFlags
dflags = Bool -> Bool
not (Unit -> Bool
unitIsDefinite (DynFlags -> Unit
thisPackage DynFlags
dflags))
applyPackageFlag
:: DynFlags
-> PackagePrecedenceIndex
-> UnitInfoMap
-> UnusablePackages
-> Bool
-> [UnitInfo]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag :: DynFlags
-> PackagePrecedenceIndex
-> UnitInfoMap
-> UnusablePackages
-> Bool
-> [UnitInfo]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnitInfoMap
pkg_db UnusablePackages
unusable Bool
no_hide_others [UnitInfo]
pkgs VisibilityMap
vm PackageFlag
flag =
case PackageFlag
flag of
ExposePackage [Char]
_ PackageArg
arg (ModRenaming Bool
b [(ModuleName, ModuleName)]
rns) ->
case PackagePrecedenceIndex
-> UnitInfoMap
-> PackageArg
-> [UnitInfo]
-> UnusablePackages
-> Either [(UnitInfo, UnusablePackageReason)] [UnitInfo]
findPackages PackagePrecedenceIndex
prec_map UnitInfoMap
pkg_db PackageArg
arg [UnitInfo]
pkgs UnusablePackages
unusable of
Left [(UnitInfo, UnusablePackageReason)]
ps -> DynFlags
-> PackageFlag
-> [(UnitInfo, UnusablePackageReason)]
-> IO VisibilityMap
forall a.
DynFlags
-> PackageFlag -> [(UnitInfo, UnusablePackageReason)] -> IO a
packageFlagErr DynFlags
dflags PackageFlag
flag [(UnitInfo, UnusablePackageReason)]
ps
Right (UnitInfo
p:[UnitInfo]
_) -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return VisibilityMap
vm'
where
n :: FastString
n = UnitInfo -> FastString
fsPackageName UnitInfo
p
reqs :: Map ModuleName (Set InstantiatedModule)
reqs | UnitIdArg Unit
orig_uid <- PackageArg
arg = Unit -> Map ModuleName (Set InstantiatedModule)
forall {uid}.
GenUnit uid
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
collectHoles Unit
orig_uid
| Bool
otherwise = Map ModuleName (Set InstantiatedModule)
forall k a. Map k a
Map.empty
collectHoles :: GenUnit uid
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
collectHoles GenUnit uid
uid = case GenUnit uid
uid of
GenUnit uid
HoleUnit -> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
forall k a. Map k a
Map.empty
RealUnit {} -> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
forall k a. Map k a
Map.empty
VirtUnit GenInstantiatedUnit uid
indef ->
let local :: [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
local = [ ModuleName
-> Set (GenModule (GenInstantiatedUnit uid))
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
forall k a. k -> a -> Map k a
Map.singleton
(GenModule (GenUnit uid) -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule (GenUnit uid)
mod)
(GenModule (GenInstantiatedUnit uid)
-> Set (GenModule (GenInstantiatedUnit uid))
forall a. a -> Set a
Set.singleton (GenModule (GenInstantiatedUnit uid)
-> Set (GenModule (GenInstantiatedUnit uid)))
-> GenModule (GenInstantiatedUnit uid)
-> Set (GenModule (GenInstantiatedUnit uid))
forall a b. (a -> b) -> a -> b
$ GenInstantiatedUnit uid
-> ModuleName -> GenModule (GenInstantiatedUnit uid)
forall unit. unit -> ModuleName -> GenModule unit
Module GenInstantiatedUnit uid
indef ModuleName
mod_name)
| (ModuleName
mod_name, GenModule (GenUnit uid)
mod) <- GenInstantiatedUnit uid -> GenInstantiations uid
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit uid
indef
, GenModule (GenUnit uid) -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule GenModule (GenUnit uid)
mod ]
recurse :: [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
recurse = [ GenUnit uid
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
collectHoles (GenModule (GenUnit uid) -> GenUnit uid
forall unit. GenModule unit -> unit
moduleUnit GenModule (GenUnit uid)
mod)
| (ModuleName
_, GenModule (GenUnit uid)
mod) <- GenInstantiatedUnit uid -> GenInstantiations uid
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit uid
indef ]
in (Set (GenModule (GenInstantiatedUnit uid))
-> Set (GenModule (GenInstantiatedUnit uid))
-> Set (GenModule (GenInstantiatedUnit uid)))
-> [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
External instance of the constraint type Ord ModuleName
External instance of the constraint type Foldable []
Map.unionsWith Set (GenModule (GenInstantiatedUnit uid))
-> Set (GenModule (GenInstantiatedUnit uid))
-> Set (GenModule (GenInstantiatedUnit uid))
forall a. Ord a => Set a -> Set a -> Set a
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type forall unit. Ord (GenInstantiatedUnit unit)
Set.union ([Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid))))
-> [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
-> Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))
forall a b. (a -> b) -> a -> b
$ [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
local [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
-> [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
-> [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
forall a. [a] -> [a] -> [a]
++ [Map ModuleName (Set (GenModule (GenInstantiatedUnit uid)))]
recurse
uv :: UnitVisibility
uv = UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set InstantiatedModule)
-> Bool
-> UnitVisibility
UnitVisibility
{ uv_expose_all :: Bool
uv_expose_all = Bool
b
, uv_renamings :: [(ModuleName, ModuleName)]
uv_renamings = [(ModuleName, ModuleName)]
rns
, uv_package_name :: First FastString
uv_package_name = Maybe FastString -> First FastString
forall a. Maybe a -> First a
First (FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
n)
, uv_requirements :: Map ModuleName (Set InstantiatedModule)
uv_requirements = Map ModuleName (Set InstantiatedModule)
reqs
, uv_explicit :: Bool
uv_explicit = Bool
True
}
vm' :: VisibilityMap
vm' = (UnitVisibility -> UnitVisibility -> UnitVisibility)
-> Unit -> UnitVisibility -> VisibilityMap -> VisibilityMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
External instance of the constraint type Ord Unit
Map.insertWith UnitVisibility -> UnitVisibility -> UnitVisibility
forall a. Monoid a => a -> a -> a
Instance of class: Monoid of the constraint type Monoid UnitVisibility
mappend (UnitInfo -> Unit
mkUnit UnitInfo
p) UnitVisibility
uv VisibilityMap
vm_cleared
vm_cleared :: VisibilityMap
vm_cleared | Bool
no_hide_others = VisibilityMap
vm
| ((ModuleName, ModuleName)
_:[(ModuleName, ModuleName)]
_) <- [(ModuleName, ModuleName)]
rns = VisibilityMap
vm
| Bool
otherwise = (Unit -> UnitVisibility -> Bool) -> VisibilityMap -> VisibilityMap
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
(\Unit
k UnitVisibility
uv -> Unit
k Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Unit
== UnitInfo -> Unit
mkUnit UnitInfo
p
Bool -> Bool -> Bool
|| Maybe FastString -> First FastString
forall a. Maybe a -> First a
First (FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
n) First FastString -> First FastString -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq (First a)
External instance of the constraint type Eq FastString
/= UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv) VisibilityMap
vm
Either [(UnitInfo, UnusablePackageReason)] [UnitInfo]
_ -> [Char] -> IO VisibilityMap
forall a. [Char] -> a
panic [Char]
"applyPackageFlag"
HidePackage [Char]
str ->
case PackagePrecedenceIndex
-> UnitInfoMap
-> PackageArg
-> [UnitInfo]
-> UnusablePackages
-> Either [(UnitInfo, UnusablePackageReason)] [UnitInfo]
findPackages PackagePrecedenceIndex
prec_map UnitInfoMap
pkg_db ([Char] -> PackageArg
PackageArg [Char]
str) [UnitInfo]
pkgs UnusablePackages
unusable of
Left [(UnitInfo, UnusablePackageReason)]
ps -> DynFlags
-> PackageFlag
-> [(UnitInfo, UnusablePackageReason)]
-> IO VisibilityMap
forall a.
DynFlags
-> PackageFlag -> [(UnitInfo, UnusablePackageReason)] -> IO a
packageFlagErr DynFlags
dflags PackageFlag
flag [(UnitInfo, UnusablePackageReason)]
ps
Right [UnitInfo]
ps -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return VisibilityMap
vm'
where vm' :: VisibilityMap
vm' = (VisibilityMap -> Unit -> VisibilityMap)
-> VisibilityMap -> [Unit] -> VisibilityMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' ((Unit -> VisibilityMap -> VisibilityMap)
-> VisibilityMap -> Unit -> VisibilityMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip Unit -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> Map k a -> Map k a
External instance of the constraint type Ord Unit
Map.delete) VisibilityMap
vm ((UnitInfo -> Unit) -> [UnitInfo] -> [Unit]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> Unit
mkUnit [UnitInfo]
ps)
findPackages :: PackagePrecedenceIndex
-> UnitInfoMap -> PackageArg -> [UnitInfo]
-> UnusablePackages
-> Either [(UnitInfo, UnusablePackageReason)]
[UnitInfo]
findPackages :: PackagePrecedenceIndex
-> UnitInfoMap
-> PackageArg
-> [UnitInfo]
-> UnusablePackages
-> Either [(UnitInfo, UnusablePackageReason)] [UnitInfo]
findPackages PackagePrecedenceIndex
prec_map UnitInfoMap
pkg_db PackageArg
arg [UnitInfo]
pkgs UnusablePackages
unusable
= let ps :: [UnitInfo]
ps = (UnitInfo -> Maybe UnitInfo) -> [UnitInfo] -> [UnitInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageArg -> UnitInfo -> Maybe UnitInfo
finder PackageArg
arg) [UnitInfo]
pkgs
in if [UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [UnitInfo]
ps
then [(UnitInfo, UnusablePackageReason)]
-> Either [(UnitInfo, UnusablePackageReason)] [UnitInfo]
forall a b. a -> Either a b
Left (((UnitInfo, UnusablePackageReason)
-> Maybe (UnitInfo, UnusablePackageReason))
-> [(UnitInfo, UnusablePackageReason)]
-> [(UnitInfo, UnusablePackageReason)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(UnitInfo
x,UnusablePackageReason
y) -> PackageArg -> UnitInfo -> Maybe UnitInfo
finder PackageArg
arg UnitInfo
x Maybe UnitInfo
-> (UnitInfo -> Maybe (UnitInfo, UnusablePackageReason))
-> Maybe (UnitInfo, UnusablePackageReason)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad Maybe
>>= \UnitInfo
x' -> (UnitInfo, UnusablePackageReason)
-> Maybe (UnitInfo, UnusablePackageReason)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (UnitInfo
x',UnusablePackageReason
y))
(UnusablePackages -> [(UnitInfo, UnusablePackageReason)]
forall k a. Map k a -> [a]
Map.elems UnusablePackages
unusable))
else [UnitInfo] -> Either [(UnitInfo, UnusablePackageReason)] [UnitInfo]
forall a b. b -> Either a b
Right (PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
sortByPreference PackagePrecedenceIndex
prec_map [UnitInfo]
ps)
where
finder :: PackageArg -> UnitInfo -> Maybe UnitInfo
finder (PackageArg [Char]
str) UnitInfo
p
= if [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageIdString UnitInfo
p Bool -> Bool -> Bool
|| [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageNameString UnitInfo
p
then UnitInfo -> Maybe UnitInfo
forall a. a -> Maybe a
Just UnitInfo
p
else Maybe UnitInfo
forall a. Maybe a
Nothing
finder (UnitIdArg Unit
uid) UnitInfo
p
= case Unit
uid of
RealUnit (Definite UnitId
iuid)
| UnitId
iuid UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq UnitId
== UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
p
-> UnitInfo -> Maybe UnitInfo
forall a. a -> Maybe a
Just UnitInfo
p
VirtUnit GenInstantiatedUnit UnitId
inst
| Indefinite UnitId -> UnitId
forall unit. Indefinite unit -> unit
indefUnit (GenInstantiatedUnit UnitId -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf GenInstantiatedUnit UnitId
inst) UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq UnitId
== UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
p
-> UnitInfo -> Maybe UnitInfo
forall a. a -> Maybe a
Just (UnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
renamePackage UnitInfoMap
pkg_db (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit UnitId
inst) UnitInfo
p)
Unit
_ -> Maybe UnitInfo
forall a. Maybe a
Nothing
selectPackages :: PackagePrecedenceIndex -> PackageArg -> [UnitInfo]
-> UnusablePackages
-> Either [(UnitInfo, UnusablePackageReason)]
([UnitInfo], [UnitInfo])
selectPackages :: PackagePrecedenceIndex
-> PackageArg
-> [UnitInfo]
-> UnusablePackages
-> Either
[(UnitInfo, UnusablePackageReason)] ([UnitInfo], [UnitInfo])
selectPackages PackagePrecedenceIndex
prec_map PackageArg
arg [UnitInfo]
pkgs UnusablePackages
unusable
= let matches :: UnitInfo -> Bool
matches = PackageArg -> UnitInfo -> Bool
matching PackageArg
arg
([UnitInfo]
ps,[UnitInfo]
rest) = (UnitInfo -> Bool) -> [UnitInfo] -> ([UnitInfo], [UnitInfo])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition UnitInfo -> Bool
matches [UnitInfo]
pkgs
in if [UnitInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [UnitInfo]
ps
then [(UnitInfo, UnusablePackageReason)]
-> Either
[(UnitInfo, UnusablePackageReason)] ([UnitInfo], [UnitInfo])
forall a b. a -> Either a b
Left (((UnitInfo, UnusablePackageReason) -> Bool)
-> [(UnitInfo, UnusablePackageReason)]
-> [(UnitInfo, UnusablePackageReason)]
forall a. (a -> Bool) -> [a] -> [a]
filter (UnitInfo -> Bool
matches(UnitInfo -> Bool)
-> ((UnitInfo, UnusablePackageReason) -> UnitInfo)
-> (UnitInfo, UnusablePackageReason)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UnitInfo, UnusablePackageReason) -> UnitInfo
forall a b. (a, b) -> a
fst) (UnusablePackages -> [(UnitInfo, UnusablePackageReason)]
forall k a. Map k a -> [a]
Map.elems UnusablePackages
unusable))
else ([UnitInfo], [UnitInfo])
-> Either
[(UnitInfo, UnusablePackageReason)] ([UnitInfo], [UnitInfo])
forall a b. b -> Either a b
Right (PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
sortByPreference PackagePrecedenceIndex
prec_map [UnitInfo]
ps, [UnitInfo]
rest)
renamePackage :: UnitInfoMap -> [(ModuleName, Module)]
-> UnitInfo -> UnitInfo
renamePackage :: UnitInfoMap -> [(ModuleName, Module)] -> UnitInfo -> UnitInfo
renamePackage UnitInfoMap
pkg_map [(ModuleName, Module)]
insts UnitInfo
conf =
let hsubst :: UniqFM Module
hsubst = [(ModuleName, Module)] -> UniqFM Module
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
External instance of the constraint type Uniquable ModuleName
listToUFM [(ModuleName, Module)]
insts
smod :: Module -> Module
smod = UnitInfoMap -> UniqFM Module -> Module -> Module
renameHoleModule' UnitInfoMap
pkg_map UniqFM Module
hsubst
new_insts :: [(ModuleName, Module)]
new_insts = ((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
k,Module
v) -> (ModuleName
k,Module -> Module
smod Module
v)) (UnitInfo -> [(ModuleName, Module)]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations UnitInfo
conf)
in UnitInfo
conf {
unitInstantiations :: [(ModuleName, Module)]
unitInstantiations = [(ModuleName, Module)]
new_insts,
unitExposedModules :: [(ModuleName, Maybe Module)]
unitExposedModules = ((ModuleName, Maybe Module) -> (ModuleName, Maybe Module))
-> [(ModuleName, Maybe Module)] -> [(ModuleName, Maybe Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
mod_name, Maybe Module
mb_mod) -> (ModuleName
mod_name, (Module -> Module) -> Maybe Module -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap Module -> Module
smod Maybe Module
mb_mod))
(UnitInfo -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules UnitInfo
conf)
}
matchingStr :: String -> UnitInfo -> Bool
matchingStr :: [Char] -> UnitInfo -> Bool
matchingStr [Char]
str UnitInfo
p
= [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageIdString UnitInfo
p
Bool -> Bool -> Bool
|| [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageNameString UnitInfo
p
matchingId :: UnitId -> UnitInfo -> Bool
matchingId :: UnitId -> UnitInfo -> Bool
matchingId UnitId
uid UnitInfo
p = UnitId
uid UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq UnitId
== UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
p
matching :: PackageArg -> UnitInfo -> Bool
matching :: PackageArg -> UnitInfo -> Bool
matching (PackageArg [Char]
str) = [Char] -> UnitInfo -> Bool
matchingStr [Char]
str
matching (UnitIdArg (RealUnit (Definite UnitId
uid))) = UnitId -> UnitInfo -> Bool
matchingId UnitId
uid
matching (UnitIdArg Unit
_) = \UnitInfo
_ -> Bool
False
sortByPreference :: PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
sortByPreference :: PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
sortByPreference PackagePrecedenceIndex
prec_map = (UnitInfo -> UnitInfo -> Ordering) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((UnitInfo -> UnitInfo -> Ordering)
-> UnitInfo -> UnitInfo -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PackagePrecedenceIndex -> UnitInfo -> UnitInfo -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map))
compareByPreference
:: PackagePrecedenceIndex
-> UnitInfo
-> UnitInfo
-> Ordering
compareByPreference :: PackagePrecedenceIndex -> UnitInfo -> UnitInfo -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map UnitInfo
pkg UnitInfo
pkg'
| Just Int
prec <- UnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg) PackagePrecedenceIndex
prec_map
, Just Int
prec' <- UnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg') PackagePrecedenceIndex
prec_map
, UnitInfo -> UnitInfo -> Bool
forall {uid} {uid}. GenUnitInfo uid -> GenUnitInfo uid -> Bool
differentIntegerPkgs UnitInfo
pkg UnitInfo
pkg'
= Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Int
compare Int
prec Int
prec'
| Bool
otherwise
= case (UnitInfo -> Version) -> UnitInfo -> UnitInfo -> Ordering
forall a t. Ord a => (t -> a) -> t -> t -> Ordering
External instance of the constraint type Ord Version
comparing UnitInfo -> Version
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Version
unitPackageVersion UnitInfo
pkg UnitInfo
pkg' of
Ordering
GT -> Ordering
GT
Ordering
EQ | Just Int
prec <- UnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg) PackagePrecedenceIndex
prec_map
, Just Int
prec' <- UnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg') PackagePrecedenceIndex
prec_map
-> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Int
compare Int
prec Int
prec'
| Bool
otherwise
-> Ordering
EQ
Ordering
LT -> Ordering
LT
where isIntegerPkg :: GenUnitInfo u -> Bool
isIntegerPkg GenUnitInfo u
p = GenUnitInfo u -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageNameString GenUnitInfo u
p [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem`
[[Char]
"integer-simple", [Char]
"integer-gmp"]
differentIntegerPkgs :: GenUnitInfo uid -> GenUnitInfo uid -> Bool
differentIntegerPkgs GenUnitInfo uid
p GenUnitInfo uid
p' =
GenUnitInfo uid -> Bool
forall {u}. GenUnitInfo u -> Bool
isIntegerPkg GenUnitInfo uid
p Bool -> Bool -> Bool
&& GenUnitInfo uid -> Bool
forall {u}. GenUnitInfo u -> Bool
isIntegerPkg GenUnitInfo uid
p' Bool -> Bool -> Bool
&&
(GenUnitInfo uid -> PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName GenUnitInfo uid
p PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq PackageName
/= GenUnitInfo uid -> PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName GenUnitInfo uid
p')
comparing :: Ord a => (t -> a) -> t -> t -> Ordering
comparing :: (t -> a) -> t -> t -> Ordering
comparing t -> a
f t
a t
b = t -> a
f t
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
Evidence bound by a type signature of the constraint type Ord a
`compare` t -> a
f t
b
packageFlagErr :: DynFlags
-> PackageFlag
-> [(UnitInfo, UnusablePackageReason)]
-> IO a
packageFlagErr :: DynFlags
-> PackageFlag -> [(UnitInfo, UnusablePackageReason)] -> IO a
packageFlagErr DynFlags
dflags PackageFlag
flag [(UnitInfo, UnusablePackageReason)]
reasons
= DynFlags -> MsgDoc -> [(UnitInfo, UnusablePackageReason)] -> IO a
forall a.
DynFlags -> MsgDoc -> [(UnitInfo, UnusablePackageReason)] -> IO a
packageFlagErr' DynFlags
dflags (PackageFlag -> MsgDoc
pprFlag PackageFlag
flag) [(UnitInfo, UnusablePackageReason)]
reasons
trustFlagErr :: DynFlags
-> TrustFlag
-> [(UnitInfo, UnusablePackageReason)]
-> IO a
trustFlagErr :: DynFlags
-> TrustFlag -> [(UnitInfo, UnusablePackageReason)] -> IO a
trustFlagErr DynFlags
dflags TrustFlag
flag [(UnitInfo, UnusablePackageReason)]
reasons
= DynFlags -> MsgDoc -> [(UnitInfo, UnusablePackageReason)] -> IO a
forall a.
DynFlags -> MsgDoc -> [(UnitInfo, UnusablePackageReason)] -> IO a
packageFlagErr' DynFlags
dflags (TrustFlag -> MsgDoc
pprTrustFlag TrustFlag
flag) [(UnitInfo, UnusablePackageReason)]
reasons
packageFlagErr' :: DynFlags
-> SDoc
-> [(UnitInfo, UnusablePackageReason)]
-> IO a
packageFlagErr' :: DynFlags -> MsgDoc -> [(UnitInfo, UnusablePackageReason)] -> IO a
packageFlagErr' DynFlags
dflags MsgDoc
flag_doc [(UnitInfo, UnusablePackageReason)]
reasons
= GhcException -> IO a
forall a. GhcException -> IO a
throwGhcExceptionIO ([Char] -> GhcException
CmdLineError (DynFlags -> MsgDoc -> [Char]
showSDoc DynFlags
dflags (MsgDoc -> [Char]) -> MsgDoc -> [Char]
forall a b. (a -> b) -> a -> b
$ MsgDoc
err))
where err :: MsgDoc
err = [Char] -> MsgDoc
text [Char]
"cannot satisfy " MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
flag_doc MsgDoc -> MsgDoc -> MsgDoc
<>
(if [(UnitInfo, UnusablePackageReason)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [(UnitInfo, UnusablePackageReason)]
reasons then MsgDoc
Outputable.empty else [Char] -> MsgDoc
text [Char]
": ") MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest Int
4 (MsgDoc
ppr_reasons MsgDoc -> MsgDoc -> MsgDoc
$$
[Char] -> MsgDoc
text [Char]
"(use -v for more information)")
ppr_reasons :: MsgDoc
ppr_reasons = [MsgDoc] -> MsgDoc
vcat (((UnitInfo, UnusablePackageReason) -> MsgDoc)
-> [(UnitInfo, UnusablePackageReason)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitInfo, UnusablePackageReason) -> MsgDoc
forall {a} {compid} {srcpkgid} {srcpkgname} {modulename} {mod}.
Outputable a =>
(GenericUnitInfo compid srcpkgid srcpkgname a modulename mod,
UnusablePackageReason)
-> MsgDoc
External instance of the constraint type Outputable UnitId
ppr_reason [(UnitInfo, UnusablePackageReason)]
reasons)
ppr_reason :: (GenericUnitInfo compid srcpkgid srcpkgname a modulename mod,
UnusablePackageReason)
-> MsgDoc
ppr_reason (GenericUnitInfo compid srcpkgid srcpkgname a modulename mod
p, UnusablePackageReason
reason) =
MsgDoc -> UnusablePackageReason -> MsgDoc
pprReason (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr (GenericUnitInfo compid srcpkgid srcpkgname a modulename mod -> a
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId GenericUnitInfo compid srcpkgid srcpkgname a modulename mod
p) MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"is") UnusablePackageReason
reason
pprFlag :: PackageFlag -> SDoc
pprFlag :: PackageFlag -> MsgDoc
pprFlag PackageFlag
flag = case PackageFlag
flag of
HidePackage [Char]
p -> [Char] -> MsgDoc
text [Char]
"-hide-package " MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
p
ExposePackage [Char]
doc PackageArg
_ ModRenaming
_ -> [Char] -> MsgDoc
text [Char]
doc
pprTrustFlag :: TrustFlag -> SDoc
pprTrustFlag :: TrustFlag -> MsgDoc
pprTrustFlag TrustFlag
flag = case TrustFlag
flag of
TrustPackage [Char]
p -> [Char] -> MsgDoc
text [Char]
"-trust " MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
p
DistrustPackage [Char]
p -> [Char] -> MsgDoc
text [Char]
"-distrust " MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
p
type WiredInUnitId = String
type WiredPackagesMap = Map WiredUnitId WiredUnitId
wired_in_unitids :: [WiredInUnitId]
wired_in_unitids :: [[Char]]
wired_in_unitids = (Unit -> [Char]) -> [Unit] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> [Char]
unitString [Unit]
wiredInUnitIds
findWiredInPackages
:: DynFlags
-> PackagePrecedenceIndex
-> [UnitInfo]
-> VisibilityMap
-> IO ([UnitInfo],
WiredPackagesMap)
findWiredInPackages :: DynFlags
-> PackagePrecedenceIndex
-> [UnitInfo]
-> VisibilityMap
-> IO ([UnitInfo], Map (Definite UnitId) (Definite UnitId))
findWiredInPackages DynFlags
dflags PackagePrecedenceIndex
prec_map [UnitInfo]
pkgs VisibilityMap
vis_map = do
let
matches :: UnitInfo -> WiredInUnitId -> Bool
UnitInfo
pc matches :: UnitInfo -> [Char] -> Bool
`matches` [Char]
pid
| [Char]
pid [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== Unit -> [Char]
unitString Unit
integerUnitId
= UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageNameString UnitInfo
pc [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` [[Char]
"integer-gmp", [Char]
"integer-simple"]
UnitInfo
pc `matches` [Char]
pid = UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageNameString UnitInfo
pc [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== [Char]
pid
findWiredInPackage :: [UnitInfo] -> WiredInUnitId
-> IO (Maybe (WiredInUnitId, UnitInfo))
findWiredInPackage :: [UnitInfo] -> [Char] -> IO (Maybe ([Char], UnitInfo))
findWiredInPackage [UnitInfo]
pkgs [Char]
wired_pkg =
let all_ps :: [UnitInfo]
all_ps = [ UnitInfo
p | UnitInfo
p <- [UnitInfo]
pkgs, UnitInfo
p UnitInfo -> [Char] -> Bool
`matches` [Char]
wired_pkg ]
all_exposed_ps :: [UnitInfo]
all_exposed_ps =
[ UnitInfo
p | UnitInfo
p <- [UnitInfo]
all_ps
, Unit -> VisibilityMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
External instance of the constraint type Ord Unit
Map.member (UnitInfo -> Unit
mkUnit UnitInfo
p) VisibilityMap
vis_map ] in
case [UnitInfo]
all_exposed_ps of
[] -> case [UnitInfo]
all_ps of
[] -> IO (Maybe ([Char], UnitInfo))
forall {a}. IO (Maybe a)
notfound
[UnitInfo]
many -> UnitInfo -> IO (Maybe ([Char], UnitInfo))
pick ([UnitInfo] -> UnitInfo
forall a. [a] -> a
head (PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
sortByPreference PackagePrecedenceIndex
prec_map [UnitInfo]
many))
[UnitInfo]
many -> UnitInfo -> IO (Maybe ([Char], UnitInfo))
pick ([UnitInfo] -> UnitInfo
forall a. [a] -> a
head (PackagePrecedenceIndex -> [UnitInfo] -> [UnitInfo]
sortByPreference PackagePrecedenceIndex
prec_map [UnitInfo]
many))
where
notfound :: IO (Maybe a)
notfound = do
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> MsgDoc
text [Char]
"wired-in package "
MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
wired_pkg
MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
" not found."
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe a
forall a. Maybe a
Nothing
pick :: UnitInfo
-> IO (Maybe (WiredInUnitId, UnitInfo))
pick :: UnitInfo -> IO (Maybe ([Char], UnitInfo))
pick UnitInfo
pkg = do
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> MsgDoc
text [Char]
"wired-in package "
MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
wired_pkg
MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
" mapped to "
MsgDoc -> MsgDoc -> MsgDoc
<> UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg)
Maybe ([Char], UnitInfo) -> IO (Maybe ([Char], UnitInfo))
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (([Char], UnitInfo) -> Maybe ([Char], UnitInfo)
forall a. a -> Maybe a
Just ([Char]
wired_pkg, UnitInfo
pkg))
[Maybe ([Char], UnitInfo)]
mb_wired_in_pkgs <- ([Char] -> IO (Maybe ([Char], UnitInfo)))
-> [[Char]] -> IO [Maybe ([Char], UnitInfo)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
mapM ([UnitInfo] -> [Char] -> IO (Maybe ([Char], UnitInfo))
findWiredInPackage [UnitInfo]
pkgs) [[Char]]
wired_in_unitids
let
wired_in_pkgs :: [([Char], UnitInfo)]
wired_in_pkgs = [Maybe ([Char], UnitInfo)] -> [([Char], UnitInfo)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ([Char], UnitInfo)]
mb_wired_in_pkgs
pkgstate :: PackageState
pkgstate = DynFlags -> PackageState
pkgState DynFlags
dflags
wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap :: Map (Definite UnitId) (Definite UnitId)
wiredInMap = [(Definite UnitId, Definite UnitId)]
-> Map (Definite UnitId) (Definite UnitId)
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type forall unit. Ord unit => Ord (Definite unit)
External instance of the constraint type Ord UnitId
Map.fromList
[ (Definite UnitId
key, UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite ([Char] -> UnitId
stringToUnitId [Char]
wiredInUnitId))
| ([Char]
wiredInUnitId, UnitInfo
pkg) <- [([Char], UnitInfo)]
wired_in_pkgs
, Just Definite UnitId
key <- Maybe (Definite UnitId) -> [Maybe (Definite UnitId)]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative []
pure (Maybe (Definite UnitId) -> [Maybe (Definite UnitId)])
-> Maybe (Definite UnitId) -> [Maybe (Definite UnitId)]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> Maybe (Definite UnitId)
definiteUnitInfoId UnitInfo
pkg
]
updateWiredInDependencies :: [UnitInfo] -> [UnitInfo]
updateWiredInDependencies [UnitInfo]
pkgs = (UnitInfo -> UnitInfo) -> [UnitInfo] -> [UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map (UnitInfo -> UnitInfo
forall {compid} {srcpkgid} {srcpkgname} {a}.
GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
-> GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
upd_deps (UnitInfo -> UnitInfo)
-> (UnitInfo -> UnitInfo) -> UnitInfo -> UnitInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> UnitInfo
upd_pkg) [UnitInfo]
pkgs
where upd_pkg :: UnitInfo -> UnitInfo
upd_pkg UnitInfo
pkg
| Just Definite UnitId
def_uid <- UnitInfo -> Maybe (Definite UnitId)
definiteUnitInfoId UnitInfo
pkg
, Just Definite UnitId
wiredInUnitId <- Definite UnitId
-> Map (Definite UnitId) (Definite UnitId)
-> Maybe (Definite UnitId)
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall unit. Ord unit => Ord (Definite unit)
External instance of the constraint type Ord UnitId
Map.lookup Definite UnitId
def_uid Map (Definite UnitId) (Definite UnitId)
wiredInMap
= let fs :: FastString
fs = UnitId -> FastString
unitIdFS (Definite UnitId -> UnitId
forall unit. Definite unit -> unit
unDefinite Definite UnitId
wiredInUnitId)
in UnitInfo
pkg {
unitId :: UnitId
unitId = FastString -> UnitId
UnitId FastString
fs,
unitInstanceOf :: Indefinite UnitId
unitInstanceOf = PackageState -> FastString -> Indefinite UnitId
mkIndefUnitId PackageState
pkgstate FastString
fs
}
| Bool
otherwise
= UnitInfo
pkg
upd_deps :: GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
-> GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
upd_deps GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
pkg = GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
pkg {
unitDepends :: [UnitId]
unitDepends = (UnitId -> UnitId) -> [UnitId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Definite UnitId -> UnitId
forall unit. Definite unit -> unit
unDefinite (Definite UnitId -> UnitId)
-> (UnitId -> Definite UnitId) -> UnitId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Definite UnitId) (Definite UnitId)
-> Definite UnitId -> Definite UnitId
upd_wired_in Map (Definite UnitId) (Definite UnitId)
wiredInMap (Definite UnitId -> Definite UnitId)
-> (UnitId -> Definite UnitId) -> UnitId -> Definite UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite) (GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
-> [UnitId]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitDepends GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
pkg),
unitExposedModules :: [(a, Maybe Module)]
unitExposedModules
= ((a, Maybe Module) -> (a, Maybe Module))
-> [(a, Maybe Module)] -> [(a, Maybe Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,Maybe Module
v) -> (a
k, (Module -> Module) -> Maybe Module -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap (Map (Definite UnitId) (Definite UnitId) -> Module -> Module
upd_wired_in_mod Map (Definite UnitId) (Definite UnitId)
wiredInMap) Maybe Module
v))
(GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
-> [(a, Maybe Module)]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules GenericUnitInfo compid srcpkgid srcpkgname UnitId a Module
pkg)
}
([UnitInfo], Map (Definite UnitId) (Definite UnitId))
-> IO ([UnitInfo], Map (Definite UnitId) (Definite UnitId))
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([UnitInfo] -> [UnitInfo]
updateWiredInDependencies [UnitInfo]
pkgs, Map (Definite UnitId) (Definite UnitId)
wiredInMap)
upd_wired_in_mod :: WiredPackagesMap -> Module -> Module
upd_wired_in_mod :: Map (Definite UnitId) (Definite UnitId) -> Module -> Module
upd_wired_in_mod Map (Definite UnitId) (Definite UnitId)
wiredInMap (Module Unit
uid ModuleName
m) = Unit -> ModuleName -> Module
forall unit. unit -> ModuleName -> GenModule unit
Module (Map (Definite UnitId) (Definite UnitId) -> Unit -> Unit
upd_wired_in_uid Map (Definite UnitId) (Definite UnitId)
wiredInMap Unit
uid) ModuleName
m
upd_wired_in_uid :: WiredPackagesMap -> Unit -> Unit
upd_wired_in_uid :: Map (Definite UnitId) (Definite UnitId) -> Unit -> Unit
upd_wired_in_uid Map (Definite UnitId) (Definite UnitId)
wiredInMap Unit
u = case Unit
u of
Unit
HoleUnit -> Unit
forall uid. GenUnit uid
HoleUnit
RealUnit Definite UnitId
def_uid -> Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (Map (Definite UnitId) (Definite UnitId)
-> Definite UnitId -> Definite UnitId
upd_wired_in Map (Definite UnitId) (Definite UnitId)
wiredInMap Definite UnitId
def_uid)
VirtUnit GenInstantiatedUnit UnitId
indef_uid ->
GenInstantiatedUnit UnitId -> Unit
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (GenInstantiatedUnit UnitId -> Unit)
-> GenInstantiatedUnit UnitId -> Unit
forall a b. (a -> b) -> a -> b
$ Indefinite UnitId
-> [(ModuleName, Module)] -> GenInstantiatedUnit UnitId
mkInstantiatedUnit
(GenInstantiatedUnit UnitId -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf GenInstantiatedUnit UnitId
indef_uid)
(((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
x,Module
y) -> (ModuleName
x,Map (Definite UnitId) (Definite UnitId) -> Module -> Module
upd_wired_in_mod Map (Definite UnitId) (Definite UnitId)
wiredInMap Module
y)) (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit UnitId
indef_uid))
upd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId
upd_wired_in :: Map (Definite UnitId) (Definite UnitId)
-> Definite UnitId -> Definite UnitId
upd_wired_in Map (Definite UnitId) (Definite UnitId)
wiredInMap Definite UnitId
key
| Just Definite UnitId
key' <- Definite UnitId
-> Map (Definite UnitId) (Definite UnitId)
-> Maybe (Definite UnitId)
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall unit. Ord unit => Ord (Definite unit)
External instance of the constraint type Ord UnitId
Map.lookup Definite UnitId
key Map (Definite UnitId) (Definite UnitId)
wiredInMap = Definite UnitId
key'
| Bool
otherwise = Definite UnitId
key
updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap
updateVisibilityMap :: Map (Definite UnitId) (Definite UnitId)
-> VisibilityMap -> VisibilityMap
updateVisibilityMap Map (Definite UnitId) (Definite UnitId)
wiredInMap VisibilityMap
vis_map = (VisibilityMap
-> (Definite UnitId, Definite UnitId) -> VisibilityMap)
-> VisibilityMap
-> [(Definite UnitId, Definite UnitId)]
-> VisibilityMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' VisibilityMap
-> (Definite UnitId, Definite UnitId) -> VisibilityMap
f VisibilityMap
vis_map (Map (Definite UnitId) (Definite UnitId)
-> [(Definite UnitId, Definite UnitId)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Definite UnitId) (Definite UnitId)
wiredInMap)
where f :: VisibilityMap
-> (Definite UnitId, Definite UnitId) -> VisibilityMap
f VisibilityMap
vm (Definite UnitId
from, Definite UnitId
to) = case Unit -> VisibilityMap -> Maybe UnitVisibility
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord Unit
Map.lookup (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit Definite UnitId
from) VisibilityMap
vis_map of
Maybe UnitVisibility
Nothing -> VisibilityMap
vm
Just UnitVisibility
r -> Unit -> UnitVisibility -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
External instance of the constraint type Ord Unit
Map.insert (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit Definite UnitId
to) UnitVisibility
r
(Unit -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> Map k a -> Map k a
External instance of the constraint type Ord Unit
Map.delete (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit Definite UnitId
from) VisibilityMap
vm)
data UnusablePackageReason
=
IgnoredWithFlag
| BrokenDependencies [UnitId]
| CyclicDependencies [UnitId]
| IgnoredDependencies [UnitId]
| ShadowedDependencies [UnitId]
instance Outputable UnusablePackageReason where
ppr :: UnusablePackageReason -> MsgDoc
ppr UnusablePackageReason
IgnoredWithFlag = [Char] -> MsgDoc
text [Char]
"[ignored with flag]"
ppr (BrokenDependencies [UnitId]
uids) = MsgDoc -> MsgDoc
brackets ([Char] -> MsgDoc
text [Char]
"broken" MsgDoc -> MsgDoc -> MsgDoc
<+> [UnitId] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable UnitId
ppr [UnitId]
uids)
ppr (CyclicDependencies [UnitId]
uids) = MsgDoc -> MsgDoc
brackets ([Char] -> MsgDoc
text [Char]
"cyclic" MsgDoc -> MsgDoc -> MsgDoc
<+> [UnitId] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable UnitId
ppr [UnitId]
uids)
ppr (IgnoredDependencies [UnitId]
uids) = MsgDoc -> MsgDoc
brackets ([Char] -> MsgDoc
text [Char]
"ignored" MsgDoc -> MsgDoc -> MsgDoc
<+> [UnitId] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable UnitId
ppr [UnitId]
uids)
ppr (ShadowedDependencies [UnitId]
uids) = MsgDoc -> MsgDoc
brackets ([Char] -> MsgDoc
text [Char]
"shadowed" MsgDoc -> MsgDoc -> MsgDoc
<+> [UnitId] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable UnitId
ppr [UnitId]
uids)
type UnusablePackages = Map UnitId
(UnitInfo, UnusablePackageReason)
pprReason :: SDoc -> UnusablePackageReason -> SDoc
pprReason :: MsgDoc -> UnusablePackageReason -> MsgDoc
pprReason MsgDoc
pref UnusablePackageReason
reason = case UnusablePackageReason
reason of
UnusablePackageReason
IgnoredWithFlag ->
MsgDoc
pref MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"ignored due to an -ignore-package flag"
BrokenDependencies [UnitId]
deps ->
MsgDoc
pref MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"unusable due to missing dependencies:" MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
hsep ((UnitId -> MsgDoc) -> [UnitId] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr [UnitId]
deps))
CyclicDependencies [UnitId]
deps ->
MsgDoc
pref MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"unusable due to cyclic dependencies:" MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
hsep ((UnitId -> MsgDoc) -> [UnitId] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr [UnitId]
deps))
IgnoredDependencies [UnitId]
deps ->
MsgDoc
pref MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text ([Char]
"unusable because the -ignore-package flag was used to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"ignore at least one of its dependencies:") MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
hsep ((UnitId -> MsgDoc) -> [UnitId] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr [UnitId]
deps))
ShadowedDependencies [UnitId]
deps ->
MsgDoc
pref MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"unusable due to shadowed dependencies:" MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
hsep ((UnitId -> MsgDoc) -> [UnitId] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr [UnitId]
deps))
reportCycles :: DynFlags -> [SCC UnitInfo] -> IO ()
reportCycles :: DynFlags -> [SCC UnitInfo] -> IO ()
reportCycles DynFlags
dflags [SCC UnitInfo]
sccs = (SCC UnitInfo -> IO ()) -> [SCC UnitInfo] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
mapM_ SCC UnitInfo -> IO ()
forall {a} {compid} {srcpkgid} {srcpkgname} {modulename} {mod}.
Outputable a =>
SCC (GenericUnitInfo compid srcpkgid srcpkgname a modulename mod)
-> IO ()
External instance of the constraint type Outputable UnitId
report [SCC UnitInfo]
sccs
where
report :: SCC (GenericUnitInfo compid srcpkgid srcpkgname a modulename mod)
-> IO ()
report (AcyclicSCC GenericUnitInfo compid srcpkgid srcpkgname a modulename mod
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()
report (CyclicSCC [GenericUnitInfo compid srcpkgid srcpkgname a modulename mod]
vs) =
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> MsgDoc
text [Char]
"these packages are involved in a cycle:" MsgDoc -> MsgDoc -> MsgDoc
$$
Int -> MsgDoc -> MsgDoc
nest Int
2 ([MsgDoc] -> MsgDoc
hsep ((GenericUnitInfo compid srcpkgid srcpkgname a modulename mod
-> MsgDoc)
-> [GenericUnitInfo compid srcpkgid srcpkgname a modulename mod]
-> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr (a -> MsgDoc)
-> (GenericUnitInfo compid srcpkgid srcpkgname a modulename mod
-> a)
-> GenericUnitInfo compid srcpkgid srcpkgname a modulename mod
-> MsgDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericUnitInfo compid srcpkgid srcpkgname a modulename mod -> a
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId) [GenericUnitInfo compid srcpkgid srcpkgname a modulename mod]
vs))
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
reportUnusable DynFlags
dflags UnusablePackages
pkgs = ((UnitId, (UnitInfo, UnusablePackageReason)) -> IO ())
-> [(UnitId, (UnitInfo, UnusablePackageReason))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
mapM_ (UnitId, (UnitInfo, UnusablePackageReason)) -> IO ()
forall {a} {a}.
Outputable a =>
(a, (a, UnusablePackageReason)) -> IO ()
External instance of the constraint type Outputable UnitId
report (UnusablePackages -> [(UnitId, (UnitInfo, UnusablePackageReason))]
forall k a. Map k a -> [(k, a)]
Map.toList UnusablePackages
pkgs)
where
report :: (a, (a, UnusablePackageReason)) -> IO ()
report (a
ipid, (a
_, UnusablePackageReason
reason)) =
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
MsgDoc -> UnusablePackageReason -> MsgDoc
pprReason
([Char] -> MsgDoc
text [Char]
"package" MsgDoc -> MsgDoc -> MsgDoc
<+> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr a
ipid MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"is") UnusablePackageReason
reason
type RevIndex = Map UnitId [UnitId]
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps InstalledPackageIndex
db = (RevIndex -> UnitInfo -> RevIndex)
-> RevIndex -> InstalledPackageIndex -> RevIndex
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' RevIndex -> UnitInfo -> RevIndex
forall {k} {compid} {srcpkgid} {srcpkgname} {modulename} {mod}.
Ord k =>
Map k [k]
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> Map k [k]
External instance of the constraint type Ord UnitId
go RevIndex
forall k a. Map k a
Map.empty InstalledPackageIndex
db
where
go :: Map k [k]
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> Map k [k]
go Map k [k]
r GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg = (Map k [k] -> k -> Map k [k]) -> Map k [k] -> [k] -> Map k [k]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' (k -> Map k [k] -> k -> Map k [k]
forall {k} {a}. Ord k => a -> Map k [a] -> k -> Map k [a]
Evidence bound by a type signature of the constraint type Ord k
go' (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod -> k
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg)) Map k [k]
r (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod -> [k]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitDepends GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg)
go' :: a -> Map k [a] -> k -> Map k [a]
go' a
from Map k [a]
r k
to = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Evidence bound by a type signature of the constraint type Ord k
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) k
to [a
from] Map k [a]
r
removePackages :: [UnitId] -> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages :: [UnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages [UnitId]
uids RevIndex
index InstalledPackageIndex
m = [UnitId]
-> (InstalledPackageIndex, [UnitInfo])
-> (InstalledPackageIndex, [UnitInfo])
forall {a}. [UnitId] -> (Map UnitId a, [a]) -> (Map UnitId a, [a])
go [UnitId]
uids (InstalledPackageIndex
m,[])
where
go :: [UnitId] -> (Map UnitId a, [a]) -> (Map UnitId a, [a])
go [] (Map UnitId a
m,[a]
pkgs) = (Map UnitId a
m,[a]
pkgs)
go (UnitId
uid:[UnitId]
uids) (Map UnitId a
m,[a]
pkgs)
| Just a
pkg <- UnitId -> Map UnitId a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup UnitId
uid Map UnitId a
m
= case UnitId -> RevIndex -> Maybe [UnitId]
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup UnitId
uid RevIndex
index of
Maybe [UnitId]
Nothing -> [UnitId] -> (Map UnitId a, [a]) -> (Map UnitId a, [a])
go [UnitId]
uids (UnitId -> Map UnitId a -> Map UnitId a
forall k a. Ord k => k -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
Map.delete UnitId
uid Map UnitId a
m, a
pkga -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pkgs)
Just [UnitId]
rdeps -> [UnitId] -> (Map UnitId a, [a]) -> (Map UnitId a, [a])
go ([UnitId]
rdeps [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++ [UnitId]
uids) (UnitId -> Map UnitId a -> Map UnitId a
forall k a. Ord k => k -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
Map.delete UnitId
uid Map UnitId a
m, a
pkga -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pkgs)
| Bool
otherwise
= [UnitId] -> (Map UnitId a, [a]) -> (Map UnitId a, [a])
go [UnitId]
uids (Map UnitId a
m,[a]
pkgs)
depsNotAvailable :: InstalledPackageIndex
-> UnitInfo
-> [UnitId]
depsNotAvailable :: InstalledPackageIndex -> UnitInfo -> [UnitId]
depsNotAvailable InstalledPackageIndex
pkg_map UnitInfo
pkg = (UnitId -> Bool) -> [UnitId] -> [UnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (UnitId -> Bool) -> UnitId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId -> InstalledPackageIndex -> Bool
forall k a. Ord k => k -> Map k a -> Bool
External instance of the constraint type Ord UnitId
`Map.member` InstalledPackageIndex
pkg_map)) (UnitInfo -> [UnitId]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitDepends UnitInfo
pkg)
depsAbiMismatch :: InstalledPackageIndex
-> UnitInfo
-> [UnitId]
depsAbiMismatch :: InstalledPackageIndex -> UnitInfo -> [UnitId]
depsAbiMismatch InstalledPackageIndex
pkg_map UnitInfo
pkg = ((UnitId, [Char]) -> UnitId) -> [(UnitId, [Char])] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId, [Char]) -> UnitId
forall a b. (a, b) -> a
fst ([(UnitId, [Char])] -> [UnitId])
-> ([(UnitId, [Char])] -> [(UnitId, [Char])])
-> [(UnitId, [Char])]
-> [UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnitId, [Char]) -> Bool)
-> [(UnitId, [Char])] -> [(UnitId, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((UnitId, [Char]) -> Bool) -> (UnitId, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId, [Char]) -> Bool
abiMatch) ([(UnitId, [Char])] -> [UnitId]) -> [(UnitId, [Char])] -> [UnitId]
forall a b. (a -> b) -> a -> b
$ UnitInfo -> [(UnitId, [Char])]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(uid, [Char])]
unitAbiDepends UnitInfo
pkg
where
abiMatch :: (UnitId, [Char]) -> Bool
abiMatch (UnitId
dep_uid, [Char]
abi)
| Just UnitInfo
dep_pkg <- UnitId -> InstalledPackageIndex -> Maybe UnitInfo
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord UnitId
Map.lookup UnitId
dep_uid InstalledPackageIndex
pkg_map
= UnitInfo -> [Char]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [Char]
unitAbiHash UnitInfo
dep_pkg [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
== [Char]
abi
| Bool
otherwise
= Bool
False
ignorePackages :: [IgnorePackageFlag] -> [UnitInfo] -> UnusablePackages
ignorePackages :: [IgnorePackageFlag] -> [UnitInfo] -> UnusablePackages
ignorePackages [IgnorePackageFlag]
flags [UnitInfo]
pkgs = [(UnitId, (UnitInfo, UnusablePackageReason))] -> UnusablePackages
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type Ord UnitId
Map.fromList ((IgnorePackageFlag
-> [(UnitId, (UnitInfo, UnusablePackageReason))])
-> [IgnorePackageFlag]
-> [(UnitId, (UnitInfo, UnusablePackageReason))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap IgnorePackageFlag -> [(UnitId, (UnitInfo, UnusablePackageReason))]
doit [IgnorePackageFlag]
flags)
where
doit :: IgnorePackageFlag -> [(UnitId, (UnitInfo, UnusablePackageReason))]
doit (IgnorePackage [Char]
str) =
case (UnitInfo -> Bool) -> [UnitInfo] -> ([UnitInfo], [UnitInfo])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Char] -> UnitInfo -> Bool
matchingStr [Char]
str) [UnitInfo]
pkgs of
([UnitInfo]
ps, [UnitInfo]
_) -> [ (UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
p, (UnitInfo
p, UnusablePackageReason
IgnoredWithFlag))
| UnitInfo
p <- [UnitInfo]
ps ]
type PackagePrecedenceIndex = Map UnitId Int
mergeDatabases :: DynFlags -> [PackageDatabase UnitId]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases :: DynFlags
-> [PackageDatabase UnitId]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases DynFlags
dflags = ((InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, PackageDatabase UnitId)
-> IO (InstalledPackageIndex, PackagePrecedenceIndex))
-> (InstalledPackageIndex, PackagePrecedenceIndex)
-> [(Int, PackageDatabase UnitId)]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
foldM (InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, PackageDatabase UnitId)
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
merge (InstalledPackageIndex
forall k a. Map k a
Map.empty, PackagePrecedenceIndex
forall k a. Map k a
Map.empty) ([(Int, PackageDatabase UnitId)]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex))
-> ([PackageDatabase UnitId] -> [(Int, PackageDatabase UnitId)])
-> [PackageDatabase UnitId]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [PackageDatabase UnitId] -> [(Int, PackageDatabase UnitId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]
where
merge :: (InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, PackageDatabase UnitId)
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
merge (InstalledPackageIndex
pkg_map, PackagePrecedenceIndex
prec_map) (Int
i, PackageDatabase [Char]
db_path [UnitInfo]
db) = do
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> MsgDoc
text [Char]
"loading package database" MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
db_path
[UnitId] -> (UnitId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
forM_ (Set UnitId -> [UnitId]
forall a. Set a -> [a]
Set.toList Set UnitId
override_set) ((UnitId -> IO ()) -> IO ()) -> (UnitId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \UnitId
pkg ->
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> MsgDoc
text [Char]
"package" MsgDoc -> MsgDoc -> MsgDoc
<+> UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
ppr UnitId
pkg MsgDoc -> MsgDoc -> MsgDoc
<+>
[Char] -> MsgDoc
text [Char]
"overrides a previously defined package"
(InstalledPackageIndex, PackagePrecedenceIndex)
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (InstalledPackageIndex
pkg_map', PackagePrecedenceIndex
prec_map')
where
db_map :: InstalledPackageIndex
db_map = [UnitInfo] -> InstalledPackageIndex
forall {compid} {srcpkgid} {srcpkgname} {modulename} {mod}.
[GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod]
-> Map
UnitId
(GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)
mk_pkg_map [UnitInfo]
db
mk_pkg_map :: [GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod]
-> Map
UnitId
(GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)
mk_pkg_map = [(UnitId,
GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)]
-> Map
UnitId
(GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type Ord UnitId
Map.fromList ([(UnitId,
GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)]
-> Map
UnitId
(GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod))
-> ([GenericUnitInfo
compid srcpkgid srcpkgname UnitId modulename mod]
-> [(UnitId,
GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)])
-> [GenericUnitInfo
compid srcpkgid srcpkgname UnitId modulename mod]
-> Map
UnitId
(GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> (UnitId,
GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod))
-> [GenericUnitInfo
compid srcpkgid srcpkgname UnitId modulename mod]
-> [(UnitId,
GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod)]
forall a b. (a -> b) -> [a] -> [b]
map (\GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
p -> (GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
p, GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
p))
override_set :: Set UnitId
override_set :: Set UnitId
override_set = Set UnitId -> Set UnitId -> Set UnitId
forall a. Ord a => Set a -> Set a -> Set a
External instance of the constraint type Ord UnitId
Set.intersection (InstalledPackageIndex -> Set UnitId
forall k a. Map k a -> Set k
Map.keysSet InstalledPackageIndex
db_map)
(InstalledPackageIndex -> Set UnitId
forall k a. Map k a -> Set k
Map.keysSet InstalledPackageIndex
pkg_map)
pkg_map' :: InstalledPackageIndex
pkg_map' :: InstalledPackageIndex
pkg_map' = InstalledPackageIndex
-> InstalledPackageIndex -> InstalledPackageIndex
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
Map.union InstalledPackageIndex
db_map InstalledPackageIndex
pkg_map
prec_map' :: PackagePrecedenceIndex
prec_map' :: PackagePrecedenceIndex
prec_map' = PackagePrecedenceIndex
-> PackagePrecedenceIndex -> PackagePrecedenceIndex
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
Map.union ((UnitInfo -> Int)
-> InstalledPackageIndex -> PackagePrecedenceIndex
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int -> UnitInfo -> Int
forall a b. a -> b -> a
const Int
i) InstalledPackageIndex
db_map) PackagePrecedenceIndex
prec_map
validateDatabase :: DynFlags -> InstalledPackageIndex
-> (InstalledPackageIndex, UnusablePackages, [SCC UnitInfo])
validateDatabase :: DynFlags
-> InstalledPackageIndex
-> (InstalledPackageIndex, UnusablePackages, [SCC UnitInfo])
validateDatabase DynFlags
dflags InstalledPackageIndex
pkg_map1 =
(InstalledPackageIndex
pkg_map5, UnusablePackages
unusable, [SCC UnitInfo]
sccs)
where
ignore_flags :: [IgnorePackageFlag]
ignore_flags = [IgnorePackageFlag] -> [IgnorePackageFlag]
forall a. [a] -> [a]
reverse (DynFlags -> [IgnorePackageFlag]
ignorePackageFlags DynFlags
dflags)
index :: RevIndex
index = InstalledPackageIndex -> RevIndex
reverseDeps InstalledPackageIndex
pkg_map1
mk_unusable :: (t -> b)
-> (t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> t)
-> t
-> [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
-> Map
k (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b)
mk_unusable t -> b
mk_err t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod -> t
dep_matcher t
m [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
uids =
[(k,
(GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b))]
-> Map
k (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b)
forall k a. Ord k => [(k, a)] -> Map k a
Evidence bound by a type signature of the constraint type Ord k
Map.fromList [ (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod -> k
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg, (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg, t -> b
mk_err (t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod -> t
dep_matcher t
m GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg)))
| GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
pkg <- [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
uids ]
directly_broken :: [UnitInfo]
directly_broken = (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (UnitInfo -> Bool) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnitId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null ([UnitId] -> Bool) -> (UnitInfo -> [UnitId]) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageIndex -> UnitInfo -> [UnitId]
depsNotAvailable InstalledPackageIndex
pkg_map1)
(InstalledPackageIndex -> [UnitInfo]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map1)
(InstalledPackageIndex
pkg_map2, [UnitInfo]
broken) = [UnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages ((UnitInfo -> UnitId) -> [UnitInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId [UnitInfo]
directly_broken) RevIndex
index InstalledPackageIndex
pkg_map1
unusable_broken :: UnusablePackages
unusable_broken = ([UnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> UnitInfo -> [UnitId])
-> InstalledPackageIndex
-> [UnitInfo]
-> UnusablePackages
forall {k} {t} {b} {t} {compid} {srcpkgid} {srcpkgname}
{modulename} {mod}.
Ord k =>
(t -> b)
-> (t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> t)
-> t
-> [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
-> Map
k (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b)
External instance of the constraint type Ord UnitId
mk_unusable [UnitId] -> UnusablePackageReason
BrokenDependencies InstalledPackageIndex -> UnitInfo -> [UnitId]
depsNotAvailable InstalledPackageIndex
pkg_map2 [UnitInfo]
broken
sccs :: [SCC UnitInfo]
sccs = [(UnitInfo, UnitId, [UnitId])] -> [SCC UnitInfo]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
External instance of the constraint type Ord UnitId
stronglyConnComp [ (UnitInfo
pkg, UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg, UnitInfo -> [UnitId]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitDepends UnitInfo
pkg)
| UnitInfo
pkg <- InstalledPackageIndex -> [UnitInfo]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map2 ]
getCyclicSCC :: SCC (GenericUnitInfo compid srcpkgid srcpkgname b modulename mod)
-> [b]
getCyclicSCC (CyclicSCC [GenericUnitInfo compid srcpkgid srcpkgname b modulename mod]
vs) = (GenericUnitInfo compid srcpkgid srcpkgname b modulename mod -> b)
-> [GenericUnitInfo compid srcpkgid srcpkgname b modulename mod]
-> [b]
forall a b. (a -> b) -> [a] -> [b]
map GenericUnitInfo compid srcpkgid srcpkgname b modulename mod -> b
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId [GenericUnitInfo compid srcpkgid srcpkgname b modulename mod]
vs
getCyclicSCC (AcyclicSCC GenericUnitInfo compid srcpkgid srcpkgname b modulename mod
_) = []
(InstalledPackageIndex
pkg_map3, [UnitInfo]
cyclic) = [UnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages ((SCC UnitInfo -> [UnitId]) -> [SCC UnitInfo] -> [UnitId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap SCC UnitInfo -> [UnitId]
forall {compid} {srcpkgid} {srcpkgname} {b} {modulename} {mod}.
SCC (GenericUnitInfo compid srcpkgid srcpkgname b modulename mod)
-> [b]
getCyclicSCC [SCC UnitInfo]
sccs) RevIndex
index InstalledPackageIndex
pkg_map2
unusable_cyclic :: UnusablePackages
unusable_cyclic = ([UnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> UnitInfo -> [UnitId])
-> InstalledPackageIndex
-> [UnitInfo]
-> UnusablePackages
forall {k} {t} {b} {t} {compid} {srcpkgid} {srcpkgname}
{modulename} {mod}.
Ord k =>
(t -> b)
-> (t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> t)
-> t
-> [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
-> Map
k (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b)
External instance of the constraint type Ord UnitId
mk_unusable [UnitId] -> UnusablePackageReason
CyclicDependencies InstalledPackageIndex -> UnitInfo -> [UnitId]
depsNotAvailable InstalledPackageIndex
pkg_map3 [UnitInfo]
cyclic
directly_ignored :: UnusablePackages
directly_ignored = [IgnorePackageFlag] -> [UnitInfo] -> UnusablePackages
ignorePackages [IgnorePackageFlag]
ignore_flags (InstalledPackageIndex -> [UnitInfo]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map3)
(InstalledPackageIndex
pkg_map4, [UnitInfo]
ignored) = [UnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages (UnusablePackages -> [UnitId]
forall k a. Map k a -> [k]
Map.keys UnusablePackages
directly_ignored) RevIndex
index InstalledPackageIndex
pkg_map3
unusable_ignored :: UnusablePackages
unusable_ignored = ([UnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> UnitInfo -> [UnitId])
-> InstalledPackageIndex
-> [UnitInfo]
-> UnusablePackages
forall {k} {t} {b} {t} {compid} {srcpkgid} {srcpkgname}
{modulename} {mod}.
Ord k =>
(t -> b)
-> (t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> t)
-> t
-> [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
-> Map
k (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b)
External instance of the constraint type Ord UnitId
mk_unusable [UnitId] -> UnusablePackageReason
IgnoredDependencies InstalledPackageIndex -> UnitInfo -> [UnitId]
depsNotAvailable InstalledPackageIndex
pkg_map4 [UnitInfo]
ignored
directly_shadowed :: [UnitInfo]
directly_shadowed = (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (UnitInfo -> Bool) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnitId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null ([UnitId] -> Bool) -> (UnitInfo -> [UnitId]) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageIndex -> UnitInfo -> [UnitId]
depsAbiMismatch InstalledPackageIndex
pkg_map4)
(InstalledPackageIndex -> [UnitInfo]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map4)
(InstalledPackageIndex
pkg_map5, [UnitInfo]
shadowed) = [UnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [UnitInfo])
removePackages ((UnitInfo -> UnitId) -> [UnitInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId [UnitInfo]
directly_shadowed) RevIndex
index InstalledPackageIndex
pkg_map4
unusable_shadowed :: UnusablePackages
unusable_shadowed = ([UnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> UnitInfo -> [UnitId])
-> InstalledPackageIndex
-> [UnitInfo]
-> UnusablePackages
forall {k} {t} {b} {t} {compid} {srcpkgid} {srcpkgname}
{modulename} {mod}.
Ord k =>
(t -> b)
-> (t
-> GenericUnitInfo compid srcpkgid srcpkgname k modulename mod
-> t)
-> t
-> [GenericUnitInfo compid srcpkgid srcpkgname k modulename mod]
-> Map
k (GenericUnitInfo compid srcpkgid srcpkgname k modulename mod, b)
External instance of the constraint type Ord UnitId
mk_unusable [UnitId] -> UnusablePackageReason
ShadowedDependencies InstalledPackageIndex -> UnitInfo -> [UnitId]
depsAbiMismatch InstalledPackageIndex
pkg_map5 [UnitInfo]
shadowed
unusable :: UnusablePackages
unusable = UnusablePackages
directly_ignored UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
`Map.union` UnusablePackages
unusable_ignored
UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
`Map.union` UnusablePackages
unusable_broken
UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
`Map.union` UnusablePackages
unusable_cyclic
UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord UnitId
`Map.union` UnusablePackages
unusable_shadowed
mkPackageState
:: DynFlags
-> [PackageDatabase UnitId]
-> [PreloadUnitId]
-> IO (PackageState,
[PreloadUnitId],
Maybe [(ModuleName, Module)])
mkPackageState :: DynFlags
-> [PackageDatabase UnitId]
-> [UnitId]
-> IO (PackageState, [UnitId], Maybe [(ModuleName, Module)])
mkPackageState DynFlags
dflags [PackageDatabase UnitId]
dbs [UnitId]
preload0 = do
let other_flags :: [PackageFlag]
other_flags = [PackageFlag] -> [PackageFlag]
forall a. [a] -> [a]
reverse (DynFlags -> [PackageFlag]
packageFlags DynFlags
dflags)
DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> MsgDoc
text [Char]
"package flags" MsgDoc -> MsgDoc -> MsgDoc
<+> [PackageFlag] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type Outputable PackageFlag
ppr [PackageFlag]
other_flags
(InstalledPackageIndex
pkg_map1, PackagePrecedenceIndex
prec_map) <- DynFlags
-> [PackageDatabase UnitId]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases DynFlags
dflags [PackageDatabase UnitId]
dbs
let (InstalledPackageIndex
pkg_map2, UnusablePackages
unusable, [SCC UnitInfo]
sccs) = DynFlags
-> InstalledPackageIndex
-> (InstalledPackageIndex, UnusablePackages, [SCC UnitInfo])
validateDatabase DynFlags
dflags InstalledPackageIndex
pkg_map1
DynFlags -> [SCC UnitInfo] -> IO ()
reportCycles DynFlags
dflags [SCC UnitInfo]
sccs
DynFlags -> UnusablePackages -> IO ()
reportUnusable DynFlags
dflags UnusablePackages
unusable
[UnitInfo]
pkgs1 <- ([UnitInfo] -> TrustFlag -> IO [UnitInfo])
-> [UnitInfo] -> [TrustFlag] -> IO [UnitInfo]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
foldM (DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [UnitInfo]
-> TrustFlag
-> IO [UnitInfo]
applyTrustFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnusablePackages
unusable)
(InstalledPackageIndex -> [UnitInfo]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map2) ([TrustFlag] -> [TrustFlag]
forall a. [a] -> [a]
reverse (DynFlags -> [TrustFlag]
trustFlags DynFlags
dflags))
let prelim_pkg_db :: UnitInfoMap
prelim_pkg_db = UnitInfoMap -> [UnitInfo] -> UnitInfoMap
extendUnitInfoMap UnitInfoMap
emptyUnitInfoMap [UnitInfo]
pkgs1
let preferLater :: UnitInfo -> UnitInfo -> UnitInfo
preferLater UnitInfo
unit UnitInfo
unit' =
case PackagePrecedenceIndex -> UnitInfo -> UnitInfo -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map UnitInfo
unit UnitInfo
unit' of
Ordering
GT -> UnitInfo
unit
Ordering
_ -> UnitInfo
unit'
addIfMorePreferable :: UniqDFM UnitInfo -> UnitInfo -> UniqDFM UnitInfo
addIfMorePreferable UniqDFM UnitInfo
m UnitInfo
unit = (UnitInfo -> UnitInfo -> UnitInfo)
-> UniqDFM UnitInfo -> FastString -> UnitInfo -> UniqDFM UnitInfo
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqDFM elt -> key -> elt -> UniqDFM elt
External instance of the constraint type Uniquable FastString
addToUDFM_C UnitInfo -> UnitInfo -> UnitInfo
preferLater UniqDFM UnitInfo
m (UnitInfo -> FastString
fsPackageName UnitInfo
unit) UnitInfo
unit
mostPreferablePackageReps :: UniqDFM UnitInfo
mostPreferablePackageReps = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPackages DynFlags
dflags
then UniqDFM UnitInfo
forall elt. UniqDFM elt
emptyUDFM
else (UniqDFM UnitInfo -> UnitInfo -> UniqDFM UnitInfo)
-> UniqDFM UnitInfo -> [UnitInfo] -> UniqDFM UnitInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' UniqDFM UnitInfo -> UnitInfo -> UniqDFM UnitInfo
addIfMorePreferable UniqDFM UnitInfo
forall elt. UniqDFM elt
emptyUDFM [UnitInfo]
pkgs1
mostPreferable :: UnitInfo -> Bool
mostPreferable UnitInfo
u =
case UniqDFM UnitInfo -> FastString -> Maybe UnitInfo
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable FastString
lookupUDFM UniqDFM UnitInfo
mostPreferablePackageReps (UnitInfo -> FastString
fsPackageName UnitInfo
u) of
Maybe UnitInfo
Nothing -> Bool
False
Just UnitInfo
u' -> PackagePrecedenceIndex -> UnitInfo -> UnitInfo -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map UnitInfo
u UnitInfo
u' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Ordering
== Ordering
EQ
vis_map1 :: VisibilityMap
vis_map1 = (VisibilityMap -> UnitInfo -> VisibilityMap)
-> VisibilityMap -> [UnitInfo] -> VisibilityMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' (\VisibilityMap
vm UnitInfo
p ->
if UnitInfo -> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsExposed UnitInfo
p Bool -> Bool -> Bool
&& Unit -> Bool
unitIsDefinite (UnitInfo -> Unit
mkUnit UnitInfo
p) Bool -> Bool -> Bool
&& UnitInfo -> Bool
mostPreferable UnitInfo
p
then Unit -> UnitVisibility -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
External instance of the constraint type Ord Unit
Map.insert (UnitInfo -> Unit
mkUnit UnitInfo
p)
UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set InstantiatedModule)
-> Bool
-> UnitVisibility
UnitVisibility {
uv_expose_all :: Bool
uv_expose_all = Bool
True,
uv_renamings :: [(ModuleName, ModuleName)]
uv_renamings = [],
uv_package_name :: First FastString
uv_package_name = Maybe FastString -> First FastString
forall a. Maybe a -> First a
First (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (UnitInfo -> FastString
fsPackageName UnitInfo
p)),
uv_requirements :: Map ModuleName (Set InstantiatedModule)
uv_requirements = Map ModuleName (Set InstantiatedModule)
forall k a. Map k a
Map.empty,
uv_explicit :: Bool
uv_explicit = Bool
False
}
VisibilityMap
vm
else VisibilityMap
vm)
VisibilityMap
forall k a. Map k a
Map.empty [UnitInfo]
pkgs1
VisibilityMap
vis_map2 <- (VisibilityMap -> PackageFlag -> IO VisibilityMap)
-> VisibilityMap -> [PackageFlag] -> IO VisibilityMap
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
foldM (DynFlags
-> PackagePrecedenceIndex
-> UnitInfoMap
-> UnusablePackages
-> Bool
-> [UnitInfo]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnitInfoMap
prelim_pkg_db UnusablePackages
unusable
(GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPackages DynFlags
dflags) [UnitInfo]
pkgs1)
VisibilityMap
vis_map1 [PackageFlag]
other_flags
([UnitInfo]
pkgs2, Map (Definite UnitId) (Definite UnitId)
wired_map) <- DynFlags
-> PackagePrecedenceIndex
-> [UnitInfo]
-> VisibilityMap
-> IO ([UnitInfo], Map (Definite UnitId) (Definite UnitId))
findWiredInPackages DynFlags
dflags PackagePrecedenceIndex
prec_map [UnitInfo]
pkgs1 VisibilityMap
vis_map2
let pkg_db :: UnitInfoMap
pkg_db = UnitInfoMap -> [UnitInfo] -> UnitInfoMap
extendUnitInfoMap UnitInfoMap
emptyUnitInfoMap [UnitInfo]
pkgs2
let vis_map :: VisibilityMap
vis_map = Map (Definite UnitId) (Definite UnitId)
-> VisibilityMap -> VisibilityMap
updateVisibilityMap Map (Definite UnitId) (Definite UnitId)
wired_map VisibilityMap
vis_map2
let hide_plugin_pkgs :: Bool
hide_plugin_pkgs = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPluginPackages DynFlags
dflags
VisibilityMap
plugin_vis_map <-
case DynFlags -> [PackageFlag]
pluginPackageFlags DynFlags
dflags of
[] | Bool -> Bool
not Bool
hide_plugin_pkgs -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return VisibilityMap
vis_map
| Bool
otherwise -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return VisibilityMap
forall k a. Map k a
Map.empty
[PackageFlag]
_ -> do let plugin_vis_map1 :: VisibilityMap
plugin_vis_map1
| Bool
hide_plugin_pkgs = VisibilityMap
forall k a. Map k a
Map.empty
| Bool
otherwise = VisibilityMap
vis_map2
VisibilityMap
plugin_vis_map2
<- (VisibilityMap -> PackageFlag -> IO VisibilityMap)
-> VisibilityMap -> [PackageFlag] -> IO VisibilityMap
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type Monad IO
External instance of the constraint type Foldable []
foldM (DynFlags
-> PackagePrecedenceIndex
-> UnitInfoMap
-> UnusablePackages
-> Bool
-> [UnitInfo]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnitInfoMap
prelim_pkg_db UnusablePackages
unusable
(GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPluginPackages DynFlags
dflags) [UnitInfo]
pkgs1)
VisibilityMap
plugin_vis_map1
([PackageFlag] -> [PackageFlag]
forall a. [a] -> [a]
reverse (DynFlags -> [PackageFlag]
pluginPackageFlags DynFlags
dflags))
VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Map (Definite UnitId) (Definite UnitId)
-> VisibilityMap -> VisibilityMap
updateVisibilityMap Map (Definite UnitId) (Definite UnitId)
wired_map VisibilityMap
plugin_vis_map2)
let preload1 :: [Unit]
preload1 = VisibilityMap -> [Unit]
forall k a. Map k a -> [k]
Map.keys ((UnitVisibility -> Bool) -> VisibilityMap -> VisibilityMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter UnitVisibility -> Bool
uv_explicit VisibilityMap
vis_map)
let pkgname_map :: Map PackageName (Indefinite UnitId)
pkgname_map = (Map PackageName (Indefinite UnitId)
-> UnitInfo -> Map PackageName (Indefinite UnitId))
-> Map PackageName (Indefinite UnitId)
-> [UnitInfo]
-> Map PackageName (Indefinite UnitId)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' Map PackageName (Indefinite UnitId)
-> UnitInfo -> Map PackageName (Indefinite UnitId)
forall {srcpkgname} {a} {srcpkgid} {uid} {modulename} {mod}.
Ord srcpkgname =>
Map srcpkgname a
-> GenericUnitInfo a srcpkgid srcpkgname uid modulename mod
-> Map srcpkgname a
External instance of the constraint type Ord PackageName
add Map PackageName (Indefinite UnitId)
forall k a. Map k a
Map.empty [UnitInfo]
pkgs2
where add :: Map srcpkgname a
-> GenericUnitInfo a srcpkgid srcpkgname uid modulename mod
-> Map srcpkgname a
add Map srcpkgname a
pn_map GenericUnitInfo a srcpkgid srcpkgname uid modulename mod
p
= srcpkgname -> a -> Map srcpkgname a -> Map srcpkgname a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Evidence bound by a type signature of the constraint type Ord srcpkgname
Map.insert (GenericUnitInfo a srcpkgid srcpkgname uid modulename mod
-> srcpkgname
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName GenericUnitInfo a srcpkgid srcpkgname uid modulename mod
p) (GenericUnitInfo a srcpkgid srcpkgname uid modulename mod -> a
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> compid
unitInstanceOf GenericUnitInfo a srcpkgid srcpkgname uid modulename mod
p) Map srcpkgname a
pn_map
let explicit_pkgs :: [Unit]
explicit_pkgs = VisibilityMap -> [Unit]
forall k a. Map k a -> [k]
Map.keys VisibilityMap
vis_map
req_ctx :: Map ModuleName [InstantiatedModule]
req_ctx = (Set InstantiatedModule -> [InstantiatedModule])
-> Map ModuleName (Set InstantiatedModule)
-> Map ModuleName [InstantiatedModule]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Set InstantiatedModule -> [InstantiatedModule]
forall a. Set a -> [a]
Set.toList)
(Map ModuleName (Set InstantiatedModule)
-> Map ModuleName [InstantiatedModule])
-> Map ModuleName (Set InstantiatedModule)
-> Map ModuleName [InstantiatedModule]
forall a b. (a -> b) -> a -> b
$ (Set InstantiatedModule
-> Set InstantiatedModule -> Set InstantiatedModule)
-> [Map ModuleName (Set InstantiatedModule)]
-> Map ModuleName (Set InstantiatedModule)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
External instance of the constraint type Ord ModuleName
External instance of the constraint type Foldable []
Map.unionsWith Set InstantiatedModule
-> Set InstantiatedModule -> Set InstantiatedModule
forall a. Ord a => Set a -> Set a -> Set a
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type forall unit. Ord (GenInstantiatedUnit unit)
Set.union ((UnitVisibility -> Map ModuleName (Set InstantiatedModule))
-> [UnitVisibility] -> [Map ModuleName (Set InstantiatedModule)]
forall a b. (a -> b) -> [a] -> [b]
map UnitVisibility -> Map ModuleName (Set InstantiatedModule)
uv_requirements (VisibilityMap -> [UnitVisibility]
forall k a. Map k a -> [a]
Map.elems VisibilityMap
vis_map))
let preload2 :: [Unit]
preload2 = [Unit]
preload1
let
basicLinkedPackages :: [Unit]
basicLinkedPackages
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_AutoLinkPackages DynFlags
dflags
= (Unit -> Bool) -> [Unit] -> [Unit]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Unit -> UniqDFM UnitInfo -> Bool)
-> UniqDFM UnitInfo -> Unit -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Unit -> UniqDFM UnitInfo -> Bool
forall key elt. Uniquable key => key -> UniqDFM elt -> Bool
External instance of the constraint type Uniquable Unit
elemUDFM (UnitInfoMap -> UniqDFM UnitInfo
unUnitInfoMap UnitInfoMap
pkg_db))
[Unit
baseUnitId, Unit
rtsUnitId]
| Bool
otherwise = []
preload3 :: [Unit]
preload3 = [Unit] -> [Unit]
forall a. Ord a => [a] -> [a]
External instance of the constraint type Ord Unit
ordNub ([Unit] -> [Unit]) -> [Unit] -> [Unit]
forall a b. (a -> b) -> a -> b
$ (Unit -> Bool) -> [Unit] -> [Unit]
forall a. (a -> Bool) -> [a] -> [a]
filter (Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Unit
/= DynFlags -> Unit
thisPackage DynFlags
dflags)
([Unit] -> [Unit]) -> [Unit] -> [Unit]
forall a b. (a -> b) -> a -> b
$ ([Unit]
basicLinkedPackages [Unit] -> [Unit] -> [Unit]
forall a. [a] -> [a] -> [a]
++ [Unit]
preload2)
[UnitId]
dep_preload <- DynFlags -> UnitInfoMap -> [(UnitId, Maybe UnitId)] -> IO [UnitId]
closeDeps DynFlags
dflags UnitInfoMap
pkg_db ([UnitId] -> [Maybe UnitId] -> [(UnitId, Maybe UnitId)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Unit -> UnitId) -> [Unit] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map Unit -> UnitId
toUnitId [Unit]
preload3) (Maybe UnitId -> [Maybe UnitId]
forall a. a -> [a]
repeat Maybe UnitId
forall a. Maybe a
Nothing))
let new_dep_preload :: [UnitId]
new_dep_preload = (UnitId -> Bool) -> [UnitId] -> [UnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UnitId -> [UnitId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq UnitId
External instance of the constraint type Foldable []
`notElem` [UnitId]
preload0) [UnitId]
dep_preload
let mod_map1 :: ModuleNameProvidersMap
mod_map1 = DynFlags -> UnitInfoMap -> VisibilityMap -> ModuleNameProvidersMap
mkModuleNameProvidersMap DynFlags
dflags UnitInfoMap
pkg_db VisibilityMap
vis_map
mod_map2 :: ModuleNameProvidersMap
mod_map2 = UnusablePackages -> ModuleNameProvidersMap
mkUnusableModuleNameProvidersMap UnusablePackages
unusable
mod_map :: ModuleNameProvidersMap
mod_map = ModuleNameProvidersMap
-> ModuleNameProvidersMap -> ModuleNameProvidersMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord ModuleName
Map.union ModuleNameProvidersMap
mod_map1 ModuleNameProvidersMap
mod_map2
DynFlags -> DumpFlag -> [Char] -> DumpFormat -> MsgDoc -> IO ()
dumpIfSet_dyn (DynFlags
dflags { pprCols :: Int
pprCols = Int
200 }) DumpFlag
Opt_D_dump_mod_map [Char]
"Mod Map"
DumpFormat
FormatText
(ModuleNameProvidersMap -> MsgDoc
pprModuleMap ModuleNameProvidersMap
mod_map)
let !pstate :: PackageState
pstate = PackageState :: UnitInfoMap
-> Map PackageName (Indefinite UnitId)
-> Map (Definite UnitId) (Definite UnitId)
-> [UnitId]
-> [Unit]
-> ModuleNameProvidersMap
-> ModuleNameProvidersMap
-> Map ModuleName [InstantiatedModule]
-> PackageState
PackageState{
preloadPackages :: [UnitId]
preloadPackages = [UnitId]
dep_preload,
explicitPackages :: [Unit]
explicitPackages = [Unit]
explicit_pkgs,
unitInfoMap :: UnitInfoMap
unitInfoMap = UnitInfoMap
pkg_db,
moduleNameProvidersMap :: ModuleNameProvidersMap
moduleNameProvidersMap = ModuleNameProvidersMap
mod_map,
pluginModuleNameProvidersMap :: ModuleNameProvidersMap
pluginModuleNameProvidersMap = DynFlags -> UnitInfoMap -> VisibilityMap -> ModuleNameProvidersMap
mkModuleNameProvidersMap DynFlags
dflags UnitInfoMap
pkg_db VisibilityMap
plugin_vis_map,
packageNameMap :: Map PackageName (Indefinite UnitId)
packageNameMap = Map PackageName (Indefinite UnitId)
pkgname_map,
unwireMap :: Map (Definite UnitId) (Definite UnitId)
unwireMap = [(Definite UnitId, Definite UnitId)]
-> Map (Definite UnitId) (Definite UnitId)
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type forall unit. Ord unit => Ord (Definite unit)
External instance of the constraint type Ord UnitId
Map.fromList [ (Definite UnitId
v,Definite UnitId
k) | (Definite UnitId
k,Definite UnitId
v) <- Map (Definite UnitId) (Definite UnitId)
-> [(Definite UnitId, Definite UnitId)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Definite UnitId) (Definite UnitId)
wired_map ],
requirementContext :: Map ModuleName [InstantiatedModule]
requirementContext = Map ModuleName [InstantiatedModule]
req_ctx
}
let new_insts :: Maybe [(ModuleName, Module)]
new_insts = ([(ModuleName, Module)] -> [(ModuleName, Module)])
-> Maybe [(ModuleName, Module)] -> Maybe [(ModuleName, Module)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap (((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map ((Module -> Module) -> (ModuleName, Module) -> (ModuleName, Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall a. Functor ((,) a)
fmap (Map (Definite UnitId) (Definite UnitId) -> Module -> Module
upd_wired_in_mod Map (Definite UnitId) (Definite UnitId)
wired_map))) (DynFlags -> Maybe [(ModuleName, Module)]
thisUnitIdInsts_ DynFlags
dflags)
(PackageState, [UnitId], Maybe [(ModuleName, Module)])
-> IO (PackageState, [UnitId], Maybe [(ModuleName, Module)])
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (PackageState
pstate, [UnitId]
new_dep_preload, Maybe [(ModuleName, Module)]
new_insts)
unwireUnit :: DynFlags -> Unit-> Unit
unwireUnit :: DynFlags -> Unit -> Unit
unwireUnit DynFlags
dflags uid :: Unit
uid@(RealUnit Definite UnitId
def_uid) =
Unit
-> (Definite UnitId -> Unit) -> Maybe (Definite UnitId) -> Unit
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Unit
uid Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (Definite UnitId
-> Map (Definite UnitId) (Definite UnitId)
-> Maybe (Definite UnitId)
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall unit. Ord unit => Ord (Definite unit)
External instance of the constraint type Ord UnitId
Map.lookup Definite UnitId
def_uid (PackageState -> Map (Definite UnitId) (Definite UnitId)
unwireMap (DynFlags -> PackageState
pkgState DynFlags
dflags)))
unwireUnit DynFlags
_ Unit
uid = Unit
uid
mkModuleNameProvidersMap
:: DynFlags
-> UnitInfoMap
-> VisibilityMap
-> ModuleNameProvidersMap
mkModuleNameProvidersMap :: DynFlags -> UnitInfoMap -> VisibilityMap -> ModuleNameProvidersMap
mkModuleNameProvidersMap DynFlags
dflags UnitInfoMap
pkg_db VisibilityMap
vis_map =
(ModuleNameProvidersMap
-> Unit -> UnitVisibility -> ModuleNameProvidersMap)
-> ModuleNameProvidersMap
-> VisibilityMap
-> ModuleNameProvidersMap
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey ModuleNameProvidersMap
-> Unit -> UnitVisibility -> ModuleNameProvidersMap
extend_modmap ModuleNameProvidersMap
forall k a. Map k a
emptyMap VisibilityMap
vis_map_extended
where
vis_map_extended :: VisibilityMap
vis_map_extended = VisibilityMap -> VisibilityMap -> VisibilityMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
External instance of the constraint type Ord Unit
Map.union VisibilityMap
vis_map VisibilityMap
default_vis
default_vis :: VisibilityMap
default_vis = [(Unit, UnitVisibility)] -> VisibilityMap
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type Ord Unit
Map.fromList
[ (UnitInfo -> Unit
mkUnit UnitInfo
pkg, UnitVisibility
forall a. Monoid a => a
Instance of class: Monoid of the constraint type Monoid UnitVisibility
mempty)
| UnitInfo
pkg <- UniqDFM UnitInfo -> [UnitInfo]
forall elt. UniqDFM elt -> [elt]
eltsUDFM (UnitInfoMap -> UniqDFM UnitInfo
unUnitInfoMap UnitInfoMap
pkg_db)
, UnitInfo -> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsIndefinite UnitInfo
pkg Bool -> Bool -> Bool
|| [(ModuleName, Module)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null (UnitInfo -> [(ModuleName, Module)]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations UnitInfo
pkg)
]
emptyMap :: Map k a
emptyMap = Map k a
forall k a. Map k a
Map.empty
setOrigins :: f b -> b -> f b
setOrigins f b
m b
os = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
fmap (b -> b -> b
forall a b. a -> b -> a
const b
os) f b
m
extend_modmap :: ModuleNameProvidersMap
-> Unit -> UnitVisibility -> ModuleNameProvidersMap
extend_modmap ModuleNameProvidersMap
modmap Unit
uid
UnitVisibility { uv_expose_all :: UnitVisibility -> Bool
uv_expose_all = Bool
b, uv_renamings :: UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings = [(ModuleName, ModuleName)]
rns }
= ModuleNameProvidersMap
-> [(ModuleName, Map Module ModuleOrigin)]
-> ModuleNameProvidersMap
forall a k1 k2.
(Monoid a, Ord k1, Ord k2) =>
Map k1 (Map k2 a) -> [(k1, Map k2 a)] -> Map k1 (Map k2 a)
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type Ord Unit
External instance of the constraint type Ord ModuleName
Instance of class: Monoid of the constraint type Monoid ModuleOrigin
addListTo ModuleNameProvidersMap
modmap [(ModuleName, Map Module ModuleOrigin)]
theBindings
where
pkg :: UnitInfo
pkg = Unit -> UnitInfo
unit_lookup Unit
uid
theBindings :: [(ModuleName, Map Module ModuleOrigin)]
theBindings :: [(ModuleName, Map Module ModuleOrigin)]
theBindings = Bool
-> [(ModuleName, ModuleName)]
-> [(ModuleName, Map Module ModuleOrigin)]
newBindings Bool
b [(ModuleName, ModuleName)]
rns
newBindings :: Bool
-> [(ModuleName, ModuleName)]
-> [(ModuleName, Map Module ModuleOrigin)]
newBindings :: Bool
-> [(ModuleName, ModuleName)]
-> [(ModuleName, Map Module ModuleOrigin)]
newBindings Bool
e [(ModuleName, ModuleName)]
rns = Bool -> [(ModuleName, Map Module ModuleOrigin)]
es Bool
e [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ [(ModuleName, Map Module ModuleOrigin)]
hiddens [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ ((ModuleName, ModuleName) -> (ModuleName, Map Module ModuleOrigin))
-> [(ModuleName, ModuleName)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, ModuleName) -> (ModuleName, Map Module ModuleOrigin)
rnBinding [(ModuleName, ModuleName)]
rns
rnBinding :: (ModuleName, ModuleName)
-> (ModuleName, Map Module ModuleOrigin)
rnBinding :: (ModuleName, ModuleName) -> (ModuleName, Map Module ModuleOrigin)
rnBinding (ModuleName
orig, ModuleName
new) = (ModuleName
new, Map Module ModuleOrigin -> ModuleOrigin -> Map Module ModuleOrigin
forall {f :: * -> *} {b} {b}. Functor f => f b -> b -> f b
External instance of the constraint type forall k. Functor (Map k)
setOrigins Map Module ModuleOrigin
origEntry ModuleOrigin
fromFlag)
where origEntry :: Map Module ModuleOrigin
origEntry = case UniqFM (Map Module ModuleOrigin)
-> ModuleName -> Maybe (Map Module ModuleOrigin)
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable ModuleName
lookupUFM UniqFM (Map Module ModuleOrigin)
esmap ModuleName
orig of
Just Map Module ModuleOrigin
r -> Map Module ModuleOrigin
r
Maybe (Map Module ModuleOrigin)
Nothing -> GhcException -> Map Module ModuleOrigin
forall a. GhcException -> a
throwGhcException ([Char] -> GhcException
CmdLineError (DynFlags -> MsgDoc -> [Char]
showSDoc DynFlags
dflags
([Char] -> MsgDoc
text [Char]
"package flag: could not find module name" MsgDoc -> MsgDoc -> MsgDoc
<+>
ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable ModuleName
ppr ModuleName
orig MsgDoc -> MsgDoc -> MsgDoc
<+> [Char] -> MsgDoc
text [Char]
"in package" MsgDoc -> MsgDoc -> MsgDoc
<+> Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr Unit
pk)))
es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]
es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]
es Bool
e = do
(ModuleName
m, Maybe Module
exposedReexport) <- [(ModuleName, Maybe Module)]
exposed_mods
let (Unit
pk', ModuleName
m', ModuleOrigin
origin') =
case Maybe Module
exposedReexport of
Maybe Module
Nothing -> (Unit
pk, ModuleName
m, Bool -> ModuleOrigin
fromExposedModules Bool
e)
Just (Module Unit
pk' ModuleName
m') ->
let pkg' :: UnitInfo
pkg' = Unit -> UnitInfo
unit_lookup Unit
pk'
in (Unit
pk', ModuleName
m', Bool -> UnitInfo -> ModuleOrigin
fromReexportedModules Bool
e UnitInfo
pkg')
(ModuleName, Map Module ModuleOrigin)
-> [(ModuleName, Map Module ModuleOrigin)]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad []
return (ModuleName
m, Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap Unit
pk' ModuleName
m' ModuleOrigin
origin')
esmap :: UniqFM (Map Module ModuleOrigin)
esmap :: UniqFM (Map Module ModuleOrigin)
esmap = [(ModuleName, Map Module ModuleOrigin)]
-> UniqFM (Map Module ModuleOrigin)
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
External instance of the constraint type Uniquable ModuleName
listToUFM (Bool -> [(ModuleName, Map Module ModuleOrigin)]
es Bool
False)
hiddens :: [(ModuleName, Map Module ModuleOrigin)]
hiddens = [(ModuleName
m, Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap Unit
pk ModuleName
m ModuleOrigin
ModHidden) | ModuleName
m <- [ModuleName]
hidden_mods]
pk :: Unit
pk = UnitInfo -> Unit
mkUnit UnitInfo
pkg
unit_lookup :: Unit -> UnitInfo
unit_lookup Unit
uid = Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
lookupUnit' (DynFlags -> Bool
isIndefinite DynFlags
dflags) UnitInfoMap
pkg_db Unit
uid
Maybe UnitInfo -> UnitInfo -> UnitInfo
forall a. Maybe a -> a -> a
`orElse` [Char] -> MsgDoc -> UnitInfo
forall a. HasCallStack => [Char] -> MsgDoc -> a
pprPanic [Char]
"unit_lookup" (Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr Unit
uid)
exposed_mods :: [(ModuleName, Maybe Module)]
exposed_mods = UnitInfo -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules UnitInfo
pkg
hidden_mods :: [ModuleName]
hidden_mods = UnitInfo -> [ModuleName]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitHiddenModules UnitInfo
pkg
mkUnusableModuleNameProvidersMap :: UnusablePackages -> ModuleNameProvidersMap
mkUnusableModuleNameProvidersMap :: UnusablePackages -> ModuleNameProvidersMap
mkUnusableModuleNameProvidersMap UnusablePackages
unusables =
(ModuleNameProvidersMap
-> (UnitInfo, UnusablePackageReason) -> ModuleNameProvidersMap)
-> ModuleNameProvidersMap
-> UnusablePackages
-> ModuleNameProvidersMap
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' ModuleNameProvidersMap
-> (UnitInfo, UnusablePackageReason) -> ModuleNameProvidersMap
extend_modmap ModuleNameProvidersMap
forall k a. Map k a
Map.empty UnusablePackages
unusables
where
extend_modmap :: ModuleNameProvidersMap
-> (UnitInfo, UnusablePackageReason) -> ModuleNameProvidersMap
extend_modmap ModuleNameProvidersMap
modmap (UnitInfo
pkg, UnusablePackageReason
reason) = ModuleNameProvidersMap
-> [(ModuleName, Map Module ModuleOrigin)]
-> ModuleNameProvidersMap
forall a k1 k2.
(Monoid a, Ord k1, Ord k2) =>
Map k1 (Map k2 a) -> [(k1, Map k2 a)] -> Map k1 (Map k2 a)
External instance of the constraint type forall unit. Ord unit => Ord (GenModule unit)
External instance of the constraint type Ord Unit
External instance of the constraint type Ord ModuleName
Instance of class: Monoid of the constraint type Monoid ModuleOrigin
addListTo ModuleNameProvidersMap
modmap [(ModuleName, Map Module ModuleOrigin)]
bindings
where bindings :: [(ModuleName, Map Module ModuleOrigin)]
bindings :: [(ModuleName, Map Module ModuleOrigin)]
bindings = [(ModuleName, Map Module ModuleOrigin)]
exposed [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ [(ModuleName, Map Module ModuleOrigin)]
hidden
origin :: ModuleOrigin
origin = UnusablePackageReason -> ModuleOrigin
ModUnusable UnusablePackageReason
reason
pkg_id :: Unit
pkg_id = UnitInfo -> Unit
mkUnit UnitInfo
pkg
exposed :: [(ModuleName, Map Module ModuleOrigin)]
exposed = ((ModuleName, Maybe Module)
-> (ModuleName, Map Module ModuleOrigin))
-> [(ModuleName, Maybe Module)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Maybe Module) -> (ModuleName, Map Module ModuleOrigin)
get_exposed [(ModuleName, Maybe Module)]
exposed_mods
hidden :: [(ModuleName, Map Module ModuleOrigin)]
hidden = [(ModuleName
m, Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap Unit
pkg_id ModuleName
m ModuleOrigin
origin) | ModuleName
m <- [ModuleName]
hidden_mods]
get_exposed :: (ModuleName, Maybe Module) -> (ModuleName, Map Module ModuleOrigin)
get_exposed (ModuleName
mod, Just Module
mod') = (ModuleName
mod, Module -> ModuleOrigin -> Map Module ModuleOrigin
forall k a. k -> a -> Map k a
Map.singleton Module
mod' ModuleOrigin
origin)
get_exposed (ModuleName
mod, Maybe Module
_) = (ModuleName
mod, Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap Unit
pkg_id ModuleName
mod ModuleOrigin
origin)
exposed_mods :: [(ModuleName, Maybe Module)]
exposed_mods = UnitInfo -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules UnitInfo
pkg
hidden_mods :: [ModuleName]
hidden_mods = UnitInfo -> [ModuleName]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitHiddenModules UnitInfo
pkg
addListTo :: (Monoid a, Ord k1, Ord k2)
=> Map k1 (Map k2 a)
-> [(k1, Map k2 a)]
-> Map k1 (Map k2 a)
addListTo :: Map k1 (Map k2 a) -> [(k1, Map k2 a)] -> Map k1 (Map k2 a)
addListTo = (Map k1 (Map k2 a) -> (k1, Map k2 a) -> Map k1 (Map k2 a))
-> Map k1 (Map k2 a) -> [(k1, Map k2 a)] -> Map k1 (Map k2 a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' Map k1 (Map k2 a) -> (k1, Map k2 a) -> Map k1 (Map k2 a)
forall {k} {k} {a}.
(Ord k, Ord k, Monoid a) =>
Map k (Map k a) -> (k, Map k a) -> Map k (Map k a)
Evidence bound by a type signature of the constraint type Monoid a
Evidence bound by a type signature of the constraint type Ord k2
Evidence bound by a type signature of the constraint type Ord k1
merge
where merge :: Map k (Map k a) -> (k, Map k a) -> Map k (Map k a)
merge Map k (Map k a)
m (k
k, Map k a
v) = (Map k a -> Map k a -> Map k a)
-> k -> Map k a -> Map k (Map k a) -> Map k (Map k a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Evidence bound by a type signature of the constraint type Ord k
MapStrict.insertWith ((a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Evidence bound by a type signature of the constraint type Ord k
Map.unionWith a -> a -> a
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid a
mappend) k
k Map k a
v Map k (Map k a)
m
mkModMap :: Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap :: Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap Unit
pkg ModuleName
mod = Module -> ModuleOrigin -> Map Module ModuleOrigin
forall k a. k -> a -> Map k a
Map.singleton (Unit -> ModuleName -> Module
forall unit. unit -> ModuleName -> GenModule unit
mkModule Unit
pkg ModuleName
mod)
getPackageIncludePath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageIncludePath :: DynFlags -> [UnitId] -> IO [[Char]]
getPackageIncludePath DynFlags
dflags [UnitId]
pkgs =
[UnitInfo] -> [[Char]]
collectIncludeDirs ([UnitInfo] -> [[Char]]) -> IO [UnitInfo] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
`fmap` DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
collectIncludeDirs :: [UnitInfo] -> [FilePath]
collectIncludeDirs :: [UnitInfo] -> [[Char]]
collectIncludeDirs [UnitInfo]
ps = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
ordNub (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
forall a. [a] -> Bool
notNull ((UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitIncludeDirs [UnitInfo]
ps))
getPackageLibraryPath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageLibraryPath :: DynFlags -> [UnitId] -> IO [[Char]]
getPackageLibraryPath DynFlags
dflags [UnitId]
pkgs =
DynFlags -> [UnitInfo] -> [[Char]]
collectLibraryPaths DynFlags
dflags ([UnitInfo] -> [[Char]]) -> IO [UnitInfo] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
`fmap` DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
collectLibraryPaths :: DynFlags -> [UnitInfo] -> [FilePath]
collectLibraryPaths :: DynFlags -> [UnitInfo] -> [[Char]]
collectLibraryPaths DynFlags
dflags = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
ordNub ([[Char]] -> [[Char]])
-> ([UnitInfo] -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
forall a. [a] -> Bool
notNull
([[Char]] -> [[Char]])
-> ([UnitInfo] -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap (DynFlags -> UnitInfo -> [[Char]]
libraryDirsForWay DynFlags
dflags)
getPackageLinkOpts :: DynFlags -> [PreloadUnitId] -> IO ([String], [String], [String])
getPackageLinkOpts :: DynFlags -> [UnitId] -> IO ([[Char]], [[Char]], [[Char]])
getPackageLinkOpts DynFlags
dflags [UnitId]
pkgs =
DynFlags -> [UnitInfo] -> ([[Char]], [[Char]], [[Char]])
collectLinkOpts DynFlags
dflags ([UnitInfo] -> ([[Char]], [[Char]], [[Char]]))
-> IO [UnitInfo] -> IO ([[Char]], [[Char]], [[Char]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
`fmap` DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String])
collectLinkOpts :: DynFlags -> [UnitInfo] -> ([[Char]], [[Char]], [[Char]])
collectLinkOpts DynFlags
dflags [UnitInfo]
ps =
(
(UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-l" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> UnitInfo -> [[Char]]
packageHsLibs DynFlags
dflags) [UnitInfo]
ps,
(UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"-l" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitExtDepLibsSys) [UnitInfo]
ps,
(UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitLinkerOptions [UnitInfo]
ps
)
collectArchives :: DynFlags -> UnitInfo -> IO [FilePath]
collectArchives :: DynFlags -> UnitInfo -> IO [[Char]]
collectArchives DynFlags
dflags UnitInfo
pc =
([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
External instance of the constraint type Applicative IO
filterM [Char] -> IO Bool
doesFileExist [ [Char]
searchPath [Char] -> [Char] -> [Char]
</> ([Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".a")
| [Char]
searchPath <- [[Char]]
searchPaths
, [Char]
lib <- [[Char]]
libs ]
where searchPaths :: [[Char]]
searchPaths = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
ordNub ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
forall a. [a] -> Bool
notNull ([[Char]] -> [[Char]])
-> (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> UnitInfo -> [[Char]]
libraryDirsForWay DynFlags
dflags (UnitInfo -> [[Char]]) -> UnitInfo -> [[Char]]
forall a b. (a -> b) -> a -> b
$ UnitInfo
pc
libs :: [[Char]]
libs = DynFlags -> UnitInfo -> [[Char]]
packageHsLibs DynFlags
dflags UnitInfo
pc [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitExtDepLibsSys UnitInfo
pc
getLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)]
getLibs :: DynFlags -> [UnitId] -> IO [([Char], [Char])]
getLibs DynFlags
dflags [UnitId]
pkgs = do
[UnitInfo]
ps <- DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
([[([Char], [Char])]] -> [([Char], [Char])])
-> IO [[([Char], [Char])]] -> IO [([Char], [Char])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap [[([Char], [Char])]] -> [([Char], [Char])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
concat (IO [[([Char], [Char])]] -> IO [([Char], [Char])])
-> ((UnitInfo -> IO [([Char], [Char])]) -> IO [[([Char], [Char])]])
-> (UnitInfo -> IO [([Char], [Char])])
-> IO [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UnitInfo]
-> (UnitInfo -> IO [([Char], [Char])]) -> IO [[([Char], [Char])]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
External instance of the constraint type Monad IO
External instance of the constraint type Traversable []
forM [UnitInfo]
ps ((UnitInfo -> IO [([Char], [Char])]) -> IO [([Char], [Char])])
-> (UnitInfo -> IO [([Char], [Char])]) -> IO [([Char], [Char])]
forall a b. (a -> b) -> a -> b
$ \UnitInfo
p -> do
let candidates :: [([Char], [Char])]
candidates = [ ([Char]
l [Char] -> [Char] -> [Char]
</> [Char]
f, [Char]
f) | [Char]
l <- DynFlags -> [UnitInfo] -> [[Char]]
collectLibraryPaths DynFlags
dflags [UnitInfo
p]
, [Char]
f <- (\[Char]
n -> [Char]
"lib" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".a") ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
<$> DynFlags -> UnitInfo -> [[Char]]
packageHsLibs DynFlags
dflags UnitInfo
p ]
(([Char], [Char]) -> IO Bool)
-> [([Char], [Char])] -> IO [([Char], [Char])]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
External instance of the constraint type Applicative IO
filterM ([Char] -> IO Bool
doesFileExist ([Char] -> IO Bool)
-> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst) [([Char], [Char])]
candidates
packageHsLibs :: DynFlags -> UnitInfo -> [String]
packageHsLibs :: DynFlags -> UnitInfo -> [[Char]]
packageHsLibs DynFlags
dflags UnitInfo
p = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
mkDynName ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
addSuffix) (UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitLibraries UnitInfo
p)
where
ways0 :: Set Way
ways0 = DynFlags -> Set Way
ways DynFlags
dflags
ways1 :: Set Way
ways1 = (Way -> Bool) -> Set Way -> Set Way
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Way
/= Way
WayDyn) Set Way
ways0
ways2 :: Set Way
ways2 | Way
WayDebug Way -> Set Way -> Bool
forall a. Ord a => a -> Set a -> Bool
External instance of the constraint type Ord Way
`Set.member` Set Way
ways1 Bool -> Bool -> Bool
|| Way
WayProf Way -> Set Way -> Bool
forall a. Ord a => a -> Set a -> Bool
External instance of the constraint type Ord Way
`Set.member` Set Way
ways1
= (Way -> Bool) -> Set Way -> Set Way
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Way
/= Way
WayEventLog) Set Way
ways1
| Bool
otherwise
= Set Way
ways1
tag :: [Char]
tag = Set Way -> [Char]
waysTag ((Way -> Bool) -> Set Way -> Set Way
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Way -> Bool) -> Way -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Way -> Bool
wayRTSOnly) Set Way
ways2)
rts_tag :: [Char]
rts_tag = Set Way -> [Char]
waysTag Set Way
ways2
mkDynName :: [Char] -> [Char]
mkDynName [Char]
x
| Way
WayDyn Way -> Set Way -> Bool
forall a. Ord a => a -> Set a -> Bool
External instance of the constraint type Ord Way
`Set.notMember` DynFlags -> Set Way
ways DynFlags
dflags = [Char]
x
| [Char]
"HS" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
External instance of the constraint type Eq Char
`isPrefixOf` [Char]
x =
[Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:DynFlags -> [Char]
programName DynFlags
dflags [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [Char]
projectVersion DynFlags
dflags
| Just [Char]
x' <- [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
External instance of the constraint type Eq Char
stripPrefix [Char]
"C" [Char]
x = [Char]
x'
| Bool
otherwise
= [Char] -> [Char]
forall a. [Char] -> a
panic ([Char]
"Don't understand library name " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x)
addSuffix :: [Char] -> [Char]
addSuffix rts :: [Char]
rts@[Char]
"HSrts" = [Char]
rts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
expandTag [Char]
rts_tag)
addSuffix rts :: [Char]
rts@[Char]
"HSrts-1.0"= [Char]
rts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
expandTag [Char]
rts_tag)
addSuffix [Char]
other_lib = [Char]
other_lib [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]
expandTag [Char]
tag)
expandTag :: [Char] -> [Char]
expandTag [Char]
t | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [Char]
t = [Char]
""
| Bool
otherwise = Char
'_'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
t
libraryDirsForWay :: DynFlags -> UnitInfo -> [String]
libraryDirsForWay :: DynFlags -> UnitInfo -> [[Char]]
libraryDirsForWay DynFlags
dflags
| Way
WayDyn Way -> Set Way -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Way
External instance of the constraint type Foldable Set
`elem` DynFlags -> Set Way
ways DynFlags
dflags = UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitLibraryDynDirs
| Bool
otherwise = UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitLibraryDirs
getPackageExtraCcOpts :: DynFlags -> [PreloadUnitId] -> IO [String]
DynFlags
dflags [UnitId]
pkgs = do
[UnitInfo]
ps <- DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
[[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitCcOptions [UnitInfo]
ps)
getPackageFrameworkPath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageFrameworkPath :: DynFlags -> [UnitId] -> IO [[Char]]
getPackageFrameworkPath DynFlags
dflags [UnitId]
pkgs = do
[UnitInfo]
ps <- DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
[[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ([[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
ordNub (([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
forall a. [a] -> Bool
notNull ((UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitExtDepFrameworkDirs [UnitInfo]
ps)))
getPackageFrameworks :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageFrameworks :: DynFlags -> [UnitId] -> IO [[Char]]
getPackageFrameworks DynFlags
dflags [UnitId]
pkgs = do
[UnitInfo]
ps <- DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgs
[[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((UnitInfo -> [[Char]]) -> [UnitInfo] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap UnitInfo -> [[Char]]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [[Char]]
unitExtDepFrameworks [UnitInfo]
ps)
lookupModuleInAllPackages :: DynFlags
-> ModuleName
-> [(Module, UnitInfo)]
lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(Module, UnitInfo)]
lookupModuleInAllPackages DynFlags
dflags ModuleName
m
= case DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions DynFlags
dflags ModuleName
m Maybe FastString
forall a. Maybe a
Nothing of
LookupFound Module
a UnitInfo
b -> [(Module
a,UnitInfo
b)]
LookupMultiple [(Module, ModuleOrigin)]
rs -> ((Module, ModuleOrigin) -> (Module, UnitInfo))
-> [(Module, ModuleOrigin)] -> [(Module, UnitInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (Module, UnitInfo)
forall {b}. (Module, b) -> (Module, UnitInfo)
f [(Module, ModuleOrigin)]
rs
where f :: (Module, b) -> (Module, UnitInfo)
f (Module
m,b
_) = (Module
m, [Char] -> Maybe UnitInfo -> UnitInfo
forall a. HasCallStack => [Char] -> Maybe a -> a
expectJust [Char]
"lookupModule" (DynFlags -> Unit -> Maybe UnitInfo
lookupUnit DynFlags
dflags
(Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m)))
LookupResult
_ -> []
data LookupResult =
LookupFound Module UnitInfo
| LookupMultiple [(Module, ModuleOrigin)]
| LookupHidden [(Module, ModuleOrigin)] [(Module, ModuleOrigin)]
| LookupUnusable [(Module, ModuleOrigin)]
| LookupNotFound [ModuleSuggestion]
data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin
| SuggestHidden ModuleName Module ModuleOrigin
lookupModuleWithSuggestions :: DynFlags
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions :: DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions DynFlags
dflags
= DynFlags
-> ModuleNameProvidersMap
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' DynFlags
dflags
(PackageState -> ModuleNameProvidersMap
moduleNameProvidersMap (DynFlags -> PackageState
pkgState DynFlags
dflags))
lookupPluginModuleWithSuggestions :: DynFlags
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupPluginModuleWithSuggestions :: DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupPluginModuleWithSuggestions DynFlags
dflags
= DynFlags
-> ModuleNameProvidersMap
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' DynFlags
dflags
(PackageState -> ModuleNameProvidersMap
pluginModuleNameProvidersMap (DynFlags -> PackageState
pkgState DynFlags
dflags))
lookupModuleWithSuggestions' :: DynFlags
-> ModuleNameProvidersMap
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' :: DynFlags
-> ModuleNameProvidersMap
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' DynFlags
dflags ModuleNameProvidersMap
mod_map ModuleName
m Maybe FastString
mb_pn
= case ModuleName
-> ModuleNameProvidersMap -> Maybe (Map Module ModuleOrigin)
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord ModuleName
Map.lookup ModuleName
m ModuleNameProvidersMap
mod_map of
Maybe (Map Module ModuleOrigin)
Nothing -> [ModuleSuggestion] -> LookupResult
LookupNotFound [ModuleSuggestion]
suggestions
Just Map Module ModuleOrigin
xs ->
case (([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> (Module, ModuleOrigin)
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)]))
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> [(Module, ModuleOrigin)]
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> (Module, ModuleOrigin)
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
classify ([],[],[], []) (Map Module ModuleOrigin -> [(Module, ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Module ModuleOrigin
xs) of
([], [], [], []) -> [ModuleSuggestion] -> LookupResult
LookupNotFound [ModuleSuggestion]
suggestions
([(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, [(Module
m, ModuleOrigin
_)]) -> Module -> UnitInfo -> LookupResult
LookupFound Module
m (Module -> UnitInfo
mod_unit Module
m)
([(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, exposed :: [(Module, ModuleOrigin)]
exposed@((Module, ModuleOrigin)
_:[(Module, ModuleOrigin)]
_)) -> [(Module, ModuleOrigin)] -> LookupResult
LookupMultiple [(Module, ModuleOrigin)]
exposed
([], [], unusable :: [(Module, ModuleOrigin)]
unusable@((Module, ModuleOrigin)
_:[(Module, ModuleOrigin)]
_), []) -> [(Module, ModuleOrigin)] -> LookupResult
LookupUnusable [(Module, ModuleOrigin)]
unusable
([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
_, []) ->
[(Module, ModuleOrigin)]
-> [(Module, ModuleOrigin)] -> LookupResult
LookupHidden [(Module, ModuleOrigin)]
hidden_pkg [(Module, ModuleOrigin)]
hidden_mod
where
classify :: ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> (Module, ModuleOrigin)
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
classify ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed) (Module
m, ModuleOrigin
origin0) =
let origin :: ModuleOrigin
origin = Maybe FastString -> UnitInfo -> ModuleOrigin -> ModuleOrigin
filterOrigin Maybe FastString
mb_pn (Module -> UnitInfo
mod_unit Module
m) ModuleOrigin
origin0
x :: (Module, ModuleOrigin)
x = (Module
m, ModuleOrigin
origin)
in case ModuleOrigin
origin of
ModuleOrigin
ModHidden
-> ([(Module, ModuleOrigin)]
hidden_pkg, (Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
ModUnusable UnusablePackageReason
_
-> ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, (Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
ModuleOrigin
_ | ModuleOrigin -> Bool
originEmpty ModuleOrigin
origin
-> ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
| ModuleOrigin -> Bool
originVisible ModuleOrigin
origin
-> ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, (Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
exposed)
| Bool
otherwise
-> ((Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
unit_lookup :: Unit -> UnitInfo
unit_lookup Unit
p = DynFlags -> Unit -> Maybe UnitInfo
lookupUnit DynFlags
dflags Unit
p Maybe UnitInfo -> UnitInfo -> UnitInfo
forall a. Maybe a -> a -> a
`orElse` [Char] -> MsgDoc -> UnitInfo
forall a. HasCallStack => [Char] -> MsgDoc -> a
pprPanic [Char]
"lookupModuleWithSuggestions" (Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr Unit
p MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable ModuleName
ppr ModuleName
m)
mod_unit :: Module -> UnitInfo
mod_unit = Unit -> UnitInfo
unit_lookup (Unit -> UnitInfo) -> (Module -> Unit) -> Module -> UnitInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit
filterOrigin :: Maybe FastString
-> UnitInfo
-> ModuleOrigin
-> ModuleOrigin
filterOrigin :: Maybe FastString -> UnitInfo -> ModuleOrigin -> ModuleOrigin
filterOrigin Maybe FastString
Nothing UnitInfo
_ ModuleOrigin
o = ModuleOrigin
o
filterOrigin (Just FastString
pn) UnitInfo
pkg ModuleOrigin
o =
case ModuleOrigin
o of
ModuleOrigin
ModHidden -> if UnitInfo -> Bool
go UnitInfo
pkg then ModuleOrigin
ModHidden else ModuleOrigin
forall a. Monoid a => a
Instance of class: Monoid of the constraint type Monoid ModuleOrigin
mempty
(ModUnusable UnusablePackageReason
_) -> if UnitInfo -> Bool
go UnitInfo
pkg then ModuleOrigin
o else ModuleOrigin
forall a. Monoid a => a
Instance of class: Monoid of the constraint type Monoid ModuleOrigin
mempty
ModOrigin { fromOrigPackage :: ModuleOrigin -> Maybe Bool
fromOrigPackage = Maybe Bool
e, fromExposedReexport :: ModuleOrigin -> [UnitInfo]
fromExposedReexport = [UnitInfo]
res,
fromHiddenReexport :: ModuleOrigin -> [UnitInfo]
fromHiddenReexport = [UnitInfo]
rhs }
-> ModOrigin :: Maybe Bool -> [UnitInfo] -> [UnitInfo] -> Bool -> ModuleOrigin
ModOrigin {
fromOrigPackage :: Maybe Bool
fromOrigPackage = if UnitInfo -> Bool
go UnitInfo
pkg then Maybe Bool
e else Maybe Bool
forall a. Maybe a
Nothing
, fromExposedReexport :: [UnitInfo]
fromExposedReexport = (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter UnitInfo -> Bool
go [UnitInfo]
res
, fromHiddenReexport :: [UnitInfo]
fromHiddenReexport = (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter UnitInfo -> Bool
go [UnitInfo]
rhs
, fromPackageFlag :: Bool
fromPackageFlag = Bool
False
}
where go :: UnitInfo -> Bool
go UnitInfo
pkg = FastString
pn FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq FastString
== UnitInfo -> FastString
fsPackageName UnitInfo
pkg
suggestions :: [ModuleSuggestion]
suggestions
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HelpfulErrors DynFlags
dflags =
[Char] -> [([Char], ModuleSuggestion)] -> [ModuleSuggestion]
forall a. [Char] -> [([Char], a)] -> [a]
fuzzyLookup (ModuleName -> [Char]
moduleNameString ModuleName
m) [([Char], ModuleSuggestion)]
all_mods
| Bool
otherwise = []
all_mods :: [(String, ModuleSuggestion)]
all_mods :: [([Char], ModuleSuggestion)]
all_mods = (([Char], ModuleSuggestion)
-> ([Char], ModuleSuggestion) -> Ordering)
-> [([Char], ModuleSuggestion)] -> [([Char], ModuleSuggestion)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((([Char], ModuleSuggestion) -> [Char])
-> ([Char], ModuleSuggestion)
-> ([Char], ModuleSuggestion)
-> Ordering
forall a t. Ord a => (t -> a) -> t -> t -> Ordering
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
comparing ([Char], ModuleSuggestion) -> [Char]
forall a b. (a, b) -> a
fst) ([([Char], ModuleSuggestion)] -> [([Char], ModuleSuggestion)])
-> [([Char], ModuleSuggestion)] -> [([Char], ModuleSuggestion)]
forall a b. (a -> b) -> a -> b
$
[ (ModuleName -> [Char]
moduleNameString ModuleName
m, ModuleSuggestion
suggestion)
| (ModuleName
m, Map Module ModuleOrigin
e) <- ModuleNameProvidersMap -> [(ModuleName, Map Module ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageState -> ModuleNameProvidersMap
moduleNameProvidersMap (DynFlags -> PackageState
pkgState DynFlags
dflags))
, ModuleSuggestion
suggestion <- ((Module, ModuleOrigin) -> ModuleSuggestion)
-> [(Module, ModuleOrigin)] -> [ModuleSuggestion]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> (Module, ModuleOrigin) -> ModuleSuggestion
getSuggestion ModuleName
m) (Map Module ModuleOrigin -> [(Module, ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Module ModuleOrigin
e)
]
getSuggestion :: ModuleName -> (Module, ModuleOrigin) -> ModuleSuggestion
getSuggestion ModuleName
name (Module
mod, ModuleOrigin
origin) =
(if ModuleOrigin -> Bool
originVisible ModuleOrigin
origin then ModuleName -> Module -> ModuleOrigin -> ModuleSuggestion
SuggestVisible else ModuleName -> Module -> ModuleOrigin -> ModuleSuggestion
SuggestHidden)
ModuleName
name Module
mod ModuleOrigin
origin
listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames DynFlags
dflags =
((ModuleName, Map Module ModuleOrigin) -> ModuleName)
-> [(ModuleName, Map Module ModuleOrigin)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Map Module ModuleOrigin) -> ModuleName
forall a b. (a, b) -> a
fst (((ModuleName, Map Module ModuleOrigin) -> Bool)
-> [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName, Map Module ModuleOrigin) -> Bool
forall {a} {k}. (a, Map k ModuleOrigin) -> Bool
visible (ModuleNameProvidersMap -> [(ModuleName, Map Module ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageState -> ModuleNameProvidersMap
moduleNameProvidersMap (DynFlags -> PackageState
pkgState DynFlags
dflags))))
where visible :: (a, Map k ModuleOrigin) -> Bool
visible (a
_, Map k ModuleOrigin
ms) = (ModuleOrigin -> Bool) -> [ModuleOrigin] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
External instance of the constraint type Foldable []
any ModuleOrigin -> Bool
originVisible (Map k ModuleOrigin -> [ModuleOrigin]
forall k a. Map k a -> [a]
Map.elems Map k ModuleOrigin
ms)
getPreloadPackagesAnd :: DynFlags -> [PreloadUnitId] -> IO [UnitInfo]
getPreloadPackagesAnd :: DynFlags -> [UnitId] -> IO [UnitInfo]
getPreloadPackagesAnd DynFlags
dflags [UnitId]
pkgids0 =
let
pkgids :: [UnitId]
pkgids = [UnitId]
pkgids0 [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++
if DynFlags -> Bool
isIndefinite DynFlags
dflags
then []
else ((ModuleName, Module) -> UnitId)
-> [(ModuleName, Module)] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (Unit -> UnitId
toUnitId (Unit -> UnitId)
-> ((ModuleName, Module) -> Unit) -> (ModuleName, Module) -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit (Module -> Unit)
-> ((ModuleName, Module) -> Module) -> (ModuleName, Module) -> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, Module) -> Module
forall a b. (a, b) -> b
snd)
(DynFlags -> [(ModuleName, Module)]
thisUnitIdInsts DynFlags
dflags)
state :: PackageState
state = DynFlags -> PackageState
pkgState DynFlags
dflags
pkg_map :: UnitInfoMap
pkg_map = PackageState -> UnitInfoMap
unitInfoMap PackageState
state
preload :: [UnitId]
preload = PackageState -> [UnitId]
preloadPackages PackageState
state
pairs :: [(UnitId, Maybe a)]
pairs = [UnitId] -> [Maybe a] -> [(UnitId, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UnitId]
pkgids (Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing)
in do
[UnitId]
all_pkgs <- DynFlags -> MaybeErr MsgDoc [UnitId] -> IO [UnitId]
forall a. DynFlags -> MaybeErr MsgDoc a -> IO a
throwErr DynFlags
dflags (([UnitId] -> (UnitId, Maybe UnitId) -> MaybeErr MsgDoc [UnitId])
-> [UnitId] -> [(UnitId, Maybe UnitId)] -> MaybeErr MsgDoc [UnitId]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type forall err. Monad (MaybeErr err)
External instance of the constraint type Foldable []
foldM (DynFlags
-> UnitInfoMap
-> [UnitId]
-> (UnitId, Maybe UnitId)
-> MaybeErr MsgDoc [UnitId]
add_package DynFlags
dflags UnitInfoMap
pkg_map) [UnitId]
preload [(UnitId, Maybe UnitId)]
forall {a}. [(UnitId, Maybe a)]
pairs)
[UnitInfo] -> IO [UnitInfo]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ((UnitId -> UnitInfo) -> [UnitId] -> [UnitInfo]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => PackageState -> UnitId -> UnitInfo
PackageState -> UnitId -> UnitInfo
External instance of the constraint type HasDebugCallStack
getInstalledPackageDetails PackageState
state) [UnitId]
all_pkgs)
closeDeps :: DynFlags
-> UnitInfoMap
-> [(UnitId, Maybe UnitId)]
-> IO [UnitId]
closeDeps :: DynFlags -> UnitInfoMap -> [(UnitId, Maybe UnitId)] -> IO [UnitId]
closeDeps DynFlags
dflags UnitInfoMap
pkg_map [(UnitId, Maybe UnitId)]
ps
= DynFlags -> MaybeErr MsgDoc [UnitId] -> IO [UnitId]
forall a. DynFlags -> MaybeErr MsgDoc a -> IO a
throwErr DynFlags
dflags (DynFlags
-> UnitInfoMap
-> [(UnitId, Maybe UnitId)]
-> MaybeErr MsgDoc [UnitId]
closeDepsErr DynFlags
dflags UnitInfoMap
pkg_map [(UnitId, Maybe UnitId)]
ps)
throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
throwErr DynFlags
dflags MaybeErr MsgDoc a
m
= case MaybeErr MsgDoc a
m of
Failed MsgDoc
e -> GhcException -> IO a
forall a. GhcException -> IO a
throwGhcExceptionIO ([Char] -> GhcException
CmdLineError (DynFlags -> MsgDoc -> [Char]
showSDoc DynFlags
dflags MsgDoc
e))
Succeeded a
r -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return a
r
closeDepsErr :: DynFlags
-> UnitInfoMap
-> [(UnitId,Maybe UnitId)]
-> MaybeErr MsgDoc [UnitId]
closeDepsErr :: DynFlags
-> UnitInfoMap
-> [(UnitId, Maybe UnitId)]
-> MaybeErr MsgDoc [UnitId]
closeDepsErr DynFlags
dflags UnitInfoMap
pkg_map [(UnitId, Maybe UnitId)]
ps = ([UnitId] -> (UnitId, Maybe UnitId) -> MaybeErr MsgDoc [UnitId])
-> [UnitId] -> [(UnitId, Maybe UnitId)] -> MaybeErr MsgDoc [UnitId]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type forall err. Monad (MaybeErr err)
External instance of the constraint type Foldable []
foldM (DynFlags
-> UnitInfoMap
-> [UnitId]
-> (UnitId, Maybe UnitId)
-> MaybeErr MsgDoc [UnitId]
add_package DynFlags
dflags UnitInfoMap
pkg_map) [] [(UnitId, Maybe UnitId)]
ps
add_package :: DynFlags
-> UnitInfoMap
-> [PreloadUnitId]
-> (PreloadUnitId,Maybe PreloadUnitId)
-> MaybeErr MsgDoc [PreloadUnitId]
add_package :: DynFlags
-> UnitInfoMap
-> [UnitId]
-> (UnitId, Maybe UnitId)
-> MaybeErr MsgDoc [UnitId]
add_package DynFlags
dflags UnitInfoMap
pkg_db [UnitId]
ps (UnitId
p, Maybe UnitId
mb_parent)
| UnitId
p UnitId -> [UnitId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq UnitId
External instance of the constraint type Foldable []
`elem` [UnitId]
ps = [UnitId] -> MaybeErr MsgDoc [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall err. Monad (MaybeErr err)
return [UnitId]
ps
| Bool
otherwise =
case UnitInfoMap -> UnitId -> Maybe UnitInfo
lookupInstalledPackage' UnitInfoMap
pkg_db UnitId
p of
Maybe UnitInfo
Nothing -> MsgDoc -> MaybeErr MsgDoc [UnitId]
forall err val. err -> MaybeErr err val
Failed (UnitId -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable UnitId
missingPackageMsg UnitId
p MsgDoc -> MsgDoc -> MsgDoc
<>
Maybe UnitId -> MsgDoc
missingDependencyMsg Maybe UnitId
mb_parent)
Just UnitInfo
pkg -> do
[UnitId]
ps' <- ([UnitId] -> UnitId -> MaybeErr MsgDoc [UnitId])
-> [UnitId] -> [UnitId] -> MaybeErr MsgDoc [UnitId]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
External instance of the constraint type forall err. Monad (MaybeErr err)
External instance of the constraint type Foldable []
foldM [UnitId] -> UnitId -> MaybeErr MsgDoc [UnitId]
add_unit_key [UnitId]
ps (UnitInfo -> [UnitId]
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> [uid]
unitDepends UnitInfo
pkg)
[UnitId] -> MaybeErr MsgDoc [UnitId]
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall err. Monad (MaybeErr err)
return (UnitId
p UnitId -> [UnitId] -> [UnitId]
forall a. a -> [a] -> [a]
: [UnitId]
ps')
where
add_unit_key :: [UnitId] -> UnitId -> MaybeErr MsgDoc [UnitId]
add_unit_key [UnitId]
ps UnitId
key
= DynFlags
-> UnitInfoMap
-> [UnitId]
-> (UnitId, Maybe UnitId)
-> MaybeErr MsgDoc [UnitId]
add_package DynFlags
dflags UnitInfoMap
pkg_db [UnitId]
ps (UnitId
key, UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just UnitId
p)
missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
missingPackageMsg :: pkgid -> MsgDoc
missingPackageMsg pkgid
p = [Char] -> MsgDoc
text [Char]
"unknown package:" MsgDoc -> MsgDoc -> MsgDoc
<+> pkgid -> MsgDoc
forall a. Outputable a => a -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable pkgid
ppr pkgid
p
missingDependencyMsg :: Maybe UnitId -> SDoc
missingDependencyMsg :: Maybe UnitId -> MsgDoc
missingDependencyMsg Maybe UnitId
Nothing = MsgDoc
Outputable.empty
missingDependencyMsg (Just UnitId
parent)
= MsgDoc
space MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc -> MsgDoc
parens ([Char] -> MsgDoc
text [Char]
"dependency of" MsgDoc -> MsgDoc -> MsgDoc
<+> FastString -> MsgDoc
ftext (UnitId -> FastString
unitIdFS UnitId
parent))
mkIndefUnitId :: PackageState -> FastString -> IndefUnitId
mkIndefUnitId :: PackageState -> FastString -> Indefinite UnitId
mkIndefUnitId PackageState
pkgstate FastString
raw =
let uid :: UnitId
uid = FastString -> UnitId
UnitId FastString
raw
in case PackageState -> UnitId -> Maybe UnitInfo
lookupInstalledPackage PackageState
pkgstate UnitId
uid of
Maybe UnitInfo
Nothing -> UnitId -> Maybe UnitPprInfo -> Indefinite UnitId
forall unit. unit -> Maybe UnitPprInfo -> Indefinite unit
Indefinite UnitId
uid Maybe UnitPprInfo
forall a. Maybe a
Nothing
Just UnitInfo
c -> UnitId -> Maybe UnitPprInfo -> Indefinite UnitId
forall unit. unit -> Maybe UnitPprInfo -> Indefinite unit
Indefinite UnitId
uid (Maybe UnitPprInfo -> Indefinite UnitId)
-> Maybe UnitPprInfo -> Indefinite UnitId
forall a b. (a -> b) -> a -> b
$ UnitPprInfo -> Maybe UnitPprInfo
forall a. a -> Maybe a
Just (UnitPprInfo -> Maybe UnitPprInfo)
-> UnitPprInfo -> Maybe UnitPprInfo
forall a b. (a -> b) -> a -> b
$ UnitInfo -> UnitPprInfo
forall u. GenUnitInfo u -> UnitPprInfo
mkUnitPprInfo UnitInfo
c
updateIndefUnitId :: PackageState -> IndefUnitId -> IndefUnitId
updateIndefUnitId :: PackageState -> Indefinite UnitId -> Indefinite UnitId
updateIndefUnitId PackageState
pkgstate Indefinite UnitId
uid = PackageState -> FastString -> Indefinite UnitId
mkIndefUnitId PackageState
pkgstate (UnitId -> FastString
unitIdFS (Indefinite UnitId -> UnitId
forall unit. Indefinite unit -> unit
indefUnit Indefinite UnitId
uid))
displayUnitId :: PackageState -> UnitId -> Maybe String
displayUnitId :: PackageState -> UnitId -> Maybe [Char]
displayUnitId PackageState
pkgstate UnitId
uid =
(UnitInfo -> [Char]) -> Maybe UnitInfo -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap UnitInfo -> [Char]
forall u. GenUnitInfo u -> [Char]
unitPackageIdString (PackageState -> UnitId -> Maybe UnitInfo
lookupInstalledPackage PackageState
pkgstate UnitId
uid)
pprPackages :: PackageState -> SDoc
pprPackages :: PackageState -> MsgDoc
pprPackages = (UnitInfo -> MsgDoc) -> PackageState -> MsgDoc
pprPackagesWith UnitInfo -> MsgDoc
pprUnitInfo
pprPackagesWith :: (UnitInfo -> SDoc) -> PackageState -> SDoc
pprPackagesWith :: (UnitInfo -> MsgDoc) -> PackageState -> MsgDoc
pprPackagesWith UnitInfo -> MsgDoc
pprIPI PackageState
pkgstate =
[MsgDoc] -> MsgDoc
vcat (MsgDoc -> [MsgDoc] -> [MsgDoc]
forall a. a -> [a] -> [a]
intersperse ([Char] -> MsgDoc
text [Char]
"---") ((UnitInfo -> MsgDoc) -> [UnitInfo] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map UnitInfo -> MsgDoc
pprIPI (PackageState -> [UnitInfo]
listUnitInfoMap PackageState
pkgstate)))
pprPackagesSimple :: PackageState -> SDoc
pprPackagesSimple :: PackageState -> MsgDoc
pprPackagesSimple = (UnitInfo -> MsgDoc) -> PackageState -> MsgDoc
pprPackagesWith UnitInfo -> MsgDoc
forall {compid} {srcpkgid} {srcpkgname} {modulename} {mod}.
GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> MsgDoc
pprIPI
where pprIPI :: GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> MsgDoc
pprIPI GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
ipi = let i :: FastString
i = UnitId -> FastString
unitIdFS (GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
ipi)
e :: MsgDoc
e = if GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsExposed GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
ipi then [Char] -> MsgDoc
text [Char]
"E" else [Char] -> MsgDoc
text [Char]
" "
t :: MsgDoc
t = if GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
-> Bool
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> Bool
unitIsTrusted GenericUnitInfo compid srcpkgid srcpkgname UnitId modulename mod
ipi then [Char] -> MsgDoc
text [Char]
"T" else [Char] -> MsgDoc
text [Char]
" "
in MsgDoc
e MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
t MsgDoc -> MsgDoc -> MsgDoc
<> [Char] -> MsgDoc
text [Char]
" " MsgDoc -> MsgDoc -> MsgDoc
<> FastString -> MsgDoc
ftext FastString
i
pprModuleMap :: ModuleNameProvidersMap -> SDoc
pprModuleMap :: ModuleNameProvidersMap -> MsgDoc
pprModuleMap ModuleNameProvidersMap
mod_map =
[MsgDoc] -> MsgDoc
vcat (((ModuleName, Map Module ModuleOrigin) -> MsgDoc)
-> [(ModuleName, Map Module ModuleOrigin)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Map Module ModuleOrigin) -> MsgDoc
forall {a}. Outputable a => (ModuleName, Map Module a) -> MsgDoc
Instance of class: Outputable of the constraint type Outputable ModuleOrigin
pprLine (ModuleNameProvidersMap -> [(ModuleName, Map Module ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList ModuleNameProvidersMap
mod_map))
where
pprLine :: (ModuleName, Map Module a) -> MsgDoc
pprLine (ModuleName
m,Map Module a
e) = ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable ModuleName
ppr ModuleName
m MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest Int
50 ([MsgDoc] -> MsgDoc
vcat (((Module, a) -> MsgDoc) -> [(Module, a)] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> (Module, a) -> MsgDoc
forall a. Outputable a => ModuleName -> (Module, a) -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable a
pprEntry ModuleName
m) (Map Module a -> [(Module, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Module a
e)))
pprEntry :: Outputable a => ModuleName -> (Module, a) -> SDoc
pprEntry :: ModuleName -> (Module, a) -> MsgDoc
pprEntry ModuleName
m (Module
m',a
o)
| ModuleName
m ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq ModuleName
== Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m' = Unit -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Unit
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m') MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
parens (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr a
o)
| Bool
otherwise = Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
External instance of the constraint type Outputable Module
ppr Module
m' MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
parens (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
Evidence bound by a type signature of the constraint type Outputable a
ppr a
o)
fsPackageName :: UnitInfo -> FastString
fsPackageName :: UnitInfo -> FastString
fsPackageName UnitInfo
info = FastString
fs
where
PackageName FastString
fs = UnitInfo -> PackageName
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName UnitInfo
info
improveUnit :: UnitInfoMap -> Unit -> Unit
improveUnit :: UnitInfoMap -> Unit -> Unit
improveUnit UnitInfoMap
_ uid :: Unit
uid@(RealUnit Definite UnitId
_) = Unit
uid
improveUnit UnitInfoMap
pkg_map Unit
uid =
case Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
lookupUnit' Bool
False UnitInfoMap
pkg_map Unit
uid of
Maybe UnitInfo
Nothing -> Unit
uid
Just UnitInfo
pkg ->
if UnitInfo -> UnitId
forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId UnitInfo
pkg UnitId -> UniqSet UnitId -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
External instance of the constraint type Uniquable UnitId
`elementOfUniqSet` UnitInfoMap -> UniqSet UnitId
preloadClosure UnitInfoMap
pkg_map
then UnitInfo -> Unit
mkUnit UnitInfo
pkg
else Unit
uid