Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
c6c1d6ec
Commit
c6c1d6ec
authored
Nov 04, 2009
by
Duncan Coutts
Browse files
Add a couple checks to "cabal unpack" and improve the messages
parent
97075ecc
Changes
1
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/Unpack.hs
View file @
c6c1d6ec
...
...
@@ -17,10 +17,14 @@ module Distribution.Client.Unpack (
)
where
import
Distribution.Package
(
packageId
,
Dependency
(
..
)
)
import
Distribution.Package
(
PackageId
,
packageId
,
Dependency
(
..
)
)
import
Distribution.Client.PackageIndex
as
PackageIndex
(
lookupDependency
)
import
Distribution.Simple.Setup
(
fromFlag
,
fromFlagOrDefault
)
import
Distribution.Simple.Utils
(
info
,
notice
,
die
)
import
Distribution.Simple.Utils
(
notice
,
die
)
import
Distribution.Verbosity
(
Verbosity
)
import
Distribution.Text
(
display
)
import
Distribution.Version
(
anyVersion
,
intersectVersionRanges
)
...
...
@@ -36,11 +40,14 @@ import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
import
Distribution.Client.IndexUtils
as
IndexUtils
(
getAvailablePackages
,
disambiguateDependencies
)
import
System.Directory
(
createDirectoryIfMissing
)
import
Control.Monad
(
unless
)
import
System.Directory
(
createDirectoryIfMissing
,
doesDirectoryExist
,
doesFileExist
)
import
Control.Monad
(
unless
,
when
)
import
Data.Ord
(
comparing
)
import
Data.List
(
null
,
maximumBy
)
import
System.FilePath
((
</>
))
import
System.FilePath
(
(
</>
),
addTrailingPathSeparator
)
import
qualified
Data.Map
as
Map
unpack
::
UnpackFlags
->
[
Repo
]
->
[
Dependency
]
->
IO
()
...
...
@@ -67,12 +74,8 @@ unpack flags repos deps
++
" that satisfies "
++
display
ver
Right
(
AvailablePackage
pkgid
_
(
RepoTarballPackage
repo
))
->
do
pkgPath
<-
fetchPackage
verbosity
repo
pkgid
let
pkgdir
=
display
pkgid
notice
verbosity
$
"Unpacking "
++
pkgdir
++
"..."
info
verbosity
$
"Extracting "
++
pkgPath
++
" to "
++
prefix
</>
pkgdir
++
"..."
Tar
.
extractTarGzFile
prefix
pkgdir
pkgPath
pkgPath
<-
fetchPackage
verbosity
repo
pkgid
unpackPackage
verbosity
prefix
pkgid
pkgPath
Right
(
AvailablePackage
_
_
LocalUnpackedPackage
)
->
error
"Distribution.Client.Unpack.unpack: the impossible happened."
...
...
@@ -81,6 +84,20 @@ unpack flags repos deps
prefix
=
fromFlagOrDefault
""
(
unpackDestDir
flags
)
toUnresolved
d
=
UnresolvedDependency
d
[]
unpackPackage
::
Verbosity
->
FilePath
->
PackageId
->
FilePath
->
IO
()
unpackPackage
verbosity
prefix
pkgid
pkgPath
=
do
let
pkgdirname
=
display
pkgid
pkgdir
=
prefix
</>
pkgdirname
pkgdir'
=
addTrailingPathSeparator
pkgdir
existsDir
<-
doesDirectoryExist
pkgdir
when
existsDir
$
die
$
"The directory
\"
"
++
pkgdir'
++
"
\"
already exists, not unpacking."
existsFile
<-
doesFileExist
pkgdir
when
existsFile
$
die
$
"A file
\"
"
++
pkgdir
++
"
\"
is in the way, not unpacking."
notice
verbosity
$
"Unpacking to "
++
pkgdir'
Tar
.
extractTarGzFile
prefix
pkgdirname
pkgPath
resolvePackages
::
AvailablePackageDb
->
[
Dependency
]
->
[
Either
Dependency
AvailablePackage
]
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment