Unverified Commit 4a3bf67f authored by Mikhail Glushenkov's avatar Mikhail Glushenkov Committed by Mikhail Glushenkov
Browse files

Formatting, whitespace, 80-col violations.

parent 9db9e696
......@@ -72,15 +72,15 @@ import Distribution.Version
-- constraining each dependency to an exact version.
--
freeze :: Verbosity
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> Maybe SandboxPackageInfo
-> GlobalFlags
-> FreezeFlags
-> IO ()
-> PackageDBStack
-> RepoContext
-> Compiler
-> Platform
-> ProgramDb
-> Maybe SandboxPackageInfo
-> GlobalFlags
-> FreezeFlags
-> IO ()
freeze verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
globalFlags freezeFlags = do
......@@ -238,7 +238,8 @@ freezePackages :: Package pkg => Verbosity -> GlobalFlags -> [pkg] -> IO ()
freezePackages verbosity globalFlags pkgs = do
pkgEnv <- fmap (createPkgEnv . addFrozenConstraints) $
loadUserConfig verbosity "" (flagToMaybe . globalConstraintsFile $ globalFlags)
loadUserConfig verbosity ""
(flagToMaybe . globalConstraintsFile $ globalFlags)
writeFileAtomic userPackageEnvironmentFile $ showPkgEnv pkgEnv
where
addFrozenConstraints config =
......@@ -248,7 +249,8 @@ freezePackages verbosity globalFlags pkgs = do
}
}
constraint pkg =
(pkgIdToConstraint $ packageId pkg, ConstraintSourceUserConfig userPackageEnvironmentFile)
(pkgIdToConstraint $ packageId pkg
,ConstraintSourceUserConfig userPackageEnvironmentFile)
where
pkgIdToConstraint pkgId =
UserConstraint UserToplevel (packageName pkgId)
......
......@@ -50,7 +50,7 @@ import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
import Distribution.Simple.Setup ( Flag(..)
, ConfigFlags(..), HaddockFlags(..)
, fromFlagOrDefault, toFlag, flagToMaybe )
import Distribution.Simple.Utils ( die, info, notice, warn )
import Distribution.Simple.Utils ( die, info, notice, warn, debug )
import Distribution.Solver.Types.ConstraintSource
import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..)
, commaListField, commaNewLineListField
......@@ -277,14 +277,24 @@ inheritedPackageEnvironment verbosity pkgEnv = do
-- | Load the user package environment if it exists (the optional "cabal.config"
-- file). If it does not exist locally, attempt to load an optional global one.
userPackageEnvironment :: Verbosity -> FilePath -> Maybe FilePath -> IO PackageEnvironment
userPackageEnvironment :: Verbosity -> FilePath -> Maybe FilePath
-> IO PackageEnvironment
userPackageEnvironment verbosity pkgEnvDir globalConfigLocation = do
let path = pkgEnvDir </> userPackageEnvironmentFile
minp <- readPackageEnvironmentFile (ConstraintSourceUserConfig path) mempty path
minp <- readPackageEnvironmentFile (ConstraintSourceUserConfig path)
mempty path
case (minp, globalConfigLocation) of
(Just parseRes, _) -> processConfigParse path parseRes
(_, Just globalLoc) -> maybe (warn verbosity ("no constraints file found at " ++ globalLoc) >> return mempty) (processConfigParse globalLoc) =<< readPackageEnvironmentFile (ConstraintSourceUserConfig globalLoc) mempty globalLoc
_ -> return mempty
(_, Just globalLoc) -> do
minp' <- readPackageEnvironmentFile (ConstraintSourceUserConfig globalLoc)
mempty globalLoc
maybe (warn verbosity ("no constraints file found at " ++ globalLoc)
>> return mempty)
(processConfigParse globalLoc)
minp'
_ -> do
debug verbosity ("no user package environment file found at " ++ pkgEnvDir)
return mempty
where
processConfigParse path (ParseOk warns parseResult) = do
when (not $ null warns) $ warn verbosity $
......@@ -299,7 +309,8 @@ userPackageEnvironment verbosity pkgEnvDir globalConfigLocation = do
-- | Same as @userPackageEnvironmentFile@, but returns a SavedConfig.
loadUserConfig :: Verbosity -> FilePath -> Maybe FilePath -> IO SavedConfig
loadUserConfig verbosity pkgEnvDir globalConfigLocation =
fmap pkgEnvSavedConfig $ userPackageEnvironment verbosity pkgEnvDir globalConfigLocation
fmap pkgEnvSavedConfig $
userPackageEnvironment verbosity pkgEnvDir globalConfigLocation
-- | Common error handling code used by 'tryLoadSandboxPackageEnvironment' and
-- 'updatePackageEnvironment'.
......@@ -401,7 +412,8 @@ pkgEnvFieldDescrs src = [
, commaNewLineListField "constraints"
(Text.disp . fst) ((\pc -> (pc, src)) `fmap` Text.parse)
(sortConstraints . configExConstraints . savedConfigureExFlags . pkgEnvSavedConfig)
(sortConstraints . configExConstraints
. savedConfigureExFlags . pkgEnvSavedConfig)
(\v pkgEnv -> updateConfigureExFlags pkgEnv
(\flags -> flags { configExConstraints = v }))
......
......@@ -185,7 +185,8 @@ insert pkg (PackageIndex index) = mkPackageIndex $
-- | Internal delete helper.
--
delete :: Package pkg => PackageName -> (pkg -> Bool) -> PackageIndex pkg -> PackageIndex pkg
delete :: Package pkg => PackageName -> (pkg -> Bool) -> PackageIndex pkg
-> PackageIndex pkg
delete name p (PackageIndex index) = mkPackageIndex $
Map.update filterBucket name index
where
......@@ -196,19 +197,22 @@ delete name p (PackageIndex index) = mkPackageIndex $
-- | Removes a single package from the index.
--
deletePackageId :: Package pkg => PackageIdentifier -> PackageIndex pkg -> PackageIndex pkg
deletePackageId :: Package pkg => PackageIdentifier -> PackageIndex pkg
-> PackageIndex pkg
deletePackageId pkgid =
delete (packageName pkgid) (\pkg -> packageId pkg == pkgid)
-- | Removes all packages with this (case-sensitive) name from the index.
--
deletePackageName :: Package pkg => PackageName -> PackageIndex pkg -> PackageIndex pkg
deletePackageName :: Package pkg => PackageName -> PackageIndex pkg
-> PackageIndex pkg
deletePackageName name =
delete name (\pkg -> packageName pkg == name)
-- | Removes all packages satisfying this dependency from the index.
--
deleteDependency :: Package pkg => Dependency -> PackageIndex pkg -> PackageIndex pkg
deleteDependency :: Package pkg => Dependency -> PackageIndex pkg
-> PackageIndex pkg
deleteDependency (Dependency name verstionRange) =
delete name (\pkg -> packageVersion pkg `withinRange` verstionRange)
......@@ -244,7 +248,8 @@ elemByPackageName index = not . null . lookupPackageName index
-- Since multiple package DBs mask each other case-sensitively by package name,
-- then we get back at most one package.
--
lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier -> Maybe pkg
lookupPackageId :: Package pkg => PackageIndex pkg -> PackageIdentifier
-> Maybe pkg
lookupPackageId index pkgid =
case [ pkg | pkg <- lookup index (packageName pkgid)
, packageId pkg == pkgid ] of
......
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