Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
b00e3a6c
Commit
b00e3a6c
authored
Dec 18, 2010
by
Ian Lynagh
Browse files
Replace uses of the old catch function with the new one
parent
50769d75
Changes
7
Hide whitespace changes
Inline
Side-by-side
compiler/coreSyn/MkExternalCore.lhs
View file @
b00e3a6c
...
...
@@ -27,6 +27,7 @@ import Encoding
import ForeignCall
import DynFlags
import FastString
import Exception
import Data.Char
import System.IO
...
...
@@ -35,10 +36,10 @@ emitExternalCore :: DynFlags -> CgGuts -> IO ()
emitExternalCore dflags cg_guts
| dopt Opt_EmitExternalCore dflags
= (do handle <- openFile corename WriteMode
hPutStrLn handle (show (mkExternalCore cg_guts))
hPutStrLn handle (show (mkExternalCore cg_guts))
hClose handle)
`catch` (\_ -> pprPanic "Failed to open or write external core output file"
(text corename))
`catch
IO
` (\_ -> pprPanic "Failed to open or write external core output file"
(text corename))
where corename = extCoreName dflags
emitExternalCore _ _
| otherwise
...
...
compiler/main/SysTools.lhs
View file @
b00e3a6c
...
...
@@ -45,8 +45,8 @@ import ErrUtils
import Panic
import Util
import DynFlags
import Exception
import Data.IORef
import Control.Monad
import System.Exit
...
...
@@ -528,7 +528,7 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir})
writeIORef ref mapping'
debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname)
return dirname
`
IO.
catch` \e ->
`catch
IO
` \e ->
if isAlreadyExistsError e
then mkTempDir (x+1)
else ioError e
...
...
@@ -567,7 +567,7 @@ removeTmpFiles dflags fs
(non_deletees, deletees) = partition isHaskellUserSrcFilename fs
removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
removeWith dflags remover f = remover f `
IO.
catch`
removeWith dflags remover f = remover f `catch
IO
`
(\e ->
let msg = if isDoesNotExistError e
then ptext (sLit "Warning: deleting non-existent") <+> text f
...
...
@@ -604,7 +604,7 @@ runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
#endif
traceCmd dflags phase_name cmdLine $ do
(exit_code, doesn'tExist) <-
IO.
catch (do
catch
IO
(do
rc <- builderMainLoop dflags filter_fn pgm real_args mb_env
case rc of
ExitSuccess{} -> return (rc, False)
...
...
@@ -756,7 +756,7 @@ traceCmd dflags phase_name cmd_line action
; unless (dopt Opt_DryRun dflags) $ do {
-- And run it!
; action `
IO.
catch` handle_exn verb
; action `catch
IO
` handle_exn verb
}}
where
handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
...
...
compiler/parser/ParserCoreUtils.hs
View file @
b00e3a6c
module
ParserCoreUtils
where
import
Exception
import
System.IO
data
ParseResult
a
=
OkP
a
|
FailP
String
...
...
@@ -19,7 +20,7 @@ failP s s' _ = FailP (s ++ ":" ++ s')
getCoreModuleName
::
FilePath
->
IO
String
getCoreModuleName
fpath
=
catch
(
do
catch
IO
(
do
h
<-
openFile
fpath
ReadMode
ls
<-
hGetContents
h
let
mo
=
findMod
(
words
ls
)
...
...
compiler/utils/Util.lhs
View file @
b00e3a6c
...
...
@@ -86,6 +86,7 @@ module Util (
#include "HsVersions.h"
import Exception
import Panic
import Data.Data
...
...
@@ -99,7 +100,7 @@ import FastTypes
#endif
import Control.Monad ( unless )
import System.IO.Error as IO (
catch,
isDoesNotExistError )
import System.IO.Error as IO ( isDoesNotExistError )
import System.Directory ( doesDirectoryExist, createDirectory,
getModificationTime )
import System.FilePath
...
...
@@ -939,9 +940,9 @@ doesDirNameExist fpath = case takeDirectory fpath of
modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
modificationTimeIfExists f = do
(do t <- getModificationTime f; return (Just t))
`
IO.
catch` \e -> if isDoesNotExistError e
then return Nothing
else ioError e
`catch
IO
` \e -> if isDoesNotExistError e
then return Nothing
else ioError e
-- split a string at the last character where 'pred' is True,
-- returning a pair of strings. The first component holds the string
...
...
ghc/InteractiveUI.hs
View file @
b00e3a6c
...
...
@@ -280,7 +280,7 @@ helpText =
findEditor
::
IO
String
findEditor
=
do
getEnv
"EDITOR"
`
IO
.
catch
`
\
_
->
do
`
catch
IO
`
\
_
->
do
#
if
mingw32_HOST_OS
win
<-
System
.
Win32
.
getWindowsDirectory
return
(
win
</>
"notepad.exe"
)
...
...
@@ -413,7 +413,7 @@ runGHCi paths maybe_exprs = do
Right
hdl
->
do
runInputTWithPrefs
defaultPrefs
defaultSettings
$
runCommands
$
fileLoop
hdl
liftIO
(
hClose
hdl
`
IO
.
catch
`
\
_
->
return
()
)
liftIO
(
hClose
hdl
`
catch
IO
`
\
_
->
return
()
)
where
getDirectory
f
=
case
takeDirectory
f
of
""
->
"."
;
d
->
d
...
...
utils/ghc-pkg/Main.hs
View file @
b00e3a6c
...
...
@@ -724,7 +724,7 @@ updateDBCache verbosity db = do
when
(
verbosity
>
Normal
)
$
putStrLn
(
"writing cache "
++
filename
)
writeBinaryFileAtomic
filename
(
map
convertPackageInfoOut
(
packages
db
))
`
catch
`
\
e
->
`
catch
IO
`
\
e
->
if
isPermissionError
e
then
die
(
filename
++
": you don't have permission to modify this file"
)
else
ioError
e
...
...
@@ -1138,7 +1138,7 @@ writeNewConfig verbosity filename ipis = do
$
map
(
show
.
convertPackageInfoOut
)
ipis
fileContents
=
"["
++
shown
++
"
\n
]"
writeFileUtf8Atomic
filename
fileContents
`
catch
`
\
e
->
`
catch
IO
`
\
e
->
if
isPermissionError
e
then
die
(
filename
++
": you don't have permission to modify this file"
)
else
ioError
e
...
...
@@ -1374,7 +1374,7 @@ findModules paths =
return
(
concat
mms
)
searchDir
path
prefix
=
do
fs
<-
getDirectoryEntries
path
`
catch
`
\
_
->
return
[]
fs
<-
getDirectoryEntries
path
`
catch
IO
`
\
_
->
return
[]
searchEntries
path
prefix
fs
searchEntries
path
prefix
[]
=
return
[]
...
...
@@ -1417,7 +1417,7 @@ expandEnvVars str0 force = go str0 ""
lookupEnvVar
::
String
->
IO
String
lookupEnvVar
nm
=
catch
(
System
.
Environment
.
getEnv
nm
)
catch
IO
(
System
.
Environment
.
getEnv
nm
)
(
\
_
->
do
dieOrForceAll
force
(
"Unable to expand variable "
++
show
nm
)
return
""
)
...
...
@@ -1533,10 +1533,10 @@ installSignalHandlers = do
#
if
mingw32_HOST_OS
||
mingw32_TARGET_OS
throwIOIO
::
Exception
.
IOException
->
IO
a
throwIOIO
=
Exception
.
throwIO
#
endif
catchIO
::
IO
a
->
(
Exception
.
IOException
->
IO
a
)
->
IO
a
catchIO
=
Exception
.
catch
#
endif
catchError
::
IO
a
->
(
String
->
IO
a
)
->
IO
a
catchError
io
handler
=
io
`
Exception
.
catch
`
handler'
...
...
@@ -1624,5 +1624,5 @@ readUTF8File file = do
-- removeFileSave doesn't throw an exceptions, if the file is already deleted
removeFileSafe
::
FilePath
->
IO
()
removeFileSafe
fn
=
removeFile
fn
`
catch
`
\
e
->
removeFile
fn
`
catch
IO
`
\
e
->
when
(
not
$
isDoesNotExistError
e
)
$
ioError
e
utils/hpc/HpcUtils.hs
View file @
b00e3a6c
...
...
@@ -23,9 +23,9 @@ readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
readFileFromPath
_
filename
@
(
'/'
:
_
)
_
=
readFile
filename
readFileFromPath
err
filename
path0
=
readTheFile
path0
where
readTheFile
[]
=
err
$
"could not find "
++
show
filename
++
" in path "
++
show
path0
readTheFile
(
dir
:
dirs
)
=
catch
(
do
str
<-
readFile
(
dir
++
"/"
++
filename
)
return
str
)
(
\
_
->
readTheFile
dirs
)
readTheFile
[]
=
err
$
"could not find "
++
show
filename
++
" in path "
++
show
path0
readTheFile
(
dir
:
dirs
)
=
catch
IO
(
do
str
<-
readFile
(
dir
++
"/"
++
filename
)
return
str
)
(
\
_
->
readTheFile
dirs
)
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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