{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns, FlexibleContexts #-}
module Packages (
module PackageConfig,
PackageState(preloadPackages, explicitPackages, moduleToPkgConfAll, requirementContext),
PackageConfigMap,
emptyPackageState,
initPackages,
readPackageConfigs,
getPackageConfRefs,
resolvePackageConfig,
readPackageConfig,
listPackageConfigMap,
lookupPackage,
lookupPackage',
lookupInstalledPackage,
lookupPackageName,
improveUnitId,
searchPackageId,
getPackageDetails,
getInstalledPackageDetails,
componentIdString,
displayInstalledUnitId,
listVisibleModuleNames,
lookupModuleInAllPackages,
lookupModuleWithSuggestions,
lookupPluginModuleWithSuggestions,
LookupResult(..),
ModuleSuggestion(..),
ModuleOrigin(..),
UnusablePackageReason(..),
pprReason,
getPackageIncludePath,
getPackageLibraryPath,
getPackageLinkOpts,
getPackageExtraCcOpts,
getPackageFrameworkPath,
getPackageFrameworks,
getPackageConfigMap,
getPreloadPackagesAnd,
collectArchives,
collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
packageHsLibs, getLibs,
unwireUnitId,
pprFlag,
pprPackages,
pprPackagesSimple,
pprModuleMap,
isIndefinite,
isDllName
)
where
#include "HsVersions.h"
import GhcPrelude
import GHC.PackageDb
import PackageConfig
import DynFlags
import Name ( Name, nameModule_maybe )
import UniqFM
import UniqDFM
import UniqSet
import Module
import Util
import Panic
import Platform
import Outputable
import Maybes
import System.Environment ( getEnv )
import FastString
import ErrUtils ( debugTraceMsg, MsgDoc, dumpIfSet_dyn )
import Exception
import System.Directory
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
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
import Data.Version
data ModuleOrigin =
ModHidden
| ModUnusable UnusablePackageReason
| ModOrigin {
ModuleOrigin -> Maybe Bool
fromOrigPackage :: Maybe Bool
, ModuleOrigin -> [PackageConfig]
fromExposedReexport :: [PackageConfig]
, ModuleOrigin -> [PackageConfig]
fromHiddenReexport :: [PackageConfig]
, ModuleOrigin -> Bool
fromPackageFlag :: Bool
}
instance Outputable ModuleOrigin where
ppr :: ModuleOrigin -> SDoc
ppr ModHidden = String -> SDoc
text "hidden module"
ppr (ModUnusable _) = String -> SDoc
text "unusable module"
ppr (ModOrigin e :: Maybe Bool
e res :: [PackageConfig]
res rhs :: [PackageConfig]
rhs f :: Bool
f) = [SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (
(case Maybe Bool
e of
Nothing -> []
Just False -> [String -> SDoc
text "hidden package"]
Just True -> [String -> SDoc
text "exposed package"]) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
(if [PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
res
then []
else [String -> SDoc
text "reexport by" SDoc -> SDoc -> SDoc
<+>
[SDoc] -> SDoc
sep ((PackageConfig -> SDoc) -> [PackageConfig] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId -> SDoc)
-> (PackageConfig -> UnitId) -> PackageConfig -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> UnitId
packageConfigId) [PackageConfig]
res)]) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
(if [PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
rhs
then []
else [String -> SDoc
text "hidden reexport by" SDoc -> SDoc -> SDoc
<+>
[SDoc] -> SDoc
sep ((PackageConfig -> SDoc) -> [PackageConfig] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (UnitId -> SDoc)
-> (PackageConfig -> UnitId) -> PackageConfig -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> UnitId
packageConfigId) [PackageConfig]
res)]) [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
(if Bool
f then [String -> SDoc
text "package flag"] else [])
))
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules e :: Bool
e = Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
e) [] [] Bool
False
fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin
fromReexportedModules :: Bool -> PackageConfig -> ModuleOrigin
fromReexportedModules True pkg :: PackageConfig
pkg = Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [PackageConfig
pkg] [] Bool
False
fromReexportedModules False pkg :: PackageConfig
pkg = Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [PackageConfig
pkg] Bool
False
fromFlag :: ModuleOrigin
fromFlag :: ModuleOrigin
fromFlag = Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [] [] Bool
True
instance Semigroup ModuleOrigin where
ModOrigin e :: Maybe Bool
e res :: [PackageConfig]
res rhs :: [PackageConfig]
rhs f :: Bool
f <> :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin
<> ModOrigin e' :: Maybe Bool
e' res' :: [PackageConfig]
res' rhs' :: [PackageConfig]
rhs' f' :: Bool
f' =
Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin (Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
g Maybe Bool
e Maybe Bool
e') ([PackageConfig]
res [PackageConfig] -> [PackageConfig] -> [PackageConfig]
forall a. [a] -> [a] -> [a]
++ [PackageConfig]
res') ([PackageConfig]
rhs [PackageConfig] -> [PackageConfig] -> [PackageConfig]
forall a. [a] -> [a] -> [a]
++ [PackageConfig]
rhs') (Bool
f Bool -> Bool -> Bool
|| Bool
f')
where g :: Maybe a -> Maybe a -> Maybe a
g (Just b :: a
b) (Just b' :: a
b')
| a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b' = a -> Maybe a
forall a. a -> Maybe a
Just a
b
| Bool
otherwise = String -> Maybe a
forall a. String -> a
panic "ModOrigin: package both exposed/hidden"
g Nothing x :: Maybe a
x = Maybe a
x
g x :: Maybe a
x Nothing = Maybe a
x
_x :: ModuleOrigin
_x <> _y :: ModuleOrigin
_y = String -> ModuleOrigin
forall a. String -> a
panic "ModOrigin: hidden module redefined"
instance Monoid ModuleOrigin where
mempty :: ModuleOrigin
mempty = Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> 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
(Semigroup.<>)
originVisible :: ModuleOrigin -> Bool
originVisible :: ModuleOrigin -> Bool
originVisible ModHidden = Bool
False
originVisible (ModUnusable _) = Bool
False
originVisible (ModOrigin b :: Maybe Bool
b res :: [PackageConfig]
res _ f :: Bool
f) = Maybe Bool
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
|| Bool -> Bool
not ([PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
res) Bool -> Bool -> Bool
|| Bool
f
originEmpty :: ModuleOrigin -> Bool
originEmpty :: ModuleOrigin -> Bool
originEmpty (ModOrigin Nothing [] [] False) = Bool
True
originEmpty _ = Bool
False
type InstalledUnitIdMap = UniqDFM
data PackageConfigMap = PackageConfigMap {
PackageConfigMap -> InstalledUnitIdMap PackageConfig
unPackageConfigMap :: InstalledUnitIdMap PackageConfig,
PackageConfigMap -> UniqSet InstalledUnitId
preloadClosure :: UniqSet InstalledUnitId
}
type VisibilityMap = Map UnitId 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 IndefModule)
uv_requirements :: Map ModuleName (Set IndefModule)
, UnitVisibility -> Bool
uv_explicit :: Bool
}
instance Outputable UnitVisibility where
ppr :: UnitVisibility -> SDoc
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 mb_pn :: Maybe FastString
mb_pn,
uv_requirements :: UnitVisibility -> Map ModuleName (Set IndefModule)
uv_requirements = Map ModuleName (Set IndefModule)
reqs,
uv_explicit :: UnitVisibility -> Bool
uv_explicit = Bool
explicit
}) = (Bool, [(ModuleName, ModuleName)], Maybe FastString,
Map ModuleName (Set IndefModule), Bool)
-> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool
b, [(ModuleName, ModuleName)]
rns, Maybe FastString
mb_pn, Map ModuleName (Set IndefModule)
reqs, Bool
explicit)
instance Semigroup UnitVisibility where
uv1 :: UnitVisibility
uv1 <> :: UnitVisibility -> UnitVisibility -> UnitVisibility
<> uv2 :: UnitVisibility
uv2
= UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set IndefModule)
-> 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
mappend (UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv1) (UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv2)
, uv_requirements :: Map ModuleName (Set IndefModule)
uv_requirements = (Set IndefModule -> Set IndefModule -> Set IndefModule)
-> Map ModuleName (Set IndefModule)
-> Map ModuleName (Set IndefModule)
-> Map ModuleName (Set IndefModule)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set IndefModule -> Set IndefModule -> Set IndefModule
forall a. Ord a => Set a -> Set a -> Set a
Set.union (UnitVisibility -> Map ModuleName (Set IndefModule)
uv_requirements UnitVisibility
uv1) (UnitVisibility -> Map ModuleName (Set IndefModule)
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 IndefModule)
-> 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 IndefModule)
uv_requirements = Map ModuleName (Set IndefModule)
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
(Semigroup.<>)
type WiredUnitId = DefUnitId
type PreloadUnitId = InstalledUnitId
type ModuleToPkgConfAll =
Map ModuleName (Map Module ModuleOrigin)
data PackageState = PackageState {
PackageState -> PackageConfigMap
pkgIdMap :: PackageConfigMap,
PackageState -> Map PackageName ComponentId
packageNameMap :: Map PackageName ComponentId,
PackageState -> Map WiredUnitId WiredUnitId
unwireMap :: Map WiredUnitId WiredUnitId,
PackageState -> [InstalledUnitId]
preloadPackages :: [PreloadUnitId],
PackageState -> [UnitId]
explicitPackages :: [UnitId],
PackageState -> ModuleToPkgConfAll
moduleToPkgConfAll :: !ModuleToPkgConfAll,
PackageState -> ModuleToPkgConfAll
pluginModuleToPkgConfAll :: !ModuleToPkgConfAll,
PackageState -> Map ModuleName [IndefModule]
requirementContext :: Map ModuleName [IndefModule]
}
emptyPackageState :: PackageState
emptyPackageState :: PackageState
emptyPackageState = $WPackageState :: PackageConfigMap
-> Map PackageName ComponentId
-> Map WiredUnitId WiredUnitId
-> [InstalledUnitId]
-> [UnitId]
-> ModuleToPkgConfAll
-> ModuleToPkgConfAll
-> Map ModuleName [IndefModule]
-> PackageState
PackageState {
pkgIdMap :: PackageConfigMap
pkgIdMap = PackageConfigMap
emptyPackageConfigMap,
packageNameMap :: Map PackageName ComponentId
packageNameMap = Map PackageName ComponentId
forall k a. Map k a
Map.empty,
unwireMap :: Map WiredUnitId WiredUnitId
unwireMap = Map WiredUnitId WiredUnitId
forall k a. Map k a
Map.empty,
preloadPackages :: [InstalledUnitId]
preloadPackages = [],
explicitPackages :: [UnitId]
explicitPackages = [],
moduleToPkgConfAll :: ModuleToPkgConfAll
moduleToPkgConfAll = ModuleToPkgConfAll
forall k a. Map k a
Map.empty,
pluginModuleToPkgConfAll :: ModuleToPkgConfAll
pluginModuleToPkgConfAll = ModuleToPkgConfAll
forall k a. Map k a
Map.empty,
requirementContext :: Map ModuleName [IndefModule]
requirementContext = Map ModuleName [IndefModule]
forall k a. Map k a
Map.empty
}
type InstalledPackageIndex = Map InstalledUnitId PackageConfig
emptyPackageConfigMap :: PackageConfigMap
emptyPackageConfigMap :: PackageConfigMap
emptyPackageConfigMap = InstalledUnitIdMap PackageConfig
-> UniqSet InstalledUnitId -> PackageConfigMap
PackageConfigMap InstalledUnitIdMap PackageConfig
forall elt. UniqDFM elt
emptyUDFM UniqSet InstalledUnitId
forall a. UniqSet a
emptyUniqSet
lookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage dflags :: DynFlags
dflags = Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig
lookupPackage' (DynFlags -> Bool
isIndefinite DynFlags
dflags) (PackageState -> PackageConfigMap
pkgIdMap (DynFlags -> PackageState
pkgState DynFlags
dflags))
lookupPackage' :: Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig
lookupPackage' :: Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig
lookupPackage' False (PackageConfigMap pkg_map :: InstalledUnitIdMap PackageConfig
pkg_map _) uid :: UnitId
uid = InstalledUnitIdMap PackageConfig -> UnitId -> Maybe PackageConfig
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
lookupUDFM InstalledUnitIdMap PackageConfig
pkg_map UnitId
uid
lookupPackage' True m :: PackageConfigMap
m@(PackageConfigMap pkg_map :: InstalledUnitIdMap PackageConfig
pkg_map _) uid :: UnitId
uid =
case UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts UnitId
uid of
(iuid :: InstalledUnitId
iuid, Just indef :: IndefUnitId
indef) ->
(PackageConfig -> PackageConfig)
-> Maybe PackageConfig -> Maybe PackageConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PackageConfigMap
-> [(ModuleName, Module)] -> PackageConfig -> PackageConfig
renamePackage PackageConfigMap
m (IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
indef))
(InstalledUnitIdMap PackageConfig
-> InstalledUnitId -> Maybe PackageConfig
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
lookupUDFM InstalledUnitIdMap PackageConfig
pkg_map InstalledUnitId
iuid)
(_, Nothing) -> InstalledUnitIdMap PackageConfig -> UnitId -> Maybe PackageConfig
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
lookupUDFM InstalledUnitIdMap PackageConfig
pkg_map UnitId
uid
lookupPackageName :: DynFlags -> PackageName -> Maybe ComponentId
lookupPackageName :: DynFlags -> PackageName -> Maybe ComponentId
lookupPackageName dflags :: DynFlags
dflags n :: PackageName
n = PackageName -> Map PackageName ComponentId -> Maybe ComponentId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
n (PackageState -> Map PackageName ComponentId
packageNameMap (DynFlags -> PackageState
pkgState DynFlags
dflags))
searchPackageId :: DynFlags -> SourcePackageId -> [PackageConfig]
searchPackageId :: DynFlags -> SourcePackageId -> [PackageConfig]
searchPackageId dflags :: DynFlags
dflags pid :: SourcePackageId
pid = (PackageConfig -> Bool) -> [PackageConfig] -> [PackageConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SourcePackageId
pid SourcePackageId -> SourcePackageId -> Bool
forall a. Eq a => a -> a -> Bool
==) (SourcePackageId -> Bool)
-> (PackageConfig -> SourcePackageId) -> PackageConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> SourcePackageId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgid
sourcePackageId)
(DynFlags -> [PackageConfig]
listPackageConfigMap DynFlags
dflags)
extendPackageConfigMap
:: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
extendPackageConfigMap :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
extendPackageConfigMap (PackageConfigMap pkg_map :: InstalledUnitIdMap PackageConfig
pkg_map closure :: UniqSet InstalledUnitId
closure) new_pkgs :: [PackageConfig]
new_pkgs
= InstalledUnitIdMap PackageConfig
-> UniqSet InstalledUnitId -> PackageConfigMap
PackageConfigMap ((InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig)
-> InstalledUnitIdMap PackageConfig
-> [PackageConfig]
-> InstalledUnitIdMap PackageConfig
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig
add InstalledUnitIdMap PackageConfig
pkg_map [PackageConfig]
new_pkgs) UniqSet InstalledUnitId
closure
where add :: InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig
add pkg_map :: InstalledUnitIdMap PackageConfig
pkg_map p :: PackageConfig
p = InstalledUnitIdMap PackageConfig
-> InstalledUnitId
-> PackageConfig
-> InstalledUnitIdMap PackageConfig
forall key elt.
Uniquable key =>
UniqDFM elt -> key -> elt -> UniqDFM elt
addToUDFM (InstalledUnitIdMap PackageConfig
-> UnitId -> PackageConfig -> InstalledUnitIdMap PackageConfig
forall key elt.
Uniquable key =>
UniqDFM elt -> key -> elt -> UniqDFM elt
addToUDFM InstalledUnitIdMap PackageConfig
pkg_map (PackageConfig -> UnitId
expandedPackageConfigId PackageConfig
p) PackageConfig
p)
(PackageConfig -> InstalledUnitId
installedPackageConfigId PackageConfig
p) PackageConfig
p
getPackageDetails :: DynFlags -> UnitId -> PackageConfig
getPackageDetails :: DynFlags -> UnitId -> PackageConfig
getPackageDetails dflags :: DynFlags
dflags pid :: UnitId
pid =
String -> Maybe PackageConfig -> PackageConfig
forall a. HasCallStack => String -> Maybe a -> a
expectJust "getPackageDetails" (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags UnitId
pid)
lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage dflags :: DynFlags
dflags uid :: InstalledUnitId
uid = PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage' (PackageState -> PackageConfigMap
pkgIdMap (DynFlags -> PackageState
pkgState DynFlags
dflags)) InstalledUnitId
uid
lookupInstalledPackage' :: PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage' :: PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage' (PackageConfigMap db :: InstalledUnitIdMap PackageConfig
db _) uid :: InstalledUnitId
uid = InstalledUnitIdMap PackageConfig
-> InstalledUnitId -> Maybe PackageConfig
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
lookupUDFM InstalledUnitIdMap PackageConfig
db InstalledUnitId
uid
getInstalledPackageDetails :: DynFlags -> InstalledUnitId -> PackageConfig
getInstalledPackageDetails :: DynFlags -> InstalledUnitId -> PackageConfig
getInstalledPackageDetails dflags :: DynFlags
dflags uid :: InstalledUnitId
uid =
String -> Maybe PackageConfig -> PackageConfig
forall a. HasCallStack => String -> Maybe a -> a
expectJust "getInstalledPackageDetails" (Maybe PackageConfig -> PackageConfig)
-> Maybe PackageConfig -> PackageConfig
forall a b. (a -> b) -> a -> b
$
DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage DynFlags
dflags InstalledUnitId
uid
listPackageConfigMap :: DynFlags -> [PackageConfig]
listPackageConfigMap :: DynFlags -> [PackageConfig]
listPackageConfigMap dflags :: DynFlags
dflags = InstalledUnitIdMap PackageConfig -> [PackageConfig]
forall elt. UniqDFM elt -> [elt]
eltsUDFM InstalledUnitIdMap PackageConfig
pkg_map
where
PackageConfigMap pkg_map :: InstalledUnitIdMap PackageConfig
pkg_map _ = PackageState -> PackageConfigMap
pkgIdMap (DynFlags -> PackageState
pkgState DynFlags
dflags)
initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])
initPackages :: DynFlags -> IO (DynFlags, [InstalledUnitId])
initPackages dflags0 :: DynFlags
dflags0 = do
DynFlags
dflags <- DynFlags -> IO DynFlags
interpretPackageEnv DynFlags
dflags0
[(String, [PackageConfig])]
pkg_db <-
case DynFlags -> Maybe [(String, [PackageConfig])]
pkgDatabase DynFlags
dflags of
Nothing -> DynFlags -> IO [(String, [PackageConfig])]
readPackageConfigs DynFlags
dflags
Just db :: [(String, [PackageConfig])]
db -> [(String, [PackageConfig])] -> IO [(String, [PackageConfig])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, [PackageConfig])] -> IO [(String, [PackageConfig])])
-> [(String, [PackageConfig])] -> IO [(String, [PackageConfig])]
forall a b. (a -> b) -> a -> b
$ ((String, [PackageConfig]) -> (String, [PackageConfig]))
-> [(String, [PackageConfig])] -> [(String, [PackageConfig])]
forall a b. (a -> b) -> [a] -> [b]
map (\(p :: String
p, pkgs :: [PackageConfig]
pkgs)
-> (String
p, DynFlags -> [PackageConfig] -> [PackageConfig]
setBatchPackageFlags DynFlags
dflags [PackageConfig]
pkgs)) [(String, [PackageConfig])]
db
(pkg_state :: PackageState
pkg_state, preload :: [InstalledUnitId]
preload, insts :: Maybe [(ModuleName, Module)]
insts)
<- DynFlags
-> [(String, [PackageConfig])]
-> [InstalledUnitId]
-> IO
(PackageState, [InstalledUnitId], Maybe [(ModuleName, Module)])
mkPackageState DynFlags
dflags [(String, [PackageConfig])]
pkg_db []
(DynFlags, [InstalledUnitId]) -> IO (DynFlags, [InstalledUnitId])
forall (m :: * -> *) a. Monad m => a -> m a
return (DynFlags
dflags{ pkgDatabase :: Maybe [(String, [PackageConfig])]
pkgDatabase = [(String, [PackageConfig])] -> Maybe [(String, [PackageConfig])]
forall a. a -> Maybe a
Just [(String, [PackageConfig])]
pkg_db,
pkgState :: PackageState
pkgState = PackageState
pkg_state,
thisUnitIdInsts_ :: Maybe [(ModuleName, Module)]
thisUnitIdInsts_ = Maybe [(ModuleName, Module)]
insts },
[InstalledUnitId]
preload)
readPackageConfigs :: DynFlags -> IO [(FilePath, [PackageConfig])]
readPackageConfigs :: DynFlags -> IO [(String, [PackageConfig])]
readPackageConfigs dflags :: DynFlags
dflags = do
[PkgConfRef]
conf_refs <- DynFlags -> IO [PkgConfRef]
getPackageConfRefs DynFlags
dflags
[String]
confs <- ([Maybe String] -> [String]) -> IO [Maybe String] -> IO [String]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe String] -> IO [String])
-> IO [Maybe String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (PkgConfRef -> IO (Maybe String))
-> [PkgConfRef] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DynFlags -> PkgConfRef -> IO (Maybe String)
resolvePackageConfig DynFlags
dflags) [PkgConfRef]
conf_refs
(String -> IO (String, [PackageConfig]))
-> [String] -> IO [(String, [PackageConfig])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DynFlags -> String -> IO (String, [PackageConfig])
readPackageConfig DynFlags
dflags) [String]
confs
getPackageConfRefs :: DynFlags -> IO [PkgConfRef]
getPackageConfRefs :: DynFlags -> IO [PkgConfRef]
getPackageConfRefs dflags :: DynFlags
dflags = do
let system_conf_refs :: [PkgConfRef]
system_conf_refs = [PkgConfRef
UserPkgConf, PkgConfRef
GlobalPkgConf]
Either IOException String
e_pkg_path <- IO String -> IO (Either IOException String)
forall a. IO a -> IO (Either IOException a)
tryIO (String -> IO String
getEnv (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (DynFlags -> String
programName DynFlags
dflags) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "_PACKAGE_PATH")
let base_conf_refs :: [PkgConfRef]
base_conf_refs = case Either IOException String
e_pkg_path of
Left _ -> [PkgConfRef]
system_conf_refs
Right path :: String
path
| Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path) Bool -> Bool -> Bool
&& Char -> Bool
isSearchPathSeparator (String -> Char
forall a. [a] -> a
last String
path)
-> (String -> PkgConfRef) -> [String] -> [PkgConfRef]
forall a b. (a -> b) -> [a] -> [b]
map String -> PkgConfRef
PkgConfFile (String -> [String]
splitSearchPath (String -> String
forall a. [a] -> [a]
init String
path)) [PkgConfRef] -> [PkgConfRef] -> [PkgConfRef]
forall a. [a] -> [a] -> [a]
++ [PkgConfRef]
system_conf_refs
| Bool
otherwise
-> (String -> PkgConfRef) -> [String] -> [PkgConfRef]
forall a b. (a -> b) -> [a] -> [b]
map String -> PkgConfRef
PkgConfFile (String -> [String]
splitSearchPath String
path)
[PkgConfRef] -> IO [PkgConfRef]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PkgConfRef] -> IO [PkgConfRef])
-> [PkgConfRef] -> IO [PkgConfRef]
forall a b. (a -> b) -> a -> b
$ [PkgConfRef] -> [PkgConfRef]
forall a. [a] -> [a]
reverse ((PackageDBFlag -> [PkgConfRef] -> [PkgConfRef])
-> [PkgConfRef] -> [PackageDBFlag] -> [PkgConfRef]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PackageDBFlag -> [PkgConfRef] -> [PkgConfRef]
doFlag [PkgConfRef]
base_conf_refs (DynFlags -> [PackageDBFlag]
packageDBFlags DynFlags
dflags))
where
doFlag :: PackageDBFlag -> [PkgConfRef] -> [PkgConfRef]
doFlag (PackageDB p :: PkgConfRef
p) dbs :: [PkgConfRef]
dbs = PkgConfRef
p PkgConfRef -> [PkgConfRef] -> [PkgConfRef]
forall a. a -> [a] -> [a]
: [PkgConfRef]
dbs
doFlag NoUserPackageDB dbs :: [PkgConfRef]
dbs = (PkgConfRef -> Bool) -> [PkgConfRef] -> [PkgConfRef]
forall a. (a -> Bool) -> [a] -> [a]
filter PkgConfRef -> Bool
isNotUser [PkgConfRef]
dbs
doFlag NoGlobalPackageDB dbs :: [PkgConfRef]
dbs = (PkgConfRef -> Bool) -> [PkgConfRef] -> [PkgConfRef]
forall a. (a -> Bool) -> [a] -> [a]
filter PkgConfRef -> Bool
isNotGlobal [PkgConfRef]
dbs
doFlag ClearPackageDBs _ = []
isNotUser :: PkgConfRef -> Bool
isNotUser UserPkgConf = Bool
False
isNotUser _ = Bool
True
isNotGlobal :: PkgConfRef -> Bool
isNotGlobal GlobalPkgConf = Bool
False
isNotGlobal _ = Bool
True
resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)
resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe String)
resolvePackageConfig dflags :: DynFlags
dflags GlobalPkgConf = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (DynFlags -> String
systemPackageConfig DynFlags
dflags)
resolvePackageConfig dflags :: DynFlags
dflags UserPkgConf = MaybeT IO String -> IO (Maybe String)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO String -> IO (Maybe String))
-> MaybeT IO String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
String
dir <- DynFlags -> MaybeT IO String
versionedAppDir DynFlags
dflags
let pkgconf :: String
pkgconf = String
dir String -> String -> String
</> "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
$ String -> IO Bool
doesDirectoryExist String
pkgconf
if Bool
exist then String -> MaybeT IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
pkgconf else MaybeT IO String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
resolvePackageConfig _ (PkgConfFile name :: String
name) = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
name
readPackageConfig :: DynFlags -> FilePath -> IO (FilePath, [PackageConfig])
readPackageConfig :: DynFlags -> String -> IO (String, [PackageConfig])
readPackageConfig dflags :: DynFlags
dflags conf_file :: String
conf_file = do
Bool
isdir <- String -> IO Bool
doesDirectoryExist String
conf_file
[PackageConfig]
proto_pkg_configs <-
if Bool
isdir
then String -> IO [PackageConfig]
forall b c f a d e g.
(BinaryStringRep b, BinaryStringRep c, BinaryStringRep f,
BinaryStringRep a, BinaryStringRep d,
DbUnitIdModuleRep d a e f g) =>
String -> IO [InstalledPackageInfo a b c d e f g]
readDirStylePackageConfig String
conf_file
else do
Bool
isfile <- String -> IO Bool
doesFileExist String
conf_file
if Bool
isfile
then do
Maybe [PackageConfig]
mpkgs <- IO (Maybe [PackageConfig])
tryReadOldFileStylePackageConfig
case Maybe [PackageConfig]
mpkgs of
Just pkgs :: [PackageConfig]
pkgs -> [PackageConfig] -> IO [PackageConfig]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageConfig]
pkgs
Nothing -> GhcException -> IO [PackageConfig]
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO [PackageConfig])
-> GhcException -> IO [PackageConfig]
forall a b. (a -> b) -> a -> b
$ String -> GhcException
InstallationError (String -> GhcException) -> String -> GhcException
forall a b. (a -> b) -> a -> b
$
"ghc no longer supports single-file style package " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"databases (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conf_file String -> String -> String
forall a. [a] -> [a] -> [a]
++
") use 'ghc-pkg init' to create the database with " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"the correct format."
else GhcException -> IO [PackageConfig]
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO [PackageConfig])
-> GhcException -> IO [PackageConfig]
forall a b. (a -> b) -> a -> b
$ String -> GhcException
InstallationError (String -> GhcException) -> String -> GhcException
forall a b. (a -> b) -> a -> b
$
"can't find a package database at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conf_file
let
top_dir :: String
top_dir = DynFlags -> String
topDir DynFlags
dflags
pkgroot :: String
pkgroot = String -> String
takeDirectory String
conf_file
pkg_configs1 :: [PackageConfig]
pkg_configs1 = (PackageConfig -> PackageConfig)
-> [PackageConfig] -> [PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> PackageConfig -> PackageConfig
mungePackageConfig String
top_dir String
pkgroot)
[PackageConfig]
proto_pkg_configs
pkg_configs2 :: [PackageConfig]
pkg_configs2 = DynFlags -> [PackageConfig] -> [PackageConfig]
setBatchPackageFlags DynFlags
dflags [PackageConfig]
pkg_configs1
(String, [PackageConfig]) -> IO (String, [PackageConfig])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
conf_file, [PackageConfig]
pkg_configs2)
where
readDirStylePackageConfig :: String -> IO [InstalledPackageInfo a b c d e f g]
readDirStylePackageConfig conf_dir :: String
conf_dir = do
let filename :: String
filename = String
conf_dir String -> String -> String
</> "package.cache"
Bool
cache_exists <- String -> IO Bool
doesFileExist String
filename
if Bool
cache_exists
then do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "Using binary package database:"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
filename
String -> IO [InstalledPackageInfo a b c d e f g]
forall a b c d e f g.
RepInstalledPackageInfo a b c d e f g =>
String -> IO [InstalledPackageInfo a b c d e f g]
readPackageDbForGhc String
filename
else do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "There is no package.cache in"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
conf_dir
SDoc -> SDoc -> SDoc
<> String -> SDoc
text ", checking if the database is empty"
Bool
db_empty <- (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf ".conf")
([String] -> Bool) -> IO [String] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents String
conf_dir
if Bool
db_empty
then do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "There are no .conf files in"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
conf_dir SDoc -> SDoc -> SDoc
<> String -> SDoc
text ", treating"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "package database as empty"
[InstalledPackageInfo a b c d e f g]
-> IO [InstalledPackageInfo a b c d e f g]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
GhcException -> IO [InstalledPackageInfo a b c d e f g]
forall a. GhcException -> IO a
throwGhcExceptionIO (GhcException -> IO [InstalledPackageInfo a b c d e f g])
-> GhcException -> IO [InstalledPackageInfo a b c d e f g]
forall a b. (a -> b) -> a -> b
$ String -> GhcException
InstallationError (String -> GhcException) -> String -> GhcException
forall a b. (a -> b) -> a -> b
$
"there is no package.cache in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conf_dir String -> String -> String
forall a. [a] -> [a] -> [a]
++
" even though package database is not empty"
tryReadOldFileStylePackageConfig :: IO (Maybe [PackageConfig])
tryReadOldFileStylePackageConfig = do
String
content <- String -> IO String
readFile String
conf_file IO String -> (IOException -> IO String) -> IO String
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \_ -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
if Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 String
content String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "[]"
then do
let conf_dir :: String
conf_dir = String
conf_file String -> String -> String
<.> "d"
Bool
direxists <- String -> IO Bool
doesDirectoryExist String
conf_dir
if Bool
direxists
then do DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (String -> SDoc
text "Ignoring old file-style db and trying:" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
conf_dir)
([PackageConfig] -> Maybe [PackageConfig])
-> IO [PackageConfig] -> IO (Maybe [PackageConfig])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [PackageConfig] -> Maybe [PackageConfig]
forall a. a -> Maybe a
Just (String -> IO [PackageConfig]
forall b c f a d e g.
(BinaryStringRep b, BinaryStringRep c, BinaryStringRep f,
BinaryStringRep a, BinaryStringRep d,
DbUnitIdModuleRep d a e f g) =>
String -> IO [InstalledPackageInfo a b c d e f g]
readDirStylePackageConfig String
conf_dir)
else Maybe [PackageConfig] -> IO (Maybe [PackageConfig])
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageConfig] -> Maybe [PackageConfig]
forall a. a -> Maybe a
Just [])
else Maybe [PackageConfig] -> IO (Maybe [PackageConfig])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [PackageConfig]
forall a. Maybe a
Nothing
setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]
setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig]
setBatchPackageFlags dflags :: DynFlags
dflags pkgs :: [PackageConfig]
pkgs = [PackageConfig] -> [PackageConfig]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
[InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
maybeDistrustAll [PackageConfig]
pkgs
where
maybeDistrustAll :: [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
maybeDistrustAll pkgs' :: [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
pkgs'
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DistrustAllPackages DynFlags
dflags = (InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod)
-> [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
forall compid srcpkgid srcpkgname instunitid unitid modulename mod
unitid.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
distrust [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
pkgs'
| Bool
otherwise = [InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod]
pkgs'
distrust :: InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
distrust pkg :: InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
pkg = InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
pkg{ trusted :: Bool
trusted = Bool
False }
mungePackageConfig :: FilePath -> FilePath
-> PackageConfig -> PackageConfig
mungePackageConfig :: String -> String -> PackageConfig -> PackageConfig
mungePackageConfig top_dir :: String
top_dir pkgroot :: String
pkgroot =
PackageConfig -> PackageConfig
mungeDynLibFields
(PackageConfig -> PackageConfig)
-> (PackageConfig -> PackageConfig)
-> PackageConfig
-> PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> PackageConfig -> PackageConfig
mungePackagePaths String
top_dir String
pkgroot
mungeDynLibFields :: PackageConfig -> PackageConfig
mungeDynLibFields :: PackageConfig -> PackageConfig
mungeDynLibFields pkg :: PackageConfig
pkg =
PackageConfig
pkg {
libraryDynDirs :: [String]
libraryDynDirs = PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDynDirs PackageConfig
pkg
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
`orIfNull` PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDirs PackageConfig
pkg
}
where
orIfNull :: [a] -> [a] -> [a]
orIfNull [] flags :: [a]
flags = [a]
flags
orIfNull flags :: [a]
flags _ = [a]
flags
mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
mungePackagePaths :: String -> String -> PackageConfig -> PackageConfig
mungePackagePaths top_dir :: String
top_dir pkgroot :: String
pkgroot pkg :: PackageConfig
pkg =
PackageConfig
pkg {
importDirs :: [String]
importDirs = [String] -> [String]
munge_paths (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
importDirs PackageConfig
pkg),
includeDirs :: [String]
includeDirs = [String] -> [String]
munge_paths (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
includeDirs PackageConfig
pkg),
libraryDirs :: [String]
libraryDirs = [String] -> [String]
munge_paths (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDirs PackageConfig
pkg),
libraryDynDirs :: [String]
libraryDynDirs = [String] -> [String]
munge_paths (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDynDirs PackageConfig
pkg),
frameworkDirs :: [String]
frameworkDirs = [String] -> [String]
munge_paths (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
frameworkDirs PackageConfig
pkg),
haddockInterfaces :: [String]
haddockInterfaces = [String] -> [String]
munge_paths (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
haddockInterfaces PackageConfig
pkg),
haddockHTMLs :: [String]
haddockHTMLs = [String] -> [String]
munge_urls (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
haddockHTMLs PackageConfig
pkg)
}
where
munge_paths :: [String] -> [String]
munge_paths = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
munge_path
munge_urls :: [String] -> [String]
munge_urls = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
munge_url
munge_path :: String -> String
munge_path p :: String
p
| Just p' :: String
p' <- String -> String -> Maybe String
stripVarPrefix "${pkgroot}" String
p = String
pkgroot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p'
| Just p' :: String
p' <- String -> String -> Maybe String
stripVarPrefix "$topdir" String
p = String
top_dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p'
| Bool
otherwise = String
p
munge_url :: String -> String
munge_url p :: String
p
| Just p' :: String
p' <- String -> String -> Maybe String
stripVarPrefix "${pkgrooturl}" String
p = String -> String -> String
toUrlPath String
pkgroot String
p'
| Just p' :: String
p' <- String -> String -> Maybe String
stripVarPrefix "$httptopdir" String
p = String -> String -> String
toUrlPath String
top_dir String
p'
| Bool
otherwise = String
p
toUrlPath :: String -> String -> String
toUrlPath r :: String
r p :: String
p = "file:///"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
FilePath.Posix.joinPath
(String
r String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
(String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator)
(String -> [String]
FilePath.splitDirectories String
p))
stripVarPrefix :: String -> String -> Maybe String
stripVarPrefix var :: String
var path :: String
path = case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
var String
path of
Just [] -> String -> Maybe String
forall a. a -> Maybe a
Just []
Just cs :: String
cs@(c :: Char
c : _) | Char -> Bool
isPathSeparator Char
c -> String -> Maybe String
forall a. a -> Maybe a
Just String
cs
_ -> Maybe String
forall a. Maybe a
Nothing
applyTrustFlag
:: DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [PackageConfig]
-> TrustFlag
-> IO [PackageConfig]
applyTrustFlag :: DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [PackageConfig]
-> TrustFlag
-> IO [PackageConfig]
applyTrustFlag dflags :: DynFlags
dflags prec_map :: PackagePrecedenceIndex
prec_map unusable :: UnusablePackages
unusable pkgs :: [PackageConfig]
pkgs flag :: TrustFlag
flag =
case TrustFlag
flag of
TrustPackage str :: String
str ->
case PackagePrecedenceIndex
-> PackageArg
-> [PackageConfig]
-> UnusablePackages
-> Either
[(PackageConfig, UnusablePackageReason)]
([PackageConfig], [PackageConfig])
selectPackages PackagePrecedenceIndex
prec_map (String -> PackageArg
PackageArg String
str) [PackageConfig]
pkgs UnusablePackages
unusable of
Left ps :: [(PackageConfig, UnusablePackageReason)]
ps -> DynFlags
-> TrustFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO [PackageConfig]
forall a.
DynFlags
-> TrustFlag -> [(PackageConfig, UnusablePackageReason)] -> IO a
trustFlagErr DynFlags
dflags TrustFlag
flag [(PackageConfig, UnusablePackageReason)]
ps
Right (ps :: [PackageConfig]
ps,qs :: [PackageConfig]
qs) -> [PackageConfig] -> IO [PackageConfig]
forall (m :: * -> *) a. Monad m => a -> m a
return ((PackageConfig -> PackageConfig)
-> [PackageConfig] -> [PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> PackageConfig
forall compid srcpkgid srcpkgname instunitid unitid modulename mod
unitid.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
trust [PackageConfig]
ps [PackageConfig] -> [PackageConfig] -> [PackageConfig]
forall a. [a] -> [a] -> [a]
++ [PackageConfig]
qs)
where trust :: InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
trust p :: InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
p = InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
p {trusted :: Bool
trusted=Bool
True}
DistrustPackage str :: String
str ->
case PackagePrecedenceIndex
-> PackageArg
-> [PackageConfig]
-> UnusablePackages
-> Either
[(PackageConfig, UnusablePackageReason)]
([PackageConfig], [PackageConfig])
selectPackages PackagePrecedenceIndex
prec_map (String -> PackageArg
PackageArg String
str) [PackageConfig]
pkgs UnusablePackages
unusable of
Left ps :: [(PackageConfig, UnusablePackageReason)]
ps -> DynFlags
-> TrustFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO [PackageConfig]
forall a.
DynFlags
-> TrustFlag -> [(PackageConfig, UnusablePackageReason)] -> IO a
trustFlagErr DynFlags
dflags TrustFlag
flag [(PackageConfig, UnusablePackageReason)]
ps
Right (ps :: [PackageConfig]
ps,qs :: [PackageConfig]
qs) -> [PackageConfig] -> IO [PackageConfig]
forall (m :: * -> *) a. Monad m => a -> m a
return ((PackageConfig -> PackageConfig)
-> [PackageConfig] -> [PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> PackageConfig
forall compid srcpkgid srcpkgname instunitid unitid modulename mod
unitid.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
distrust [PackageConfig]
ps [PackageConfig] -> [PackageConfig] -> [PackageConfig]
forall a. [a] -> [a] -> [a]
++ [PackageConfig]
qs)
where distrust :: InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
distrust p :: InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
p = InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
p {trusted :: Bool
trusted=Bool
False}
isIndefinite :: DynFlags -> Bool
isIndefinite :: DynFlags -> Bool
isIndefinite dflags :: DynFlags
dflags = Bool -> Bool
not (UnitId -> Bool
unitIdIsDefinite (DynFlags -> UnitId
thisPackage DynFlags
dflags))
applyPackageFlag
:: DynFlags
-> PackagePrecedenceIndex
-> PackageConfigMap
-> UnusablePackages
-> Bool
-> [PackageConfig]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag :: DynFlags
-> PackagePrecedenceIndex
-> PackageConfigMap
-> UnusablePackages
-> Bool
-> [PackageConfig]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag dflags :: DynFlags
dflags prec_map :: PackagePrecedenceIndex
prec_map pkg_db :: PackageConfigMap
pkg_db unusable :: UnusablePackages
unusable no_hide_others :: Bool
no_hide_others pkgs :: [PackageConfig]
pkgs vm :: VisibilityMap
vm flag :: PackageFlag
flag =
case PackageFlag
flag of
ExposePackage _ arg :: PackageArg
arg (ModRenaming b :: Bool
b rns :: [(ModuleName, ModuleName)]
rns) ->
case PackagePrecedenceIndex
-> PackageConfigMap
-> PackageArg
-> [PackageConfig]
-> UnusablePackages
-> Either [(PackageConfig, UnusablePackageReason)] [PackageConfig]
findPackages PackagePrecedenceIndex
prec_map PackageConfigMap
pkg_db PackageArg
arg [PackageConfig]
pkgs UnusablePackages
unusable of
Left ps :: [(PackageConfig, UnusablePackageReason)]
ps -> DynFlags
-> PackageFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO VisibilityMap
forall a.
DynFlags
-> PackageFlag -> [(PackageConfig, UnusablePackageReason)] -> IO a
packageFlagErr DynFlags
dflags PackageFlag
flag [(PackageConfig, UnusablePackageReason)]
ps
Right (p :: PackageConfig
p:_) -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
return VisibilityMap
vm'
where
n :: FastString
n = PackageConfig -> FastString
fsPackageName PackageConfig
p
reqs :: Map ModuleName (Set IndefModule)
reqs | UnitIdArg orig_uid :: UnitId
orig_uid <- PackageArg
arg = UnitId -> Map ModuleName (Set IndefModule)
collectHoles UnitId
orig_uid
| Bool
otherwise = Map ModuleName (Set IndefModule)
forall k a. Map k a
Map.empty
collectHoles :: UnitId -> Map ModuleName (Set IndefModule)
collectHoles uid :: UnitId
uid = case UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts UnitId
uid of
(_, Just indef :: IndefUnitId
indef) ->
let local :: [Map ModuleName (Set IndefModule)]
local = [ ModuleName -> Set IndefModule -> Map ModuleName (Set IndefModule)
forall k a. k -> a -> Map k a
Map.singleton
(Module -> ModuleName
moduleName Module
mod)
(IndefModule -> Set IndefModule
forall a. a -> Set a
Set.singleton (IndefModule -> Set IndefModule) -> IndefModule -> Set IndefModule
forall a b. (a -> b) -> a -> b
$ IndefUnitId -> ModuleName -> IndefModule
IndefModule IndefUnitId
indef ModuleName
mod_name)
| (mod_name :: ModuleName
mod_name, mod :: Module
mod) <- IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
indef
, Module -> Bool
isHoleModule Module
mod ]
recurse :: [Map ModuleName (Set IndefModule)]
recurse = [ UnitId -> Map ModuleName (Set IndefModule)
collectHoles (Module -> UnitId
moduleUnitId Module
mod)
| (_, mod :: Module
mod) <- IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
indef ]
in (Set IndefModule -> Set IndefModule -> Set IndefModule)
-> [Map ModuleName (Set IndefModule)]
-> Map ModuleName (Set IndefModule)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set IndefModule -> Set IndefModule -> Set IndefModule
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Map ModuleName (Set IndefModule)]
-> Map ModuleName (Set IndefModule))
-> [Map ModuleName (Set IndefModule)]
-> Map ModuleName (Set IndefModule)
forall a b. (a -> b) -> a -> b
$ [Map ModuleName (Set IndefModule)]
local [Map ModuleName (Set IndefModule)]
-> [Map ModuleName (Set IndefModule)]
-> [Map ModuleName (Set IndefModule)]
forall a. [a] -> [a] -> [a]
++ [Map ModuleName (Set IndefModule)]
recurse
(_, Nothing) -> Map ModuleName (Set IndefModule)
forall k a. Map k a
Map.empty
uv :: UnitVisibility
uv = UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set IndefModule)
-> 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 IndefModule)
uv_requirements = Map ModuleName (Set IndefModule)
reqs
, uv_explicit :: Bool
uv_explicit = Bool
True
}
vm' :: VisibilityMap
vm' = (UnitVisibility -> UnitVisibility -> UnitVisibility)
-> UnitId -> UnitVisibility -> VisibilityMap -> VisibilityMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith UnitVisibility -> UnitVisibility -> UnitVisibility
forall a. Monoid a => a -> a -> a
mappend (PackageConfig -> UnitId
packageConfigId PackageConfig
p) UnitVisibility
uv VisibilityMap
vm_cleared
vm_cleared :: VisibilityMap
vm_cleared | Bool
no_hide_others = VisibilityMap
vm
| (_:_) <- [(ModuleName, ModuleName)]
rns = VisibilityMap
vm
| Bool
otherwise = (UnitId -> UnitVisibility -> Bool)
-> VisibilityMap -> VisibilityMap
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
(\k :: UnitId
k uv :: UnitVisibility
uv -> UnitId
k UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> UnitId
packageConfigId PackageConfig
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
/= UnitVisibility -> First FastString
uv_package_name UnitVisibility
uv) VisibilityMap
vm
_ -> String -> IO VisibilityMap
forall a. String -> a
panic "applyPackageFlag"
HidePackage str :: String
str ->
case PackagePrecedenceIndex
-> PackageConfigMap
-> PackageArg
-> [PackageConfig]
-> UnusablePackages
-> Either [(PackageConfig, UnusablePackageReason)] [PackageConfig]
findPackages PackagePrecedenceIndex
prec_map PackageConfigMap
pkg_db (String -> PackageArg
PackageArg String
str) [PackageConfig]
pkgs UnusablePackages
unusable of
Left ps :: [(PackageConfig, UnusablePackageReason)]
ps -> DynFlags
-> PackageFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO VisibilityMap
forall a.
DynFlags
-> PackageFlag -> [(PackageConfig, UnusablePackageReason)] -> IO a
packageFlagErr DynFlags
dflags PackageFlag
flag [(PackageConfig, UnusablePackageReason)]
ps
Right ps :: [PackageConfig]
ps -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
return VisibilityMap
vm'
where vm' :: VisibilityMap
vm' = (VisibilityMap -> UnitId -> VisibilityMap)
-> VisibilityMap -> [UnitId] -> VisibilityMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((UnitId -> VisibilityMap -> VisibilityMap)
-> VisibilityMap -> UnitId -> VisibilityMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip UnitId -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete) VisibilityMap
vm ((PackageConfig -> UnitId) -> [PackageConfig] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> UnitId
packageConfigId [PackageConfig]
ps)
findPackages :: PackagePrecedenceIndex
-> PackageConfigMap -> PackageArg -> [PackageConfig]
-> UnusablePackages
-> Either [(PackageConfig, UnusablePackageReason)]
[PackageConfig]
findPackages :: PackagePrecedenceIndex
-> PackageConfigMap
-> PackageArg
-> [PackageConfig]
-> UnusablePackages
-> Either [(PackageConfig, UnusablePackageReason)] [PackageConfig]
findPackages prec_map :: PackagePrecedenceIndex
prec_map pkg_db :: PackageConfigMap
pkg_db arg :: PackageArg
arg pkgs :: [PackageConfig]
pkgs unusable :: UnusablePackages
unusable
= let ps :: [PackageConfig]
ps = (PackageConfig -> Maybe PackageConfig)
-> [PackageConfig] -> [PackageConfig]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PackageArg -> PackageConfig -> Maybe PackageConfig
finder PackageArg
arg) [PackageConfig]
pkgs
in if [PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
ps
then [(PackageConfig, UnusablePackageReason)]
-> Either [(PackageConfig, UnusablePackageReason)] [PackageConfig]
forall a b. a -> Either a b
Left (((PackageConfig, UnusablePackageReason)
-> Maybe (PackageConfig, UnusablePackageReason))
-> [(PackageConfig, UnusablePackageReason)]
-> [(PackageConfig, UnusablePackageReason)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(x :: PackageConfig
x,y :: UnusablePackageReason
y) -> PackageArg -> PackageConfig -> Maybe PackageConfig
finder PackageArg
arg PackageConfig
x Maybe PackageConfig
-> (PackageConfig -> Maybe (PackageConfig, UnusablePackageReason))
-> Maybe (PackageConfig, UnusablePackageReason)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \x' :: PackageConfig
x' -> (PackageConfig, UnusablePackageReason)
-> Maybe (PackageConfig, UnusablePackageReason)
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageConfig
x',UnusablePackageReason
y))
(UnusablePackages -> [(PackageConfig, UnusablePackageReason)]
forall k a. Map k a -> [a]
Map.elems UnusablePackages
unusable))
else [PackageConfig]
-> Either [(PackageConfig, UnusablePackageReason)] [PackageConfig]
forall a b. b -> Either a b
Right (PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference PackagePrecedenceIndex
prec_map [PackageConfig]
ps)
where
finder :: PackageArg -> PackageConfig -> Maybe PackageConfig
finder (PackageArg str :: String
str) p :: PackageConfig
p
= if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> String
sourcePackageIdString PackageConfig
p Bool -> Bool -> Bool
|| String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> String
packageNameString PackageConfig
p
then PackageConfig -> Maybe PackageConfig
forall a. a -> Maybe a
Just PackageConfig
p
else Maybe PackageConfig
forall a. Maybe a
Nothing
finder (UnitIdArg uid :: UnitId
uid) p :: PackageConfig
p
= let (iuid :: InstalledUnitId
iuid, mb_indef :: Maybe IndefUnitId
mb_indef) = UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts UnitId
uid
in if InstalledUnitId
iuid InstalledUnitId -> InstalledUnitId -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> InstalledUnitId
installedPackageConfigId PackageConfig
p
then PackageConfig -> Maybe PackageConfig
forall a. a -> Maybe a
Just (case Maybe IndefUnitId
mb_indef of
Nothing -> PackageConfig
p
Just indef :: IndefUnitId
indef -> PackageConfigMap
-> [(ModuleName, Module)] -> PackageConfig -> PackageConfig
renamePackage PackageConfigMap
pkg_db (IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
indef) PackageConfig
p)
else Maybe PackageConfig
forall a. Maybe a
Nothing
selectPackages :: PackagePrecedenceIndex -> PackageArg -> [PackageConfig]
-> UnusablePackages
-> Either [(PackageConfig, UnusablePackageReason)]
([PackageConfig], [PackageConfig])
selectPackages :: PackagePrecedenceIndex
-> PackageArg
-> [PackageConfig]
-> UnusablePackages
-> Either
[(PackageConfig, UnusablePackageReason)]
([PackageConfig], [PackageConfig])
selectPackages prec_map :: PackagePrecedenceIndex
prec_map arg :: PackageArg
arg pkgs :: [PackageConfig]
pkgs unusable :: UnusablePackages
unusable
= let matches :: PackageConfig -> Bool
matches = PackageArg -> PackageConfig -> Bool
matching PackageArg
arg
(ps :: [PackageConfig]
ps,rest :: [PackageConfig]
rest) = (PackageConfig -> Bool)
-> [PackageConfig] -> ([PackageConfig], [PackageConfig])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PackageConfig -> Bool
matches [PackageConfig]
pkgs
in if [PackageConfig] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageConfig]
ps
then [(PackageConfig, UnusablePackageReason)]
-> Either
[(PackageConfig, UnusablePackageReason)]
([PackageConfig], [PackageConfig])
forall a b. a -> Either a b
Left (((PackageConfig, UnusablePackageReason) -> Bool)
-> [(PackageConfig, UnusablePackageReason)]
-> [(PackageConfig, UnusablePackageReason)]
forall a. (a -> Bool) -> [a] -> [a]
filter (PackageConfig -> Bool
matches(PackageConfig -> Bool)
-> ((PackageConfig, UnusablePackageReason) -> PackageConfig)
-> (PackageConfig, UnusablePackageReason)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PackageConfig, UnusablePackageReason) -> PackageConfig
forall a b. (a, b) -> a
fst) (UnusablePackages -> [(PackageConfig, UnusablePackageReason)]
forall k a. Map k a -> [a]
Map.elems UnusablePackages
unusable))
else ([PackageConfig], [PackageConfig])
-> Either
[(PackageConfig, UnusablePackageReason)]
([PackageConfig], [PackageConfig])
forall a b. b -> Either a b
Right (PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference PackagePrecedenceIndex
prec_map [PackageConfig]
ps, [PackageConfig]
rest)
renamePackage :: PackageConfigMap -> [(ModuleName, Module)]
-> PackageConfig -> PackageConfig
renamePackage :: PackageConfigMap
-> [(ModuleName, Module)] -> PackageConfig -> PackageConfig
renamePackage pkg_map :: PackageConfigMap
pkg_map insts :: [(ModuleName, Module)]
insts conf :: PackageConfig
conf =
let hsubst :: UniqFM Module
hsubst = [(ModuleName, Module)] -> UniqFM Module
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
listToUFM [(ModuleName, Module)]
insts
smod :: Module -> Module
smod = PackageConfigMap -> UniqFM Module -> Module -> Module
renameHoleModule' PackageConfigMap
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 (\(k :: ModuleName
k,v :: Module
v) -> (ModuleName
k,Module -> Module
smod Module
v)) (PackageConfig -> [(ModuleName, Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, mod)]
instantiatedWith PackageConfig
conf)
in PackageConfig
conf {
instantiatedWith :: [(ModuleName, Module)]
instantiatedWith = [(ModuleName, Module)]
new_insts,
exposedModules :: [(ModuleName, Maybe Module)]
exposedModules = ((ModuleName, Maybe Module) -> (ModuleName, Maybe Module))
-> [(ModuleName, Maybe Module)] -> [(ModuleName, Maybe Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: ModuleName
mod_name, mb_mod :: 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
fmap Module -> Module
smod Maybe Module
mb_mod))
(PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules PackageConfig
conf)
}
matchingStr :: String -> PackageConfig -> Bool
matchingStr :: String -> PackageConfig -> Bool
matchingStr str :: String
str p :: PackageConfig
p
= String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> String
sourcePackageIdString PackageConfig
p
Bool -> Bool -> Bool
|| String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> String
packageNameString PackageConfig
p
matchingId :: InstalledUnitId -> PackageConfig -> Bool
matchingId :: InstalledUnitId -> PackageConfig -> Bool
matchingId uid :: InstalledUnitId
uid p :: PackageConfig
p = InstalledUnitId
uid InstalledUnitId -> InstalledUnitId -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> InstalledUnitId
installedPackageConfigId PackageConfig
p
matching :: PackageArg -> PackageConfig -> Bool
matching :: PackageArg -> PackageConfig -> Bool
matching (PackageArg str :: String
str) = String -> PackageConfig -> Bool
matchingStr String
str
matching (UnitIdArg (DefiniteUnitId (DefUnitId uid :: InstalledUnitId
uid))) = InstalledUnitId -> PackageConfig -> Bool
matchingId InstalledUnitId
uid
matching (UnitIdArg _) = \_ -> Bool
False
sortByPreference :: PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference :: PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference prec_map :: PackagePrecedenceIndex
prec_map = (PackageConfig -> PackageConfig -> Ordering)
-> [PackageConfig] -> [PackageConfig]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((PackageConfig -> PackageConfig -> Ordering)
-> PackageConfig -> PackageConfig -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PackagePrecedenceIndex
-> PackageConfig -> PackageConfig -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map))
compareByPreference
:: PackagePrecedenceIndex
-> PackageConfig
-> PackageConfig
-> Ordering
compareByPreference :: PackagePrecedenceIndex
-> PackageConfig -> PackageConfig -> Ordering
compareByPreference prec_map :: PackagePrecedenceIndex
prec_map pkg :: PackageConfig
pkg pkg' :: PackageConfig
pkg'
| Just prec :: Int
prec <- InstalledUnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkg) PackagePrecedenceIndex
prec_map
, Just prec' :: Int
prec' <- InstalledUnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkg') PackagePrecedenceIndex
prec_map
, PackageConfig -> PackageConfig -> Bool
differentIntegerPkgs PackageConfig
pkg PackageConfig
pkg'
= Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
prec Int
prec'
| Bool
otherwise
= case (PackageConfig -> Version)
-> PackageConfig -> PackageConfig -> Ordering
forall a t. Ord a => (t -> a) -> t -> t -> Ordering
comparing PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
packageVersion PackageConfig
pkg PackageConfig
pkg' of
GT -> Ordering
GT
EQ | Just prec :: Int
prec <- InstalledUnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkg) PackagePrecedenceIndex
prec_map
, Just prec' :: Int
prec' <- InstalledUnitId -> PackagePrecedenceIndex -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkg') PackagePrecedenceIndex
prec_map
-> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
prec Int
prec'
| Bool
otherwise
-> Ordering
EQ
LT -> Ordering
LT
where isIntegerPkg :: PackageConfig -> Bool
isIntegerPkg p :: PackageConfig
p = PackageConfig -> String
packageNameString PackageConfig
p String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
["integer-simple", "integer-gmp"]
differentIntegerPkgs :: PackageConfig -> PackageConfig -> Bool
differentIntegerPkgs p :: PackageConfig
p p' :: PackageConfig
p' =
PackageConfig -> Bool
isIntegerPkg PackageConfig
p Bool -> Bool -> Bool
&& PackageConfig -> Bool
isIntegerPkg PackageConfig
p' Bool -> Bool -> Bool
&&
(PackageConfig -> PackageName
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgname
packageName PackageConfig
p PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageConfig -> PackageName
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgname
packageName PackageConfig
p')
comparing :: Ord a => (t -> a) -> t -> t -> Ordering
comparing :: (t -> a) -> t -> t -> Ordering
comparing f :: t -> a
f a :: t
a b :: t
b = t -> a
f t
a a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` t -> a
f t
b
packageFlagErr :: DynFlags
-> PackageFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO a
packageFlagErr :: DynFlags
-> PackageFlag -> [(PackageConfig, UnusablePackageReason)] -> IO a
packageFlagErr dflags :: DynFlags
dflags flag :: PackageFlag
flag reasons :: [(PackageConfig, UnusablePackageReason)]
reasons
= DynFlags
-> SDoc -> [(PackageConfig, UnusablePackageReason)] -> IO a
forall a.
DynFlags
-> SDoc -> [(PackageConfig, UnusablePackageReason)] -> IO a
packageFlagErr' DynFlags
dflags (PackageFlag -> SDoc
pprFlag PackageFlag
flag) [(PackageConfig, UnusablePackageReason)]
reasons
trustFlagErr :: DynFlags
-> TrustFlag
-> [(PackageConfig, UnusablePackageReason)]
-> IO a
trustFlagErr :: DynFlags
-> TrustFlag -> [(PackageConfig, UnusablePackageReason)] -> IO a
trustFlagErr dflags :: DynFlags
dflags flag :: TrustFlag
flag reasons :: [(PackageConfig, UnusablePackageReason)]
reasons
= DynFlags
-> SDoc -> [(PackageConfig, UnusablePackageReason)] -> IO a
forall a.
DynFlags
-> SDoc -> [(PackageConfig, UnusablePackageReason)] -> IO a
packageFlagErr' DynFlags
dflags (TrustFlag -> SDoc
pprTrustFlag TrustFlag
flag) [(PackageConfig, UnusablePackageReason)]
reasons
packageFlagErr' :: DynFlags
-> SDoc
-> [(PackageConfig, UnusablePackageReason)]
-> IO a
packageFlagErr' :: DynFlags
-> SDoc -> [(PackageConfig, UnusablePackageReason)] -> IO a
packageFlagErr' dflags :: DynFlags
dflags flag_doc :: SDoc
flag_doc reasons :: [(PackageConfig, UnusablePackageReason)]
reasons
= GhcException -> IO a
forall a. GhcException -> IO a
throwGhcExceptionIO (String -> GhcException
CmdLineError (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ SDoc
err))
where err :: SDoc
err = String -> SDoc
text "cannot satisfy " SDoc -> SDoc -> SDoc
<> SDoc
flag_doc SDoc -> SDoc -> SDoc
<>
(if [(PackageConfig, UnusablePackageReason)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageConfig, UnusablePackageReason)]
reasons then SDoc
Outputable.empty else String -> SDoc
text ": ") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 4 (SDoc
ppr_reasons SDoc -> SDoc -> SDoc
$$
String -> SDoc
text "(use -v for more information)")
ppr_reasons :: SDoc
ppr_reasons = [SDoc] -> SDoc
vcat (((PackageConfig, UnusablePackageReason) -> SDoc)
-> [(PackageConfig, UnusablePackageReason)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PackageConfig, UnusablePackageReason) -> SDoc
forall a compid srcpkgid srcpkgname unitid modulename mod.
Outputable a =>
(InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod,
UnusablePackageReason)
-> SDoc
ppr_reason [(PackageConfig, UnusablePackageReason)]
reasons)
ppr_reason :: (InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod,
UnusablePackageReason)
-> SDoc
ppr_reason (p :: InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
p, reason :: UnusablePackageReason
reason) =
SDoc -> UnusablePackageReason -> SDoc
pprReason (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
-> a
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
p) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "is") UnusablePackageReason
reason
pprFlag :: PackageFlag -> SDoc
pprFlag :: PackageFlag -> SDoc
pprFlag flag :: PackageFlag
flag = case PackageFlag
flag of
HidePackage p :: String
p -> String -> SDoc
text "-hide-package " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
p
ExposePackage doc :: String
doc _ _ -> String -> SDoc
text String
doc
pprTrustFlag :: TrustFlag -> SDoc
pprTrustFlag :: TrustFlag -> SDoc
pprTrustFlag flag :: TrustFlag
flag = case TrustFlag
flag of
TrustPackage p :: String
p -> String -> SDoc
text "-trust " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
p
DistrustPackage p :: String
p -> String -> SDoc
text "-distrust " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
p
type WiredInUnitId = String
type WiredPackagesMap = Map WiredUnitId WiredUnitId
wired_in_pkgids :: [WiredInUnitId]
wired_in_pkgids :: [String]
wired_in_pkgids = (UnitId -> String) -> [UnitId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> String
unitIdString [UnitId]
wiredInUnitIds
findWiredInPackages
:: DynFlags
-> PackagePrecedenceIndex
-> [PackageConfig]
-> VisibilityMap
-> IO ([PackageConfig],
WiredPackagesMap)
findWiredInPackages :: DynFlags
-> PackagePrecedenceIndex
-> [PackageConfig]
-> VisibilityMap
-> IO ([PackageConfig], Map WiredUnitId WiredUnitId)
findWiredInPackages dflags :: DynFlags
dflags prec_map :: PackagePrecedenceIndex
prec_map pkgs :: [PackageConfig]
pkgs vis_map :: VisibilityMap
vis_map = do
let
matches :: PackageConfig -> WiredInUnitId -> Bool
pc :: PackageConfig
pc matches :: PackageConfig -> String -> Bool
`matches` pid :: String
pid
| String
pid String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId -> String
unitIdString UnitId
integerUnitId
= PackageConfig -> String
packageNameString PackageConfig
pc String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["integer-gmp", "integer-simple"]
pc :: PackageConfig
pc `matches` pid :: String
pid = PackageConfig -> String
packageNameString PackageConfig
pc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pid
findWiredInPackage :: [PackageConfig] -> WiredInUnitId
-> IO (Maybe (WiredInUnitId, PackageConfig))
findWiredInPackage :: [PackageConfig] -> String -> IO (Maybe (String, PackageConfig))
findWiredInPackage pkgs :: [PackageConfig]
pkgs wired_pkg :: String
wired_pkg =
let all_ps :: [PackageConfig]
all_ps = [ PackageConfig
p | PackageConfig
p <- [PackageConfig]
pkgs, PackageConfig
p PackageConfig -> String -> Bool
`matches` String
wired_pkg ]
all_exposed_ps :: [PackageConfig]
all_exposed_ps =
[ PackageConfig
p | PackageConfig
p <- [PackageConfig]
all_ps
, UnitId -> VisibilityMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (PackageConfig -> UnitId
packageConfigId PackageConfig
p) VisibilityMap
vis_map ] in
case [PackageConfig]
all_exposed_ps of
[] -> case [PackageConfig]
all_ps of
[] -> IO (Maybe (String, PackageConfig))
forall a. IO (Maybe a)
notfound
many :: [PackageConfig]
many -> PackageConfig -> IO (Maybe (String, PackageConfig))
pick ([PackageConfig] -> PackageConfig
forall a. [a] -> a
head (PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference PackagePrecedenceIndex
prec_map [PackageConfig]
many))
many :: [PackageConfig]
many -> PackageConfig -> IO (Maybe (String, PackageConfig))
pick ([PackageConfig] -> PackageConfig
forall a. [a] -> a
head (PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference PackagePrecedenceIndex
prec_map [PackageConfig]
many))
where
notfound :: IO (Maybe a)
notfound = do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text "wired-in package "
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
wired_pkg
SDoc -> SDoc -> SDoc
<> String -> SDoc
text " not found."
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
pick :: PackageConfig
-> IO (Maybe (WiredInUnitId, PackageConfig))
pick :: PackageConfig -> IO (Maybe (String, PackageConfig))
pick pkg :: PackageConfig
pkg = do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text "wired-in package "
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
wired_pkg
SDoc -> SDoc -> SDoc
<> String -> SDoc
text " mapped to "
SDoc -> SDoc -> SDoc
<> InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkg)
Maybe (String, PackageConfig) -> IO (Maybe (String, PackageConfig))
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, PackageConfig) -> Maybe (String, PackageConfig)
forall a. a -> Maybe a
Just (String
wired_pkg, PackageConfig
pkg))
[Maybe (String, PackageConfig)]
mb_wired_in_pkgs <- (String -> IO (Maybe (String, PackageConfig)))
-> [String] -> IO [Maybe (String, PackageConfig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([PackageConfig] -> String -> IO (Maybe (String, PackageConfig))
findWiredInPackage [PackageConfig]
pkgs) [String]
wired_in_pkgids
let
wired_in_pkgs :: [(String, PackageConfig)]
wired_in_pkgs = [Maybe (String, PackageConfig)] -> [(String, PackageConfig)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (String, PackageConfig)]
mb_wired_in_pkgs
wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap = [(WiredUnitId, WiredUnitId)] -> Map WiredUnitId WiredUnitId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (WiredUnitId
key, InstalledUnitId -> WiredUnitId
DefUnitId (String -> InstalledUnitId
stringToInstalledUnitId String
wiredInUnitId))
| (wiredInUnitId :: String
wiredInUnitId, pkg :: PackageConfig
pkg) <- [(String, PackageConfig)]
wired_in_pkgs
, Just key :: WiredUnitId
key <- Maybe WiredUnitId -> [Maybe WiredUnitId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe WiredUnitId -> [Maybe WiredUnitId])
-> Maybe WiredUnitId -> [Maybe WiredUnitId]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> Maybe WiredUnitId
definitePackageConfigId PackageConfig
pkg
]
updateWiredInDependencies :: [PackageConfig]
-> [InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module]
updateWiredInDependencies pkgs :: [PackageConfig]
pkgs = (PackageConfig
-> InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module)
-> [PackageConfig]
-> [InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module]
forall a b. (a -> b) -> [a] -> [b]
map (PackageConfig
-> InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module
forall compid srcpkgid srcpkgname unitid a unitid.
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
-> InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
upd_deps (PackageConfig
-> InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module)
-> (PackageConfig -> PackageConfig)
-> PackageConfig
-> InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> PackageConfig
upd_pkg) [PackageConfig]
pkgs
where upd_pkg :: PackageConfig -> PackageConfig
upd_pkg pkg :: PackageConfig
pkg
| Just def_uid :: WiredUnitId
def_uid <- PackageConfig -> Maybe WiredUnitId
definitePackageConfigId PackageConfig
pkg
, Just wiredInUnitId :: WiredUnitId
wiredInUnitId <- WiredUnitId -> Map WiredUnitId WiredUnitId -> Maybe WiredUnitId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WiredUnitId
def_uid Map WiredUnitId WiredUnitId
wiredInMap
= let fs :: FastString
fs = InstalledUnitId -> FastString
installedUnitIdFS (WiredUnitId -> InstalledUnitId
unDefUnitId WiredUnitId
wiredInUnitId)
in PackageConfig
pkg {
unitId :: InstalledUnitId
unitId = FastString -> InstalledUnitId
fsToInstalledUnitId FastString
fs,
componentId :: ComponentId
componentId = FastString -> ComponentId
ComponentId FastString
fs
}
| Bool
otherwise
= PackageConfig
pkg
upd_deps :: InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
-> InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
upd_deps pkg :: InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
pkg = InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
pkg {
depends :: [InstalledUnitId]
depends = (InstalledUnitId -> InstalledUnitId)
-> [InstalledUnitId] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (WiredUnitId -> InstalledUnitId
unDefUnitId (WiredUnitId -> InstalledUnitId)
-> (InstalledUnitId -> WiredUnitId)
-> InstalledUnitId
-> InstalledUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WiredUnitId WiredUnitId -> WiredUnitId -> WiredUnitId
upd_wired_in Map WiredUnitId WiredUnitId
wiredInMap (WiredUnitId -> WiredUnitId)
-> (InstalledUnitId -> WiredUnitId)
-> InstalledUnitId
-> WiredUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledUnitId -> WiredUnitId
DefUnitId) (InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
-> [InstalledUnitId]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
depends InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
pkg),
exposedModules :: [(a, Maybe Module)]
exposedModules
= ((a, Maybe Module) -> (a, Maybe Module))
-> [(a, Maybe Module)] -> [(a, Maybe Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: a
k,v :: Maybe Module
v) -> (a
k, (Module -> Module) -> Maybe Module -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map WiredUnitId WiredUnitId -> Module -> Module
upd_wired_in_mod Map WiredUnitId WiredUnitId
wiredInMap) Maybe Module
v))
(InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
-> [(a, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid a Module
pkg)
}
([PackageConfig], Map WiredUnitId WiredUnitId)
-> IO ([PackageConfig], Map WiredUnitId WiredUnitId)
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageConfig] -> [PackageConfig]
forall unitid.
[PackageConfig]
-> [InstalledPackageInfo
ComponentId
SourcePackageId
PackageName
InstalledUnitId
unitid
ModuleName
Module]
updateWiredInDependencies [PackageConfig]
pkgs, Map WiredUnitId WiredUnitId
wiredInMap)
upd_wired_in_mod :: WiredPackagesMap -> Module -> Module
upd_wired_in_mod :: Map WiredUnitId WiredUnitId -> Module -> Module
upd_wired_in_mod wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap (Module uid :: UnitId
uid m :: ModuleName
m) = UnitId -> ModuleName -> Module
Module (Map WiredUnitId WiredUnitId -> UnitId -> UnitId
upd_wired_in_uid Map WiredUnitId WiredUnitId
wiredInMap UnitId
uid) ModuleName
m
upd_wired_in_uid :: WiredPackagesMap -> UnitId -> UnitId
upd_wired_in_uid :: Map WiredUnitId WiredUnitId -> UnitId -> UnitId
upd_wired_in_uid wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap (DefiniteUnitId def_uid :: WiredUnitId
def_uid) =
WiredUnitId -> UnitId
DefiniteUnitId (Map WiredUnitId WiredUnitId -> WiredUnitId -> WiredUnitId
upd_wired_in Map WiredUnitId WiredUnitId
wiredInMap WiredUnitId
def_uid)
upd_wired_in_uid wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap (IndefiniteUnitId indef_uid :: IndefUnitId
indef_uid) =
IndefUnitId -> UnitId
IndefiniteUnitId (IndefUnitId -> UnitId) -> IndefUnitId -> UnitId
forall a b. (a -> b) -> a -> b
$ ComponentId -> [(ModuleName, Module)] -> IndefUnitId
newIndefUnitId
(IndefUnitId -> ComponentId
indefUnitIdComponentId IndefUnitId
indef_uid)
(((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: ModuleName
x,y :: Module
y) -> (ModuleName
x,Map WiredUnitId WiredUnitId -> Module -> Module
upd_wired_in_mod Map WiredUnitId WiredUnitId
wiredInMap Module
y)) (IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
indef_uid))
upd_wired_in :: WiredPackagesMap -> DefUnitId -> DefUnitId
upd_wired_in :: Map WiredUnitId WiredUnitId -> WiredUnitId -> WiredUnitId
upd_wired_in wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap key :: WiredUnitId
key
| Just key' :: WiredUnitId
key' <- WiredUnitId -> Map WiredUnitId WiredUnitId -> Maybe WiredUnitId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WiredUnitId
key Map WiredUnitId WiredUnitId
wiredInMap = WiredUnitId
key'
| Bool
otherwise = WiredUnitId
key
updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap
updateVisibilityMap :: Map WiredUnitId WiredUnitId -> VisibilityMap -> VisibilityMap
updateVisibilityMap wiredInMap :: Map WiredUnitId WiredUnitId
wiredInMap vis_map :: VisibilityMap
vis_map = (VisibilityMap -> (WiredUnitId, WiredUnitId) -> VisibilityMap)
-> VisibilityMap -> [(WiredUnitId, WiredUnitId)] -> VisibilityMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' VisibilityMap -> (WiredUnitId, WiredUnitId) -> VisibilityMap
f VisibilityMap
vis_map (Map WiredUnitId WiredUnitId -> [(WiredUnitId, WiredUnitId)]
forall k a. Map k a -> [(k, a)]
Map.toList Map WiredUnitId WiredUnitId
wiredInMap)
where f :: VisibilityMap -> (WiredUnitId, WiredUnitId) -> VisibilityMap
f vm :: VisibilityMap
vm (from :: WiredUnitId
from, to :: WiredUnitId
to) = case UnitId -> VisibilityMap -> Maybe UnitVisibility
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (WiredUnitId -> UnitId
DefiniteUnitId WiredUnitId
from) VisibilityMap
vis_map of
Nothing -> VisibilityMap
vm
Just r :: UnitVisibility
r -> UnitId -> UnitVisibility -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (WiredUnitId -> UnitId
DefiniteUnitId WiredUnitId
to) UnitVisibility
r
(UnitId -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (WiredUnitId -> UnitId
DefiniteUnitId WiredUnitId
from) VisibilityMap
vm)
data UnusablePackageReason
=
IgnoredWithFlag
| BrokenDependencies [InstalledUnitId]
| CyclicDependencies [InstalledUnitId]
| IgnoredDependencies [InstalledUnitId]
| ShadowedDependencies [InstalledUnitId]
instance Outputable UnusablePackageReason where
ppr :: UnusablePackageReason -> SDoc
ppr IgnoredWithFlag = String -> SDoc
text "[ignored with flag]"
ppr (BrokenDependencies uids :: [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text "broken" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
ppr (CyclicDependencies uids :: [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text "cyclic" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
ppr (IgnoredDependencies uids :: [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text "ignored" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
ppr (ShadowedDependencies uids :: [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text "shadowed" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
type UnusablePackages = Map InstalledUnitId
(PackageConfig, UnusablePackageReason)
pprReason :: SDoc -> UnusablePackageReason -> SDoc
pprReason :: SDoc -> UnusablePackageReason -> SDoc
pprReason pref :: SDoc
pref reason :: UnusablePackageReason
reason = case UnusablePackageReason
reason of
IgnoredWithFlag ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "ignored due to an -ignore-package flag"
BrokenDependencies deps :: [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "unusable due to missing dependencies:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
hsep ((InstalledUnitId -> SDoc) -> [InstalledUnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
deps))
CyclicDependencies deps :: [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "unusable due to cyclic dependencies:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
hsep ((InstalledUnitId -> SDoc) -> [InstalledUnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
deps))
IgnoredDependencies deps :: [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ("unusable because the -ignore-package flag was used to " String -> String -> String
forall a. [a] -> [a] -> [a]
++
"ignore at least one of its dependencies:") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
hsep ((InstalledUnitId -> SDoc) -> [InstalledUnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
deps))
ShadowedDependencies deps :: [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "unusable due to shadowed dependencies:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
hsep ((InstalledUnitId -> SDoc) -> [InstalledUnitId] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
deps))
reportCycles :: DynFlags -> [SCC PackageConfig] -> IO ()
reportCycles :: DynFlags -> [SCC PackageConfig] -> IO ()
reportCycles dflags :: DynFlags
dflags sccs :: [SCC PackageConfig]
sccs = (SCC PackageConfig -> IO ()) -> [SCC PackageConfig] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SCC PackageConfig -> IO ()
forall a compid srcpkgid srcpkgname unitid modulename mod.
Outputable a =>
SCC
(InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod)
-> IO ()
report [SCC PackageConfig]
sccs
where
report :: SCC
(InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod)
-> IO ()
report (AcyclicSCC _) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
report (CyclicSCC vs :: [InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod]
vs) =
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text "these packages are involved in a cycle:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
hsep ((InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
-> SDoc)
-> [InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod]
-> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr (a -> SDoc)
-> (InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
-> a)
-> InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
-> a
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId) [InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod]
vs))
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
reportUnusable :: DynFlags -> UnusablePackages -> IO ()
reportUnusable dflags :: DynFlags
dflags pkgs :: UnusablePackages
pkgs = ((InstalledUnitId, (PackageConfig, UnusablePackageReason))
-> IO ())
-> [(InstalledUnitId, (PackageConfig, UnusablePackageReason))]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (InstalledUnitId, (PackageConfig, UnusablePackageReason)) -> IO ()
forall a a.
Outputable a =>
(a, (a, UnusablePackageReason)) -> IO ()
report (UnusablePackages
-> [(InstalledUnitId, (PackageConfig, UnusablePackageReason))]
forall k a. Map k a -> [(k, a)]
Map.toList UnusablePackages
pkgs)
where
report :: (a, (a, UnusablePackageReason)) -> IO ()
report (ipid :: a
ipid, (_, reason :: UnusablePackageReason
reason)) =
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
SDoc -> UnusablePackageReason -> SDoc
pprReason
(String -> SDoc
text "package" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ipid SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "is") UnusablePackageReason
reason
type RevIndex = Map InstalledUnitId [InstalledUnitId]
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps db :: InstalledPackageIndex
db = (RevIndex -> PackageConfig -> RevIndex)
-> RevIndex -> InstalledPackageIndex -> RevIndex
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' RevIndex -> PackageConfig -> RevIndex
forall k compid srcpkgid srcpkgname unitid modulename mod.
Ord k =>
Map k [k]
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> Map k [k]
go RevIndex
forall k a. Map k a
Map.empty InstalledPackageIndex
db
where
go :: Map k [k]
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> Map k [k]
go r :: Map k [k]
r pkg :: InstalledPackageInfo
compid srcpkgid srcpkgname k unitid 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
foldl' (k -> Map k [k] -> k -> Map k [k]
forall k a. Ord k => a -> Map k [a] -> k -> Map k [a]
go' (InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> k
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
pkg)) Map k [k]
r (InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> [k]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
depends InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
pkg)
go' :: a -> Map k [a] -> k -> Map k [a]
go' from :: a
from r :: Map k [a]
r to :: 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
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) k
to [a
from] Map k [a]
r
removePackages :: [InstalledUnitId] -> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [PackageConfig])
removePackages :: [InstalledUnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [PackageConfig])
removePackages uids :: [InstalledUnitId]
uids index :: RevIndex
index m :: InstalledPackageIndex
m = [InstalledUnitId]
-> (InstalledPackageIndex, [PackageConfig])
-> (InstalledPackageIndex, [PackageConfig])
forall a.
[InstalledUnitId]
-> (Map InstalledUnitId a, [a]) -> (Map InstalledUnitId a, [a])
go [InstalledUnitId]
uids (InstalledPackageIndex
m,[])
where
go :: [InstalledUnitId]
-> (Map InstalledUnitId a, [a]) -> (Map InstalledUnitId a, [a])
go [] (m :: Map InstalledUnitId a
m,pkgs :: [a]
pkgs) = (Map InstalledUnitId a
m,[a]
pkgs)
go (uid :: InstalledUnitId
uid:uids :: [InstalledUnitId]
uids) (m :: Map InstalledUnitId a
m,pkgs :: [a]
pkgs)
| Just pkg :: a
pkg <- InstalledUnitId -> Map InstalledUnitId a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledUnitId
uid Map InstalledUnitId a
m
= case InstalledUnitId -> RevIndex -> Maybe [InstalledUnitId]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledUnitId
uid RevIndex
index of
Nothing -> [InstalledUnitId]
-> (Map InstalledUnitId a, [a]) -> (Map InstalledUnitId a, [a])
go [InstalledUnitId]
uids (InstalledUnitId -> Map InstalledUnitId a -> Map InstalledUnitId a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete InstalledUnitId
uid Map InstalledUnitId a
m, a
pkga -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pkgs)
Just rdeps :: [InstalledUnitId]
rdeps -> [InstalledUnitId]
-> (Map InstalledUnitId a, [a]) -> (Map InstalledUnitId a, [a])
go ([InstalledUnitId]
rdeps [InstalledUnitId] -> [InstalledUnitId] -> [InstalledUnitId]
forall a. [a] -> [a] -> [a]
++ [InstalledUnitId]
uids) (InstalledUnitId -> Map InstalledUnitId a -> Map InstalledUnitId a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete InstalledUnitId
uid Map InstalledUnitId a
m, a
pkga -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
pkgs)
| Bool
otherwise
= [InstalledUnitId]
-> (Map InstalledUnitId a, [a]) -> (Map InstalledUnitId a, [a])
go [InstalledUnitId]
uids (Map InstalledUnitId a
m,[a]
pkgs)
depsNotAvailable :: InstalledPackageIndex
-> PackageConfig
-> [InstalledUnitId]
depsNotAvailable :: InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsNotAvailable pkg_map :: InstalledPackageIndex
pkg_map pkg :: PackageConfig
pkg = (InstalledUnitId -> Bool) -> [InstalledUnitId] -> [InstalledUnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (InstalledUnitId -> Bool) -> InstalledUnitId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledUnitId -> InstalledPackageIndex -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` InstalledPackageIndex
pkg_map)) (PackageConfig -> [InstalledUnitId]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
depends PackageConfig
pkg)
depsAbiMismatch :: InstalledPackageIndex
-> PackageConfig
-> [InstalledUnitId]
depsAbiMismatch :: InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsAbiMismatch pkg_map :: InstalledPackageIndex
pkg_map pkg :: PackageConfig
pkg = ((InstalledUnitId, String) -> InstalledUnitId)
-> [(InstalledUnitId, String)] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (InstalledUnitId, String) -> InstalledUnitId
forall a b. (a, b) -> a
fst ([(InstalledUnitId, String)] -> [InstalledUnitId])
-> ([(InstalledUnitId, String)] -> [(InstalledUnitId, String)])
-> [(InstalledUnitId, String)]
-> [InstalledUnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InstalledUnitId, String) -> Bool)
-> [(InstalledUnitId, String)] -> [(InstalledUnitId, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((InstalledUnitId, String) -> Bool)
-> (InstalledUnitId, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledUnitId, String) -> Bool
abiMatch) ([(InstalledUnitId, String)] -> [InstalledUnitId])
-> [(InstalledUnitId, String)] -> [InstalledUnitId]
forall a b. (a -> b) -> a -> b
$ PackageConfig -> [(InstalledUnitId, String)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(instunitid, String)]
abiDepends PackageConfig
pkg
where
abiMatch :: (InstalledUnitId, String) -> Bool
abiMatch (dep_uid :: InstalledUnitId
dep_uid, abi :: String
abi)
| Just dep_pkg :: PackageConfig
dep_pkg <- InstalledUnitId -> InstalledPackageIndex -> Maybe PackageConfig
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledUnitId
dep_uid InstalledPackageIndex
pkg_map
= PackageConfig -> String
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
abiHash PackageConfig
dep_pkg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
abi
| Bool
otherwise
= Bool
False
ignorePackages :: [IgnorePackageFlag] -> [PackageConfig] -> UnusablePackages
ignorePackages :: [IgnorePackageFlag] -> [PackageConfig] -> UnusablePackages
ignorePackages flags :: [IgnorePackageFlag]
flags pkgs :: [PackageConfig]
pkgs = [(InstalledUnitId, (PackageConfig, UnusablePackageReason))]
-> UnusablePackages
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((IgnorePackageFlag
-> [(InstalledUnitId, (PackageConfig, UnusablePackageReason))])
-> [IgnorePackageFlag]
-> [(InstalledUnitId, (PackageConfig, UnusablePackageReason))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IgnorePackageFlag
-> [(InstalledUnitId, (PackageConfig, UnusablePackageReason))]
doit [IgnorePackageFlag]
flags)
where
doit :: IgnorePackageFlag
-> [(InstalledUnitId, (PackageConfig, UnusablePackageReason))]
doit (IgnorePackage str :: String
str) =
case (PackageConfig -> Bool)
-> [PackageConfig] -> ([PackageConfig], [PackageConfig])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> PackageConfig -> Bool
matchingStr String
str) [PackageConfig]
pkgs of
(ps :: [PackageConfig]
ps, _) -> [ (PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
p, (PackageConfig
p, UnusablePackageReason
IgnoredWithFlag))
| PackageConfig
p <- [PackageConfig]
ps ]
type PackagePrecedenceIndex = Map InstalledUnitId Int
mergeDatabases :: DynFlags -> [(FilePath, [PackageConfig])]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases :: DynFlags
-> [(String, [PackageConfig])]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases dflags :: DynFlags
dflags = ((InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, (String, [PackageConfig]))
-> IO (InstalledPackageIndex, PackagePrecedenceIndex))
-> (InstalledPackageIndex, PackagePrecedenceIndex)
-> [(Int, (String, [PackageConfig]))]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, (String, [PackageConfig]))
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
merge (InstalledPackageIndex
forall k a. Map k a
Map.empty, PackagePrecedenceIndex
forall k a. Map k a
Map.empty) ([(Int, (String, [PackageConfig]))]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex))
-> ([(String, [PackageConfig])]
-> [(Int, (String, [PackageConfig]))])
-> [(String, [PackageConfig])]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [(String, [PackageConfig])]
-> [(Int, (String, [PackageConfig]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [1..]
where
merge :: (InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, (String, [PackageConfig]))
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
merge (pkg_map :: InstalledPackageIndex
pkg_map, prec_map :: PackagePrecedenceIndex
prec_map) (i :: Int
i, (db_path :: String
db_path, db :: [PackageConfig]
db)) = do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text "loading package database" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
db_path
[InstalledUnitId] -> (InstalledUnitId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Set InstalledUnitId -> [InstalledUnitId]
forall a. Set a -> [a]
Set.toList Set InstalledUnitId
override_set) ((InstalledUnitId -> IO ()) -> IO ())
-> (InstalledUnitId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \pkg :: InstalledUnitId
pkg ->
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text "package" SDoc -> SDoc -> SDoc
<+> InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledUnitId
pkg SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text "overrides a previously defined package"
(InstalledPackageIndex, PackagePrecedenceIndex)
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledPackageIndex
pkg_map', PackagePrecedenceIndex
prec_map')
where
db_map :: InstalledPackageIndex
db_map = [PackageConfig] -> InstalledPackageIndex
forall compid srcpkgid srcpkgname unitid modulename mod.
[InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod]
-> Map
InstalledUnitId
(InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)
mk_pkg_map [PackageConfig]
db
mk_pkg_map :: [InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod]
-> Map
InstalledUnitId
(InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)
mk_pkg_map = [(InstalledUnitId,
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)]
-> Map
InstalledUnitId
(InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(InstalledUnitId,
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)]
-> Map
InstalledUnitId
(InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod))
-> ([InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod]
-> [(InstalledUnitId,
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)])
-> [InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod]
-> Map
InstalledUnitId
(InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> (InstalledUnitId,
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod))
-> [InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod]
-> [(InstalledUnitId,
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod)]
forall a b. (a -> b) -> [a] -> [b]
map (\p :: InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
p -> (InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
p, InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
p))
override_set :: Set InstalledUnitId
override_set :: Set InstalledUnitId
override_set = Set InstalledUnitId -> Set InstalledUnitId -> Set InstalledUnitId
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (InstalledPackageIndex -> Set InstalledUnitId
forall k a. Map k a -> Set k
Map.keysSet InstalledPackageIndex
db_map)
(InstalledPackageIndex -> Set InstalledUnitId
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
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
Map.union ((PackageConfig -> Int)
-> InstalledPackageIndex -> PackagePrecedenceIndex
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Int -> PackageConfig -> Int
forall a b. a -> b -> a
const Int
i) InstalledPackageIndex
db_map) PackagePrecedenceIndex
prec_map
validateDatabase :: DynFlags -> InstalledPackageIndex
-> (InstalledPackageIndex, UnusablePackages, [SCC PackageConfig])
validateDatabase :: DynFlags
-> InstalledPackageIndex
-> (InstalledPackageIndex, UnusablePackages, [SCC PackageConfig])
validateDatabase dflags :: DynFlags
dflags pkg_map1 :: InstalledPackageIndex
pkg_map1 =
(InstalledPackageIndex
pkg_map5, UnusablePackages
unusable, [SCC PackageConfig]
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
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t)
-> t
-> [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
-> Map
k
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b)
mk_unusable mk_err :: t -> b
mk_err dep_matcher :: t
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t
dep_matcher m :: t
m uids :: [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
uids =
[(k,
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b))]
-> Map
k
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> k
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
pkg, (InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
pkg, t -> b
mk_err (t
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t
dep_matcher t
m InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
pkg)))
| InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
pkg <- [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
uids ]
directly_broken :: [PackageConfig]
directly_broken = (PackageConfig -> Bool) -> [PackageConfig] -> [PackageConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PackageConfig -> Bool) -> PackageConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstalledUnitId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InstalledUnitId] -> Bool)
-> (PackageConfig -> [InstalledUnitId]) -> PackageConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsNotAvailable InstalledPackageIndex
pkg_map1)
(InstalledPackageIndex -> [PackageConfig]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map1)
(pkg_map2 :: InstalledPackageIndex
pkg_map2, broken :: [PackageConfig]
broken) = [InstalledUnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [PackageConfig])
removePackages ((PackageConfig -> InstalledUnitId)
-> [PackageConfig] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId [PackageConfig]
directly_broken) RevIndex
index InstalledPackageIndex
pkg_map1
unusable_broken :: UnusablePackages
unusable_broken = ([InstalledUnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> PackageConfig -> [InstalledUnitId])
-> InstalledPackageIndex
-> [PackageConfig]
-> UnusablePackages
forall k t b t compid srcpkgid srcpkgname unitid modulename mod.
Ord k =>
(t -> b)
-> (t
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t)
-> t
-> [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
-> Map
k
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b)
mk_unusable [InstalledUnitId] -> UnusablePackageReason
BrokenDependencies InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsNotAvailable InstalledPackageIndex
pkg_map2 [PackageConfig]
broken
sccs :: [SCC PackageConfig]
sccs = [(PackageConfig, InstalledUnitId, [InstalledUnitId])]
-> [SCC PackageConfig]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp [ (PackageConfig
pkg, PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId PackageConfig
pkg, PackageConfig -> [InstalledUnitId]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
depends PackageConfig
pkg)
| PackageConfig
pkg <- InstalledPackageIndex -> [PackageConfig]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map2 ]
getCyclicSCC :: SCC
(InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod)
-> [b]
getCyclicSCC (CyclicSCC vs :: [InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod]
vs) = (InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod
-> b)
-> [InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod]
-> [b]
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod
-> b
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId [InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod]
vs
getCyclicSCC (AcyclicSCC _) = []
(pkg_map3 :: InstalledPackageIndex
pkg_map3, cyclic :: [PackageConfig]
cyclic) = [InstalledUnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [PackageConfig])
removePackages ((SCC PackageConfig -> [InstalledUnitId])
-> [SCC PackageConfig] -> [InstalledUnitId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SCC PackageConfig -> [InstalledUnitId]
forall compid srcpkgid srcpkgname b unitid modulename mod.
SCC
(InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod)
-> [b]
getCyclicSCC [SCC PackageConfig]
sccs) RevIndex
index InstalledPackageIndex
pkg_map2
unusable_cyclic :: UnusablePackages
unusable_cyclic = ([InstalledUnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> PackageConfig -> [InstalledUnitId])
-> InstalledPackageIndex
-> [PackageConfig]
-> UnusablePackages
forall k t b t compid srcpkgid srcpkgname unitid modulename mod.
Ord k =>
(t -> b)
-> (t
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t)
-> t
-> [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
-> Map
k
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b)
mk_unusable [InstalledUnitId] -> UnusablePackageReason
CyclicDependencies InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsNotAvailable InstalledPackageIndex
pkg_map3 [PackageConfig]
cyclic
directly_ignored :: UnusablePackages
directly_ignored = [IgnorePackageFlag] -> [PackageConfig] -> UnusablePackages
ignorePackages [IgnorePackageFlag]
ignore_flags (InstalledPackageIndex -> [PackageConfig]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map3)
(pkg_map4 :: InstalledPackageIndex
pkg_map4, ignored :: [PackageConfig]
ignored) = [InstalledUnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [PackageConfig])
removePackages (UnusablePackages -> [InstalledUnitId]
forall k a. Map k a -> [k]
Map.keys UnusablePackages
directly_ignored) RevIndex
index InstalledPackageIndex
pkg_map3
unusable_ignored :: UnusablePackages
unusable_ignored = ([InstalledUnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> PackageConfig -> [InstalledUnitId])
-> InstalledPackageIndex
-> [PackageConfig]
-> UnusablePackages
forall k t b t compid srcpkgid srcpkgname unitid modulename mod.
Ord k =>
(t -> b)
-> (t
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t)
-> t
-> [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
-> Map
k
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b)
mk_unusable [InstalledUnitId] -> UnusablePackageReason
IgnoredDependencies InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsNotAvailable InstalledPackageIndex
pkg_map4 [PackageConfig]
ignored
directly_shadowed :: [PackageConfig]
directly_shadowed = (PackageConfig -> Bool) -> [PackageConfig] -> [PackageConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (PackageConfig -> Bool) -> PackageConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InstalledUnitId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([InstalledUnitId] -> Bool)
-> (PackageConfig -> [InstalledUnitId]) -> PackageConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsAbiMismatch InstalledPackageIndex
pkg_map4)
(InstalledPackageIndex -> [PackageConfig]
forall k a. Map k a -> [a]
Map.elems InstalledPackageIndex
pkg_map4)
(pkg_map5 :: InstalledPackageIndex
pkg_map5, shadowed :: [PackageConfig]
shadowed) = [InstalledUnitId]
-> RevIndex
-> InstalledPackageIndex
-> (InstalledPackageIndex, [PackageConfig])
removePackages ((PackageConfig -> InstalledUnitId)
-> [PackageConfig] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId [PackageConfig]
directly_shadowed) RevIndex
index InstalledPackageIndex
pkg_map4
unusable_shadowed :: UnusablePackages
unusable_shadowed = ([InstalledUnitId] -> UnusablePackageReason)
-> (InstalledPackageIndex -> PackageConfig -> [InstalledUnitId])
-> InstalledPackageIndex
-> [PackageConfig]
-> UnusablePackages
forall k t b t compid srcpkgid srcpkgname unitid modulename mod.
Ord k =>
(t -> b)
-> (t
-> InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod
-> t)
-> t
-> [InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod]
-> Map
k
(InstalledPackageInfo
compid srcpkgid srcpkgname k unitid modulename mod,
b)
mk_unusable [InstalledUnitId] -> UnusablePackageReason
ShadowedDependencies InstalledPackageIndex -> PackageConfig -> [InstalledUnitId]
depsAbiMismatch InstalledPackageIndex
pkg_map5 [PackageConfig]
shadowed
unusable :: UnusablePackages
unusable = UnusablePackages
directly_ignored UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` UnusablePackages
unusable_ignored
UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` UnusablePackages
unusable_broken
UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` UnusablePackages
unusable_cyclic
UnusablePackages -> UnusablePackages -> UnusablePackages
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` UnusablePackages
unusable_shadowed
mkPackageState
:: DynFlags
-> [(FilePath, [PackageConfig])]
-> [PreloadUnitId]
-> IO (PackageState,
[PreloadUnitId],
Maybe [(ModuleName, Module)])
mkPackageState :: DynFlags
-> [(String, [PackageConfig])]
-> [InstalledUnitId]
-> IO
(PackageState, [InstalledUnitId], Maybe [(ModuleName, Module)])
mkPackageState dflags :: DynFlags
dflags dbs :: [(String, [PackageConfig])]
dbs preload0 :: [InstalledUnitId]
preload0 = do
let other_flags :: [PackageFlag]
other_flags = [PackageFlag] -> [PackageFlag]
forall a. [a] -> [a]
reverse (DynFlags -> [PackageFlag]
packageFlags DynFlags
dflags)
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags 2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text "package flags" SDoc -> SDoc -> SDoc
<+> [PackageFlag] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [PackageFlag]
other_flags
(pkg_map1 :: InstalledPackageIndex
pkg_map1, prec_map :: PackagePrecedenceIndex
prec_map) <- DynFlags
-> [(String, [PackageConfig])]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases DynFlags
dflags [(String, [PackageConfig])]
dbs
let (pkg_map2 :: InstalledPackageIndex
pkg_map2, unusable :: UnusablePackages
unusable, sccs :: [SCC PackageConfig]
sccs) = DynFlags
-> InstalledPackageIndex
-> (InstalledPackageIndex, UnusablePackages, [SCC PackageConfig])
validateDatabase DynFlags
dflags InstalledPackageIndex
pkg_map1
DynFlags -> [SCC PackageConfig] -> IO ()
reportCycles DynFlags
dflags [SCC PackageConfig]
sccs
DynFlags -> UnusablePackages -> IO ()
reportUnusable DynFlags
dflags UnusablePackages
unusable
[PackageConfig]
pkgs1 <- ([PackageConfig] -> TrustFlag -> IO [PackageConfig])
-> [PackageConfig] -> [TrustFlag] -> IO [PackageConfig]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [PackageConfig]
-> TrustFlag
-> IO [PackageConfig]
applyTrustFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnusablePackages
unusable)
(InstalledPackageIndex -> [PackageConfig]
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 :: PackageConfigMap
prelim_pkg_db = PackageConfigMap -> [PackageConfig] -> PackageConfigMap
extendPackageConfigMap PackageConfigMap
emptyPackageConfigMap [PackageConfig]
pkgs1
let preferLater :: PackageConfig -> PackageConfig -> PackageConfig
preferLater unit :: PackageConfig
unit unit' :: PackageConfig
unit' =
case PackagePrecedenceIndex
-> PackageConfig -> PackageConfig -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map PackageConfig
unit PackageConfig
unit' of
GT -> PackageConfig
unit
_ -> PackageConfig
unit'
addIfMorePreferable :: InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig
addIfMorePreferable m :: InstalledUnitIdMap PackageConfig
m unit :: PackageConfig
unit = (PackageConfig -> PackageConfig -> PackageConfig)
-> InstalledUnitIdMap PackageConfig
-> FastString
-> PackageConfig
-> InstalledUnitIdMap PackageConfig
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqDFM elt -> key -> elt -> UniqDFM elt
addToUDFM_C PackageConfig -> PackageConfig -> PackageConfig
preferLater InstalledUnitIdMap PackageConfig
m (PackageConfig -> FastString
fsPackageName PackageConfig
unit) PackageConfig
unit
mostPreferablePackageReps :: InstalledUnitIdMap PackageConfig
mostPreferablePackageReps = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPackages DynFlags
dflags
then InstalledUnitIdMap PackageConfig
forall elt. UniqDFM elt
emptyUDFM
else (InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig)
-> InstalledUnitIdMap PackageConfig
-> [PackageConfig]
-> InstalledUnitIdMap PackageConfig
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig
addIfMorePreferable InstalledUnitIdMap PackageConfig
forall elt. UniqDFM elt
emptyUDFM [PackageConfig]
pkgs1
mostPreferable :: PackageConfig -> Bool
mostPreferable u :: PackageConfig
u =
case InstalledUnitIdMap PackageConfig
-> FastString -> Maybe PackageConfig
forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt
lookupUDFM InstalledUnitIdMap PackageConfig
mostPreferablePackageReps (PackageConfig -> FastString
fsPackageName PackageConfig
u) of
Nothing -> Bool
False
Just u' :: PackageConfig
u' -> PackagePrecedenceIndex
-> PackageConfig -> PackageConfig -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map PackageConfig
u PackageConfig
u' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
vis_map1 :: VisibilityMap
vis_map1 = (VisibilityMap -> PackageConfig -> VisibilityMap)
-> VisibilityMap -> [PackageConfig] -> VisibilityMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\vm :: VisibilityMap
vm p :: PackageConfig
p ->
if PackageConfig -> Bool
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
exposed PackageConfig
p Bool -> Bool -> Bool
&& UnitId -> Bool
unitIdIsDefinite (PackageConfig -> UnitId
packageConfigId PackageConfig
p) Bool -> Bool -> Bool
&& PackageConfig -> Bool
mostPreferable PackageConfig
p
then UnitId -> UnitVisibility -> VisibilityMap -> VisibilityMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (PackageConfig -> UnitId
packageConfigId PackageConfig
p)
UnitVisibility :: Bool
-> [(ModuleName, ModuleName)]
-> First FastString
-> Map ModuleName (Set IndefModule)
-> 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 (PackageConfig -> FastString
fsPackageName PackageConfig
p)),
uv_requirements :: Map ModuleName (Set IndefModule)
uv_requirements = Map ModuleName (Set IndefModule)
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 [PackageConfig]
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
foldM (DynFlags
-> PackagePrecedenceIndex
-> PackageConfigMap
-> UnusablePackages
-> Bool
-> [PackageConfig]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag DynFlags
dflags PackagePrecedenceIndex
prec_map PackageConfigMap
prelim_pkg_db UnusablePackages
unusable
(GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPackages DynFlags
dflags) [PackageConfig]
pkgs1)
VisibilityMap
vis_map1 [PackageFlag]
other_flags
(pkgs2 :: [PackageConfig]
pkgs2, wired_map :: Map WiredUnitId WiredUnitId
wired_map) <- DynFlags
-> PackagePrecedenceIndex
-> [PackageConfig]
-> VisibilityMap
-> IO ([PackageConfig], Map WiredUnitId WiredUnitId)
findWiredInPackages DynFlags
dflags PackagePrecedenceIndex
prec_map [PackageConfig]
pkgs1 VisibilityMap
vis_map2
let pkg_db :: PackageConfigMap
pkg_db = PackageConfigMap -> [PackageConfig] -> PackageConfigMap
extendPackageConfigMap PackageConfigMap
emptyPackageConfigMap [PackageConfig]
pkgs2
let vis_map :: VisibilityMap
vis_map = Map WiredUnitId WiredUnitId -> VisibilityMap -> VisibilityMap
updateVisibilityMap Map WiredUnitId WiredUnitId
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
return VisibilityMap
vis_map
| Bool
otherwise -> VisibilityMap -> IO VisibilityMap
forall (m :: * -> *) a. Monad m => a -> m a
return VisibilityMap
forall k a. Map k a
Map.empty
_ -> 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
foldM (DynFlags
-> PackagePrecedenceIndex
-> PackageConfigMap
-> UnusablePackages
-> Bool
-> [PackageConfig]
-> VisibilityMap
-> PackageFlag
-> IO VisibilityMap
applyPackageFlag DynFlags
dflags PackagePrecedenceIndex
prec_map PackageConfigMap
prelim_pkg_db UnusablePackages
unusable
(GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HideAllPluginPackages DynFlags
dflags) [PackageConfig]
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
return (Map WiredUnitId WiredUnitId -> VisibilityMap -> VisibilityMap
updateVisibilityMap Map WiredUnitId WiredUnitId
wired_map VisibilityMap
plugin_vis_map2)
let preload1 :: [UnitId]
preload1 = VisibilityMap -> [UnitId]
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 ComponentId
pkgname_map = (Map PackageName ComponentId
-> PackageConfig -> Map PackageName ComponentId)
-> Map PackageName ComponentId
-> [PackageConfig]
-> Map PackageName ComponentId
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map PackageName ComponentId
-> PackageConfig -> Map PackageName ComponentId
forall srcpkgname a srcpkgid instunitid unitid modulename mod.
Ord srcpkgname =>
Map srcpkgname a
-> InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
-> Map srcpkgname a
add Map PackageName ComponentId
forall k a. Map k a
Map.empty [PackageConfig]
pkgs2
where add :: Map srcpkgname a
-> InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
-> Map srcpkgname a
add pn_map :: Map srcpkgname a
pn_map p :: InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
p
= srcpkgname -> a -> Map srcpkgname a -> Map srcpkgname a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgname
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgname
packageName InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
p) (InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
-> a
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> compid
componentId InstalledPackageInfo
a srcpkgid srcpkgname instunitid unitid modulename mod
p) Map srcpkgname a
pn_map
let explicit_pkgs :: [UnitId]
explicit_pkgs = VisibilityMap -> [UnitId]
forall k a. Map k a -> [k]
Map.keys VisibilityMap
vis_map
req_ctx :: Map ModuleName [IndefModule]
req_ctx = (Set IndefModule -> [IndefModule])
-> Map ModuleName (Set IndefModule) -> Map ModuleName [IndefModule]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Set IndefModule -> [IndefModule]
forall a. Set a -> [a]
Set.toList)
(Map ModuleName (Set IndefModule) -> Map ModuleName [IndefModule])
-> Map ModuleName (Set IndefModule) -> Map ModuleName [IndefModule]
forall a b. (a -> b) -> a -> b
$ (Set IndefModule -> Set IndefModule -> Set IndefModule)
-> [Map ModuleName (Set IndefModule)]
-> Map ModuleName (Set IndefModule)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Set IndefModule -> Set IndefModule -> Set IndefModule
forall a. Ord a => Set a -> Set a -> Set a
Set.union ((UnitVisibility -> Map ModuleName (Set IndefModule))
-> [UnitVisibility] -> [Map ModuleName (Set IndefModule)]
forall a b. (a -> b) -> [a] -> [b]
map UnitVisibility -> Map ModuleName (Set IndefModule)
uv_requirements (VisibilityMap -> [UnitVisibility]
forall k a. Map k a -> [a]
Map.elems VisibilityMap
vis_map))
let preload2 :: [UnitId]
preload2 = [UnitId]
preload1
let
basicLinkedPackages :: [UnitId]
basicLinkedPackages
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_AutoLinkPackages DynFlags
dflags
= (UnitId -> Bool) -> [UnitId] -> [UnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnitId -> InstalledUnitIdMap PackageConfig -> Bool)
-> InstalledUnitIdMap PackageConfig -> UnitId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip UnitId -> InstalledUnitIdMap PackageConfig -> Bool
forall key elt. Uniquable key => key -> UniqDFM elt -> Bool
elemUDFM (PackageConfigMap -> InstalledUnitIdMap PackageConfig
unPackageConfigMap PackageConfigMap
pkg_db))
[UnitId
baseUnitId, UnitId
rtsUnitId]
| Bool
otherwise = []
preload3 :: [UnitId]
preload3 = [UnitId] -> [UnitId]
forall a. Eq a => [a] -> [a]
nub ([UnitId] -> [UnitId]) -> [UnitId] -> [UnitId]
forall a b. (a -> b) -> a -> b
$ (UnitId -> Bool) -> [UnitId] -> [UnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= DynFlags -> UnitId
thisPackage DynFlags
dflags)
([UnitId] -> [UnitId]) -> [UnitId] -> [UnitId]
forall a b. (a -> b) -> a -> b
$ ([UnitId]
basicLinkedPackages [UnitId] -> [UnitId] -> [UnitId]
forall a. [a] -> [a] -> [a]
++ [UnitId]
preload2)
[InstalledUnitId]
dep_preload <- DynFlags
-> PackageConfigMap
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> IO [InstalledUnitId]
closeDeps DynFlags
dflags PackageConfigMap
pkg_db ([InstalledUnitId]
-> [Maybe InstalledUnitId]
-> [(InstalledUnitId, Maybe InstalledUnitId)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((UnitId -> InstalledUnitId) -> [UnitId] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> InstalledUnitId
toInstalledUnitId [UnitId]
preload3) (Maybe InstalledUnitId -> [Maybe InstalledUnitId]
forall a. a -> [a]
repeat Maybe InstalledUnitId
forall a. Maybe a
Nothing))
let new_dep_preload :: [InstalledUnitId]
new_dep_preload = (InstalledUnitId -> Bool) -> [InstalledUnitId] -> [InstalledUnitId]
forall a. (a -> Bool) -> [a] -> [a]
filter (InstalledUnitId -> [InstalledUnitId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [InstalledUnitId]
preload0) [InstalledUnitId]
dep_preload
let mod_map1 :: ModuleToPkgConfAll
mod_map1 = DynFlags -> PackageConfigMap -> VisibilityMap -> ModuleToPkgConfAll
mkModuleToPkgConfAll DynFlags
dflags PackageConfigMap
pkg_db VisibilityMap
vis_map
mod_map2 :: ModuleToPkgConfAll
mod_map2 = UnusablePackages -> ModuleToPkgConfAll
mkUnusableModuleToPkgConfAll UnusablePackages
unusable
mod_map :: ModuleToPkgConfAll
mod_map = ModuleToPkgConfAll -> ModuleToPkgConfAll -> ModuleToPkgConfAll
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ModuleToPkgConfAll
mod_map1 ModuleToPkgConfAll
mod_map2
DynFlags -> DumpFlag -> String -> SDoc -> IO ()
dumpIfSet_dyn (DynFlags
dflags { pprCols :: Int
pprCols = 200 }) DumpFlag
Opt_D_dump_mod_map "Mod Map"
(ModuleToPkgConfAll -> SDoc
pprModuleMap ModuleToPkgConfAll
mod_map)
let !pstate :: PackageState
pstate = $WPackageState :: PackageConfigMap
-> Map PackageName ComponentId
-> Map WiredUnitId WiredUnitId
-> [InstalledUnitId]
-> [UnitId]
-> ModuleToPkgConfAll
-> ModuleToPkgConfAll
-> Map ModuleName [IndefModule]
-> PackageState
PackageState{
preloadPackages :: [InstalledUnitId]
preloadPackages = [InstalledUnitId]
dep_preload,
explicitPackages :: [UnitId]
explicitPackages = [UnitId]
explicit_pkgs,
pkgIdMap :: PackageConfigMap
pkgIdMap = PackageConfigMap
pkg_db,
moduleToPkgConfAll :: ModuleToPkgConfAll
moduleToPkgConfAll = ModuleToPkgConfAll
mod_map,
pluginModuleToPkgConfAll :: ModuleToPkgConfAll
pluginModuleToPkgConfAll = DynFlags -> PackageConfigMap -> VisibilityMap -> ModuleToPkgConfAll
mkModuleToPkgConfAll DynFlags
dflags PackageConfigMap
pkg_db VisibilityMap
plugin_vis_map,
packageNameMap :: Map PackageName ComponentId
packageNameMap = Map PackageName ComponentId
pkgname_map,
unwireMap :: Map WiredUnitId WiredUnitId
unwireMap = [(WiredUnitId, WiredUnitId)] -> Map WiredUnitId WiredUnitId
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (WiredUnitId
v,WiredUnitId
k) | (k :: WiredUnitId
k,v :: WiredUnitId
v) <- Map WiredUnitId WiredUnitId -> [(WiredUnitId, WiredUnitId)]
forall k a. Map k a -> [(k, a)]
Map.toList Map WiredUnitId WiredUnitId
wired_map ],
requirementContext :: Map ModuleName [IndefModule]
requirementContext = Map ModuleName [IndefModule]
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
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
fmap (Map WiredUnitId WiredUnitId -> Module -> Module
upd_wired_in_mod Map WiredUnitId WiredUnitId
wired_map))) (DynFlags -> Maybe [(ModuleName, Module)]
thisUnitIdInsts_ DynFlags
dflags)
(PackageState, [InstalledUnitId], Maybe [(ModuleName, Module)])
-> IO
(PackageState, [InstalledUnitId], Maybe [(ModuleName, Module)])
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageState
pstate, [InstalledUnitId]
new_dep_preload, Maybe [(ModuleName, Module)]
new_insts)
unwireUnitId :: DynFlags -> UnitId -> UnitId
unwireUnitId :: DynFlags -> UnitId -> UnitId
unwireUnitId dflags :: DynFlags
dflags uid :: UnitId
uid@(DefiniteUnitId def_uid :: WiredUnitId
def_uid) =
UnitId -> (WiredUnitId -> UnitId) -> Maybe WiredUnitId -> UnitId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UnitId
uid WiredUnitId -> UnitId
DefiniteUnitId (WiredUnitId -> Map WiredUnitId WiredUnitId -> Maybe WiredUnitId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WiredUnitId
def_uid (PackageState -> Map WiredUnitId WiredUnitId
unwireMap (DynFlags -> PackageState
pkgState DynFlags
dflags)))
unwireUnitId _ uid :: UnitId
uid = UnitId
uid
mkModuleToPkgConfAll
:: DynFlags
-> PackageConfigMap
-> VisibilityMap
-> ModuleToPkgConfAll
mkModuleToPkgConfAll :: DynFlags -> PackageConfigMap -> VisibilityMap -> ModuleToPkgConfAll
mkModuleToPkgConfAll dflags :: DynFlags
dflags pkg_db :: PackageConfigMap
pkg_db vis_map :: VisibilityMap
vis_map =
(ModuleToPkgConfAll
-> UnitId -> UnitVisibility -> ModuleToPkgConfAll)
-> ModuleToPkgConfAll -> VisibilityMap -> ModuleToPkgConfAll
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey ModuleToPkgConfAll
-> UnitId -> UnitVisibility -> ModuleToPkgConfAll
extend_modmap ModuleToPkgConfAll
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
Map.union VisibilityMap
vis_map VisibilityMap
default_vis
default_vis :: VisibilityMap
default_vis = [(UnitId, UnitVisibility)] -> VisibilityMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (PackageConfig -> UnitId
packageConfigId PackageConfig
pkg, UnitVisibility
forall a. Monoid a => a
mempty)
| PackageConfig
pkg <- InstalledUnitIdMap PackageConfig -> [PackageConfig]
forall elt. UniqDFM elt -> [elt]
eltsUDFM (PackageConfigMap -> InstalledUnitIdMap PackageConfig
unPackageConfigMap PackageConfigMap
pkg_db)
, PackageConfig -> Bool
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
indefinite PackageConfig
pkg Bool -> Bool -> Bool
|| [(ModuleName, Module)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PackageConfig -> [(ModuleName, Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, mod)]
instantiatedWith PackageConfig
pkg)
]
emptyMap :: Map k a
emptyMap = Map k a
forall k a. Map k a
Map.empty
setOrigins :: f b -> b -> f b
setOrigins m :: f b
m os :: b
os = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b -> b
forall a b. a -> b -> a
const b
os) f b
m
extend_modmap :: ModuleToPkgConfAll
-> UnitId -> UnitVisibility -> ModuleToPkgConfAll
extend_modmap modmap :: ModuleToPkgConfAll
modmap uid :: UnitId
uid
UnitVisibility { uv_expose_all :: UnitVisibility -> Bool
uv_expose_all = Bool
b, uv_renamings :: UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings = [(ModuleName, ModuleName)]
rns }
= ModuleToPkgConfAll
-> [(ModuleName, Map Module ModuleOrigin)] -> ModuleToPkgConfAll
forall a k1 k2.
(Monoid a, Ord k1, Ord k2) =>
Map k1 (Map k2 a) -> [(k1, Map k2 a)] -> Map k1 (Map k2 a)
addListTo ModuleToPkgConfAll
modmap [(ModuleName, Map Module ModuleOrigin)]
theBindings
where
pkg :: PackageConfig
pkg = UnitId -> PackageConfig
pkg_lookup UnitId
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 e :: Bool
e rns :: [(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 (orig :: ModuleName
orig, new :: ModuleName
new) = (ModuleName
new, Map Module ModuleOrigin -> ModuleOrigin -> Map Module ModuleOrigin
forall (f :: * -> *) b b. Functor f => f b -> b -> f b
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
lookupUFM UniqFM (Map Module ModuleOrigin)
esmap ModuleName
orig of
Just r :: Map Module ModuleOrigin
r -> Map Module ModuleOrigin
r
Nothing -> GhcException -> Map Module ModuleOrigin
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags
(String -> SDoc
text "package flag: could not find module name" SDoc -> SDoc -> SDoc
<+>
ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
orig SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "in package" SDoc -> SDoc -> SDoc
<+> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
pk)))
es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]
es :: Bool -> [(ModuleName, Map Module ModuleOrigin)]
es e :: Bool
e = do
(m :: ModuleName
m, exposedReexport :: Maybe Module
exposedReexport) <- [(ModuleName, Maybe Module)]
exposed_mods
let (pk' :: UnitId
pk', m' :: ModuleName
m', origin' :: ModuleOrigin
origin') =
case Maybe Module
exposedReexport of
Nothing -> (UnitId
pk, ModuleName
m, Bool -> ModuleOrigin
fromExposedModules Bool
e)
Just (Module pk' :: UnitId
pk' m' :: ModuleName
m') ->
let pkg' :: PackageConfig
pkg' = UnitId -> PackageConfig
pkg_lookup UnitId
pk'
in (UnitId
pk', ModuleName
m', Bool -> PackageConfig -> ModuleOrigin
fromReexportedModules Bool
e PackageConfig
pkg')
(ModuleName, Map Module ModuleOrigin)
-> [(ModuleName, Map Module ModuleOrigin)]
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
m, UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap UnitId
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
listToUFM (Bool -> [(ModuleName, Map Module ModuleOrigin)]
es Bool
False)
hiddens :: [(ModuleName, Map Module ModuleOrigin)]
hiddens = [(ModuleName
m, UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap UnitId
pk ModuleName
m ModuleOrigin
ModHidden) | ModuleName
m <- [ModuleName]
hidden_mods]
pk :: UnitId
pk = PackageConfig -> UnitId
packageConfigId PackageConfig
pkg
pkg_lookup :: UnitId -> PackageConfig
pkg_lookup uid :: UnitId
uid = Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig
lookupPackage' (DynFlags -> Bool
isIndefinite DynFlags
dflags) PackageConfigMap
pkg_db UnitId
uid
Maybe PackageConfig -> PackageConfig -> PackageConfig
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> PackageConfig
forall a. HasCallStack => String -> SDoc -> a
pprPanic "pkg_lookup" (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
uid)
exposed_mods :: [(ModuleName, Maybe Module)]
exposed_mods = PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules PackageConfig
pkg
hidden_mods :: [ModuleName]
hidden_mods = PackageConfig -> [ModuleName]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [modulename]
hiddenModules PackageConfig
pkg
mkUnusableModuleToPkgConfAll :: UnusablePackages -> ModuleToPkgConfAll
mkUnusableModuleToPkgConfAll :: UnusablePackages -> ModuleToPkgConfAll
mkUnusableModuleToPkgConfAll unusables :: UnusablePackages
unusables =
(ModuleToPkgConfAll
-> (PackageConfig, UnusablePackageReason) -> ModuleToPkgConfAll)
-> ModuleToPkgConfAll -> UnusablePackages -> ModuleToPkgConfAll
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' ModuleToPkgConfAll
-> (PackageConfig, UnusablePackageReason) -> ModuleToPkgConfAll
extend_modmap ModuleToPkgConfAll
forall k a. Map k a
Map.empty UnusablePackages
unusables
where
extend_modmap :: ModuleToPkgConfAll
-> (PackageConfig, UnusablePackageReason) -> ModuleToPkgConfAll
extend_modmap modmap :: ModuleToPkgConfAll
modmap (pkg :: PackageConfig
pkg, reason :: UnusablePackageReason
reason) = ModuleToPkgConfAll
-> [(ModuleName, Map Module ModuleOrigin)] -> ModuleToPkgConfAll
forall a k1 k2.
(Monoid a, Ord k1, Ord k2) =>
Map k1 (Map k2 a) -> [(k1, Map k2 a)] -> Map k1 (Map k2 a)
addListTo ModuleToPkgConfAll
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 :: UnitId
pkg_id = PackageConfig -> UnitId
packageConfigId PackageConfig
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, UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap UnitId
pkg_id ModuleName
m ModuleOrigin
origin) | ModuleName
m <- [ModuleName]
hidden_mods]
get_exposed :: (ModuleName, Maybe Module) -> (ModuleName, Map Module ModuleOrigin)
get_exposed (mod :: ModuleName
mod, Just mod' :: 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 (mod :: ModuleName
mod, _) = (ModuleName
mod, UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap UnitId
pkg_id ModuleName
mod ModuleOrigin
origin)
exposed_mods :: [(ModuleName, Maybe Module)]
exposed_mods = PackageConfig -> [(ModuleName, Maybe Module)]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules PackageConfig
pkg
hidden_mods :: [ModuleName]
hidden_mods = PackageConfig -> [ModuleName]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [modulename]
hiddenModules PackageConfig
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
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)
merge
where merge :: Map k (Map k a) -> (k, Map k a) -> Map k (Map k a)
merge m :: Map k (Map k a)
m (k :: k
k, v :: 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
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
Map.unionWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend) k
k Map k a
v Map k (Map k a)
m
mkModMap :: UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap :: UnitId -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
mkModMap pkg :: UnitId
pkg mod :: ModuleName
mod = Module -> ModuleOrigin -> Map Module ModuleOrigin
forall k a. k -> a -> Map k a
Map.singleton (UnitId -> ModuleName -> Module
mkModule UnitId
pkg ModuleName
mod)
getPackageIncludePath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageIncludePath :: DynFlags -> [InstalledUnitId] -> IO [String]
getPackageIncludePath dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs =
[PackageConfig] -> [String]
collectIncludeDirs ([PackageConfig] -> [String]) -> IO [PackageConfig] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
collectIncludeDirs :: [PackageConfig] -> [FilePath]
collectIncludeDirs :: [PackageConfig] -> [String]
collectIncludeDirs ps :: [PackageConfig]
ps = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. [a] -> Bool
notNull ((PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
includeDirs [PackageConfig]
ps))
getPackageLibraryPath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageLibraryPath :: DynFlags -> [InstalledUnitId] -> IO [String]
getPackageLibraryPath dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs =
DynFlags -> [PackageConfig] -> [String]
collectLibraryPaths DynFlags
dflags ([PackageConfig] -> [String]) -> IO [PackageConfig] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
collectLibraryPaths :: DynFlags -> [PackageConfig] -> [FilePath]
collectLibraryPaths :: DynFlags -> [PackageConfig] -> [String]
collectLibraryPaths dflags :: DynFlags
dflags = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([PackageConfig] -> [String]) -> [PackageConfig] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. [a] -> Bool
notNull
([String] -> [String])
-> ([PackageConfig] -> [String]) -> [PackageConfig] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags -> PackageConfig -> [String]
libraryDirsForWay DynFlags
dflags)
getPackageLinkOpts :: DynFlags -> [PreloadUnitId] -> IO ([String], [String], [String])
getPackageLinkOpts :: DynFlags -> [InstalledUnitId] -> IO ([String], [String], [String])
getPackageLinkOpts dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs =
DynFlags -> [PackageConfig] -> ([String], [String], [String])
collectLinkOpts DynFlags
dflags ([PackageConfig] -> ([String], [String], [String]))
-> IO [PackageConfig] -> IO ([String], [String], [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
collectLinkOpts :: DynFlags -> [PackageConfig] -> ([String], [String], [String])
collectLinkOpts :: DynFlags -> [PackageConfig] -> ([String], [String], [String])
collectLinkOpts dflags :: DynFlags
dflags ps :: [PackageConfig]
ps =
(
(PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (PackageConfig -> [String]) -> PackageConfig -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PackageConfig -> [String]
packageHsLibs DynFlags
dflags) [PackageConfig]
ps,
(PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String])
-> (PackageConfig -> [String]) -> PackageConfig -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
extraLibraries) [PackageConfig]
ps,
(PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
ldOptions [PackageConfig]
ps
)
collectArchives :: DynFlags -> PackageConfig -> IO [FilePath]
collectArchives :: DynFlags -> PackageConfig -> IO [String]
collectArchives dflags :: DynFlags
dflags pc :: PackageConfig
pc =
(String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [ String
searchPath String -> String -> String
</> ("lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lib String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".a")
| String
searchPath <- [String]
searchPaths
, String
lib <- [String]
libs ]
where searchPaths :: [String]
searchPaths = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> (PackageConfig -> [String]) -> PackageConfig -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. [a] -> Bool
notNull ([String] -> [String])
-> (PackageConfig -> [String]) -> PackageConfig -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PackageConfig -> [String]
libraryDirsForWay DynFlags
dflags (PackageConfig -> [String]) -> PackageConfig -> [String]
forall a b. (a -> b) -> a -> b
$ PackageConfig
pc
libs :: [String]
libs = DynFlags -> PackageConfig -> [String]
packageHsLibs DynFlags
dflags PackageConfig
pc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
extraLibraries PackageConfig
pc
getLibs :: DynFlags -> [PreloadUnitId] -> IO [(String,String)]
getLibs :: DynFlags -> [InstalledUnitId] -> IO [(String, String)]
getLibs dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs = do
[PackageConfig]
ps <- DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
([[(String, String)]] -> [(String, String)])
-> IO [[(String, String)]] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[(String, String)]] -> IO [(String, String)])
-> ((PackageConfig -> IO [(String, String)])
-> IO [[(String, String)]])
-> (PackageConfig -> IO [(String, String)])
-> IO [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageConfig]
-> (PackageConfig -> IO [(String, String)])
-> IO [[(String, String)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PackageConfig]
ps ((PackageConfig -> IO [(String, String)]) -> IO [(String, String)])
-> (PackageConfig -> IO [(String, String)])
-> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ \p :: PackageConfig
p -> do
let candidates :: [(String, String)]
candidates = [ (String
l String -> String -> String
</> String
f, String
f) | String
l <- DynFlags -> [PackageConfig] -> [String]
collectLibraryPaths DynFlags
dflags [PackageConfig
p]
, String
f <- (\n :: String
n -> "lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".a") (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> PackageConfig -> [String]
packageHsLibs DynFlags
dflags PackageConfig
p ]
((String, String) -> IO Bool)
-> [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
doesFileExist (String -> IO Bool)
-> ((String, String) -> String) -> (String, String) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
candidates
packageHsLibs :: DynFlags -> PackageConfig -> [String]
packageHsLibs :: DynFlags -> PackageConfig -> [String]
packageHsLibs dflags :: DynFlags
dflags p :: PackageConfig
p = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
mkDynName (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addSuffix) (PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
hsLibraries PackageConfig
p)
where
ways0 :: [Way]
ways0 = DynFlags -> [Way]
ways DynFlags
dflags
ways1 :: [Way]
ways1 = (Way -> Bool) -> [Way] -> [Way]
forall a. (a -> Bool) -> [a] -> [a]
filter (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
/= Way
WayDyn) [Way]
ways0
ways2 :: [Way]
ways2 | Way
WayDebug Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Way]
ways1 Bool -> Bool -> Bool
|| Way
WayProf Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Way]
ways1
= (Way -> Bool) -> [Way] -> [Way]
forall a. (a -> Bool) -> [a] -> [a]
filter (Way -> Way -> Bool
forall a. Eq a => a -> a -> Bool
/= Way
WayEventLog) [Way]
ways1
| Bool
otherwise
= [Way]
ways1
tag :: String
tag = [Way] -> String
mkBuildTag ((Way -> Bool) -> [Way] -> [Way]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Way -> Bool) -> Way -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Way -> Bool
wayRTSOnly) [Way]
ways2)
rts_tag :: String
rts_tag = [Way] -> String
mkBuildTag [Way]
ways2
mkDynName :: String -> String
mkDynName x :: String
x
| Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` DynFlags -> [Way]
ways DynFlags
dflags = String
x
| "HS" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x =
String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ '-'Char -> String -> String
forall a. a -> [a] -> [a]
:DynFlags -> String
programName DynFlags
dflags String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> String
projectVersion DynFlags
dflags
| Just x' :: String
x' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "C" String
x = String
x'
| Bool
otherwise
= String -> String
forall a. String -> a
panic ("Don't understand library name " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
addSuffix :: String -> String
addSuffix rts :: String
rts@String
"HSrts" = String
rts String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
expandTag String
rts_tag)
addSuffix rts :: String
rts@String
"HSrts-1.0"= String
rts String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
expandTag String
rts_tag)
addSuffix other_lib :: String
other_lib = String
other_lib String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
expandTag String
tag)
expandTag :: String -> String
expandTag t :: String
t | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t = ""
| Bool
otherwise = '_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
t
libraryDirsForWay :: DynFlags -> PackageConfig -> [String]
libraryDirsForWay :: DynFlags -> PackageConfig -> [String]
libraryDirsForWay dflags :: DynFlags
dflags
| Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags = PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDynDirs
| Bool
otherwise = PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDirs
getPackageExtraCcOpts :: DynFlags -> [PreloadUnitId] -> IO [String]
dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs = do
[PackageConfig]
ps <- DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ((PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
ccOptions [PackageConfig]
ps)
getPackageFrameworkPath :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageFrameworkPath :: DynFlags -> [InstalledUnitId] -> IO [String]
getPackageFrameworkPath dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs = do
[PackageConfig]
ps <- DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall a. [a] -> Bool
notNull ((PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
frameworkDirs [PackageConfig]
ps)))
getPackageFrameworks :: DynFlags -> [PreloadUnitId] -> IO [String]
getPackageFrameworks :: DynFlags -> [InstalledUnitId] -> IO [String]
getPackageFrameworks dflags :: DynFlags
dflags pkgs :: [InstalledUnitId]
pkgs = do
[PackageConfig]
ps <- DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
pkgs
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ((PackageConfig -> [String]) -> [PackageConfig] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PackageConfig -> [String]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
frameworks [PackageConfig]
ps)
lookupModuleInAllPackages :: DynFlags
-> ModuleName
-> [(Module, PackageConfig)]
lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(Module, PackageConfig)]
lookupModuleInAllPackages dflags :: DynFlags
dflags m :: ModuleName
m
= case DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions DynFlags
dflags ModuleName
m Maybe FastString
forall a. Maybe a
Nothing of
LookupFound a :: Module
a b :: PackageConfig
b -> [(Module
a,PackageConfig
b)]
LookupMultiple rs :: [(Module, ModuleOrigin)]
rs -> ((Module, ModuleOrigin) -> (Module, PackageConfig))
-> [(Module, ModuleOrigin)] -> [(Module, PackageConfig)]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> (Module, PackageConfig)
forall b. (Module, b) -> (Module, PackageConfig)
f [(Module, ModuleOrigin)]
rs
where f :: (Module, b) -> (Module, PackageConfig)
f (m :: Module
m,_) = (Module
m, String -> Maybe PackageConfig -> PackageConfig
forall a. HasCallStack => String -> Maybe a -> a
expectJust "lookupModule" (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags
(Module -> UnitId
moduleUnitId Module
m)))
_ -> []
data LookupResult =
LookupFound Module PackageConfig
| 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 dflags :: DynFlags
dflags
= DynFlags
-> ModuleToPkgConfAll
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' DynFlags
dflags
(PackageState -> ModuleToPkgConfAll
moduleToPkgConfAll (DynFlags -> PackageState
pkgState DynFlags
dflags))
lookupPluginModuleWithSuggestions :: DynFlags
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupPluginModuleWithSuggestions :: DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupPluginModuleWithSuggestions dflags :: DynFlags
dflags
= DynFlags
-> ModuleToPkgConfAll
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' DynFlags
dflags
(PackageState -> ModuleToPkgConfAll
pluginModuleToPkgConfAll (DynFlags -> PackageState
pkgState DynFlags
dflags))
lookupModuleWithSuggestions' :: DynFlags
-> ModuleToPkgConfAll
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' :: DynFlags
-> ModuleToPkgConfAll
-> ModuleName
-> Maybe FastString
-> LookupResult
lookupModuleWithSuggestions' dflags :: DynFlags
dflags mod_map :: ModuleToPkgConfAll
mod_map m :: ModuleName
m mb_pn :: Maybe FastString
mb_pn
= case ModuleName -> ModuleToPkgConfAll -> Maybe (Map Module ModuleOrigin)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
m ModuleToPkgConfAll
mod_map of
Nothing -> [ModuleSuggestion] -> LookupResult
LookupNotFound [ModuleSuggestion]
suggestions
Just xs :: 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
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
(_, _, _, [(m :: Module
m, _)]) -> Module -> PackageConfig -> LookupResult
LookupFound Module
m (Module -> PackageConfig
mod_pkg Module
m)
(_, _, _, exposed :: [(Module, ModuleOrigin)]
exposed@(_:_)) -> [(Module, ModuleOrigin)] -> LookupResult
LookupMultiple [(Module, ModuleOrigin)]
exposed
([], [], unusable :: [(Module, ModuleOrigin)]
unusable@(_:_), []) -> [(Module, ModuleOrigin)] -> LookupResult
LookupUnusable [(Module, ModuleOrigin)]
unusable
(hidden_pkg :: [(Module, ModuleOrigin)]
hidden_pkg, hidden_mod :: [(Module, ModuleOrigin)]
hidden_mod, _, []) ->
[(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 (hidden_pkg :: [(Module, ModuleOrigin)]
hidden_pkg, hidden_mod :: [(Module, ModuleOrigin)]
hidden_mod, unusable :: [(Module, ModuleOrigin)]
unusable, exposed :: [(Module, ModuleOrigin)]
exposed) (m :: Module
m, origin0 :: ModuleOrigin
origin0) =
let origin :: ModuleOrigin
origin = Maybe FastString -> PackageConfig -> ModuleOrigin -> ModuleOrigin
filterOrigin Maybe FastString
mb_pn (Module -> PackageConfig
mod_pkg Module
m) ModuleOrigin
origin0
x :: (Module, ModuleOrigin)
x = (Module
m, ModuleOrigin
origin)
in case ModuleOrigin
origin of
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 _
-> ([(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 -> 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)
pkg_lookup :: UnitId -> PackageConfig
pkg_lookup p :: UnitId
p = DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags UnitId
p Maybe PackageConfig -> PackageConfig -> PackageConfig
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> PackageConfig
forall a. HasCallStack => String -> SDoc -> a
pprPanic "lookupModuleWithSuggestions" (UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
p SDoc -> SDoc -> SDoc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m)
mod_pkg :: Module -> PackageConfig
mod_pkg = UnitId -> PackageConfig
pkg_lookup (UnitId -> PackageConfig)
-> (Module -> UnitId) -> Module -> PackageConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UnitId
moduleUnitId
filterOrigin :: Maybe FastString
-> PackageConfig
-> ModuleOrigin
-> ModuleOrigin
filterOrigin :: Maybe FastString -> PackageConfig -> ModuleOrigin -> ModuleOrigin
filterOrigin Nothing _ o :: ModuleOrigin
o = ModuleOrigin
o
filterOrigin (Just pn :: FastString
pn) pkg :: PackageConfig
pkg o :: ModuleOrigin
o =
case ModuleOrigin
o of
ModHidden -> if PackageConfig -> Bool
go PackageConfig
pkg then ModuleOrigin
ModHidden else ModuleOrigin
forall a. Monoid a => a
mempty
(ModUnusable _) -> if PackageConfig -> Bool
go PackageConfig
pkg then ModuleOrigin
o else ModuleOrigin
forall a. Monoid a => a
mempty
ModOrigin { fromOrigPackage :: ModuleOrigin -> Maybe Bool
fromOrigPackage = Maybe Bool
e, fromExposedReexport :: ModuleOrigin -> [PackageConfig]
fromExposedReexport = [PackageConfig]
res,
fromHiddenReexport :: ModuleOrigin -> [PackageConfig]
fromHiddenReexport = [PackageConfig]
rhs }
-> ModOrigin :: Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin {
fromOrigPackage :: Maybe Bool
fromOrigPackage = if PackageConfig -> Bool
go PackageConfig
pkg then Maybe Bool
e else Maybe Bool
forall a. Maybe a
Nothing
, fromExposedReexport :: [PackageConfig]
fromExposedReexport = (PackageConfig -> Bool) -> [PackageConfig] -> [PackageConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter PackageConfig -> Bool
go [PackageConfig]
res
, fromHiddenReexport :: [PackageConfig]
fromHiddenReexport = (PackageConfig -> Bool) -> [PackageConfig] -> [PackageConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter PackageConfig -> Bool
go [PackageConfig]
rhs
, fromPackageFlag :: Bool
fromPackageFlag = Bool
False
}
where go :: PackageConfig -> Bool
go pkg :: PackageConfig
pkg = FastString
pn FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== PackageConfig -> FastString
fsPackageName PackageConfig
pkg
suggestions :: [ModuleSuggestion]
suggestions
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_HelpfulErrors DynFlags
dflags =
String -> [(String, ModuleSuggestion)] -> [ModuleSuggestion]
forall a. String -> [(String, a)] -> [a]
fuzzyLookup (ModuleName -> String
moduleNameString ModuleName
m) [(String, ModuleSuggestion)]
all_mods
| Bool
otherwise = []
all_mods :: [(String, ModuleSuggestion)]
all_mods :: [(String, ModuleSuggestion)]
all_mods = ((String, ModuleSuggestion)
-> (String, ModuleSuggestion) -> Ordering)
-> [(String, ModuleSuggestion)] -> [(String, ModuleSuggestion)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, ModuleSuggestion) -> String)
-> (String, ModuleSuggestion)
-> (String, ModuleSuggestion)
-> Ordering
forall a t. Ord a => (t -> a) -> t -> t -> Ordering
comparing (String, ModuleSuggestion) -> String
forall a b. (a, b) -> a
fst) ([(String, ModuleSuggestion)] -> [(String, ModuleSuggestion)])
-> [(String, ModuleSuggestion)] -> [(String, ModuleSuggestion)]
forall a b. (a -> b) -> a -> b
$
[ (ModuleName -> String
moduleNameString ModuleName
m, ModuleSuggestion
suggestion)
| (m :: ModuleName
m, e :: Map Module ModuleOrigin
e) <- ModuleToPkgConfAll -> [(ModuleName, Map Module ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageState -> ModuleToPkgConfAll
moduleToPkgConfAll (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 name :: ModuleName
name (mod :: Module
mod, origin :: 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 dflags :: 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 (ModuleToPkgConfAll -> [(ModuleName, Map Module ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageState -> ModuleToPkgConfAll
moduleToPkgConfAll (DynFlags -> PackageState
pkgState DynFlags
dflags))))
where visible :: (a, Map k ModuleOrigin) -> Bool
visible (_, ms :: Map k ModuleOrigin
ms) = (ModuleOrigin -> Bool) -> [ModuleOrigin] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
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 [PackageConfig]
getPreloadPackagesAnd :: DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd dflags :: DynFlags
dflags pkgids0 :: [InstalledUnitId]
pkgids0 =
let
pkgids :: [InstalledUnitId]
pkgids = [InstalledUnitId]
pkgids0 [InstalledUnitId] -> [InstalledUnitId] -> [InstalledUnitId]
forall a. [a] -> [a] -> [a]
++
if DynFlags -> Bool
isIndefinite DynFlags
dflags
then []
else ((ModuleName, Module) -> InstalledUnitId)
-> [(ModuleName, Module)] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map (UnitId -> InstalledUnitId
toInstalledUnitId (UnitId -> InstalledUnitId)
-> ((ModuleName, Module) -> UnitId)
-> (ModuleName, Module)
-> InstalledUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UnitId
moduleUnitId (Module -> UnitId)
-> ((ModuleName, Module) -> Module)
-> (ModuleName, Module)
-> UnitId
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 :: PackageConfigMap
pkg_map = PackageState -> PackageConfigMap
pkgIdMap PackageState
state
preload :: [InstalledUnitId]
preload = PackageState -> [InstalledUnitId]
preloadPackages PackageState
state
pairs :: [(InstalledUnitId, Maybe a)]
pairs = [InstalledUnitId] -> [Maybe a] -> [(InstalledUnitId, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [InstalledUnitId]
pkgids (Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing)
in do
[InstalledUnitId]
all_pkgs <- DynFlags -> MaybeErr SDoc [InstalledUnitId] -> IO [InstalledUnitId]
forall a. DynFlags -> MaybeErr SDoc a -> IO a
throwErr DynFlags
dflags (([InstalledUnitId]
-> (InstalledUnitId, Maybe InstalledUnitId)
-> MaybeErr SDoc [InstalledUnitId])
-> [InstalledUnitId]
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> MaybeErr SDoc [InstalledUnitId]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (DynFlags
-> PackageConfigMap
-> [InstalledUnitId]
-> (InstalledUnitId, Maybe InstalledUnitId)
-> MaybeErr SDoc [InstalledUnitId]
add_package DynFlags
dflags PackageConfigMap
pkg_map) [InstalledUnitId]
preload [(InstalledUnitId, Maybe InstalledUnitId)]
forall a. [(InstalledUnitId, Maybe a)]
pairs)
[PackageConfig] -> IO [PackageConfig]
forall (m :: * -> *) a. Monad m => a -> m a
return ((InstalledUnitId -> PackageConfig)
-> [InstalledUnitId] -> [PackageConfig]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> InstalledUnitId -> PackageConfig
getInstalledPackageDetails DynFlags
dflags) [InstalledUnitId]
all_pkgs)
closeDeps :: DynFlags
-> PackageConfigMap
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> IO [InstalledUnitId]
closeDeps :: DynFlags
-> PackageConfigMap
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> IO [InstalledUnitId]
closeDeps dflags :: DynFlags
dflags pkg_map :: PackageConfigMap
pkg_map ps :: [(InstalledUnitId, Maybe InstalledUnitId)]
ps
= DynFlags -> MaybeErr SDoc [InstalledUnitId] -> IO [InstalledUnitId]
forall a. DynFlags -> MaybeErr SDoc a -> IO a
throwErr DynFlags
dflags (DynFlags
-> PackageConfigMap
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> MaybeErr SDoc [InstalledUnitId]
closeDepsErr DynFlags
dflags PackageConfigMap
pkg_map [(InstalledUnitId, Maybe InstalledUnitId)]
ps)
throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
throwErr :: DynFlags -> MaybeErr SDoc a -> IO a
throwErr dflags :: DynFlags
dflags m :: MaybeErr SDoc a
m
= case MaybeErr SDoc a
m of
Failed e :: SDoc
e -> GhcException -> IO a
forall a. GhcException -> IO a
throwGhcExceptionIO (String -> GhcException
CmdLineError (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags SDoc
e))
Succeeded r :: a
r -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
closeDepsErr :: DynFlags
-> PackageConfigMap
-> [(InstalledUnitId,Maybe InstalledUnitId)]
-> MaybeErr MsgDoc [InstalledUnitId]
closeDepsErr :: DynFlags
-> PackageConfigMap
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> MaybeErr SDoc [InstalledUnitId]
closeDepsErr dflags :: DynFlags
dflags pkg_map :: PackageConfigMap
pkg_map ps :: [(InstalledUnitId, Maybe InstalledUnitId)]
ps = ([InstalledUnitId]
-> (InstalledUnitId, Maybe InstalledUnitId)
-> MaybeErr SDoc [InstalledUnitId])
-> [InstalledUnitId]
-> [(InstalledUnitId, Maybe InstalledUnitId)]
-> MaybeErr SDoc [InstalledUnitId]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (DynFlags
-> PackageConfigMap
-> [InstalledUnitId]
-> (InstalledUnitId, Maybe InstalledUnitId)
-> MaybeErr SDoc [InstalledUnitId]
add_package DynFlags
dflags PackageConfigMap
pkg_map) [] [(InstalledUnitId, Maybe InstalledUnitId)]
ps
add_package :: DynFlags
-> PackageConfigMap
-> [PreloadUnitId]
-> (PreloadUnitId,Maybe PreloadUnitId)
-> MaybeErr MsgDoc [PreloadUnitId]
add_package :: DynFlags
-> PackageConfigMap
-> [InstalledUnitId]
-> (InstalledUnitId, Maybe InstalledUnitId)
-> MaybeErr SDoc [InstalledUnitId]
add_package dflags :: DynFlags
dflags pkg_db :: PackageConfigMap
pkg_db ps :: [InstalledUnitId]
ps (p :: InstalledUnitId
p, mb_parent :: Maybe InstalledUnitId
mb_parent)
| InstalledUnitId
p InstalledUnitId -> [InstalledUnitId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InstalledUnitId]
ps = [InstalledUnitId] -> MaybeErr SDoc [InstalledUnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledUnitId]
ps
| Bool
otherwise =
case PackageConfigMap -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage' PackageConfigMap
pkg_db InstalledUnitId
p of
Nothing -> SDoc -> MaybeErr SDoc [InstalledUnitId]
forall err val. err -> MaybeErr err val
Failed (InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
missingPackageMsg InstalledUnitId
p SDoc -> SDoc -> SDoc
<>
Maybe InstalledUnitId -> SDoc
missingDependencyMsg Maybe InstalledUnitId
mb_parent)
Just pkg :: PackageConfig
pkg -> do
[InstalledUnitId]
ps' <- ([InstalledUnitId]
-> InstalledUnitId -> MaybeErr SDoc [InstalledUnitId])
-> [InstalledUnitId]
-> [InstalledUnitId]
-> MaybeErr SDoc [InstalledUnitId]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [InstalledUnitId]
-> InstalledUnitId -> MaybeErr SDoc [InstalledUnitId]
add_unit_key [InstalledUnitId]
ps (PackageConfig -> [InstalledUnitId]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
depends PackageConfig
pkg)
[InstalledUnitId] -> MaybeErr SDoc [InstalledUnitId]
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledUnitId
p InstalledUnitId -> [InstalledUnitId] -> [InstalledUnitId]
forall a. a -> [a] -> [a]
: [InstalledUnitId]
ps')
where
add_unit_key :: [InstalledUnitId]
-> InstalledUnitId -> MaybeErr SDoc [InstalledUnitId]
add_unit_key ps :: [InstalledUnitId]
ps key :: InstalledUnitId
key
= DynFlags
-> PackageConfigMap
-> [InstalledUnitId]
-> (InstalledUnitId, Maybe InstalledUnitId)
-> MaybeErr SDoc [InstalledUnitId]
add_package DynFlags
dflags PackageConfigMap
pkg_db [InstalledUnitId]
ps (InstalledUnitId
key, InstalledUnitId -> Maybe InstalledUnitId
forall a. a -> Maybe a
Just InstalledUnitId
p)
missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
missingPackageMsg :: pkgid -> SDoc
missingPackageMsg p :: pkgid
p = String -> SDoc
text "unknown package:" SDoc -> SDoc -> SDoc
<+> pkgid -> SDoc
forall a. Outputable a => a -> SDoc
ppr pkgid
p
missingDependencyMsg :: Maybe InstalledUnitId -> SDoc
missingDependencyMsg :: Maybe InstalledUnitId -> SDoc
missingDependencyMsg Nothing = SDoc
Outputable.empty
missingDependencyMsg (Just parent :: InstalledUnitId
parent)
= SDoc
space SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens (String -> SDoc
text "dependency of" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext (InstalledUnitId -> FastString
installedUnitIdFS InstalledUnitId
parent))
componentIdString :: DynFlags -> ComponentId -> Maybe String
componentIdString :: DynFlags -> ComponentId -> Maybe String
componentIdString dflags :: DynFlags
dflags cid :: ComponentId
cid = do
PackageConfig
conf <- DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage DynFlags
dflags (ComponentId -> InstalledUnitId
componentIdToInstalledUnitId ComponentId
cid)
String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$
case PackageConfig -> Maybe PackageName
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Maybe srcpkgname
sourceLibName PackageConfig
conf of
Nothing -> PackageConfig -> String
sourcePackageIdString PackageConfig
conf
Just (PackageName libname :: FastString
libname) ->
PackageConfig -> String
packageNameString PackageConfig
conf
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion (PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
packageVersion PackageConfig
conf)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FastString -> String
unpackFS FastString
libname
displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String
displayInstalledUnitId :: DynFlags -> InstalledUnitId -> Maybe String
displayInstalledUnitId dflags :: DynFlags
dflags uid :: InstalledUnitId
uid =
(PackageConfig -> String) -> Maybe PackageConfig -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PackageConfig -> String
sourcePackageIdString (DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage DynFlags
dflags InstalledUnitId
uid)
isDllName :: DynFlags -> Module -> Name -> Bool
isDllName :: DynFlags -> Module -> Name -> Bool
isDllName dflags :: DynFlags
dflags this_mod :: Module
this_mod name :: Name
name
| Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ExternalDynamicRefs DynFlags
dflags) = Bool
False
| Just mod :: Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
= case Platform -> OS
platformOS (Platform -> OS) -> Platform -> OS
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags of
OSMinGW32 -> Module -> UnitId
moduleUnitId Module
mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= Module -> UnitId
moduleUnitId Module
this_mod
_ -> Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
this_mod
| Bool
otherwise = Bool
False
pprPackages :: DynFlags -> SDoc
pprPackages :: DynFlags -> SDoc
pprPackages = (PackageConfig -> SDoc) -> DynFlags -> SDoc
pprPackagesWith PackageConfig -> SDoc
pprPackageConfig
pprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc
pprPackagesWith :: (PackageConfig -> SDoc) -> DynFlags -> SDoc
pprPackagesWith pprIPI :: PackageConfig -> SDoc
pprIPI dflags :: DynFlags
dflags =
[SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
intersperse (String -> SDoc
text "---") ((PackageConfig -> SDoc) -> [PackageConfig] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> SDoc
pprIPI (DynFlags -> [PackageConfig]
listPackageConfigMap DynFlags
dflags)))
pprPackagesSimple :: DynFlags -> SDoc
pprPackagesSimple :: DynFlags -> SDoc
pprPackagesSimple = (PackageConfig -> SDoc) -> DynFlags -> SDoc
pprPackagesWith PackageConfig -> SDoc
forall compid srcpkgid srcpkgname unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> SDoc
pprIPI
where pprIPI :: InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> SDoc
pprIPI ipi :: InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
ipi = let i :: FastString
i = InstalledUnitId -> FastString
installedUnitIdFS (InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
ipi)
e :: SDoc
e = if InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> Bool
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
exposed InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
ipi then String -> SDoc
text "E" else String -> SDoc
text " "
t :: SDoc
t = if InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
-> Bool
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
trusted InstalledPackageInfo
compid srcpkgid srcpkgname InstalledUnitId unitid modulename mod
ipi then String -> SDoc
text "T" else String -> SDoc
text " "
in SDoc
e SDoc -> SDoc -> SDoc
<> SDoc
t SDoc -> SDoc -> SDoc
<> String -> SDoc
text " " SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext FastString
i
pprModuleMap :: ModuleToPkgConfAll -> SDoc
pprModuleMap :: ModuleToPkgConfAll -> SDoc
pprModuleMap mod_map :: ModuleToPkgConfAll
mod_map =
[SDoc] -> SDoc
vcat (((ModuleName, Map Module ModuleOrigin) -> SDoc)
-> [(ModuleName, Map Module ModuleOrigin)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Map Module ModuleOrigin) -> SDoc
forall a. Outputable a => (ModuleName, Map Module a) -> SDoc
pprLine (ModuleToPkgConfAll -> [(ModuleName, Map Module ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList ModuleToPkgConfAll
mod_map))
where
pprLine :: (ModuleName, Map Module a) -> SDoc
pprLine (m :: ModuleName
m,e :: Map Module a
e) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
$$ Int -> SDoc -> SDoc
nest 50 ([SDoc] -> SDoc
vcat (((Module, a) -> SDoc) -> [(Module, a)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> (Module, a) -> SDoc
forall a. Outputable a => ModuleName -> (Module, a) -> SDoc
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) -> SDoc
pprEntry m :: ModuleName
m (m' :: Module
m',o :: a
o)
| ModuleName
m ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleName
moduleName Module
m' = UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> UnitId
moduleUnitId Module
m') SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
o)
| Bool
otherwise = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m' SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
o)
fsPackageName :: PackageConfig -> FastString
fsPackageName :: PackageConfig -> FastString
fsPackageName = String -> FastString
mkFastString (String -> FastString)
-> (PackageConfig -> String) -> PackageConfig -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> String
packageNameString
improveUnitId :: PackageConfigMap -> UnitId -> UnitId
improveUnitId :: PackageConfigMap -> UnitId -> UnitId
improveUnitId _ uid :: UnitId
uid@(DefiniteUnitId _) = UnitId
uid
improveUnitId pkg_map :: PackageConfigMap
pkg_map uid :: UnitId
uid =
case Bool -> PackageConfigMap -> UnitId -> Maybe PackageConfig
lookupPackage' Bool
False PackageConfigMap
pkg_map UnitId
uid of
Nothing -> UnitId
uid
Just pkg :: PackageConfig
pkg ->
if PackageConfig -> InstalledUnitId
installedPackageConfigId PackageConfig
pkg InstalledUnitId -> UniqSet InstalledUnitId -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` PackageConfigMap -> UniqSet InstalledUnitId
preloadClosure PackageConfigMap
pkg_map
then PackageConfig -> UnitId
packageConfigId PackageConfig
pkg
else UnitId
uid
getPackageConfigMap :: DynFlags -> PackageConfigMap
getPackageConfigMap :: DynFlags -> PackageConfigMap
getPackageConfigMap = PackageState -> PackageConfigMap
pkgIdMap (PackageState -> PackageConfigMap)
-> (DynFlags -> PackageState) -> DynFlags -> PackageConfigMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> PackageState
pkgState