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
acb9c929
Commit
acb9c929
authored
Dec 18, 2010
by
Ian Lynagh
Browse files
Replace uses of the old try function with the new one
parent
b00e3a6c
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/main/DriverPipeline.hs
View file @
acb9c929
...
...
@@ -58,7 +58,6 @@ import Data.IORef ( readIORef )
import
System.Directory
import
System.FilePath
import
System.IO
import
System.IO.Error
as
IO
import
Control.Monad
import
Data.List
(
isSuffixOf
)
import
Data.Maybe
...
...
@@ -365,13 +364,13 @@ linkingNeeded dflags linkables pkg_deps = do
-- modification times on all of the objects and libraries, then omit
-- linking (unless the -fforce-recomp flag was given).
let
exe_file
=
exeFileName
dflags
e_exe_time
<-
IO
.
try
$
getModificationTime
exe_file
e_exe_time
<-
try
IO
$
getModificationTime
exe_file
case
e_exe_time
of
Left
_
->
return
True
Right
t
->
do
-- first check object files and extra_ld_inputs
extra_ld_inputs
<-
readIORef
v_Ld_inputs
e_extra_times
<-
mapM
(
IO
.
try
.
getModificationTime
)
extra_ld_inputs
e_extra_times
<-
mapM
(
try
IO
.
getModificationTime
)
extra_ld_inputs
let
(
errs
,
extra_times
)
=
splitEithers
e_extra_times
let
obj_times
=
map
linkableTime
linkables
++
extra_times
if
not
(
null
errs
)
||
any
(
t
<
)
obj_times
...
...
@@ -387,7 +386,7 @@ linkingNeeded dflags linkables pkg_deps = do
pkg_libfiles
<-
mapM
(
uncurry
findHSLib
)
pkg_hslibs
if
any
isNothing
pkg_libfiles
then
return
True
else
do
e_lib_times
<-
mapM
(
IO
.
try
.
getModificationTime
)
e_lib_times
<-
mapM
(
try
IO
.
getModificationTime
)
(
catMaybes
pkg_libfiles
)
let
(
lib_errs
,
lib_times
)
=
splitEithers
e_lib_times
if
not
(
null
lib_errs
)
||
any
(
t
<
)
lib_times
...
...
compiler/main/GHC.hs
View file @
acb9c929
...
...
@@ -312,7 +312,7 @@ import Exception
import
Data.IORef
import
System.FilePath
import
System.IO
import
System.IO.Error
(
try
,
isDoesNotExistError
)
import
System.IO.Error
(
isDoesNotExistError
)
import
Prelude
hiding
(
init
)
...
...
@@ -2067,7 +2067,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
case
maybe_buf
of
Just
(
_
,
t
)
->
check_timestamp
old_summary
location
src_fn
t
Nothing
->
do
m
<-
System
.
IO
.
Error
.
try
(
getModificationTime
src_fn
)
m
<-
try
IO
(
getModificationTime
src_fn
)
case
m
of
Right
t
->
check_timestamp
old_summary
location
src_fn
t
Left
e
|
isDoesNotExistError
e
->
find_it
...
...
ghc/GhciTags.hs
View file @
acb9c929
...
...
@@ -13,6 +13,7 @@ module GhciTags (
createETagsFileCmd
)
where
import
Exception
import
GHC
import
GhciMonad
import
Outputable
...
...
@@ -29,7 +30,7 @@ import Panic
import
Data.List
import
Control.Monad
import
System.IO
import
System.IO.Error
as
IO
import
System.IO.Error
-----------------------------------------------------------------------------
-- create tags file for currently loaded modules.
...
...
@@ -130,18 +131,18 @@ collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError (
-- ctags style with the Ex exresion being just the line number, Vim et al
collateAndWriteTags
CTagsWithLineNumbers
file
tagInfos
=
do
let
tags
=
unlines
$
sortLe
(
<=
)
$
map
showCTag
tagInfos
IO
.
try
(
writeFile
file
tags
)
try
IO
(
writeFile
file
tags
)
-- ctags style with the Ex exresion being a regex searching the line, Vim et al
collateAndWriteTags
CTagsWithRegExes
file
tagInfos
=
do
-- ctags style, Vim et al
tagInfoGroups
<-
makeTagGroupsWithSrcInfo
tagInfos
let
tags
=
unlines
$
sortLe
(
<=
)
$
map
showCTag
$
concat
tagInfoGroups
IO
.
try
(
writeFile
file
tags
)
try
IO
(
writeFile
file
tags
)
collateAndWriteTags
ETags
file
tagInfos
=
do
-- etags style, Emacs/XEmacs
tagInfoGroups
<-
makeTagGroupsWithSrcInfo
$
filter
tagExported
tagInfos
let
tagGroups
=
map
processGroup
tagInfoGroups
IO
.
try
(
writeFile
file
$
concat
tagGroups
)
try
IO
(
writeFile
file
$
concat
tagGroups
)
where
processGroup
[]
=
ghcError
(
CmdLineError
"empty tag file group??"
)
...
...
ghc/InteractiveUI.hs
View file @
acb9c929
...
...
@@ -81,7 +81,7 @@ import System.Environment
import
System.Exit
(
exitWith
,
ExitCode
(
..
)
)
import
System.Directory
import
System.IO
import
System.IO.Error
as
IO
import
System.IO.Error
import
Data.Char
import
Data.Array
import
Control.Monad
as
Monad
...
...
@@ -369,7 +369,7 @@ interactiveUI srcs maybe_exprs = do
withGhcAppData
::
(
FilePath
->
IO
a
)
->
IO
a
->
IO
a
withGhcAppData
right
left
=
do
either_dir
<-
IO
.
try
(
getAppUserDataDirectory
"ghc"
)
either_dir
<-
try
IO
(
getAppUserDataDirectory
"ghc"
)
case
either_dir
of
Right
dir
->
do
createDirectoryIfMissing
False
dir
`
catchIO
`
\
_
->
return
()
...
...
@@ -388,7 +388,7 @@ runGHCi paths maybe_exprs = do
(
return
Nothing
)
home_dir
=
do
either_dir
<-
liftIO
$
IO
.
try
(
getEnv
"HOME"
)
either_dir
<-
liftIO
$
try
IO
(
getEnv
"HOME"
)
case
either_dir
of
Right
home
->
return
(
Just
(
home
</>
".ghci"
))
_
->
return
Nothing
...
...
@@ -404,7 +404,7 @@ runGHCi paths maybe_exprs = do
dir_ok
<-
liftIO
$
checkPerms
(
getDirectory
file
)
file_ok
<-
liftIO
$
checkPerms
file
when
(
dir_ok
&&
file_ok
)
$
do
either_hdl
<-
liftIO
$
IO
.
try
(
openFile
file
ReadMode
)
either_hdl
<-
liftIO
$
try
IO
(
openFile
file
ReadMode
)
case
either_hdl
of
Left
_e
->
return
()
-- NOTE: this assumes that runInputT won't affect the terminal;
...
...
@@ -517,7 +517,7 @@ checkPerms name =
fileLoop
::
MonadIO
m
=>
Handle
->
InputT
m
(
Maybe
String
)
fileLoop
hdl
=
do
l
<-
liftIO
$
IO
.
try
$
hGetLine
hdl
l
<-
liftIO
$
try
IO
$
hGetLine
hdl
case
l
of
Left
e
|
isEOFError
e
->
return
Nothing
|
InvalidArgument
<-
etype
->
return
Nothing
...
...
@@ -661,7 +661,7 @@ runStmt stmt step
-- are really two stdin Handles. So we flush any bufferred data in
-- GHCi's stdin Handle here (only relevant if stdin is attached to
-- a file, otherwise the read buffer can't be flushed).
_
<-
liftIO
$
IO
.
try
$
hFlushAll
stdin
_
<-
liftIO
$
try
IO
$
hFlushAll
stdin
result
<-
GhciMonad
.
runStmt
stmt
step
afterRunStmt
(
const
True
)
result
...
...
@@ -890,7 +890,7 @@ addModule files = do
changeDirectory
::
String
->
InputT
GHCi
()
changeDirectory
""
=
do
-- :cd on its own changes to the user's home directory
either_dir
<-
liftIO
$
IO
.
try
getHomeDirectory
either_dir
<-
liftIO
$
try
IO
getHomeDirectory
case
either_dir
of
Left
_e
->
return
()
Right
dir
->
changeDirectory
dir
...
...
utils/ghc-pkg/Main.hs
View file @
acb9c929
...
...
@@ -449,7 +449,7 @@ getPkgDatabases verbosity modify use_cache my_flags = do
-- get the location of the user package database, and create it if necessary
-- getAppUserDataDirectory can fail (e.g. if $HOME isn't set)
e_appdir
<-
try
$
getAppUserDataDirectory
"ghc"
e_appdir
<-
try
IO
$
getAppUserDataDirectory
"ghc"
mb_user_conf
<-
if
no_user_db
then
return
Nothing
else
...
...
@@ -470,7 +470,7 @@ getPkgDatabases verbosity modify use_cache my_flags = do
modify
||
user_exists
=
[
user_conf
,
global_conf
]
|
otherwise
=
[
global_conf
]
e_pkg_path
<-
try
(
System
.
Environment
.
getEnv
"GHC_PACKAGE_PATH"
)
e_pkg_path
<-
try
IO
(
System
.
Environment
.
getEnv
"GHC_PACKAGE_PATH"
)
let
env_stack
=
case
e_pkg_path
of
Left
_
->
sys_databases
...
...
@@ -541,7 +541,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
|
Just
(
user_conf
,
False
)
<-
mb_user_conf
,
path
==
user_conf
=
return
PackageDB
{
location
=
path
,
packages
=
[]
}
|
otherwise
=
do
e
<-
try
$
getDirectoryContents
path
=
do
e
<-
try
IO
$
getDirectoryContents
path
case
e
of
Left
_
->
do
pkgs
<-
parseMultiPackageConf
verbosity
path
...
...
@@ -551,7 +551,7 @@ readParseDatabase verbosity mb_user_conf use_cache path
|
otherwise
->
do
let
cache
=
path
</>
cachefilename
tdir
<-
getModificationTime
path
e_tcache
<-
try
$
getModificationTime
cache
e_tcache
<-
try
IO
$
getModificationTime
cache
case
e_tcache
of
Left
ex
->
do
when
(
verbosity
>
Normal
)
$
...
...
@@ -1542,6 +1542,8 @@ catchError :: IO a -> (String -> IO a) -> IO a
catchError
io
handler
=
io
`
Exception
.
catch
`
handler'
where
handler'
(
Exception
.
ErrorCall
err
)
=
handler
err
tryIO
::
IO
a
->
IO
(
Either
Exception
.
IOException
a
)
tryIO
=
Exception
.
try
writeBinaryFileAtomic
::
Bin
.
Binary
a
=>
FilePath
->
a
->
IO
()
writeBinaryFileAtomic
targetFile
obj
=
...
...
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