getPackageFrameworks,
getPreloadPackagesAnd,
+ collectIncludeDirs, collectLibraryPaths, collectLinkOpts,
+
-- * Utils
isDllName
)
import Distribution.Version
import FastString
import ErrUtils ( debugTraceMsg, putMsg, Message )
+import Exception
import System.Directory
import System.FilePath
import Data.Maybe
import Control.Monad
import Data.List
-import Control.Exception ( throwDyn )
-- ---------------------------------------------------------------------------
-- The Package state
readPackageConfigs :: DynFlags -> IO PackageConfigMap
readPackageConfigs dflags = do
- e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
+ e_pkg_path <- tryIO (getEnv "GHC_PACKAGE_PATH")
system_pkgconfs <- getSystemPackageConfigs dflags
let pkgconfs = case e_pkg_path of
-- unless the -no-user-package-conf flag was given.
-- We only do this when getAppUserDataDirectory is available
-- (GHC >= 6.3).
- user_pkgconf <- handle (\_ -> return []) $ do
+ user_pkgconf <- do
appdir <- getAppUserDataDirectory "ghc"
let
pkgconf = appdir
if (flg && dopt Opt_ReadUserPackageConf dflags)
then return [pkgconf]
else return []
+ `catchIO` (\_ -> return [])
return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf])
-- use.
getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String]
-getPackageIncludePath dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
- return (nub (filter notNull (concatMap includeDirs ps)))
+getPackageIncludePath dflags pkgs =
+ collectIncludeDirs `fmap` getPreloadPackagesAnd dflags pkgs
+
+collectIncludeDirs :: [PackageConfig] -> [FilePath]
+collectIncludeDirs ps = nub (filter notNull (concatMap includeDirs ps))
getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String]
-getPackageLibraryPath dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
- return (nub (filter notNull (concatMap libraryDirs ps)))
+getPackageLibraryPath dflags pkgs =
+ collectLibraryPaths `fmap` getPreloadPackagesAnd dflags pkgs
+
+collectLibraryPaths :: [PackageConfig] -> [FilePath]
+collectLibraryPaths ps = nub (filter notNull (concatMap libraryDirs ps))
getPackageLinkOpts :: DynFlags -> [PackageId] -> IO [String]
-getPackageLinkOpts dflags pkgs = do
- ps <- getPreloadPackagesAnd dflags pkgs
- let tag = buildTag dflags
- rts_tag = rtsBuildTag dflags
- let
+getPackageLinkOpts dflags pkgs =
+ collectLinkOpts dflags `fmap` getPreloadPackagesAnd dflags pkgs
+
+collectLinkOpts :: DynFlags -> [PackageConfig] -> [String]
+collectLinkOpts dflags ps = concat (map all_opts ps)
+ where
+ tag = buildTag dflags
+ rts_tag = rtsBuildTag dflags
+
mkDynName | opt_Static = id
| otherwise = (++ ("-ghc" ++ cProjectVersion))
libs p = map (mkDynName . addSuffix) (hsLibraries p)
expandTag t | null t = ""
| otherwise = '_':t
- return (concat (map all_opts ps))
-
getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
getPackageExtraCcOpts dflags pkgs = do
ps <- getPreloadPackagesAnd dflags pkgs
throwErr :: MaybeErr Message a -> IO a
throwErr m = case m of
- Failed e -> throwDyn (CmdLineError (showSDoc e))
+ Failed e -> ghcError (CmdLineError (showSDoc e))
Succeeded r -> return r
closeDepsErr :: PackageConfigMap -> [(PackageId,Maybe PackageId)]
return (p : ps')
missingPackageErr :: String -> IO [PackageConfig]
-missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p)))
+missingPackageErr p = ghcError (CmdLineError (showSDoc (missingPackageMsg p)))
missingPackageMsg :: String -> SDoc
missingPackageMsg p = ptext (sLit "unknown package:") <+> text p