diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 14025d74d8be52893f42c690665157c206d875ec..06308e002f09ea41befb32c66b0cc498bb01492f 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -14,6 +14,7 @@
-----------------------------------------------------------------------------
module Distribution.Client.Dependency (
-- * The main package dependency resolver
+ DepResolverParams,
chooseSolver,
resolveDependencies,
Progress(..),
@@ -464,6 +465,7 @@ removeBounds relKind relDeps params =
depResolverSourcePkgIndex = sourcePkgIndex'
}
where
+ sourcePkgIndex' :: PackageIndex.PackageIndex UnresolvedSourcePackage
sourcePkgIndex' = fmap relaxDeps $ depResolverSourcePkgIndex params
relaxDeps :: UnresolvedSourcePackage -> UnresolvedSourcePackage
@@ -735,6 +737,7 @@ resolveDependencies platform comp pkgConfigDB solver params =
then params
else dontUpgradeNonUpgradeablePackages params
+ preferences :: PackageName -> PackagePreferences
preferences = interpretPackagesPreference targets defpref prefs
@@ -750,12 +753,14 @@ interpretPackagesPreference selected defaultPref prefs =
(installPref pkgname)
(stanzasPref pkgname)
where
+ versionPref :: PackageName -> [VersionRange]
versionPref pkgname =
fromMaybe [anyVersion] (Map.lookup pkgname versionPrefs)
versionPrefs = Map.fromListWith (++)
[(pkgname, [pref])
| PackageVersionPreference pkgname pref <- prefs]
+ installPref :: PackageName -> InstalledPreference
installPref pkgname =
fromMaybe (installPrefDefault pkgname) (Map.lookup pkgname installPrefs)
installPrefs = Map.fromList
@@ -770,6 +775,7 @@ interpretPackagesPreference selected defaultPref prefs =
if pkgname `Set.member` selected then PreferLatest
else PreferInstalled
+ stanzasPref :: PackageName -> [OptionalStanza]
stanzasPref pkgname =
fromMaybe [] (Map.lookup pkgname stanzasPrefs)
stanzasPrefs = Map.fromListWith (\a b -> nub (a ++ b))
@@ -797,9 +803,12 @@ validateSolverResult platform comp indepGoals pkgs =
problems -> error (formatPkgProblems problems)
where
+ graph :: Graph.Graph (ResolverPackage UnresolvedPkgLoc)
graph = Graph.fromDistinctList pkgs
+ formatPkgProblems :: [PlanPackageProblem] -> String
formatPkgProblems = formatProblemMessage . map showPlanPackageProblem
+ formatPlanProblems :: [SolverInstallPlan.SolverPlanProblem] -> String
formatPlanProblems = formatProblemMessage . map SolverInstallPlan.showPlanProblem
formatProblemMessage problems =
@@ -894,6 +903,7 @@ configuredPackageProblems platform cinfo
, not (packageSatisfiesDependency pkgid dep) ]
-- TODO: sanity tests on executable deps
where
+ thisPkgName :: PackageName
thisPkgName = packageName (srcpkgDescription pkg)
specifiedDeps1 :: ComponentDeps [PackageId]
@@ -902,10 +912,12 @@ configuredPackageProblems platform cinfo
specifiedDeps :: [PackageId]
specifiedDeps = CD.flatDeps specifiedDeps1
+ mergedFlags :: [MergeResult PD.FlagName PD.FlagName]
mergedFlags = mergeBy compare
(sort $ map PD.flagName (PD.genPackageFlags (srcpkgDescription pkg)))
(sort $ map fst (PD.unFlagAssignment specifiedFlags)) -- TODO
+ packageSatisfiesDependency :: PackageIdentifier -> Dependency -> Bool
packageSatisfiesDependency
(PackageIdentifier name version)
(Dependency name' versionRange _) = assert (name == name') $
@@ -991,7 +1003,9 @@ resolveWithoutDependencies (DepResolverParams targets constraints
where
-- Constraints
+ requiredVersions :: VersionRange
requiredVersions = packageConstraints pkgname
+ choices :: [UnresolvedSourcePackage]
choices = PackageIndex.lookupDependency sourcePkgIndex
pkgname
requiredVersions
@@ -1000,20 +1014,24 @@ resolveWithoutDependencies (DepResolverParams targets constraints
PackagePreferences preferredVersions preferInstalled _
= packagePreferences pkgname
+ bestByPrefs :: UnresolvedSourcePackage -> UnresolvedSourcePackage -> Ordering
bestByPrefs = comparing $ \pkg ->
(installPref pkg, versionPref pkg, packageVersion pkg)
+ installPref :: UnresolvedSourcePackage -> Bool
installPref = case preferInstalled of
PreferLatest -> const False
PreferInstalled -> not . null
. InstalledPackageIndex.lookupSourcePackageId
installedPkgIndex
. packageId
+ versionPref :: Package a => a -> Int
versionPref pkg = length . filter (packageVersion pkg `withinRange`) $
preferredVersions
packageConstraints :: PackageName -> VersionRange
packageConstraints pkgname =
Map.findWithDefault anyVersion pkgname packageVersionConstraintMap
+ packageVersionConstraintMap :: Map PackageName VersionRange
packageVersionConstraintMap =
let pcs = map unlabelPackageConstraint constraints
in Map.fromList [ (scopeToPackageName scope, range)
diff --git a/cabal-install/src/Distribution/Client/Fetch.hs b/cabal-install/src/Distribution/Client/Fetch.hs
index 21d531800073b6949dfc59fe582377e0c8609b01..8e9496c8dc65408ada658d73a05b6ce5e23dc36a 100644
--- a/cabal-install/src/Distribution/Client/Fetch.hs
+++ b/cabal-install/src/Distribution/Client/Fetch.hs
@@ -147,6 +147,7 @@ planPackages verbosity comp platform fetchFlags
resolveWithoutDependencies resolverParams
where
+ resolverParams :: DepResolverParams
resolverParams =
setMaxBackjumps (if maxBackjumps < 0 then Nothing
diff --git a/cabal-install/src/Distribution/Client/FetchUtils.hs b/cabal-install/src/Distribution/Client/FetchUtils.hs
index b087867f5d0d7a93c583da06873a4a347c06a0b4..e632147d589a64c0b686f857f4168f9a0ac3c25c 100644
--- a/cabal-install/src/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/src/Distribution/Client/FetchUtils.hs
@@ -146,6 +146,7 @@ fetchPackage verbosity repoCtxt loc = case loc of
RemoteSourceRepoPackage _repo Nothing ->
die' verbosity "fetchPackage: source repos not supported"
where
+ downloadTarballPackage :: URI -> IO FilePath
downloadTarballPackage uri = do
transport <- repoContextGetTransport repoCtxt
transportCheckHttps verbosity transport uri
@@ -173,6 +174,7 @@ fetchRepoTarball verbosity' repoCtxt repo pkgid = do
-- whether we download or not is non-deterministic
verbosity = verboseUnmarkOutput verbosity'
+ downloadRepoPackage :: IO FilePath
downloadRepoPackage = case repo of
RepoLocalNoIndex{} -> return (packageFile repo pkgid)
diff --git a/cabal-install/src/Distribution/Client/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs
index 1856ddad12e33a3364c8791eda16fbc59fef1c5b..4b4ea1f31df8494c06201de452ae04869730a0ee 100644
--- a/cabal-install/src/Distribution/Client/Freeze.hs
+++ b/cabal-install/src/Distribution/Client/Freeze.hs
@@ -121,6 +121,7 @@ getFreezePkgs verbosity packageDBs repoCtxt comp platform progdb
verbosity comp platform freezeFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers
where
+ sanityCheck :: [PackageSpecifier UnresolvedSourcePackage] -> IO ()
sanityCheck pkgSpecifiers = do
when (not . null $ [n | n@(NamedPackage _ _) <- pkgSpecifiers]) $
die' verbosity $ "internal error: 'resolveUserTargets' returned "
@@ -154,6 +155,7 @@ planPackages verbosity comp platform freezeFlags
return $ pruneInstallPlan installPlan pkgSpecifiers
where
+ resolverParams :: DepResolverParams
resolverParams =
setMaxBackjumps (if maxBackjumps < 0 then Nothing
diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs
index 6de14f3c6617ebcc84b0cbc30a402c2268d1a8c0..e5708c87d0c860062aca0747881ae9f37dde8868 100644
--- a/cabal-install/src/Distribution/Client/HttpUtils.hs
+++ b/cabal-install/src/Distribution/Client/HttpUtils.hs
@@ -143,6 +143,7 @@ downloadURI transport verbosity uri path = do
NeedsDownload hash -> makeDownload transport' hash Nothing
where
+ makeDownload :: HttpTransport -> Maybe BS8.ByteString -> Maybe String -> IO DownloadResult
makeDownload transport' sha256 etag = withTempFileName (takeDirectory path) (takeFileName path) $ \tmpFile -> do
result <- getHttp transport' verbosity uri etag tmpFile []
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
index 6e96c459fe7655629f6951184b8f432ba70b8f9f..fd5a99ae920981c05067a4b8b1a978b6815dfea8 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs
@@ -230,6 +230,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
then dryRunLocalPkg pkg depsBuildStatus srcdir
else return (BuildStatusUnpack tarball)
where
+ srcdir :: FilePath
srcdir = distUnpackedSrcDirectory (packageId pkg)
dryRunLocalPkg :: ElaboratedConfiguredPackage
@@ -250,6 +251,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared =
Right buildResult ->
return (BuildStatusUpToDate buildResult)
where
+ packageFileMonitor :: PackageFileMonitor
packageFileMonitor =
newPackageFileMonitor shared distDirLayout
(elabDistDirParams shared pkg)
@@ -295,6 +297,7 @@ improveInstallPlanWithUpToDatePackages :: BuildStatusMap
improveInstallPlanWithUpToDatePackages pkgsBuildStatus =
InstallPlan.installed canPackageBeImproved
where
+ canPackageBeImproved :: ElaboratedConfiguredPackage -> Bool
canPackageBeImproved pkg =
case Map.lookup (installedUnitId pkg) pkgsBuildStatus of
Just BuildStatusUpToDate {} -> True
@@ -376,6 +379,7 @@ packageFileMonitorKeyValues elab =
-- do not affect the configure step need to be nulled out. Those parts are
-- the specific targets that we're going to build.
--
+ elab_config :: ElaboratedConfiguredPackage
elab_config =
elab {
elabBuildTargets = [],
@@ -390,6 +394,7 @@ packageFileMonitorKeyValues elab =
-- more or less the opposite of the first part, as it's just the info about
-- what targets we're going to build.
--
+ buildComponents :: Set ComponentName
buildComponents = elabBuildTargetWholeComponents elab
-- | Do all the checks on whether a package has changed and thus needs either
@@ -464,6 +469,7 @@ checkPackageFileMonitorChanged PackageFileMonitor{..}
(docsResult, testsResult) = buildResult
where
(pkgconfig, buildComponents) = packageFileMonitorKeyValues pkg
+ changedToMaybe :: MonitorChanged a b -> Maybe b
changedToMaybe (MonitorChanged _) = Nothing
changedToMaybe (MonitorUnchanged x _) = Just x
@@ -681,6 +687,7 @@ rebuildTarget verbosity
where
unexpectedState = error "rebuildTarget: unexpected package status"
+ downloadPhase :: IO BuildResult
downloadPhase = do
downsrcloc <- annotateFailureNoLog DownloadFailed $
waitAsyncPackageDownload verbosity downloadMap pkg
@@ -888,6 +895,7 @@ unpackPackageTarball verbosity tarball parentdir pkgid pkgTextOverride =
writeFileAtomic cabalFile pkgtxt
where
+ cabalFile :: FilePath
cabalFile = parentdir </> pkgsubdir
</> prettyShow pkgname <.> "cabal"
pkgsubdir = prettyShow pkgid
@@ -1081,12 +1089,14 @@ buildAndInstallUnpackedPackage verbosity
uid = installedUnitId rpkg
compid = compilerId compiler
+ dispname :: String
dispname = case elabPkgOrComp pkg of
ElabPackage _ -> prettyShow pkgid
++ " (all, legacy fallback)"
ElabComponent comp -> prettyShow pkgid
++ " (" ++ maybe "custom" prettyShow (compComponentName comp) ++ ")"
+ noticeProgress :: ProgressPhase -> IO ()
noticeProgress phase = when isParallelBuild $
progressMessage verbosity phase dispname
@@ -1467,6 +1477,7 @@ withTempInstalledPackageInfoFile verbosity tempdir action =
"Couldn't parse the output of 'setup register --gen-pkg-config':"
++ show perror
+ readPkgConf :: FilePath -> FilePath -> IO InstalledPackageInfo
readPkgConf pkgConfDir pkgConfFile = do
pkgConfStr <- BS.readFile (pkgConfDir </> pkgConfFile)
(warns, ipkg) <- case Installed.parseInstalledPackageInfo pkgConfStr of
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 45ea7c9eccdec08712cb564605fb2c3c6862c832..4113f5f1fb14df80590c60270bdd566c5a3ffcff 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -338,10 +338,12 @@ rebuildProjectConfig verbosity
ProjectConfigShared { projectConfigConfigFile } =
projectConfigShared cliConfig
+ fileMonitorProjectConfig ::
+ FileMonitor
+ (FilePath, FilePath)
+ (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
fileMonitorProjectConfig =
- newFileMonitor (distProjectCacheFile "config") :: FileMonitor
- (FilePath, FilePath)
- (ProjectConfig, [PackageSpecifier UnresolvedSourcePackage])
+ newFileMonitor (distProjectCacheFile "config")
-- Read the cabal.project (or implicit config) and combine it with
-- arguments from the command line
@@ -964,6 +966,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
--TODO: [nice to have] disable multiple instances restriction in
-- the solver, but then make sure we can cope with that in the
-- output.
+ resolverParams :: DepResolverParams
resolverParams =
setMaxBackjumps solverSettingMaxBackjumps
@@ -1074,6 +1077,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
$ stdResolverParams
+ stdResolverParams :: DepResolverParams
stdResolverParams =
-- Note: we don't use the standardInstallPolicy here, since that uses
-- its own addDefaultSetupDependencies that is not appropriate for us.
@@ -1286,6 +1290,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
pkgConfigReplOptions = mempty
}
+ preexistingInstantiatedPkgs :: Map UnitId FullUnitId
preexistingInstantiatedPkgs =
Map.fromList (mapMaybe f (SolverInstallPlan.toList solverPlan))
where
@@ -1297,6 +1302,8 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
(Map.fromList (IPI.instantiatedWith ipkg))))
f _ = Nothing
+ elaboratedInstallPlan ::
+ LogProgress (InstallPlan.GenericInstallPlan IPI.InstalledPackageInfo ElaboratedConfiguredPackage)
elaboratedInstallPlan =
flip InstallPlan.fromSolverInstallPlanWithProgress solverPlan $ \mapDep planpkg ->
case planpkg of
diff --git a/cabal-install/src/Distribution/Client/RebuildMonad.hs b/cabal-install/src/Distribution/Client/RebuildMonad.hs
index ec7e9843bdc557174aa68ff856b1c057dcbf89fc..3818aced7a3c08dea42ba439ffe1c6c5e4f168d6 100644
--- a/cabal-install/src/Distribution/Client/RebuildMonad.hs
+++ b/cabal-install/src/Distribution/Client/RebuildMonad.hs
@@ -294,9 +294,10 @@ findFileWithExtensionMonitored extensions searchPath baseName =
, ext <- nub extensions ]
-- | Like 'findFirstFile', but in the 'Rebuild' monad.
-findFirstFileMonitored :: (a -> FilePath) -> [a] -> Rebuild (Maybe a)
+findFirstFileMonitored :: forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
findFirstFileMonitored file = findFirst
- where findFirst [] = return Nothing
+ where findFirst :: [a] -> Rebuild (Maybe a)
+ findFirst [] = return Nothing
findFirst (x:xs) = do exists <- doesFileExistMonitored (file x)
if exists
then return (Just x)
diff --git a/cabal-install/src/Distribution/Client/Reconfigure.hs b/cabal-install/src/Distribution/Client/Reconfigure.hs
index cb15790e5dd01d22752ddab8c80058f1e433a401..5be346fdd32eb0b932fc2594d2f86dad743a0be2 100644
--- a/cabal-install/src/Distribution/Client/Reconfigure.hs
+++ b/cabal-install/src/Distribution/Client/Reconfigure.hs
@@ -119,14 +119,16 @@ reconfigure
else do
- let checks =
+ let checks :: Check (ConfigFlags, ConfigExFlags)
+ checks =
checkVerb
<> checkDist
<> checkOutdated
<> check
(Any frc, flags@(configFlags, _)) <- runCheck checks mempty savedFlags
- let config' = updateInstallDirs (configUserInstall configFlags) config
+ let config' :: SavedConfig
+ config' = updateInstallDirs (configUserInstall configFlags) config
when frc $ configureAction flags extraArgs globalFlags
return config'
@@ -135,11 +137,13 @@ reconfigure
-- Changing the verbosity does not require reconfiguration, but the new
-- verbosity should be used if reconfiguring.
+ checkVerb :: Check (ConfigFlags, b)
checkVerb = Check $ \_ (configFlags, configExFlags) -> do
let configFlags' = configFlags { configVerbosity = toFlag verbosity}
return (mempty, (configFlags', configExFlags))
-- Reconfiguration is required if @--build-dir@ changes.
+ checkDist :: Check (ConfigFlags, b)
checkDist = Check $ \_ (configFlags, configExFlags) -> do
-- Always set the chosen @--build-dir@ before saving the flags,
-- or bad things could happen.
@@ -149,6 +153,7 @@ reconfigure
let configFlags' = configFlags { configDistPref = toFlag dist }
return (Any distChanged, (configFlags', configExFlags))
+ checkOutdated :: Check (ConfigFlags, b)
checkOutdated = Check $ \_ flags@(configFlags, _) -> do
let buildConfig = localBuildInfoFile dist
@@ -172,7 +177,8 @@ reconfigure
outdated <- existsAndIsMoreRecentThan descrFile buildConfig
when outdated $ info verbosity (descrFile ++ " was changed")
- let failed =
+ let failed :: Any
+ failed =
Any outdated
<> Any userPackageEnvironmentFileModified
<> Any (not configured)
diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
index f4fbbfdadbd84890178b60e645bdefcb5fe4c203..02ac3973218a9e79517fd2239b44809bc90b314b 100644
--- a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
+++ b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
@@ -126,6 +126,7 @@ showPlanPackage (Configured spkg) =
comps | null deps = ""
| otherwise = " " ++ unwords (map prettyShow $ Foldable.toList deps)
where
+ deps :: Set CD.Component
deps = CD.components (solverPkgLibDeps spkg)
<> CD.components (solverPkgExeDeps spkg)
@@ -271,6 +272,7 @@ nonSetupClosure :: SolverPlanIndex
-> SolverPlanIndex
nonSetupClosure index pkgids0 = closure Graph.empty pkgids0
where
+ closure :: Graph SolverPlanPackage -> [SolverId] -> SolverPlanIndex
closure completed [] = completed
closure completed (pkgid:pkgids) =
case Graph.lookup pkgid index of
@@ -293,6 +295,7 @@ rootSets (IndependentGoals indepGoals) index =
if indepGoals then map (:[]) libRoots else [libRoots]
++ setupRoots index
where
+ libRoots :: [SolverId]
libRoots = libraryRoots index
-- | Compute the library roots of a plan
diff --git a/cabal-install/src/Distribution/Client/SourceFiles.hs b/cabal-install/src/Distribution/Client/SourceFiles.hs
index 279593684714d32b5a95ab408adb51a7ee2a2791..b6edd067b74adbe04f90e325fe0ed00934933a3c 100644
--- a/cabal-install/src/Distribution/Client/SourceFiles.hs
+++ b/cabal-install/src/Distribution/Client/SourceFiles.hs
@@ -21,6 +21,7 @@ import Distribution.Simple.PreProcess
import Distribution.Types.PackageDescription
import Distribution.Types.Component
+import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec)
import Distribution.Types.Library
import Distribution.Types.Executable
import Distribution.Types.Benchmark
@@ -48,8 +49,11 @@ needElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -> Reb
needElaboratedPackage elab epkg =
traverse_ (needComponent pkg_descr) (enabledComponents pkg_descr enabled)
where
+ pkg_descr :: PackageDescription
pkg_descr = elabPkgDescription elab
+ enabled_stanzas :: OptionalStanzaSet
enabled_stanzas = pkgStanzasEnabled epkg
+ enabled :: ComponentRequestedSpec
enabled = enableStanzas enabled_stanzas
needElaboratedComponent :: ElaboratedConfiguredPackage -> ElaboratedComponent -> Rebuild ()
@@ -58,7 +62,9 @@ needElaboratedComponent elab ecomp =
Nothing -> needSetup
Just comp -> needComponent pkg_descr comp
where
+ pkg_descr :: PackageDescription
pkg_descr = elabPkgDescription elab
+ mb_comp :: Maybe Component
mb_comp = fmap (getComponent pkg_descr) (compComponentName ecomp)
needComponent :: PackageDescription -> Component -> Rebuild ()
@@ -101,6 +107,7 @@ needTestSuite pkg_descr t
needBuildInfo pkg_descr bi [m]
TestSuiteUnsupported _ -> return () -- soft fail
where
+ bi :: BuildInfo
bi = testBuildInfo t
needMainFile :: BuildInfo -> FilePath -> Rebuild ()
@@ -130,6 +137,7 @@ needBenchmark pkg_descr bm
needMainFile bi mainPath
BenchmarkUnsupported _ -> return () -- soft fail
where
+ bi :: BuildInfo
bi = benchmarkBuildInfo bm
needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
diff --git a/cabal-install/src/Distribution/Client/Targets.hs b/cabal-install/src/Distribution/Client/Targets.hs
index 8cc4cdaf68a496ab1e4c6cacfcbf81204941a0e0..89aaf1fdab8904b5ad43fa2ac77d0a142585458e 100644
--- a/cabal-install/src/Distribution/Client/Targets.hs
+++ b/cabal-install/src/Distribution/Client/Targets.hs
@@ -195,6 +195,7 @@ readUserTarget targetstr =
Just target -> return target
Nothing -> return (Left (UserTargetUnrecognised targetstr))
where
+ testFileTargets :: FilePath -> IO (Maybe (Either UserTargetProblem UserTarget))
testFileTargets filename = do
isDir <- doesDirectoryExist filename
isFile <- doesFileExist filename
@@ -221,6 +222,7 @@ readUserTarget targetstr =
= Nothing
return result
+ testUriTargets :: String -> Maybe (Either UserTargetProblem UserTarget)
testUriTargets str =
case parseAbsoluteURI str of
Just uri@URI {
@@ -414,6 +416,7 @@ readPackageTarget :: Verbosity
-> IO (PackageTarget UnresolvedSourcePackage)
readPackageTarget verbosity = traverse modifyLocation
where
+ modifyLocation :: ResolvedPkgLoc -> IO UnresolvedSourcePackage
modifyLocation location = case location of
LocalUnpackedPackage dir -> do
@@ -444,6 +447,7 @@ readPackageTarget verbosity = traverse modifyLocation
--
-- When that is corrected, this will also need to be fixed.
+ readTarballPackageTarget :: ResolvedPkgLoc -> FilePath -> FilePath -> IO UnresolvedSourcePackage
readTarballPackageTarget location tarballFile tarballOriginalLoc = do
(filename, content) <- extractTarballPackageCabalFile
tarballFile tarballOriginalLoc
@@ -471,6 +475,8 @@ readPackageTarget verbosity = traverse modifyLocation
where
formatErr msg = "Error reading " ++ tarballOriginalLoc ++ ": " ++ msg
+ accumEntryMap :: Tar.Entries Tar.FormatError
+ -> Either (Tar.FormatError, Map Tar.TarPath Tar.Entry) (Map Tar.TarPath Tar.Entry)
accumEntryMap = Tar.foldlEntries
(\m e -> Map.insert (Tar.entryTarPath e) e m)
Map.empty
@@ -486,6 +492,7 @@ readPackageTarget verbosity = traverse modifyLocation
noCabalFile = "No cabal file found"
multipleCabalFiles = "Multiple cabal files found"
+ isCabalFile :: Tar.Entry -> Bool
isCabalFile e = case splitPath (Tar.entryPath e) of
[ _dir, file] -> takeExtension file == ".cabal"
[".", _dir, file] -> takeExtension file == ".cabal"
diff --git a/cabal-install/src/Distribution/Client/Upload.hs b/cabal-install/src/Distribution/Client/Upload.hs
index 17a25cd2ad985c906c5807224d0cb474a40e5e84..e156580d0774a43226103d2f2cffa1a2582c15cd 100644
--- a/cabal-install/src/Distribution/Client/Upload.hs
+++ b/cabal-install/src/Distribution/Client/Upload.hs
@@ -4,7 +4,7 @@ import Distribution.Client.Compat.Prelude
import qualified Prelude as Unsafe (tail, head, read)
import Distribution.Client.Types.Credentials ( Username(..), Password(..) )
-import Distribution.Client.Types.Repo (RemoteRepo(..), maybeRepoRemote)
+import Distribution.Client.Types.Repo (Repo, RemoteRepo(..), maybeRepoRemote)
import Distribution.Client.Types.RepoName (unRepoName)
import Distribution.Client.HttpUtils
( HttpTransport(..), remoteRepoTryUpgradeToHttps )
@@ -44,15 +44,19 @@ upload :: Verbosity -> RepoContext
-> Maybe Username -> Maybe Password -> IsCandidate -> [FilePath]
-> IO ()
upload verbosity repoCtxt mUsername mPassword isCandidate paths = do
- let repos = repoContextRepos repoCtxt
+ let repos :: [Repo]
+ repos = repoContextRepos repoCtxt
transport <- repoContextGetTransport repoCtxt
targetRepo <-
case [ remoteRepo | Just remoteRepo <- map maybeRepoRemote repos ] of
[] -> die' verbosity "Cannot upload. No remote repositories are configured."
(r:rs) -> remoteRepoTryUpgradeToHttps verbosity transport (last (r:|rs))
- let targetRepoURI = remoteRepoURI targetRepo
+ let targetRepoURI :: URI
+ targetRepoURI = remoteRepoURI targetRepo
+ domain :: String
domain = maybe "Hackage" uriRegName $ uriAuthority targetRepoURI
rootIfEmpty x = if null x then "/" else x
+ uploadURI :: URI
uploadURI = targetRepoURI {
uriPath = rootIfEmpty (uriPath targetRepoURI) FilePath.Posix.</>
case isCandidate of
@@ -167,16 +171,20 @@ promptPassword domain = do
report :: Verbosity -> RepoContext -> Maybe Username -> Maybe Password -> IO ()
report verbosity repoCtxt mUsername mPassword = do
- let repos = repoContextRepos repoCtxt
+ let repos :: [Repo]
+ repos = repoContextRepos repoCtxt
+ remoteRepos :: [RemoteRepo]
remoteRepos = mapMaybe maybeRepoRemote repos
for_ remoteRepos $ \remoteRepo -> do
let domain = maybe "Hackage" uriRegName $ uriAuthority (remoteRepoURI remoteRepo)
Username username <- maybe (promptUsername domain) return mUsername
Password password <- maybe (promptPassword domain) return mPassword
- let auth = (username, password)
+ let auth :: (String, String)
+ auth = (username, password)
dotCabal <- getCabalDir
- let srcDir = dotCabal </> "reports" </> unRepoName (remoteRepoName remoteRepo)
+ let srcDir :: FilePath
+ srcDir = dotCabal </> "reports" </> unRepoName (remoteRepoName remoteRepo)
-- We don't want to bomb out just because we haven't built any packages
-- from this repo yet.
srcExists <- doesDirectoryExist srcDir
@@ -208,6 +216,7 @@ handlePackage transport verbosity uri packageUri auth isCandidate path =
++ err
exitFailure
where
+ okMessage :: IsCandidate -> String
okMessage IsCandidate =
"Package successfully uploaded as candidate. "
++ "You can now preview the result at '" ++ show packageUri
diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs
index f9021803c7d061ebea859b5598638e350d8391a5..64e715c86a5f358b3591f8d464d3c74310b957ea 100644
--- a/cabal-install/src/Distribution/Client/Utils.hs
+++ b/cabal-install/src/Distribution/Client/Utils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface, CPP #-}
+{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables, CPP #-}
module Distribution.Client.Utils
( MergeResult(..)
@@ -76,9 +76,10 @@ import qualified System.IO.Error as IOError
-- | Generic merging utility. For sorted input lists this is a full outer join.
--
-mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
+mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy cmp = merge
where
+ merge :: [a] -> [b] -> [MergeResult a b]
merge [] ys = [ OnlyInRight y | y <- ys]
merge xs [] = [ OnlyInLeft x | x <- xs]
merge (x:xs) (y:ys) =
@@ -92,9 +93,10 @@ data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b
duplicates :: Ord a => [a] -> [[a]]
duplicates = duplicatesBy compare
-duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
+duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
where
+ eq :: a -> a -> Bool
eq a b = case cmp a b of
EQ -> True
_ -> False
@@ -175,7 +177,9 @@ withEnvOverrides overrides m = do
withExtraPathEnv :: [FilePath] -> IO a -> IO a
withExtraPathEnv paths m = do
oldPathSplit <- getSearchPath
- let newPath = mungePath $ intercalate [searchPathSeparator] (paths ++ oldPathSplit)
+ let newPath :: String
+ newPath = mungePath $ intercalate [searchPathSeparator] (paths ++ oldPathSplit)
+ oldPath :: String
oldPath = mungePath $ intercalate [searchPathSeparator] oldPathSplit
-- TODO: This is a horrible hack to work around the fact that
-- setEnv can't take empty values as an argument
diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs
index 683fb1e726892d1399c2d72003f1ca377bf62430..f13b02dec9d90a9d24e359c54fc16ed7c3a8632c 100644
--- a/cabal-install/src/Distribution/Client/VCS.hs
+++ b/cabal-install/src/Distribution/Client/VCS.hs
@@ -157,6 +157,9 @@ validateSourceRepos rs =
(problems@(_:_), _) -> Left problems
([], vcss) -> Right vcss
where
+ validateSourceRepo' :: SourceRepositoryPackage f
+ -> Either (SourceRepositoryPackage f, SourceRepoProblem)
+ (SourceRepositoryPackage f, String, RepoType, VCS Program)
validateSourceRepo' r = either (Left . (,) r) Right
(validateSourceRepo r)
diff --git a/cabal-install/src/Distribution/Client/World.hs b/cabal-install/src/Distribution/Client/World.hs
index a24a663dfcace266fc572be56a43609a1cac7472..49d530fabfbcf3314bc1dce34c87a5d681c6ddde 100644
--- a/cabal-install/src/Distribution/Client/World.hs
+++ b/cabal-install/src/Distribution/Client/World.hs
@@ -35,7 +35,7 @@ import Distribution.Client.Compat.Prelude hiding (getContents)
import Distribution.Types.Dependency
import Distribution.Types.Flag
- ( FlagAssignment, unFlagAssignment
+ ( FlagAssignment, FlagName, unFlagAssignment
, unFlagName, parsecFlagAssignmentNonEmpty )
import Distribution.Simple.Utils
( die', info, chattyTry, writeFileAtomic )
@@ -104,7 +104,8 @@ modifyWorld f verbosity world pkgs =
getContents :: Verbosity -> FilePath -> IO [WorldPkgInfo]
getContents verbosity world = do
content <- safelyReadFile world
- let result = map simpleParsec (lines $ B.unpack content)
+ let result :: [Maybe WorldPkgInfo]
+ result = map simpleParsec (lines $ B.unpack content)
case sequence result of
Nothing -> die' verbosity "Could not parse world file."
Just xs -> return xs
@@ -122,6 +123,7 @@ instance Pretty WorldPkgInfo where
dispFlags [] = Disp.empty
dispFlags fs = Disp.text "--flags="
<<>> Disp.doubleQuotes (flagAssToDoc fs)
+ flagAssToDoc :: [(FlagName, Bool)] -> Disp.Doc
flagAssToDoc = foldr (\(fname,val) flagAssDoc ->
(if not val then Disp.char '-'
else Disp.char '+')