Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge remote-tracking branch 'upstream/master'

  • Loading branch information...
commit d546283b9da7cee1865939c65eb8f324888e6838 2 parents 694456f + 3419f4d
@mbenke authored
View
47 cabal-install/Distribution/Client/Freeze.hs
@@ -15,18 +15,22 @@ module Distribution.Client.Freeze (
freeze,
) where
+import Distribution.Client.Config ( SavedConfig(..) )
import Distribution.Client.Types
import Distribution.Client.Targets
-import Distribution.Client.Dependency
+import Distribution.Client.Dependency hiding ( addConstraints )
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.InstallPlan
( PlanPackage )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Setup
- ( GlobalFlags(..), FreezeFlags(..) )
+ ( GlobalFlags(..), FreezeFlags(..), ConfigExFlags(..) )
+import Distribution.Client.Sandbox
+ ( getPkgEnvDir )
import Distribution.Client.Sandbox.PackageEnvironment
- ( userPackageEnvironmentFile )
+ ( loadUserConfig, pkgEnvSavedConfig, showPackageEnvironment,
+ userPackageEnvironmentFile )
import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..) )
@@ -40,7 +44,7 @@ import Distribution.Simple.Program
import Distribution.Simple.Setup
( fromFlag )
import Distribution.Simple.Utils
- ( die, notice, debug, intercalate, writeFileAtomic )
+ ( die, notice, debug, writeFileAtomic )
import Distribution.System
( Platform )
import Distribution.Text
@@ -49,8 +53,12 @@ import Distribution.Verbosity
( Verbosity )
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
+import Data.Monoid
+ ( mempty )
import Data.Version
( showVersion )
+import Distribution.Version
+ ( thisVersion )
-- ------------------------------------------------------------
-- * The freeze command
@@ -98,7 +106,7 @@ freeze verbosity packageDBs repos comp platform conf mSandboxPkgInfo
"The following packages would be frozen:"
: formatPkgs pkgs
- else freezePackages pkgs
+ else freezePackages verbosity globalFlags pkgs
where
dryRun = fromFlag (freezeDryRun freezeFlags)
@@ -151,17 +159,26 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
shadowPkgs = fromFlag (freezeShadowPkgs freezeFlags)
maxBackjumps = fromFlag (freezeMaxBackjumps freezeFlags)
-freezePackages :: [PlanPackage] -> IO ()
-freezePackages pkgs =
- writeFileAtomic userPackageEnvironmentFile $ constraints pkgs
+freezePackages :: Verbosity -> GlobalFlags -> [PlanPackage] -> IO ()
+freezePackages verbosity globalFlags pkgs = do
+ pkgEnvDir <- getPkgEnvDir globalFlags
+ pkgEnv <- fmap (createPkgEnv . addConstraints) $
+ loadUserConfig verbosity pkgEnvDir
+ writeFileAtomic userPackageEnvironmentFile $ showPkgEnv pkgEnv
where
- constraints = BS.Char8.pack
- . (++ "\n")
- . (prefix' ++)
- . intercalate separator
- . formatPkgs
- prefix' = "constraints: "
- separator = "\n" ++ (replicate (length prefix' - 2) ' ') ++ ", "
+ addConstraints config =
+ config {
+ savedConfigureExFlags = (savedConfigureExFlags config) {
+ configExConstraints = constraints pkgs
+ }
+ }
+ constraints = map $ pkgIdToConstraint . packageId
+ where
+ pkgIdToConstraint pkg =
+ UserConstraintVersion (packageName pkg)
+ (thisVersion $ packageVersion pkg)
+ createPkgEnv config = mempty { pkgEnvSavedConfig = config }
+ showPkgEnv = BS.Char8.pack . showPackageEnvironment
formatPkgs :: [PlanPackage] -> [String]
View
1  cabal-install/Distribution/Client/Sandbox.hs
@@ -32,6 +32,7 @@ module Distribution.Client.Sandbox (
tryGetIndexFilePath,
sandboxBuildDir,
+ getPkgEnvDir,
getInstalledPackagesInSandbox,
updateSandboxConfigFileFlag,
Please sign in to comment.
Something went wrong with that request. Please try again.