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
75190409
Commit
75190409
authored
Oct 28, 2009
by
Duncan Coutts
Browse files
Allow building with base 4
parent
0d8b3a93
Changes
5
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/Install.hs
View file @
75190409
...
...
@@ -21,7 +21,18 @@ import Data.Maybe
(
isJust
,
fromMaybe
)
import
qualified
Data.Map
as
Map
import
Control.Exception
as
Exception
(
handle
,
handleJust
,
Exception
(
IOException
)
)
(
handleJust
)
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
import
Control.Exception
as
Exception
(
Exception
(
toException
),
catches
,
Handler
(
Handler
),
IOException
)
import
System.Exit
(
ExitCode
)
#
else
import
Control.Exception
as
Exception
(
Exception
(
IOException
,
ExitException
)
)
#
endif
import
Distribution.Compat.Exception
(
SomeException
,
catchIO
,
catchExit
)
import
Control.Monad
(
when
,
unless
)
import
System.Directory
...
...
@@ -294,7 +305,11 @@ storeDetailedBuildReports verbosity logsDir reports = sequence_
warn
verbosity
$
"Missing log file for build report: "
++
fromMaybe
""
(
ioeGetFileName
ioe
)
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
missingFile
ioe
#
else
missingFile
(
IOException
ioe
)
#
endif
|
isDoesNotExistError
ioe
=
Just
ioe
missingFile
_
=
Nothing
...
...
@@ -645,9 +660,10 @@ installUnpackedPackage verbosity scriptOptions miscOptions
-- Doc generation phase
docsResult
<-
if
shouldHaddock
then
Exception
.
handle
(
\
_
->
return
DocsFailed
)
$
do
setup
haddockCommand
haddockFlags
return
DocsOk
then
(
do
setup
haddockCommand
haddockFlags
return
DocsOk
)
`
catchIO
`
(
\
_
->
return
DocsFailed
)
`
catchExit
`
(
\
_
->
return
DocsFailed
)
else
return
DocsNotTried
-- Tests phase
...
...
@@ -710,9 +726,21 @@ installUnpackedPackage verbosity scriptOptions miscOptions
else
die
$
"Unable to find cabal executable at: "
++
self
-- helper
onFailure
::
(
Exception
->
BuildFailure
)
->
IO
BuildResult
->
IO
BuildResult
onFailure
result
=
Exception
.
handle
(
return
.
Left
.
result
)
onFailure
::
(
SomeException
->
BuildFailure
)
->
IO
BuildResult
->
IO
BuildResult
onFailure
result
action
=
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
action
`
catches
`
[
Handler
$
\
ioe
->
handler
(
ioe
::
IOException
)
,
Handler
$
\
exit
->
handler
(
exit
::
ExitCode
)
]
where
handler
::
Exception
e
=>
e
->
IO
BuildResult
handler
=
return
.
Left
.
result
.
toException
#
else
action
`
catchIO
`
(
return
.
Left
.
result
.
IOException
)
`
catchExit
`
(
return
.
Left
.
result
.
ExitException
)
#
endif
withWin32SelfUpgrade
::
Verbosity
->
ConfigFlags
...
...
cabal-install/Distribution/Client/Types.hs
View file @
75190409
...
...
@@ -26,8 +26,8 @@ import Distribution.Version
import
Data.Map
(
Map
)
import
Network.URI
(
URI
)
import
Control
.Exception
(
Exception
)
import
Distribution.Compat
.Exception
(
Some
Exception
)
newtype
Username
=
Username
{
unUsername
::
String
}
newtype
Password
=
Password
{
unPassword
::
String
}
...
...
@@ -137,11 +137,11 @@ data UnresolvedDependency
type
BuildResult
=
Either
BuildFailure
BuildSuccess
data
BuildFailure
=
DependentFailed
PackageId
|
DownloadFailed
Exception
|
UnpackFailed
Exception
|
ConfigureFailed
Exception
|
BuildFailed
Exception
|
InstallFailed
Exception
|
DownloadFailed
Some
Exception
|
UnpackFailed
Some
Exception
|
ConfigureFailed
Some
Exception
|
BuildFailed
Some
Exception
|
InstallFailed
Some
Exception
data
BuildSuccess
=
BuildOk
DocsResult
TestsResult
data
DocsResult
=
DocsNotTried
|
DocsFailed
|
DocsOk
...
...
cabal-install/Distribution/Client/Utils.hs
View file @
75190409
...
...
@@ -17,8 +17,9 @@ import System.Directory
import
Distribution.Compat.TempFile
(
createTempDirectory
)
import
qualified
Control.Exception
as
Exception
(
handle
,
throwIO
,
evaluate
,
finally
,
bracket
)
(
evaluate
,
finally
,
bracket
)
import
qualified
Distribution.Compat.Exception
as
Exception
(
onException
)
-- | Generic merging utility. For sorted input lists this is a full outer join.
--
-- * The result list never contains @(Nothing, Nothing)@.
...
...
@@ -51,9 +52,8 @@ duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
writeFileAtomic
::
FilePath
->
BS
.
ByteString
->
IO
()
writeFileAtomic
targetFile
content
=
do
(
tmpFile
,
tmpHandle
)
<-
openBinaryTempFile
targetDir
template
Exception
.
handle
(
\
err
->
do
hClose
tmpHandle
removeFile
tmpFile
Exception
.
throwIO
err
)
$
do
Exception
.
onException
(
do
hClose
tmpHandle
removeFile
tmpFile
)
$
do
BS
.
hPut
tmpHandle
content
hClose
tmpHandle
renameFile
tmpFile
targetFile
...
...
cabal-install/Distribution/Compat/Exception.hs
0 → 100644
View file @
75190409
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -cpp #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-- #hide
module
Distribution.Compat.Exception
(
SomeException
,
onException
,
catchIO
,
catchExit
,
throwIOIO
)
where
import
System.Exit
import
qualified
Control.Exception
as
Exception
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
import
Control.Exception
(
SomeException
)
#
else
import
Control.Exception
(
Exception
)
type
SomeException
=
Exception
#
endif
onException
::
IO
a
->
IO
b
->
IO
a
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
onException
=
Exception
.
onException
#
else
onException
io
what
=
io
`
Exception
.
catch
`
\
e
->
do
what
Exception
.
throw
e
#
endif
throwIOIO
::
Exception
.
IOException
->
IO
a
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
throwIOIO
=
Exception
.
throwIO
#
else
throwIOIO
=
Exception
.
throwIO
.
Exception
.
IOException
#
endif
catchIO
::
IO
a
->
(
Exception
.
IOException
->
IO
a
)
->
IO
a
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
catchIO
=
Exception
.
catch
#
else
catchIO
=
Exception
.
catchJust
Exception
.
ioErrors
#
endif
catchExit
::
IO
a
->
(
ExitCode
->
IO
a
)
->
IO
a
#
if
MIN_VERSION_base
(
4
,
0
,
0
)
catchExit
=
Exception
.
catch
#
else
catchExit
=
Exception
.
catchJust
exitExceptions
where
exitExceptions
(
Exception
.
ExitException
ee
)
=
Just
ee
exitExceptions
_
=
Nothing
#
endif
cabal-install/cabal-install.cabal
View file @
75190409
...
...
@@ -79,7 +79,7 @@ Executable cabal
Distribution.Compat.TempFile
Paths_cabal_install
build-depends: base >= 2 && <
4
,
build-depends: base >= 2 && <
5
,
Cabal >= 1.7.5 && < 1.9,
filepath >= 1.0,
network >= 1 && < 3,
...
...
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