{-# 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 GHC.Platform
import Outputable
import Maybes
import CmdLineParser
import System.Environment ( getEnv )
import FastString
import ErrUtils ( debugTraceMsg, MsgDoc, dumpIfSet_dyn, compilationProgressMsg,
withTiming )
import Exception
import System.Directory
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
import System.IO.Error ( isDoesNotExistError )
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 ModuleOrigin
ModHidden = String -> SDoc
text String
"hidden module"
ppr (ModUnusable UnusablePackageReason
_) = String -> SDoc
text String
"unusable module"
ppr (ModOrigin Maybe Bool
e [PackageConfig]
res [PackageConfig]
rhs Bool
f) = [SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (
(case Maybe Bool
e of
Maybe Bool
Nothing -> []
Just Bool
False -> [String -> SDoc
text String
"hidden package"]
Just Bool
True -> [String -> SDoc
text String
"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 String
"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 String
"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 String
"package flag"] else [])
))
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules :: Bool -> ModuleOrigin
fromExposedModules 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 Bool
True PackageConfig
pkg = Maybe Bool
-> [PackageConfig] -> [PackageConfig] -> Bool -> ModuleOrigin
ModOrigin Maybe Bool
forall a. Maybe a
Nothing [PackageConfig
pkg] [] Bool
False
fromReexportedModules Bool
False 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 Maybe Bool
e [PackageConfig]
res [PackageConfig]
rhs Bool
f <> :: ModuleOrigin -> ModuleOrigin -> ModuleOrigin
<> ModOrigin Maybe Bool
e' [PackageConfig]
res' [PackageConfig]
rhs' 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 a
b) (Just 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 String
"ModOrigin: package both exposed/hidden"
g Maybe a
Nothing Maybe a
x = Maybe a
x
g Maybe a
x Maybe a
Nothing = Maybe a
x
ModuleOrigin
_x <> ModuleOrigin
_y = String -> ModuleOrigin
forall a. String -> a
panic String
"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 ModuleOrigin
ModHidden = Bool
False
originVisible (ModUnusable UnusablePackageReason
_) = Bool
False
originVisible (ModOrigin Maybe Bool
b [PackageConfig]
res [PackageConfig]
_ 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 Maybe Bool
Nothing [] [] Bool
False) = Bool
True
originEmpty ModuleOrigin
_ = 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 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
UnitVisibility
uv1 <> :: UnitVisibility -> UnitVisibility -> UnitVisibility
<> 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 = PackageState :: 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 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' Bool
False (PackageConfigMap InstalledUnitIdMap PackageConfig
pkg_map UniqSet InstalledUnitId
_) 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' Bool
True m :: PackageConfigMap
m@(PackageConfigMap InstalledUnitIdMap PackageConfig
pkg_map UniqSet InstalledUnitId
_) UnitId
uid =
case UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts UnitId
uid of
(InstalledUnitId
iuid, Just 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)
(InstalledUnitId
_, Maybe IndefUnitId
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 DynFlags
dflags 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 DynFlags
dflags 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 InstalledUnitIdMap PackageConfig
pkg_map UniqSet InstalledUnitId
closure) [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 InstalledUnitIdMap PackageConfig
pkg_map 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 DynFlags
dflags UnitId
pid =
String -> Maybe PackageConfig -> PackageConfig
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"getPackageDetails" (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags UnitId
pid)
lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage :: DynFlags -> InstalledUnitId -> Maybe PackageConfig
lookupInstalledPackage DynFlags
dflags 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 InstalledUnitIdMap PackageConfig
db UniqSet InstalledUnitId
_) 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 DynFlags
dflags InstalledUnitId
uid =
String -> Maybe PackageConfig -> PackageConfig
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"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 DynFlags
dflags = InstalledUnitIdMap PackageConfig -> [PackageConfig]
forall elt. UniqDFM elt -> [elt]
eltsUDFM InstalledUnitIdMap PackageConfig
pkg_map
where
PackageConfigMap InstalledUnitIdMap PackageConfig
pkg_map UniqSet InstalledUnitId
_ = PackageState -> PackageConfigMap
pkgIdMap (DynFlags -> PackageState
pkgState DynFlags
dflags)
initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])
initPackages :: DynFlags -> IO (DynFlags, [InstalledUnitId])
initPackages DynFlags
dflags0 = DynFlags
-> SDoc
-> ((DynFlags, [InstalledUnitId]) -> ())
-> IO (DynFlags, [InstalledUnitId])
-> IO (DynFlags, [InstalledUnitId])
forall (m :: * -> *) a.
MonadIO m =>
DynFlags -> SDoc -> (a -> ()) -> m a -> m a
withTiming DynFlags
dflags0
(String -> SDoc
text String
"initializing package database")
(DynFlags, [InstalledUnitId]) -> ()
forall b. (DynFlags, b) -> ()
forcePkgDb (IO (DynFlags, [InstalledUnitId])
-> IO (DynFlags, [InstalledUnitId]))
-> IO (DynFlags, [InstalledUnitId])
-> IO (DynFlags, [InstalledUnitId])
forall a b. (a -> b) -> a -> b
$ do
DynFlags
dflags <- DynFlags -> IO DynFlags
interpretPackageEnv DynFlags
dflags0
[(String, [PackageConfig])]
pkg_db <-
case DynFlags -> Maybe [(String, [PackageConfig])]
pkgDatabase DynFlags
dflags of
Maybe [(String, [PackageConfig])]
Nothing -> DynFlags -> IO [(String, [PackageConfig])]
readPackageConfigs DynFlags
dflags
Just [(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 (\(String
p, [PackageConfig]
pkgs)
-> (String
p, DynFlags -> [PackageConfig] -> [PackageConfig]
setBatchPackageFlags DynFlags
dflags [PackageConfig]
pkgs)) [(String, [PackageConfig])]
db
(PackageState
pkg_state, [InstalledUnitId]
preload, 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)
where
forcePkgDb :: (DynFlags, b) -> ()
forcePkgDb (DynFlags
dflags, b
_) = PackageState -> PackageConfigMap
pkgIdMap (DynFlags -> PackageState
pkgState DynFlags
dflags) PackageConfigMap -> () -> ()
`seq` ()
readPackageConfigs :: DynFlags -> IO [(FilePath, [PackageConfig])]
readPackageConfigs :: DynFlags -> IO [(String, [PackageConfig])]
readPackageConfigs 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 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]
++ String
"_PACKAGE_PATH")
let base_conf_refs :: [PkgConfRef]
base_conf_refs = case Either IOException String
e_pkg_path of
Left IOException
_ -> [PkgConfRef]
system_conf_refs
Right 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 PkgConfRef
p) [PkgConfRef]
dbs = PkgConfRef
p PkgConfRef -> [PkgConfRef] -> [PkgConfRef]
forall a. a -> [a] -> [a]
: [PkgConfRef]
dbs
doFlag PackageDBFlag
NoUserPackageDB [PkgConfRef]
dbs = (PkgConfRef -> Bool) -> [PkgConfRef] -> [PkgConfRef]
forall a. (a -> Bool) -> [a] -> [a]
filter PkgConfRef -> Bool
isNotUser [PkgConfRef]
dbs
doFlag PackageDBFlag
NoGlobalPackageDB [PkgConfRef]
dbs = (PkgConfRef -> Bool) -> [PkgConfRef] -> [PkgConfRef]
forall a. (a -> Bool) -> [a] -> [a]
filter PkgConfRef -> Bool
isNotGlobal [PkgConfRef]
dbs
doFlag PackageDBFlag
ClearPackageDBs [PkgConfRef]
_ = []
isNotUser :: PkgConfRef -> Bool
isNotUser PkgConfRef
UserPkgConf = Bool
False
isNotUser PkgConfRef
_ = Bool
True
isNotGlobal :: PkgConfRef -> Bool
isNotGlobal PkgConfRef
GlobalPkgConf = Bool
False
isNotGlobal PkgConfRef
_ = Bool
True
resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)
resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe String)
resolvePackageConfig DynFlags
dflags PkgConfRef
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 DynFlags
dflags PkgConfRef
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
</> 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 DynFlags
_ (PkgConfFile 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 DynFlags
dflags 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 [PackageConfig]
pkgs -> [PackageConfig] -> IO [PackageConfig]
forall (m :: * -> *) a. Monad m => a -> m a
return [PackageConfig]
pkgs
Maybe [PackageConfig]
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
$
String
"ghc no longer supports single-file style package " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"databases (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conf_file String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
") use 'ghc-pkg init' to create the database with " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"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
$
String
"can't find a package database at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conf_file
let
conf_file' :: String
conf_file' = String -> String
dropTrailingPathSeparator String
conf_file
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 String
conf_dir = do
let filename :: String
filename = String
conf_dir String -> 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 Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"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 Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"There is no package.cache in"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
conf_dir
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
", 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 String
".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 Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"There are no .conf files in"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
conf_dir SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
", treating"
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"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
$
String
"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]
++
String
" 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` \IOException
_ -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
content String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"[]"
then do
let conf_dir :: String
conf_dir = String
conf_file String -> 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 Int
2 (String -> SDoc
text String
"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 DynFlags
dflags [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 [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 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 String
top_dir 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 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 [] [a]
flags = [a]
flags
orIfNull [a]
flags [a]
_ = [a]
flags
mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
mungePackagePaths :: String -> String -> PackageConfig -> PackageConfig
mungePackagePaths String
top_dir String
pkgroot 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 String
p
| Just String
p' <- String -> String -> Maybe String
stripVarPrefix String
"${pkgroot}" String
p = String
pkgroot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p'
| Just String
p' <- String -> String -> Maybe String
stripVarPrefix String
"$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 String
p
| Just String
p' <- String -> String -> Maybe String
stripVarPrefix String
"${pkgrooturl}" String
p = String -> String -> String
toUrlPath String
pkgroot String
p'
| Just String
p' <- String -> String -> Maybe String
stripVarPrefix String
"$httptopdir" String
p = String -> String -> String
toUrlPath String
top_dir String
p'
| Bool
otherwise = String
p
toUrlPath :: String -> String -> String
toUrlPath String
r String
p = String
"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 String
var 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@(Char
c : String
_) | Char -> Bool
isPathSeparator Char
c -> String -> Maybe String
forall a. a -> Maybe a
Just String
cs
Maybe String
_ -> Maybe String
forall a. Maybe a
Nothing
applyTrustFlag
:: DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [PackageConfig]
-> TrustFlag
-> IO [PackageConfig]
applyTrustFlag :: DynFlags
-> PackagePrecedenceIndex
-> UnusablePackages
-> [PackageConfig]
-> TrustFlag
-> IO [PackageConfig]
applyTrustFlag DynFlags
dflags PackagePrecedenceIndex
prec_map UnusablePackages
unusable [PackageConfig]
pkgs TrustFlag
flag =
case TrustFlag
flag of
TrustPackage 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 [(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 ([PackageConfig]
ps,[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 InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
p = InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
p {trusted :: Bool
trusted=Bool
True}
DistrustPackage 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 [(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 ([PackageConfig]
ps,[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 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 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 DynFlags
dflags PackagePrecedenceIndex
prec_map PackageConfigMap
pkg_db UnusablePackages
unusable Bool
no_hide_others [PackageConfig]
pkgs VisibilityMap
vm PackageFlag
flag =
case PackageFlag
flag of
ExposePackage String
_ PackageArg
arg (ModRenaming Bool
b [(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 [(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 (PackageConfig
p:[PackageConfig]
_) -> 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 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 UnitId
uid = case UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts UnitId
uid of
(InstalledUnitId
_, Just 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)
| (ModuleName
mod_name, 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)
| (ModuleName
_, 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
(InstalledUnitId
_, Maybe IndefUnitId
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)
_:[(ModuleName, ModuleName)]
_) <- [(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
(\UnitId
k 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
Either [(PackageConfig, UnusablePackageReason)] [PackageConfig]
_ -> String -> IO VisibilityMap
forall a. String -> a
panic String
"applyPackageFlag"
HidePackage 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 [(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 [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 PackagePrecedenceIndex
prec_map PackageConfigMap
pkg_db PackageArg
arg [PackageConfig]
pkgs 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 (\(PackageConfig
x,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
>>= \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 String
str) 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 UnitId
uid) PackageConfig
p
= let (InstalledUnitId
iuid, 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
Maybe IndefUnitId
Nothing -> PackageConfig
p
Just 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 PackagePrecedenceIndex
prec_map PackageArg
arg [PackageConfig]
pkgs UnusablePackages
unusable
= let matches :: PackageConfig -> Bool
matches = PackageArg -> PackageConfig -> Bool
matching PackageArg
arg
([PackageConfig]
ps,[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 PackageConfigMap
pkg_map [(ModuleName, Module)]
insts 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 (\(ModuleName
k,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 (\(ModuleName
mod_name, Maybe Module
mb_mod) -> (ModuleName
mod_name, (Module -> Module) -> Maybe Module -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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 String
str 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 InstalledUnitId
uid 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 String
str) = String -> PackageConfig -> Bool
matchingStr String
str
matching (UnitIdArg (DefiniteUnitId (DefUnitId InstalledUnitId
uid))) = InstalledUnitId -> PackageConfig -> Bool
matchingId InstalledUnitId
uid
matching (UnitIdArg UnitId
_) = \PackageConfig
_ -> Bool
False
sortByPreference :: PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference :: PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference 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 PackagePrecedenceIndex
prec_map PackageConfig
pkg PackageConfig
pkg'
| Just 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 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
Ordering
GT -> Ordering
GT
Ordering
EQ | Just 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 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
Ordering
LT -> Ordering
LT
where isIntegerPkg :: PackageConfig -> Bool
isIntegerPkg PackageConfig
p = PackageConfig -> String
packageNameString PackageConfig
p String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
[String
"integer-simple", String
"integer-gmp"]
differentIntegerPkgs :: PackageConfig -> PackageConfig -> Bool
differentIntegerPkgs PackageConfig
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 t -> a
f t
a 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 DynFlags
dflags PackageFlag
flag [(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 DynFlags
dflags TrustFlag
flag [(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' DynFlags
dflags SDoc
flag_doc [(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 String
"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 String
": ") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
4 (SDoc
ppr_reasons SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"(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 (InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
p, 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 String
"is") UnusablePackageReason
reason
pprFlag :: PackageFlag -> SDoc
pprFlag :: PackageFlag -> SDoc
pprFlag PackageFlag
flag = case PackageFlag
flag of
HidePackage String
p -> String -> SDoc
text String
"-hide-package " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
p
ExposePackage String
doc PackageArg
_ ModRenaming
_ -> String -> SDoc
text String
doc
pprTrustFlag :: TrustFlag -> SDoc
pprTrustFlag :: TrustFlag -> SDoc
pprTrustFlag TrustFlag
flag = case TrustFlag
flag of
TrustPackage String
p -> String -> SDoc
text String
"-trust " SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
p
DistrustPackage String
p -> String -> SDoc
text String
"-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 DynFlags
dflags PackagePrecedenceIndex
prec_map [PackageConfig]
pkgs VisibilityMap
vis_map = do
let
matches :: PackageConfig -> WiredInUnitId -> Bool
PackageConfig
pc matches :: PackageConfig -> String -> Bool
`matches` 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` [String
"integer-gmp", String
"integer-simple"]
PackageConfig
pc `matches` 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 [PackageConfig]
pkgs 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
[PackageConfig]
many -> PackageConfig -> IO (Maybe (String, PackageConfig))
pick ([PackageConfig] -> PackageConfig
forall a. [a] -> a
head (PackagePrecedenceIndex -> [PackageConfig] -> [PackageConfig]
sortByPreference PackagePrecedenceIndex
prec_map [PackageConfig]
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 Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"wired-in package "
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
wired_pkg
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" 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 PackageConfig
pkg = do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"wired-in package "
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
wired_pkg
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
" 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))
| (String
wiredInUnitId, PackageConfig
pkg) <- [(String, PackageConfig)]
wired_in_pkgs
, Just 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 [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 PackageConfig
pkg
| Just WiredUnitId
def_uid <- PackageConfig -> Maybe WiredUnitId
definitePackageConfigId PackageConfig
pkg
, Just 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 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 (\(a
k,Maybe Module
v) -> (a
k, (Module -> Module) -> Maybe Module -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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 Map WiredUnitId WiredUnitId
wiredInMap (Module UnitId
uid 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 Map WiredUnitId WiredUnitId
wiredInMap (DefiniteUnitId 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 Map WiredUnitId WiredUnitId
wiredInMap (IndefiniteUnitId 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 (\(ModuleName
x,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 Map WiredUnitId WiredUnitId
wiredInMap WiredUnitId
key
| Just 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 Map WiredUnitId WiredUnitId
wiredInMap 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 VisibilityMap
vm (WiredUnitId
from, 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
Maybe UnitVisibility
Nothing -> VisibilityMap
vm
Just 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 UnusablePackageReason
IgnoredWithFlag = String -> SDoc
text String
"[ignored with flag]"
ppr (BrokenDependencies [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text String
"broken" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
ppr (CyclicDependencies [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text String
"cyclic" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
ppr (IgnoredDependencies [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text String
"ignored" SDoc -> SDoc -> SDoc
<+> [InstalledUnitId] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [InstalledUnitId]
uids)
ppr (ShadowedDependencies [InstalledUnitId]
uids) = SDoc -> SDoc
brackets (String -> SDoc
text String
"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 SDoc
pref UnusablePackageReason
reason = case UnusablePackageReason
reason of
UnusablePackageReason
IgnoredWithFlag ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"ignored due to an -ignore-package flag"
BrokenDependencies [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"unusable due to missing dependencies:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
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 [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"unusable due to cyclic dependencies:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
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 [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (String
"unusable because the -ignore-package flag was used to " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"ignore at least one of its dependencies:") SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
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 [InstalledUnitId]
deps ->
SDoc
pref SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"unusable due to shadowed dependencies:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
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 DynFlags
dflags [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 InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
report (CyclicSCC [InstalledPackageInfo
compid srcpkgid srcpkgname a unitid modulename mod]
vs) =
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"these packages are involved in a cycle:" SDoc -> SDoc -> SDoc
$$
Int -> SDoc -> SDoc
nest Int
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 DynFlags
dflags 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 (a
ipid, (a
_, UnusablePackageReason
reason)) =
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
SDoc -> UnusablePackageReason -> SDoc
pprReason
(String -> SDoc
text String
"package" SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ipid SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is") UnusablePackageReason
reason
type RevIndex = Map InstalledUnitId [InstalledUnitId]
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps :: InstalledPackageIndex -> RevIndex
reverseDeps 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 Map k [k]
r 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' a
from Map k [a]
r k
to = ([a] -> [a] -> [a]) -> k -> [a] -> Map k [a] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
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 [InstalledUnitId]
uids RevIndex
index 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 [] (Map InstalledUnitId a
m,[a]
pkgs) = (Map InstalledUnitId a
m,[a]
pkgs)
go (InstalledUnitId
uid:[InstalledUnitId]
uids) (Map InstalledUnitId a
m,[a]
pkgs)
| Just 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
Maybe [InstalledUnitId]
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 [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 InstalledPackageIndex
pkg_map 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 InstalledPackageIndex
pkg_map 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 (InstalledUnitId
dep_uid, String
abi)
| Just 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 [IgnorePackageFlag]
flags [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 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
([PackageConfig]
ps, [PackageConfig]
_) -> [ (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 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 [Int
1..]
where
merge :: (InstalledPackageIndex, PackagePrecedenceIndex)
-> (Int, (String, [PackageConfig]))
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
merge (InstalledPackageIndex
pkg_map, PackagePrecedenceIndex
prec_map) (Int
i, (String
db_path, [PackageConfig]
db)) = do
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"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
$ \InstalledUnitId
pkg ->
DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"package" SDoc -> SDoc -> SDoc
<+> InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledUnitId
pkg SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"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 (\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 DynFlags
dflags 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 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]
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)
(InstalledPackageIndex
pkg_map2, [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 [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 InstalledPackageInfo
compid srcpkgid srcpkgname b unitid modulename mod
_) = []
(InstalledPackageIndex
pkg_map3, [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)
(InstalledPackageIndex
pkg_map4, [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)
(InstalledPackageIndex
pkg_map5, [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 DynFlags
dflags [(String, [PackageConfig])]
dbs [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 Int
2 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"package flags" SDoc -> SDoc -> SDoc
<+> [PackageFlag] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [PackageFlag]
other_flags
(InstalledPackageIndex
pkg_map1, PackagePrecedenceIndex
prec_map) <- DynFlags
-> [(String, [PackageConfig])]
-> IO (InstalledPackageIndex, PackagePrecedenceIndex)
mergeDatabases DynFlags
dflags [(String, [PackageConfig])]
dbs
let (InstalledPackageIndex
pkg_map2, UnusablePackages
unusable, [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 PackageConfig
unit PackageConfig
unit' =
case PackagePrecedenceIndex
-> PackageConfig -> PackageConfig -> Ordering
compareByPreference PackagePrecedenceIndex
prec_map PackageConfig
unit PackageConfig
unit' of
Ordering
GT -> PackageConfig
unit
Ordering
_ -> PackageConfig
unit'
addIfMorePreferable :: InstalledUnitIdMap PackageConfig
-> PackageConfig -> InstalledUnitIdMap PackageConfig
addIfMorePreferable InstalledUnitIdMap PackageConfig
m 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 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
Maybe PackageConfig
Nothing -> Bool
False
Just 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' (\VisibilityMap
vm 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
([PackageConfig]
pkgs2, 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
[PackageFlag]
_ -> do let plugin_vis_map1 :: VisibilityMap
plugin_vis_map1
| Bool
hide_plugin_pkgs = VisibilityMap
forall k a. Map k a
Map.empty
| Bool
otherwise = VisibilityMap
vis_map2
VisibilityMap
plugin_vis_map2
<- (VisibilityMap -> PackageFlag -> IO VisibilityMap)
-> VisibilityMap -> [PackageFlag] -> IO VisibilityMap
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
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 Map srcpkgname a
pn_map 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. Ord a => [a] -> [a]
ordNub ([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 = Int
200 }) DumpFlag
Opt_D_dump_mod_map String
"Mod Map"
(ModuleToPkgConfAll -> SDoc
pprModuleMap ModuleToPkgConfAll
mod_map)
let !pstate :: PackageState
pstate = PackageState :: 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) | (WiredUnitId
k,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 DynFlags
dflags uid :: UnitId
uid@(DefiniteUnitId 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 DynFlags
_ UnitId
uid = UnitId
uid
mkModuleToPkgConfAll
:: DynFlags
-> PackageConfigMap
-> VisibilityMap
-> ModuleToPkgConfAll
mkModuleToPkgConfAll :: DynFlags -> PackageConfigMap -> VisibilityMap -> ModuleToPkgConfAll
mkModuleToPkgConfAll DynFlags
dflags PackageConfigMap
pkg_db 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 f b
m 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 ModuleToPkgConfAll
modmap 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 Bool
e [(ModuleName, ModuleName)]
rns = Bool -> [(ModuleName, Map Module ModuleOrigin)]
es Bool
e [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ [(ModuleName, Map Module ModuleOrigin)]
hiddens [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ ((ModuleName, ModuleName) -> (ModuleName, Map Module ModuleOrigin))
-> [(ModuleName, ModuleName)]
-> [(ModuleName, Map Module ModuleOrigin)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, ModuleName) -> (ModuleName, Map Module ModuleOrigin)
rnBinding [(ModuleName, ModuleName)]
rns
rnBinding :: (ModuleName, ModuleName)
-> (ModuleName, Map Module ModuleOrigin)
rnBinding :: (ModuleName, ModuleName) -> (ModuleName, Map Module ModuleOrigin)
rnBinding (ModuleName
orig, ModuleName
new) = (ModuleName
new, Map Module ModuleOrigin -> ModuleOrigin -> Map Module ModuleOrigin
forall (f :: * -> *) b b. Functor f => f b -> b -> f b
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 Map Module ModuleOrigin
r -> Map Module ModuleOrigin
r
Maybe (Map Module ModuleOrigin)
Nothing -> GhcException -> Map Module ModuleOrigin
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError (DynFlags -> SDoc -> String
showSDoc DynFlags
dflags
(String -> SDoc
text String
"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 String
"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 Bool
e = do
(ModuleName
m, Maybe Module
exposedReexport) <- [(ModuleName, Maybe Module)]
exposed_mods
let (UnitId
pk', ModuleName
m', ModuleOrigin
origin') =
case Maybe Module
exposedReexport of
Maybe Module
Nothing -> (UnitId
pk, ModuleName
m, Bool -> ModuleOrigin
fromExposedModules Bool
e)
Just (Module UnitId
pk' 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 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 String
"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 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 ModuleToPkgConfAll
modmap (PackageConfig
pkg, 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 (ModuleName
mod, Just Module
mod') = (ModuleName
mod, Module -> ModuleOrigin -> Map Module ModuleOrigin
forall k a. k -> a -> Map k a
Map.singleton Module
mod' ModuleOrigin
origin)
get_exposed (ModuleName
mod, Maybe Module
_) = (ModuleName
mod, 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 Map k (Map k a)
m (k
k, Map k a
v) = (Map k a -> Map k a -> Map k a)
-> k -> Map k a -> Map k (Map k a) -> Map k (Map k a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
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 UnitId
pkg 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 DynFlags
dflags [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 [PackageConfig]
ps = [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub ((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 DynFlags
dflags [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 DynFlags
dflags = [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub ([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 DynFlags
dflags [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 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 (String
"-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 (String
"-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 DynFlags
dflags 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
</> (String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lib String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".a")
| String
searchPath <- [String]
searchPaths
, String
lib <- [String]
libs ]
where searchPaths :: [String]
searchPaths = [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub ([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 DynFlags
dflags [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
$ \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 <- (\String
n -> String
"lib" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".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 DynFlags
dflags 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 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
| String
"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
'-'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 String
x' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"C" String
x = String
x'
| Bool
otherwise
= String -> String
forall a. String -> a
panic (String
"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 String
other_lib = String
other_lib String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
expandTag String
tag)
expandTag :: String -> String
expandTag String
t | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t = String
""
| Bool
otherwise = Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
t
libraryDirsForWay :: DynFlags -> PackageConfig -> [String]
libraryDirsForWay :: DynFlags -> PackageConfig -> [String]
libraryDirsForWay 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]
DynFlags
dflags [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 DynFlags
dflags [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. Ord a => [a] -> [a]
ordNub ((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 DynFlags
dflags [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 DynFlags
dflags ModuleName
m
= case DynFlags -> ModuleName -> Maybe FastString -> LookupResult
lookupModuleWithSuggestions DynFlags
dflags ModuleName
m Maybe FastString
forall a. Maybe a
Nothing of
LookupFound Module
a PackageConfig
b -> [(Module
a,PackageConfig
b)]
LookupMultiple [(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 (Module
m,b
_) = (Module
m, String -> Maybe PackageConfig -> PackageConfig
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"lookupModule" (DynFlags -> UnitId -> Maybe PackageConfig
lookupPackage DynFlags
dflags
(Module -> UnitId
moduleUnitId Module
m)))
LookupResult
_ -> []
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 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 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' DynFlags
dflags ModuleToPkgConfAll
mod_map ModuleName
m 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
Maybe (Map Module ModuleOrigin)
Nothing -> [ModuleSuggestion] -> LookupResult
LookupNotFound [ModuleSuggestion]
suggestions
Just Map Module ModuleOrigin
xs ->
case (([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> (Module, ModuleOrigin)
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)]))
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> [(Module, ModuleOrigin)]
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> (Module, ModuleOrigin)
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
classify ([],[],[], []) (Map Module ModuleOrigin -> [(Module, ModuleOrigin)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Module ModuleOrigin
xs) of
([], [], [], []) -> [ModuleSuggestion] -> LookupResult
LookupNotFound [ModuleSuggestion]
suggestions
([(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, [(Module
m, ModuleOrigin
_)]) -> Module -> PackageConfig -> LookupResult
LookupFound Module
m (Module -> PackageConfig
mod_pkg Module
m)
([(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, [(Module, ModuleOrigin)]
_, exposed :: [(Module, ModuleOrigin)]
exposed@((Module, ModuleOrigin)
_:[(Module, ModuleOrigin)]
_)) -> [(Module, ModuleOrigin)] -> LookupResult
LookupMultiple [(Module, ModuleOrigin)]
exposed
([], [], unusable :: [(Module, ModuleOrigin)]
unusable@((Module, ModuleOrigin)
_:[(Module, ModuleOrigin)]
_), []) -> [(Module, ModuleOrigin)] -> LookupResult
LookupUnusable [(Module, ModuleOrigin)]
unusable
([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
_, []) ->
[(Module, ModuleOrigin)]
-> [(Module, ModuleOrigin)] -> LookupResult
LookupHidden [(Module, ModuleOrigin)]
hidden_pkg [(Module, ModuleOrigin)]
hidden_mod
where
classify :: ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
-> (Module, ModuleOrigin)
-> ([(Module, ModuleOrigin)], [(Module, ModuleOrigin)],
[(Module, ModuleOrigin)], [(Module, ModuleOrigin)])
classify ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed) (Module
m, ModuleOrigin
origin0) =
let origin :: ModuleOrigin
origin = Maybe FastString -> 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
ModuleOrigin
ModHidden
-> ([(Module, ModuleOrigin)]
hidden_pkg, (Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
ModUnusable UnusablePackageReason
_
-> ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, (Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
ModuleOrigin
_ | ModuleOrigin -> Bool
originEmpty ModuleOrigin
origin
-> ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
| ModuleOrigin -> Bool
originVisible ModuleOrigin
origin
-> ([(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, (Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
exposed)
| Bool
otherwise
-> ((Module, ModuleOrigin)
x(Module, ModuleOrigin)
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. a -> [a] -> [a]
:[(Module, ModuleOrigin)]
hidden_pkg, [(Module, ModuleOrigin)]
hidden_mod, [(Module, ModuleOrigin)]
unusable, [(Module, ModuleOrigin)]
exposed)
pkg_lookup :: UnitId -> PackageConfig
pkg_lookup 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 String
"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 Maybe FastString
Nothing PackageConfig
_ ModuleOrigin
o = ModuleOrigin
o
filterOrigin (Just FastString
pn) PackageConfig
pkg ModuleOrigin
o =
case ModuleOrigin
o of
ModuleOrigin
ModHidden -> if PackageConfig -> Bool
go PackageConfig
pkg then ModuleOrigin
ModHidden else ModuleOrigin
forall a. Monoid a => a
mempty
(ModUnusable UnusablePackageReason
_) -> 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 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)
| (ModuleName
m, 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 ModuleName
name (Module
mod, ModuleOrigin
origin) =
(if ModuleOrigin -> Bool
originVisible ModuleOrigin
origin then ModuleName -> Module -> ModuleOrigin -> ModuleSuggestion
SuggestVisible else ModuleName -> Module -> ModuleOrigin -> ModuleSuggestion
SuggestHidden)
ModuleName
name Module
mod ModuleOrigin
origin
listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames :: DynFlags -> [ModuleName]
listVisibleModuleNames DynFlags
dflags =