Commit 099b7676 authored by Edsko de Vries's avatar Edsko de Vries Committed by Austin Seipp

Package environments

Summary: Package environments are files with package IDs that indicate which packages should be visible; see entry in user guide for details.

Reviewers: duncan, austin

Reviewed By: duncan, austin

Subscribers: carter, thomie

Differential Revision: https://phabricator.haskell.org/D558
parent 07ace5c2
......@@ -18,7 +18,7 @@ module CmdLineParser
Flag(..), defFlag, defGhcFlag, defGhciFlag, defHiddenFlag,
errorsToGhcException,
EwM, addErr, addWarn, getArg, getCurLoc, liftEwM, deprecate
EwM(..), runEwM, addErr, addWarn, getArg, getCurLoc, liftEwM, deprecate
) where
#include "HsVersions.h"
......@@ -108,6 +108,9 @@ instance Monad m => Monad (EwM m) where
unEwM (k r) l e' w')
return v = EwM (\_ e w -> return (e, w, v))
runEwM :: EwM m a -> m (Errs, Warns, a)
runEwM action = unEwM action (panic "processArgs: no arg yet") emptyBag emptyBag
setArg :: Located String -> EwM m () -> EwM m ()
setArg l (EwM f) = EwM (\_ es ws -> f l es ws)
......@@ -170,8 +173,7 @@ processArgs :: Monad m
[Located String], -- errors
[Located String] ) -- warnings
processArgs spec args = do
(errs, warns, spare) <- unEwM action (panic "processArgs: no arg yet")
emptyBag emptyBag
(errs, warns, spare) <- runEwM action
return (spare, bagToList errs, bagToList warns)
where
action = process args []
......
......@@ -67,6 +67,7 @@ module DynFlags (
Settings(..),
targetPlatform, programName, projectVersion,
ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
versionedAppDir,
extraGccViaCFlags, systemPackageConfig,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T,
pgm_sysman, pgm_windres, pgm_libtool, pgm_lo, pgm_lc,
......@@ -91,6 +92,7 @@ module DynFlags (
updOptLevel,
setTmpDir,
setPackageKey,
interpretPackageEnv,
-- ** Parsing DynFlags
parseDynamicFlagsCmdLine,
......@@ -162,7 +164,7 @@ import CmdLineParser
import Constants
import Panic
import Util
import Maybes ( orElse )
import Maybes
import MonadUtils
import qualified Pretty
import SrcLoc
......@@ -177,6 +179,7 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef
import Control.Monad
import Control.Exception (throwIO)
import Data.Bits
import Data.Char
......@@ -184,11 +187,12 @@ import Data.Int
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word
import System.FilePath
import System.Directory
import System.Environment (getEnv)
import System.IO
import System.IO.Error
import Text.ParserCombinators.ReadP hiding (char)
......@@ -768,6 +772,8 @@ data DynFlags = DynFlags {
packageFlags :: [PackageFlag],
-- ^ The @-package@ and @-hide-package@ flags from the command-line
packageEnv :: Maybe FilePath,
-- ^ Filepath to the package environment file (if overriding default)
-- Package state
-- NB. do not modify this field, it is calculated by
......@@ -1013,6 +1019,14 @@ opt_lo dflags = sOpt_lo (settings dflags)
opt_lc :: DynFlags -> [String]
opt_lc dflags = sOpt_lc (settings dflags)
-- | The directory for this version of ghc in the user's app directory
-- (typically something like @~/.ghc/x86_64-linux-7.6.3@)
--
versionedAppDir :: IO FilePath
versionedAppDir = do
appdir <- getAppUserDataDirectory "ghc"
return $ appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
-- | The target code type of the compilation (if any).
--
-- Whenever you change the target, also make sure to set 'ghcLink' to
......@@ -1470,6 +1484,7 @@ defaultDynFlags mySettings =
extraPkgConfs = id,
packageFlags = [],
packageEnv = Nothing,
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
ways = defaultWays mySettings,
......@@ -2723,6 +2738,7 @@ package_flags = [
, defFlag "package-key" (HasArg exposePackageKey)
, defFlag "hide-package" (HasArg hidePackage)
, defFlag "hide-all-packages" (NoArg (setGeneralFlag Opt_HideAllPackages))
, defFlag "package-env" (HasArg setPackageEnv)
, defFlag "ignore-package" (HasArg ignorePackage)
, defFlag "syslib"
(HasArg (\s -> do exposePackage s
......@@ -2732,6 +2748,8 @@ package_flags = [
, defFlag "trust" (HasArg trustPackage)
, defFlag "distrust" (HasArg distrustPackage)
]
where
setPackageEnv env = upd $ \s -> s { packageEnv = Just env }
-- | Make a list of flags for shell completion.
-- Filter all available flags into two groups, for interactive GHC vs all other.
......@@ -3700,6 +3718,102 @@ exposePackage' p dflags
setPackageKey :: String -> DynFlags -> DynFlags
setPackageKey p s = s{ thisPackage = stringToPackageKey p }
-- -----------------------------------------------------------------------------
-- | Find the package environment (if one exists)
--
-- We interpret the package environment as a set of package flags; to be
-- specific, if we find a package environment
--
-- > id1
-- > id2
-- > ..
-- > idn
--
-- we interpret this as
--
-- > [ -hide-all-packages
-- > , -package-id id1
-- > , -package-id id2
-- > , ..
-- > , -package-id idn
-- > ]
interpretPackageEnv :: DynFlags -> IO DynFlags
interpretPackageEnv dflags = do
mPkgEnv <- runMaybeT $ msum $ [
getCmdLineArg >>= \env -> msum [
loadEnvFile env
, loadEnvName env
, cmdLineError env
]
, getEnvVar >>= \env -> msum [
loadEnvFile env
, loadEnvName env
, envError env
]
, loadEnvFile localEnvFile
, loadEnvName defaultEnvName
]
case mPkgEnv of
Nothing ->
-- No environment found. Leave DynFlags unchanged.
return dflags
Just ids -> do
let setFlags :: DynP ()
setFlags = do
setGeneralFlag Opt_HideAllPackages
mapM_ exposePackageId (lines ids)
(_, dflags') = runCmdLine (runEwM setFlags) dflags
return dflags'
where
-- Loading environments (by name or by location)
namedEnvPath :: String -> MaybeT IO FilePath
namedEnvPath name = do
appdir <- liftMaybeT $ versionedAppDir
return $ appdir </> "environments" </> name
loadEnvName :: String -> MaybeT IO String
loadEnvName name = loadEnvFile =<< namedEnvPath name
loadEnvFile :: String -> MaybeT IO String
loadEnvFile path = do
guard =<< liftMaybeT (doesFileExist path)
liftMaybeT $ readFile path
-- Various ways to define which environment to use
getCmdLineArg :: MaybeT IO String
getCmdLineArg = MaybeT $ return $ packageEnv dflags
getEnvVar :: MaybeT IO String
getEnvVar = do
mvar <- liftMaybeT $ try $ getEnv "GHC_ENVIRONMENT"
case mvar of
Right var -> return var
Left err -> if isDoesNotExistError err then mzero
else liftMaybeT $ throwIO err
defaultEnvName :: String
defaultEnvName = "default"
localEnvFile :: FilePath
localEnvFile = "./.ghc.environment"
-- Error reporting
cmdLineError :: String -> MaybeT IO a
cmdLineError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $
"Package environment " ++ show env ++ " not found"
envError :: String -> MaybeT IO a
envError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $
"Package environment "
++ show env
++ " (specified in GHC_ENVIRIONMENT) not found"
-- If we're linking a binary, then only targets that produce object
-- code are allowed (requests for other target types are ignored).
setTarget :: HscTarget -> DynP ()
......
......@@ -354,10 +354,10 @@ getPackageConfRefs dflags = do
resolvePackageConfig :: DynFlags -> PkgConfRef -> IO (Maybe FilePath)
resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig dflags)
resolvePackageConfig dflags UserPkgConf = handleIO (\_ -> return Nothing) $ do
appdir <- getAppUserDataDirectory (programName dflags)
let dir = appdir </> (TARGET_ARCH ++ '-':TARGET_OS ++ '-':projectVersion dflags)
pkgconf = dir </> "package.conf.d"
resolvePackageConfig _ UserPkgConf = handleIO (\_ -> return Nothing) $ do
dir <- versionedAppDir
let pkgconf = dir </> "package.conf.d"
exist <- doesDirectoryExist pkgconf
return $ if exist then Just pkgconf else Nothing
resolvePackageConfig _ (PkgConfFile name) = return $ Just name
......@@ -814,7 +814,8 @@ mkPackageState
PackageKey) -- this package, might be modified if the current
-- package is a wired-in package.
mkPackageState dflags pkgs0 preload0 this_package = do
mkPackageState dflags0 pkgs0 preload0 this_package = do
dflags <- interpretPackageEnv dflags0
{-
Plan.
......
......@@ -15,11 +15,10 @@ module Maybes (
whenIsJust,
expectJust,
MaybeT(..)
MaybeT(..), liftMaybeT
) where
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
#endif
import Control.Monad
import Data.Maybe
......@@ -81,6 +80,25 @@ instance Monad m => Monad (MaybeT m) where
x >>= f = MaybeT $ runMaybeT x >>= maybe (return Nothing) (runMaybeT . f)
fail _ = MaybeT $ return Nothing
#if __GLASGOW_HASKELL__ < 710
-- Pre-AMP change
instance (Monad m, Functor m) => Alternative (MaybeT m) where
#else
instance (Monad m) => Alternative (MaybeT m) where
#endif
empty = mzero
(<|>) = mplus
instance Monad m => MonadPlus (MaybeT m) where
mzero = MaybeT $ return Nothing
p `mplus` q = MaybeT $ do ma <- runMaybeT p
case ma of
Just a -> return (Just a)
Nothing -> runMaybeT q
liftMaybeT :: Monad m => m a -> MaybeT m a
liftMaybeT act = MaybeT $ Just `liftM` act
{-
************************************************************************
* *
......
......@@ -1812,6 +1812,92 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix
-->
</sect2>
<sect2 id="package-environments">
<indexterm><primary>package environments</primary></indexterm>
<title>
Package environments
</title>
<para>
A <emphasis>package environment</emphasis> is a file that tells
<literal>ghc</literal> precisely which packages should be visible. It
contains package IDs, one per line:
</para>
<screen>
package_id_1
package_id_2
...
package_id_n
</screen>
<para>
If a package environment is found, it is equivalent to passing these
command line arguments to <literal>ghc</literal>:
</para>
<screen>
-hide-all-packages
-package-id package_id_1
-package-id package_id_2
...
-package-id package_id_n
</screen>
<para>
In order, <literal>ghc</literal> will look for the package environment
in the following locations:
</para>
<itemizedlist>
<listitem>
<para>
File
<replaceable>file</replaceable>
if you pass the option
<option>-package-env <replaceable>file</replaceable></option>.
</para>
</listitem>
<listitem>
<para>
File
<filename>$HOME/.ghc/<replaceable>arch</replaceable>-<replaceable>os</replaceable>-<replaceable>version</replaceable>/environments/<replaceable>name</replaceable></filename>
if you pass the option
<option>-package-env <replaceable>name</replaceable></option>.
</para>
</listitem>
<listitem>
<para>
File
<replaceable>file</replaceable>
if the environment variable <literal>GHC_ENVIRONMENT</literal>
is set to <replaceable>file</replaceable>.
</para>
</listitem>
<listitem>
<para>
File
<filename>$HOME/.ghc/<replaceable>arch</replaceable>-<replaceable>os</replaceable>-<replaceable>version</replaceable>/environments/<replaceable>name</replaceable></filename>
if the environment variable <literal>GHC_ENVIRONMENT</literal>
is set to <replaceable>name</replaceable>.
</para>
</listitem>
<listitem>
<para>
File <filename>./.ghc.environment</filename> if it exists.
</para>
</listitem>
<listitem>
<para>
File
<filename>$HOME/.ghc/<replaceable>arch</replaceable>-<replaceable>os</replaceable>-<replaceable>version</replaceable>/environments/default</filename>
if it exists.
</para>
</listitem>
</itemizedlist>
<para>
Package environments can be modified by further command line arguments;
for example, if you specify
<option>-package <replaceable>foo</replaceable></option>
on the command line, then package <replaceable>foo</replaceable> will be
visible even if it's not listed in the currently active package
environment.
</para>
</sect2>
</sect1>
<!-- Emacs stuff:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment