Commit f0a513bf authored by Mikhail Glushenkov's avatar Mikhail Glushenkov

Whitespace, 80-col violations.

parent 628a5d55
......@@ -75,7 +75,8 @@ storeAnonymous reports = sequence_
. onlyRemote
repoName (_,_,rrepo) = remoteRepoName rrepo
onlyRemote :: [(BuildReport, Maybe Repo)] -> [(BuildReport, Repo, RemoteRepo)]
onlyRemote :: [(BuildReport, Maybe Repo)]
-> [(BuildReport, Repo, RemoteRepo)]
onlyRemote rs =
[ (report, repo, remoteRepo)
| (report, Just repo@Repo { repoKind = Left remoteRepo }) <- rs ]
......@@ -147,7 +148,8 @@ fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
_ -> Nothing
where
extractRepo (SourcePackage { packageSource = RepoTarballPackage repo _ _ }) = Just repo
extractRepo (SourcePackage { packageSource = RepoTarballPackage repo _ _ })
= Just repo
extractRepo _ = Nothing
fromPlanningFailure :: Platform -> CompilerId
......
......@@ -112,8 +112,8 @@ configure verbosity packageDBs repos comp platform conf
"Warning: solver failed to find a solution:\n"
++ message
++ "Trying configure anyway."
setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing) Nothing
configureCommand (const configFlags) extraArgs
setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
Nothing configureCommand (const configFlags) extraArgs
Right installPlan -> case InstallPlan.ready installPlan of
[pkg@(ReadyPackage
......@@ -230,10 +230,12 @@ planLocalPackage :: Verbosity -> Compiler
-> InstalledPackageIndex
-> SourcePackageDb
-> IO (Progress String String InstallPlan)
planLocalPackage verbosity comp platform configFlags configExFlags installedPkgIndex
planLocalPackage verbosity comp platform configFlags configExFlags
installedPkgIndex
(SourcePackageDb _ packagePrefs) = do
pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags) (compilerInfo comp)
solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
(compilerInfo comp)
let -- We create a local package and ask to resolve a dependency on it
localPkg = SourcePackage {
......
......@@ -151,9 +151,11 @@ debugDepResolverParams :: DepResolverParams -> String
debugDepResolverParams p =
"targets: " ++ intercalate ", " (map display (depResolverTargets p))
++ "\nconstraints: "
++ concatMap (("\n " ++) . debugPackageConstraint) (depResolverConstraints p)
++ concatMap (("\n " ++) . debugPackageConstraint)
(depResolverConstraints p)
++ "\npreferences: "
++ concatMap (("\n " ++) . debugPackagePreference) (depResolverPreferences p)
++ concatMap (("\n " ++) . debugPackagePreference)
(depResolverPreferences p)
++ "\nstrategy: " ++ show (depResolverPreferenceDefault p)
-- | A package selection preference for a particular package.
......@@ -701,7 +703,8 @@ configuredPackageProblems platform cinfo
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
++ [ DuplicateDeps pkgs
| pkgs <- CD.nonSetupDeps (fmap (duplicatesBy (comparing packageName)) specifiedDeps) ]
| pkgs <- CD.nonSetupDeps (fmap (duplicatesBy (comparing packageName))
specifiedDeps) ]
++ [ MissingDep dep | OnlyInLeft dep <- mergedDeps ]
++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ]
++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps
......@@ -724,7 +727,8 @@ configuredPackageProblems platform cinfo
mergedDeps :: [MergeResult Dependency PackageId]
mergedDeps = mergeDeps requiredDeps (CD.flatDeps specifiedDeps)
mergeDeps :: [Dependency] -> [PackageId] -> [MergeResult Dependency PackageId]
mergeDeps :: [Dependency] -> [PackageId]
-> [MergeResult Dependency PackageId]
mergeDeps required specified =
let sortNubOn f = nubBy ((==) `on` f) . sortBy (compare `on` f) in
mergeBy
......@@ -732,13 +736,13 @@ configuredPackageProblems platform cinfo
(sortNubOn dependencyName required)
(sortNubOn packageName specified)
-- TODO: It would be nicer to use ComponentDeps here so we can be more precise
-- in our checks. That's a bit tricky though, as this currently relies on
-- the 'buildDepends' field of 'PackageDescription'. (OTOH, that field is
-- deprecated and should be removed anyway.)
-- As long as we _do_ use a flat list here, we have to allow for duplicates
-- when we fold specifiedDeps; once we have proper ComponentDeps here we
-- should get rid of the `nubOn` in `mergeDeps`.
-- TODO: It would be nicer to use ComponentDeps here so we can be more
-- precise in our checks. That's a bit tricky though, as this currently
-- relies on the 'buildDepends' field of 'PackageDescription'. (OTOH, that
-- field is deprecated and should be removed anyway.) As long as we _do_
-- use a flat list here, we have to allow for duplicates when we fold
-- specifiedDeps; once we have proper ComponentDeps here we should get rid
-- of the `nubOn` in `mergeDeps`.
requiredDeps :: [Dependency]
requiredDeps =
--TODO: use something lower level than finalizePackageDescription
......
......@@ -89,7 +89,8 @@ freeze verbosity packageDBs repos comp platform conf mSandboxPkgInfo
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
sourcePkgDb <- getSourcePackages verbosity repos
transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
transport <- configureTransport verbosity
(flagToMaybe (globalHttpTransport globalFlags))
pkgSpecifiers <- resolveUserTargets verbosity transport
(fromFlag $ globalWorldFile globalFlags)
......
......@@ -230,7 +230,8 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
-- TODO: Make InstallContext a proper data type with documented fields.
-- | Common context for makeInstallPlan and processInstallPlan.
type InstallContext = ( InstalledPackageIndex, SourcePackageDb
, [UserTarget], [PackageSpecifier SourcePackage], HttpTransport )
, [UserTarget], [PackageSpecifier SourcePackage]
, HttpTransport )
-- TODO: Make InstallArgs a proper data type with documented fields or just get
-- rid of it completely.
......@@ -257,7 +258,8 @@ makeInstallContext verbosity
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
sourcePkgDb <- getSourcePackages verbosity repos
transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
transport <- configureTransport verbosity
(flagToMaybe (globalHttpTransport globalFlags))
(userTargets, pkgSpecifiers) <- case mUserTargets of
Nothing ->
......@@ -277,7 +279,8 @@ makeInstallContext verbosity
userTargets
return (userTargets, pkgSpecifiers)
return (installedPkgIndex, sourcePkgDb, userTargets, pkgSpecifiers, transport)
return (installedPkgIndex, sourcePkgDb, userTargets
,pkgSpecifiers, transport)
-- | Make an install plan given install context and install arguments.
makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext
......@@ -508,7 +511,8 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb
: map (display . Installed.sourcePackageId) newBrokenPkgs
++ if overrideReinstall
then if dryRun then [] else
["Continuing even though the plan contains dangerous reinstalls."]
["Continuing even though " ++
"the plan contains dangerous reinstalls."]
else
["Use --force-reinstalls if you want to install anyway."]
else unless dryRun $ warn verbosity
......@@ -591,8 +595,10 @@ packageStatus installedPkgIndex cpkg =
-> [MergeResult PackageIdentifier PackageIdentifier]
changes pkg pkg' = filter changed $
mergeBy (comparing packageName)
(resolveInstalledIds $ Installed.depends pkg) -- deps of installed pkg
(resolveInstalledIds $ CD.nonSetupDeps (depends pkg')) -- deps of configured pkg
-- deps of installed pkg
(resolveInstalledIds $ Installed.depends pkg)
-- deps of configured pkg
(resolveInstalledIds $ CD.nonSetupDeps (depends pkg'))
-- convert to source pkg ids via index
resolveInstalledIds :: [InstalledPackageId] -> [PackageIdentifier]
......@@ -690,7 +696,8 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
-- | Report a solver failure. This works slightly differently to
-- 'postInstallActions', as (by definition) we don't have an install plan.
reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String -> IO ()
reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String
-> IO ()
reportPlanningFailure verbosity
(_, _, comp, platform, _, _, _
,_, configFlags, _, installFlags, _)
......@@ -700,12 +707,13 @@ reportPlanningFailure verbosity
when reportFailure $ do
-- Only create reports for explicitly named packages
let pkgids =
filter (SourcePackageIndex.elemByPackageId (packageIndex sourcePkgDb)) $
let pkgids = filter
(SourcePackageIndex.elemByPackageId (packageIndex sourcePkgDb)) $
mapMaybe theSpecifiedPackage pkgSpecifiers
buildReports = BuildReports.fromPlanningFailure platform (compilerId comp)
pkgids (configConfigurationsFlags configFlags)
buildReports = BuildReports.fromPlanningFailure platform
(compilerId comp) pkgids
(configConfigurationsFlags configFlags)
when (not (null buildReports)) $
info verbosity $
......@@ -714,7 +722,8 @@ reportPlanningFailure verbosity
-- Save reports
BuildReports.storeLocal (compilerInfo comp)
(fromNubList $ installSummaryFile installFlags) buildReports platform
(fromNubList $ installSummaryFile installFlags)
buildReports platform
-- Save solver log
case logFile of
......@@ -734,7 +743,8 @@ reportPlanningFailure verbosity
-- So we fail.
dummyLibraryName = error "reportPlanningFailure: library name not available"
-- | If a 'PackageSpecifier' refers to a single package, return Just that package.
-- | If a 'PackageSpecifier' refers to a single package, return Just that
-- package.
theSpecifiedPackage :: Package pkg => PackageSpecifier pkg -> Maybe PackageId
theSpecifiedPackage pkgSpec =
case pkgSpec of
......@@ -1031,7 +1041,8 @@ performInstallations verbosity
installLock <- newLock -- serialise installation
cacheLock <- newLock -- serialise access to setup exe cache
transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
transport <- configureTransport verbosity
(flagToMaybe (globalHttpTransport globalFlags))
executeInstallPlan verbosity comp jobControl useLogFile installPlan $ \rpkg ->
-- Calculate the package key (ToDo: Is this right for source install)
......@@ -1042,8 +1053,10 @@ performInstallations verbosity
installLocalPackage verbosity buildLimit
(packageId pkg) src' distPref $ \mpath ->
installUnpackedPackage verbosity buildLimit installLock numJobs libname
(setupScriptOptions installedPkgIndex cacheLock rpkg)
miscOptions configFlags' installFlags haddockFlags
(setupScriptOptions installedPkgIndex
cacheLock rpkg)
miscOptions configFlags'
installFlags haddockFlags
cinfo platform pkg pkgoverride mpath useLogFile
where
......@@ -1108,7 +1121,8 @@ performInstallations verbosity
| parallelInstall = False
| otherwise = False
substLogFileName :: PathTemplate -> PackageIdentifier -> LibraryName -> FilePath
substLogFileName :: PathTemplate -> PackageIdentifier -> LibraryName
-> FilePath
substLogFileName template pkg libname = fromPathTemplate
. substPathTemplate env
$ template
......@@ -1416,7 +1430,8 @@ installUnpackedPackage verbosity buildLimit installLock numJobs libname
maybePkgConf <- maybeGenPkgConf mLogPath
-- Actual installation
withWin32SelfUpgrade verbosity libname configFlags cinfo platform pkg $ do
withWin32SelfUpgrade verbosity libname configFlags
cinfo platform pkg $ do
case rootCmd miscOptions of
(Just cmd) -> reexec cmd
Nothing -> do
......@@ -1588,4 +1603,5 @@ withWin32SelfUpgrade verbosity libname configFlags cinfo platform pkg action = d
platform templateDirs
substTemplate = InstallDirs.fromPathTemplate
. InstallDirs.substPathTemplate env
where env = InstallDirs.initialPathTemplateEnv pkgid libname cinfo platform
where env = InstallDirs.initialPathTemplateEnv pkgid libname
cinfo platform
......@@ -215,7 +215,8 @@ showInstallPlan :: (HasInstalledPackageId ipkg, HasInstalledPackageId srcpkg)
=> GenericInstallPlan ipkg srcpkg iresult ifailure -> String
showInstallPlan plan =
showPlanIndex (planIndex plan) ++ "\n" ++
"fake map:\n " ++ intercalate "\n " (map showKV (Map.toList (planFakeMap plan)))
"fake map:\n " ++
intercalate "\n " (map showKV (Map.toList (planFakeMap plan)))
where showKV (k,v) = display k ++ " -> " ++ display v
showPlanPackageTag :: GenericPlanPackage ipkg srcpkg iresult ifailure -> String
......@@ -239,7 +240,8 @@ new indepGoals index =
let isPreExisting (PreExisting _) = True
isPreExisting _ = False
fakeMap = Map.fromList
. map (\p -> (fakeInstalledPackageId (packageId p), installedPackageId p))
. map (\p -> (fakeInstalledPackageId (packageId p)
,installedPackageId p))
. filter isPreExisting
$ PackageIndex.allPackages index in
case problems fakeMap indepGoals index of
......@@ -307,9 +309,11 @@ ready plan = assert check readyPackages
isInstalledDep :: InstalledPackageId -> Maybe ipkg
isInstalledDep pkgid =
-- NB: Need to check if the ID has been updated in planFakeMap, in which case we
-- might be dealing with an old pointer
case PlanIndex.fakeLookupInstalledPackageId (planFakeMap plan) (planIndex plan) pkgid of
-- NB: Need to check if the ID has been updated in planFakeMap, in which
-- case we might be dealing with an old pointer
case PlanIndex.fakeLookupInstalledPackageId
(planFakeMap plan) (planIndex plan) pkgid
of
Just (PreExisting ipkg) -> Just ipkg
Just (Configured _) -> Nothing
Just (Processing _) -> Nothing
......@@ -413,7 +417,8 @@ lookupProcessingPackage plan pkgid =
-- planFakeMap
case PackageIndex.lookupInstalledPackageId (planIndex plan) pkgid of
Just (Processing pkg) -> pkg
_ -> internalError $ "not in processing state or no such pkg " ++ display pkgid
_ -> internalError $ "not in processing state or no such pkg " ++
display pkgid
-- | Check a package that we expect to be in the configured or failed state.
--
......@@ -494,18 +499,24 @@ problems :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
-> [PlanProblem ipkg srcpkg iresult ifailure]
problems fakeMap indepGoals index =
[ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PlanIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
[ PackageMissingDeps pkg
(catMaybes
(map
(fmap packageId . PlanIndex.fakeLookupInstalledPackageId fakeMap index)
missingDeps))
| (pkg, missingDeps) <- PlanIndex.brokenPackages fakeMap index ]
++ [ PackageCycle cycleGroup
| cycleGroup <- PlanIndex.dependencyCycles fakeMap index ]
++ [ PackageInconsistency name inconsistencies
| (name, inconsistencies) <- PlanIndex.dependencyInconsistencies fakeMap indepGoals index ]
| (name, inconsistencies) <-
PlanIndex.dependencyInconsistencies fakeMap indepGoals index ]
++ [ PackageStateInvalid pkg pkg'
| pkg <- PackageIndex.allPackages index
, Just pkg' <- map (PlanIndex.fakeLookupInstalledPackageId fakeMap index) (CD.nonSetupDeps (depends pkg))
, Just pkg' <- map (PlanIndex.fakeLookupInstalledPackageId fakeMap index)
(CD.nonSetupDeps (depends pkg))
, not (stateDependencyRelation pkg pkg') ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
......@@ -590,8 +601,10 @@ dependencyClosure :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> [PackageIdentifier]
-> Either [(GenericPlanPackage ipkg srcpkg iresult ifailure, [InstalledPackageId])]
(PackageIndex (GenericPlanPackage ipkg srcpkg iresult ifailure))
-> Either [(GenericPlanPackage ipkg srcpkg iresult ifailure,
[InstalledPackageId])]
(PackageIndex
(GenericPlanPackage ipkg srcpkg iresult ifailure))
dependencyClosure installPlan pids =
PlanIndex.dependencyClosure
(planFakeMap installPlan)
......
......@@ -131,7 +131,8 @@ symlinkBinaries platform comp configFlags installFlags plan =
| (ReadyPackage (ConfiguredPackage _ _flags _ _) deps, pkg, exe) <- exes
, let pkgid = packageId pkg
pkg_key = mkPackageKey (packageKeySupported comp) pkgid
(map Installed.libraryName (CD.nonSetupDeps deps))
(map Installed.libraryName
(CD.nonSetupDeps deps))
libname = packageKeyLibraryName pkgid pkg_key
publicExeName = PackageDescription.exeName exe
privateExeName = prefix ++ publicExeName ++ suffix
......
......@@ -51,8 +51,10 @@ graphFromEdges edges0 =
sorted_edges = sortBy lt edges0
edges1 = zipWith (,) [0..] sorted_edges
graph = array bounds0 [(v, (mapMaybe mk_edge ks)) | (v, (_, _, ks)) <- edges1]
key_map = array bounds0 [(v, k ) | (v, (_, k, _ )) <- edges1]
graph = array bounds0 [(v, (mapMaybe mk_edge ks))
| (v, (_, _, ks)) <- edges1]
key_map = array bounds0 [(v, k )
| (v, (_, k, _ )) <- edges1]
vertex_map = array bounds0 edges1
(_,k1,_) `lt` (_,k2,_) = k1 `compare` k2
......
......@@ -20,7 +20,8 @@ import qualified Data.Map as Map
-- Cabal
import qualified Distribution.Compiler as C
import qualified Distribution.InstalledPackageInfo as C
import qualified Distribution.Package as C hiding (HasInstalledPackageId(..))
import qualified Distribution.Package as C
hiding (HasInstalledPackageId(..))
import qualified Distribution.PackageDescription as C
import qualified Distribution.Simple.PackageIndex as C.PackageIndex
import qualified Distribution.System as C
......@@ -102,8 +103,10 @@ data ExampleAvailable = ExAv {
, exAvDeps :: ComponentDeps [ExampleDependency]
}
exAv :: ExamplePkgName -> ExamplePkgVersion -> [ExampleDependency] -> ExampleAvailable
exAv n v ds = ExAv { exAvName = n, exAvVersion = v, exAvDeps = CD.fromLibraryDeps ds }
exAv :: ExamplePkgName -> ExamplePkgVersion -> [ExampleDependency]
-> ExampleAvailable
exAv n v ds = ExAv { exAvName = n, exAvVersion = v
, exAvDeps = CD.fromLibraryDeps ds }
withSetupDeps :: ExampleAvailable -> [ExampleDependency] -> ExampleAvailable
withSetupDeps ex setupDeps = ex {
......@@ -117,7 +120,8 @@ data ExampleInstalled = ExInst {
, exInstBuildAgainst :: [ExampleInstalled]
}
exInst :: ExamplePkgName -> ExamplePkgVersion -> ExamplePkgHash -> [ExampleInstalled] -> ExampleInstalled
exInst :: ExamplePkgName -> ExamplePkgVersion -> ExamplePkgHash
-> [ExampleInstalled] -> ExampleInstalled
exInst = ExInst
type ExampleDb = [Either ExampleInstalled ExampleAvailable]
......@@ -146,10 +150,12 @@ exAvSrcPkg ex =
C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex))
}
}
, C.genPackageFlags = concatMap extractFlags (CD.libraryDeps (exAvDeps ex))
, C.genPackageFlags = concatMap extractFlags
(CD.libraryDeps (exAvDeps ex))
, C.condLibrary = Just $ mkCondTree libraryDeps
, C.condExecutables = []
, C.condTestSuites = map (\(t, deps) -> (t, mkCondTree deps)) testSuites
, C.condTestSuites = map (\(t, deps) -> (t, mkCondTree deps))
testSuites
, C.condBenchmarks = []
}
}
......@@ -159,10 +165,12 @@ exAvSrcPkg ex =
, [(ExampleTestName, [ExampleDependency])]
)
splitTopLevel [] = ([], [])
splitTopLevel (ExTest t a:deps) = let (other, testSuites) = splitTopLevel deps
in (other, (t, a):testSuites)
splitTopLevel (dep:deps) = let (other, testSuites) = splitTopLevel deps
in (dep:other, testSuites)
splitTopLevel (ExTest t a:deps) =
let (other, testSuites) = splitTopLevel deps
in (other, (t, a):testSuites)
splitTopLevel (dep:deps) =
let (other, testSuites) = splitTopLevel deps
in (dep:other, testSuites)
extractFlags :: ExampleDependency -> [C.Flag]
extractFlags (ExAny _) = []
......@@ -193,7 +201,8 @@ exAvSrcPkg ex =
mkFlagged :: Monoid a
=> (ExampleFlagName, [ExampleDependency], [ExampleDependency])
-> (C.Condition C.ConfVar, DependencyTree a, Maybe (DependencyTree a))
-> (C.Condition C.ConfVar
, DependencyTree a, Maybe (DependencyTree a))
mkFlagged (f, a, b) = ( C.Var (C.Flag (C.FlagName f))
, mkCondTree a
, Just (mkCondTree b)
......@@ -274,7 +283,8 @@ exResolve db targets indepGoals = runProgress $
packageIndex = exAvIdx avai
, packagePreferences = Map.empty
}
enableTests = map (\p -> PackageConstraintStanzas (C.PackageName p) [TestStanzas])
enableTests = map (\p -> PackageConstraintStanzas
(C.PackageName p) [TestStanzas])
(exDbPkgs db)
targets' = map (\p -> NamedPackage (C.PackageName p) []) targets
params = addConstraints enableTests
......@@ -292,7 +302,8 @@ extractInstallPlan = catMaybes . map confPkg . CI.InstallPlan.toList
srcPkg :: ConfiguredPackage -> (String, Int)
srcPkg (ConfiguredPackage pkg _flags _stanzas _deps) =
let C.PackageIdentifier (C.PackageName p) (Version (n:_) _) = packageInfoId pkg
let C.PackageIdentifier (C.PackageName p) (Version (n:_) _) =
packageInfoId pkg
in (p, n)
{-------------------------------------------------------------------------------
......
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