1{-# LANGUAGE CPP #-} 2{-# LANGUAGE FlexibleContexts #-} 3{-# LANGUAGE RankNTypes #-} 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Client.Sandbox 7-- Maintainer : cabal-devel@haskell.org 8-- Portability : portable 9-- 10-- UI for the sandboxing functionality. 11----------------------------------------------------------------------------- 12 13module Distribution.Client.Sandbox ( 14 loadConfigOrSandboxConfig, 15 findSavedDistPref, 16 17 updateInstallDirs, 18 19 getPersistOrConfigCompiler 20 ) where 21 22import Prelude () 23import Distribution.Client.Compat.Prelude 24 25import Distribution.Client.Setup 26 ( ConfigFlags(..), GlobalFlags(..), configCompilerAux' ) 27import Distribution.Client.Config 28 ( SavedConfig(..), defaultUserInstall, loadConfig ) 29 30import Distribution.Client.Sandbox.PackageEnvironment 31 ( PackageEnvironmentType(..) 32 , classifyPackageEnvironment 33 , loadUserConfig 34 ) 35import Distribution.Client.SetupWrapper 36 ( SetupScriptOptions(..), defaultSetupScriptOptions ) 37import Distribution.Simple.Compiler ( Compiler(..) ) 38import Distribution.Simple.Configure ( maybeGetPersistBuildConfig 39 , findDistPrefOrDefault 40 , findDistPref ) 41import qualified Distribution.Simple.LocalBuildInfo as LocalBuildInfo 42import Distribution.Simple.Program ( ProgramDb ) 43import Distribution.Simple.Setup ( Flag(..) 44 , fromFlagOrDefault, flagToMaybe ) 45import Distribution.System ( Platform ) 46 47import System.Directory ( getCurrentDirectory ) 48 49 50-- * Basic sandbox functions. 51-- 52 53updateInstallDirs :: Flag Bool -> SavedConfig -> SavedConfig 54updateInstallDirs userInstallFlag savedConfig = savedConfig 55 { savedConfigureFlags = configureFlags 56 { configInstallDirs = installDirs 57 } 58 } 59 where 60 configureFlags = savedConfigureFlags savedConfig 61 userInstallDirs = savedUserInstallDirs savedConfig 62 globalInstallDirs = savedGlobalInstallDirs savedConfig 63 installDirs | userInstall = userInstallDirs 64 | otherwise = globalInstallDirs 65 userInstall = fromFlagOrDefault defaultUserInstall 66 (configUserInstall configureFlags `mappend` userInstallFlag) 67 68-- | Check which type of package environment we're in and return a 69-- correctly-initialised @SavedConfig@ and a @UseSandbox@ value that indicates 70-- whether we're working in a sandbox. 71loadConfigOrSandboxConfig :: Verbosity 72 -> GlobalFlags -- ^ For @--config-file@ and 73 -- @--sandbox-config-file@. 74 -> IO SavedConfig 75loadConfigOrSandboxConfig verbosity globalFlags = do 76 let configFileFlag = globalConfigFile globalFlags 77 78 pkgEnvDir <- getCurrentDirectory 79 pkgEnvType <- classifyPackageEnvironment pkgEnvDir 80 case pkgEnvType of 81 -- Only @cabal.config@ is present. 82 UserPackageEnvironment -> do 83 config <- loadConfig verbosity configFileFlag 84 userConfig <- loadUserConfig verbosity pkgEnvDir Nothing 85 let config' = config `mappend` userConfig 86 return config' 87 88 -- Neither @cabal.sandbox.config@ nor @cabal.config@ are present. 89 AmbientPackageEnvironment -> do 90 config <- loadConfig verbosity configFileFlag 91 let globalConstraintsOpt = 92 flagToMaybe . globalConstraintsFile . savedGlobalFlags $ config 93 globalConstraintConfig <- 94 loadUserConfig verbosity pkgEnvDir globalConstraintsOpt 95 let config' = config `mappend` globalConstraintConfig 96 return config' 97 98-- | Return the saved \"dist/\" prefix, or the default prefix. 99findSavedDistPref :: SavedConfig -> Flag FilePath -> IO FilePath 100findSavedDistPref config flagDistPref = do 101 let defDistPref = useDistPref defaultSetupScriptOptions 102 flagDistPref' = configDistPref (savedConfigureFlags config) 103 `mappend` flagDistPref 104 findDistPref defDistPref flagDistPref' 105 106-- Utils (transitionary) 107-- 108 109-- | Try to read the most recently configured compiler from the 110-- 'localBuildInfoFile', falling back on 'configCompilerAuxEx' if it 111-- cannot be read. 112getPersistOrConfigCompiler :: ConfigFlags 113 -> IO (Compiler, Platform, ProgramDb) 114getPersistOrConfigCompiler configFlags = do 115 distPref <- findDistPrefOrDefault (configDistPref configFlags) 116 mlbi <- maybeGetPersistBuildConfig distPref 117 case mlbi of 118 Nothing -> do configCompilerAux' configFlags 119 Just lbi -> return ( LocalBuildInfo.compiler lbi 120 , LocalBuildInfo.hostPlatform lbi 121 , LocalBuildInfo.withPrograms lbi 122 ) 123