1{-# LANGUAGE DeriveGeneric #-} 2 3----------------------------------------------------------------------------- 4-- | 5-- Module : Distribution.Client.Sandbox.PackageEnvironment 6-- Maintainer : cabal-devel@haskell.org 7-- Portability : portable 8-- 9-- Utilities for working with the package environment file. Patterned after 10-- Distribution.Client.Config. 11----------------------------------------------------------------------------- 12 13module Distribution.Client.Sandbox.PackageEnvironment ( 14 PackageEnvironment(..) 15 , PackageEnvironmentType(..) 16 , classifyPackageEnvironment 17 , createPackageEnvironmentFile 18 , tryLoadSandboxPackageEnvironmentFile 19 , readPackageEnvironmentFile 20 , showPackageEnvironment 21 , showPackageEnvironmentWithComments 22 , setPackageDB 23 , sandboxPackageDBPath 24 , loadUserConfig 25 26 , basePackageEnvironment 27 , initialPackageEnvironment 28 , commentPackageEnvironment 29 , sandboxPackageEnvironmentFile 30 , userPackageEnvironmentFile 31 ) where 32 33import Distribution.Client.Config ( SavedConfig(..), commentSavedConfig 34 , loadConfig, configFieldDescriptions 35 , haddockFlagsFields 36 , installDirsFields, withProgramsFields 37 , withProgramOptionsFields 38 , defaultCompiler ) 39import Distribution.Client.ParseUtils ( parseFields, ppFields, ppSection ) 40import Distribution.Client.Setup ( GlobalFlags(..), ConfigExFlags(..) 41 , InstallFlags(..) 42 , defaultSandboxLocation ) 43import Distribution.Client.Targets ( userConstraintPackageName ) 44import Distribution.Utils.NubList ( toNubList ) 45import Distribution.Simple.Compiler ( Compiler, PackageDB(..) 46 , compilerFlavor, showCompilerIdWithAbi ) 47import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate 48 , defaultInstallDirs, combineInstallDirs 49 , fromPathTemplate, toPathTemplate ) 50import Distribution.Simple.Setup ( Flag(..) 51 , ConfigFlags(..), HaddockFlags(..) 52 , fromFlagOrDefault, toFlag, flagToMaybe ) 53import Distribution.Simple.Utils ( die', info, notice, warn, debug ) 54import Distribution.Solver.Types.ConstraintSource 55import Distribution.Deprecated.ParseUtils ( FieldDescr(..), ParseResult(..) 56 , commaListField, commaNewLineListField 57 , liftField, lineNo, locatedErrorMsg 58 , parseFilePathQ, readFields 59 , showPWarning, simpleField 60 , syntaxError, warning ) 61import Distribution.System ( Platform ) 62import Distribution.Verbosity ( Verbosity, normal ) 63import Control.Monad ( foldM, liftM2, unless ) 64import Data.List ( partition, sortBy ) 65import Data.Maybe ( isJust ) 66import Data.Ord ( comparing ) 67import Distribution.Compat.Exception ( catchIO ) 68import Distribution.Compat.Semigroup 69import System.Directory ( doesDirectoryExist, doesFileExist 70 , renameFile ) 71import System.FilePath ( (<.>), (</>), takeDirectory ) 72import System.IO.Error ( isDoesNotExistError ) 73import Text.PrettyPrint ( ($+$) ) 74 75import qualified Text.PrettyPrint as Disp 76import qualified Distribution.Deprecated.ReadP as Parse 77import qualified Distribution.Deprecated.ParseUtils as ParseUtils ( Field(..) ) 78import qualified Distribution.Deprecated.Text as Text 79import GHC.Generics ( Generic ) 80 81 82-- 83-- * Configuration saved in the package environment file 84-- 85 86-- TODO: would be nice to remove duplication between 87-- D.C.Sandbox.PackageEnvironment and D.C.Config. 88data PackageEnvironment = PackageEnvironment { 89 -- The 'inherit' feature is not used ATM, but could be useful in the future 90 -- for constructing nested sandboxes (see discussion in #1196). 91 pkgEnvInherit :: Flag FilePath, 92 pkgEnvSavedConfig :: SavedConfig 93} deriving Generic 94 95instance Monoid PackageEnvironment where 96 mempty = gmempty 97 mappend = (<>) 98 99instance Semigroup PackageEnvironment where 100 (<>) = gmappend 101 102-- | The automatically-created package environment file that should not be 103-- touched by the user. 104sandboxPackageEnvironmentFile :: FilePath 105sandboxPackageEnvironmentFile = "cabal.sandbox.config" 106 107-- | Optional package environment file that can be used to customize the default 108-- settings. Created by the user. 109userPackageEnvironmentFile :: FilePath 110userPackageEnvironmentFile = "cabal.config" 111 112-- | Type of the current package environment. 113data PackageEnvironmentType = 114 SandboxPackageEnvironment -- ^ './cabal.sandbox.config' 115 | UserPackageEnvironment -- ^ './cabal.config' 116 | AmbientPackageEnvironment -- ^ '~/.cabal/config' 117 118-- | Is there a 'cabal.sandbox.config' or 'cabal.config' in this 119-- directory? 120classifyPackageEnvironment :: FilePath -> Flag FilePath -> Flag Bool 121 -> IO PackageEnvironmentType 122classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag ignoreSandboxFlag = 123 do isSandbox <- liftM2 (||) (return forceSandboxConfig) 124 (configExists sandboxPackageEnvironmentFile) 125 isUser <- configExists userPackageEnvironmentFile 126 return (classify isSandbox isUser) 127 where 128 configExists fname = doesFileExist (pkgEnvDir </> fname) 129 ignoreSandbox = fromFlagOrDefault False ignoreSandboxFlag 130 forceSandboxConfig = isJust . flagToMaybe $ sandboxConfigFileFlag 131 132 classify :: Bool -> Bool -> PackageEnvironmentType 133 classify True _ 134 | not ignoreSandbox = SandboxPackageEnvironment 135 classify _ True = UserPackageEnvironment 136 classify _ False = AmbientPackageEnvironment 137 138-- | Defaults common to 'initialPackageEnvironment' and 139-- 'commentPackageEnvironment'. 140commonPackageEnvironmentConfig :: FilePath -> SavedConfig 141commonPackageEnvironmentConfig sandboxDir = 142 mempty { 143 savedConfigureFlags = mempty { 144 -- TODO: Currently, we follow cabal-dev and set 'user-install: False' in 145 -- the config file. In the future we may want to distinguish between 146 -- global, sandbox and user install types. 147 configUserInstall = toFlag False, 148 configInstallDirs = installDirs 149 }, 150 savedUserInstallDirs = installDirs, 151 savedGlobalInstallDirs = installDirs, 152 savedGlobalFlags = mempty { 153 globalLogsDir = toFlag $ sandboxDir </> "logs", 154 -- Is this right? cabal-dev uses the global world file. 155 globalWorldFile = toFlag $ sandboxDir </> "world" 156 } 157 } 158 where 159 installDirs = sandboxInstallDirs sandboxDir 160 161-- | 'commonPackageEnvironmentConfig' wrapped inside a 'PackageEnvironment'. 162commonPackageEnvironment :: FilePath -> PackageEnvironment 163commonPackageEnvironment sandboxDir = mempty { 164 pkgEnvSavedConfig = commonPackageEnvironmentConfig sandboxDir 165 } 166 167-- | Given a path to a sandbox, return the corresponding InstallDirs record. 168sandboxInstallDirs :: FilePath -> InstallDirs (Flag PathTemplate) 169sandboxInstallDirs sandboxDir = mempty { 170 prefix = toFlag (toPathTemplate sandboxDir) 171 } 172 173-- | These are the absolute basic defaults, the fields that must be 174-- initialised. When we load the package environment from the file we layer the 175-- loaded values over these ones. 176basePackageEnvironment :: PackageEnvironment 177basePackageEnvironment = 178 mempty { 179 pkgEnvSavedConfig = mempty { 180 savedConfigureFlags = mempty { 181 configHcFlavor = toFlag defaultCompiler, 182 configVerbosity = toFlag normal 183 } 184 } 185 } 186 187-- | Initial configuration that we write out to the package environment file if 188-- it does not exist. When the package environment gets loaded this 189-- configuration gets layered on top of 'basePackageEnvironment'. 190initialPackageEnvironment :: FilePath -> Compiler -> Platform 191 -> IO PackageEnvironment 192initialPackageEnvironment sandboxDir compiler platform = do 193 defInstallDirs <- defaultInstallDirs (compilerFlavor compiler) 194 {- userInstall= -} False {- _hasLibs= -} False 195 let initialConfig = commonPackageEnvironmentConfig sandboxDir 196 installDirs = combineInstallDirs (\d f -> Flag $ fromFlagOrDefault d f) 197 defInstallDirs (savedUserInstallDirs initialConfig) 198 return $ mempty { 199 pkgEnvSavedConfig = initialConfig { 200 savedUserInstallDirs = installDirs, 201 savedGlobalInstallDirs = installDirs, 202 savedGlobalFlags = (savedGlobalFlags initialConfig) { 203 globalLocalRepos = toNubList [sandboxDir </> "packages"] 204 }, 205 savedConfigureFlags = setPackageDB sandboxDir compiler platform 206 (savedConfigureFlags initialConfig), 207 savedInstallFlags = (savedInstallFlags initialConfig) { 208 installSummaryFile = toNubList [toPathTemplate (sandboxDir </> 209 "logs" </> "build.log")] 210 } 211 } 212 } 213 214-- | Return the path to the sandbox package database. 215sandboxPackageDBPath :: FilePath -> Compiler -> Platform -> String 216sandboxPackageDBPath sandboxDir compiler platform = 217 sandboxDir 218 </> (Text.display platform ++ "-" 219 ++ showCompilerIdWithAbi compiler 220 ++ "-packages.conf.d") 221-- The path in sandboxPackageDBPath should be kept in sync with the 222-- path in the bootstrap.sh which is used to bootstrap cabal-install 223-- into a sandbox. 224 225-- | Use the package DB location specific for this compiler. 226setPackageDB :: FilePath -> Compiler -> Platform -> ConfigFlags -> ConfigFlags 227setPackageDB sandboxDir compiler platform configFlags = 228 configFlags { 229 configPackageDBs = [Just (SpecificPackageDB $ sandboxPackageDBPath 230 sandboxDir 231 compiler 232 platform)] 233 } 234 235-- | Almost the same as 'savedConf `mappend` pkgEnv', but some settings are 236-- overridden instead of mappend'ed. 237overrideSandboxSettings :: PackageEnvironment -> PackageEnvironment -> 238 PackageEnvironment 239overrideSandboxSettings pkgEnv0 pkgEnv = 240 pkgEnv { 241 pkgEnvSavedConfig = mappendedConf { 242 savedConfigureFlags = (savedConfigureFlags mappendedConf) { 243 configPackageDBs = configPackageDBs pkgEnvConfigureFlags 244 } 245 , savedInstallFlags = (savedInstallFlags mappendedConf) { 246 installSummaryFile = installSummaryFile pkgEnvInstallFlags 247 } 248 }, 249 pkgEnvInherit = pkgEnvInherit pkgEnv0 250 } 251 where 252 pkgEnvConf = pkgEnvSavedConfig pkgEnv 253 mappendedConf = (pkgEnvSavedConfig pkgEnv0) `mappend` pkgEnvConf 254 pkgEnvConfigureFlags = savedConfigureFlags pkgEnvConf 255 pkgEnvInstallFlags = savedInstallFlags pkgEnvConf 256 257-- | Default values that get used if no value is given. Used here to include in 258-- comments when we write out the initial package environment. 259commentPackageEnvironment :: FilePath -> IO PackageEnvironment 260commentPackageEnvironment sandboxDir = do 261 commentConf <- commentSavedConfig 262 let baseConf = commonPackageEnvironmentConfig sandboxDir 263 return $ mempty { 264 pkgEnvSavedConfig = commentConf `mappend` baseConf 265 } 266 267-- | If this package environment inherits from some other package environment, 268-- return that package environment; otherwise return mempty. 269inheritedPackageEnvironment :: Verbosity -> PackageEnvironment 270 -> IO PackageEnvironment 271inheritedPackageEnvironment verbosity pkgEnv = do 272 case (pkgEnvInherit pkgEnv) of 273 NoFlag -> return mempty 274 confPathFlag@(Flag _) -> do 275 conf <- loadConfig verbosity confPathFlag 276 return $ mempty { pkgEnvSavedConfig = conf } 277 278-- | Load the user package environment if it exists (the optional "cabal.config" 279-- file). If it does not exist locally, attempt to load an optional global one. 280userPackageEnvironment :: Verbosity -> FilePath -> Maybe FilePath 281 -> IO PackageEnvironment 282userPackageEnvironment verbosity pkgEnvDir globalConfigLocation = do 283 let path = pkgEnvDir </> userPackageEnvironmentFile 284 minp <- readPackageEnvironmentFile (ConstraintSourceUserConfig path) 285 mempty path 286 case (minp, globalConfigLocation) of 287 (Just parseRes, _) -> processConfigParse path parseRes 288 (_, Just globalLoc) -> do 289 minp' <- readPackageEnvironmentFile (ConstraintSourceUserConfig globalLoc) 290 mempty globalLoc 291 maybe (warn verbosity ("no constraints file found at " ++ globalLoc) 292 >> return mempty) 293 (processConfigParse globalLoc) 294 minp' 295 _ -> do 296 debug verbosity ("no user package environment file found at " ++ pkgEnvDir) 297 return mempty 298 where 299 processConfigParse path (ParseOk warns parseResult) = do 300 unless (null warns) $ warn verbosity $ 301 unlines (map (showPWarning path) warns) 302 return parseResult 303 processConfigParse path (ParseFailed err) = do 304 let (line, msg) = locatedErrorMsg err 305 warn verbosity $ "Error parsing package environment file " ++ path 306 ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg 307 return mempty 308 309-- | Same as @userPackageEnvironmentFile@, but returns a SavedConfig. 310loadUserConfig :: Verbosity -> FilePath -> Maybe FilePath -> IO SavedConfig 311loadUserConfig verbosity pkgEnvDir globalConfigLocation = 312 fmap pkgEnvSavedConfig $ 313 userPackageEnvironment verbosity pkgEnvDir globalConfigLocation 314 315-- | Common error handling code used by 'tryLoadSandboxPackageEnvironment' and 316-- 'updatePackageEnvironment'. 317handleParseResult :: Verbosity -> FilePath 318 -> Maybe (ParseResult PackageEnvironment) 319 -> IO PackageEnvironment 320handleParseResult verbosity path minp = 321 case minp of 322 Nothing -> die' verbosity $ 323 "The package environment file '" ++ path ++ "' doesn't exist" 324 Just (ParseOk warns parseResult) -> do 325 unless (null warns) $ warn verbosity $ 326 unlines (map (showPWarning path) warns) 327 return parseResult 328 Just (ParseFailed err) -> do 329 let (line, msg) = locatedErrorMsg err 330 die' verbosity $ "Error parsing package environment file " ++ path 331 ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg 332 333-- | Try to load the given package environment file, exiting with error if it 334-- doesn't exist. Also returns the path to the sandbox directory. The path 335-- parameter should refer to an existing file. 336tryLoadSandboxPackageEnvironmentFile :: Verbosity -> FilePath -> (Flag FilePath) 337 -> IO (FilePath, PackageEnvironment) 338tryLoadSandboxPackageEnvironmentFile verbosity pkgEnvFile configFileFlag = do 339 let pkgEnvDir = takeDirectory pkgEnvFile 340 minp <- readPackageEnvironmentFile 341 (ConstraintSourceSandboxConfig pkgEnvFile) mempty pkgEnvFile 342 pkgEnv <- handleParseResult verbosity pkgEnvFile minp 343 344 -- Get the saved sandbox directory. 345 -- TODO: Use substPathTemplate with 346 -- compilerTemplateEnv ++ platformTemplateEnv ++ abiTemplateEnv. 347 let sandboxDir = fromFlagOrDefault defaultSandboxLocation 348 . fmap fromPathTemplate . prefix . savedUserInstallDirs 349 . pkgEnvSavedConfig $ pkgEnv 350 351 -- Do some sanity checks 352 dirExists <- doesDirectoryExist sandboxDir 353 -- TODO: Also check for an initialised package DB? 354 unless dirExists $ 355 die' verbosity ("No sandbox exists at " ++ sandboxDir) 356 info verbosity $ "Using a sandbox located at " ++ sandboxDir 357 358 let base = basePackageEnvironment 359 let common = commonPackageEnvironment sandboxDir 360 user <- userPackageEnvironment verbosity pkgEnvDir Nothing --TODO 361 inherited <- inheritedPackageEnvironment verbosity user 362 363 -- Layer the package environment settings over settings from ~/.cabal/config. 364 cabalConfig <- fmap unsetSymlinkBinDir $ loadConfig verbosity configFileFlag 365 return (sandboxDir, 366 updateInstallDirs $ 367 (base `mappend` (toPkgEnv cabalConfig) `mappend` 368 common `mappend` inherited `mappend` user) 369 `overrideSandboxSettings` pkgEnv) 370 where 371 toPkgEnv config = mempty { pkgEnvSavedConfig = config } 372 373 updateInstallDirs pkgEnv = 374 let config = pkgEnvSavedConfig pkgEnv 375 configureFlags = savedConfigureFlags config 376 installDirs = savedUserInstallDirs config 377 in pkgEnv { 378 pkgEnvSavedConfig = config { 379 savedConfigureFlags = configureFlags { 380 configInstallDirs = installDirs 381 } 382 } 383 } 384 385 -- We don't want to inherit the value of 'symlink-bindir' from 386 -- '~/.cabal/config'. See #1514. 387 unsetSymlinkBinDir config = 388 let installFlags = savedInstallFlags config 389 in config { 390 savedInstallFlags = installFlags { 391 installSymlinkBinDir = NoFlag 392 } 393 } 394 395-- | Create a new package environment file, replacing the existing one if it 396-- exists. Note that the path parameters should point to existing directories. 397createPackageEnvironmentFile :: Verbosity -> FilePath -> FilePath 398 -> Compiler 399 -> Platform 400 -> IO () 401createPackageEnvironmentFile verbosity sandboxDir pkgEnvFile compiler platform = do 402 notice verbosity $ "Writing a default package environment file to " ++ pkgEnvFile 403 initialPkgEnv <- initialPackageEnvironment sandboxDir compiler platform 404 writePackageEnvironmentFile pkgEnvFile initialPkgEnv 405 406-- | Descriptions of all fields in the package environment file. 407pkgEnvFieldDescrs :: ConstraintSource -> [FieldDescr PackageEnvironment] 408pkgEnvFieldDescrs src = [ 409 simpleField "inherit" 410 (fromFlagOrDefault Disp.empty . fmap Disp.text) (optional parseFilePathQ) 411 pkgEnvInherit (\v pkgEnv -> pkgEnv { pkgEnvInherit = v }) 412 413 , commaNewLineListField "constraints" 414 (Text.disp . fst) ((\pc -> (pc, src)) `fmap` Text.parse) 415 (sortConstraints . configExConstraints 416 . savedConfigureExFlags . pkgEnvSavedConfig) 417 (\v pkgEnv -> updateConfigureExFlags pkgEnv 418 (\flags -> flags { configExConstraints = v })) 419 420 , commaListField "preferences" 421 Text.disp Text.parse 422 (configPreferences . savedConfigureExFlags . pkgEnvSavedConfig) 423 (\v pkgEnv -> updateConfigureExFlags pkgEnv 424 (\flags -> flags { configPreferences = v })) 425 ] 426 ++ map toPkgEnv configFieldDescriptions' 427 where 428 optional = Parse.option mempty . fmap toFlag 429 430 configFieldDescriptions' :: [FieldDescr SavedConfig] 431 configFieldDescriptions' = filter 432 (\(FieldDescr name _ _) -> name /= "preference" && name /= "constraint") 433 (configFieldDescriptions src) 434 435 toPkgEnv :: FieldDescr SavedConfig -> FieldDescr PackageEnvironment 436 toPkgEnv fieldDescr = 437 liftField pkgEnvSavedConfig 438 (\savedConfig pkgEnv -> pkgEnv { pkgEnvSavedConfig = savedConfig}) 439 fieldDescr 440 441 updateConfigureExFlags :: PackageEnvironment 442 -> (ConfigExFlags -> ConfigExFlags) 443 -> PackageEnvironment 444 updateConfigureExFlags pkgEnv f = pkgEnv { 445 pkgEnvSavedConfig = (pkgEnvSavedConfig pkgEnv) { 446 savedConfigureExFlags = f . savedConfigureExFlags . pkgEnvSavedConfig 447 $ pkgEnv 448 } 449 } 450 451 sortConstraints = sortBy (comparing $ userConstraintPackageName . fst) 452 453-- | Read the package environment file. 454readPackageEnvironmentFile :: ConstraintSource -> PackageEnvironment -> FilePath 455 -> IO (Maybe (ParseResult PackageEnvironment)) 456readPackageEnvironmentFile src initial file = 457 handleNotExists $ 458 fmap (Just . parsePackageEnvironment src initial) (readFile file) 459 where 460 handleNotExists action = catchIO action $ \ioe -> 461 if isDoesNotExistError ioe 462 then return Nothing 463 else ioError ioe 464 465-- | Parse the package environment file. 466parsePackageEnvironment :: ConstraintSource -> PackageEnvironment -> String 467 -> ParseResult PackageEnvironment 468parsePackageEnvironment src initial str = do 469 fields <- readFields str 470 let (knownSections, others) = partition isKnownSection fields 471 pkgEnv <- parse others 472 let config = pkgEnvSavedConfig pkgEnv 473 installDirs0 = savedUserInstallDirs config 474 (haddockFlags, installDirs, paths, args) <- 475 foldM parseSections 476 (savedHaddockFlags config, installDirs0, [], []) 477 knownSections 478 return pkgEnv { 479 pkgEnvSavedConfig = config { 480 savedConfigureFlags = (savedConfigureFlags config) { 481 configProgramPaths = paths, 482 configProgramArgs = args 483 }, 484 savedHaddockFlags = haddockFlags, 485 savedUserInstallDirs = installDirs, 486 savedGlobalInstallDirs = installDirs 487 } 488 } 489 490 where 491 isKnownSection :: ParseUtils.Field -> Bool 492 isKnownSection (ParseUtils.Section _ "haddock" _ _) = True 493 isKnownSection (ParseUtils.Section _ "install-dirs" _ _) = True 494 isKnownSection (ParseUtils.Section _ "program-locations" _ _) = True 495 isKnownSection (ParseUtils.Section _ "program-default-options" _ _) = True 496 isKnownSection _ = False 497 498 parse :: [ParseUtils.Field] -> ParseResult PackageEnvironment 499 parse = parseFields (pkgEnvFieldDescrs src) initial 500 501 parseSections :: SectionsAccum -> ParseUtils.Field 502 -> ParseResult SectionsAccum 503 parseSections accum@(h,d,p,a) 504 (ParseUtils.Section _ "haddock" name fs) 505 | name == "" = do h' <- parseFields haddockFlagsFields h fs 506 return (h', d, p, a) 507 | otherwise = do 508 warning "The 'haddock' section should be unnamed" 509 return accum 510 parseSections (h,d,p,a) 511 (ParseUtils.Section line "install-dirs" name fs) 512 | name == "" = do d' <- parseFields installDirsFields d fs 513 return (h, d',p,a) 514 | otherwise = 515 syntaxError line $ 516 "Named 'install-dirs' section: '" ++ name 517 ++ "'. Note that named 'install-dirs' sections are not allowed in the '" 518 ++ userPackageEnvironmentFile ++ "' file." 519 parseSections accum@(h, d,p,a) 520 (ParseUtils.Section _ "program-locations" name fs) 521 | name == "" = do p' <- parseFields withProgramsFields p fs 522 return (h, d, p', a) 523 | otherwise = do 524 warning "The 'program-locations' section should be unnamed" 525 return accum 526 parseSections accum@(h, d, p, a) 527 (ParseUtils.Section _ "program-default-options" name fs) 528 | name == "" = do a' <- parseFields withProgramOptionsFields a fs 529 return (h, d, p, a') 530 | otherwise = do 531 warning "The 'program-default-options' section should be unnamed" 532 return accum 533 parseSections accum f = do 534 warning $ "Unrecognized stanza on line " ++ show (lineNo f) 535 return accum 536 537-- | Accumulator type for 'parseSections'. 538type SectionsAccum = (HaddockFlags, InstallDirs (Flag PathTemplate) 539 , [(String, FilePath)], [(String, [String])]) 540 541-- | Write out the package environment file. 542writePackageEnvironmentFile :: FilePath -> PackageEnvironment -> IO () 543writePackageEnvironmentFile path pkgEnv = do 544 let tmpPath = (path <.> "tmp") 545 writeFile tmpPath $ explanation ++ pkgEnvStr ++ "\n" 546 renameFile tmpPath path 547 where 548 pkgEnvStr = showPackageEnvironment pkgEnv 549 explanation = unlines 550 ["-- This is a Cabal package environment file." 551 ,"-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY." 552 ,"-- Please create a 'cabal.config' file in the same directory" 553 ,"-- if you want to change the default settings for this sandbox." 554 ,"","" 555 ] 556 557-- | Pretty-print the package environment. 558showPackageEnvironment :: PackageEnvironment -> String 559showPackageEnvironment pkgEnv = showPackageEnvironmentWithComments Nothing pkgEnv 560 561-- | Pretty-print the package environment with default values for empty fields 562-- commented out (just like the default ~/.cabal/config). 563showPackageEnvironmentWithComments :: (Maybe PackageEnvironment) 564 -> PackageEnvironment 565 -> String 566showPackageEnvironmentWithComments mdefPkgEnv pkgEnv = Disp.render $ 567 ppFields (pkgEnvFieldDescrs ConstraintSourceUnknown) 568 mdefPkgEnv pkgEnv 569 $+$ Disp.text "" 570 $+$ ppSection "install-dirs" "" installDirsFields 571 (fmap installDirsSection mdefPkgEnv) (installDirsSection pkgEnv) 572 where 573 installDirsSection = savedUserInstallDirs . pkgEnvSavedConfig 574