summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-02-03 16:47:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-02-03 16:47:24 -0400
commit146c36ca545a297f1e44e3cf2c91f3c0e17c909f (patch)
tree56d6fb274427bb793155182aed7e92e2e00895ba /Utility
parent05f89123e08075cfbd136f37c60423c1ad38d1fe (diff)
IO exception rework
ghc 7.4 comaplains about use of System.IO.Error to catch exceptions. Ok, use Control.Exception, with variants specialized to only catch IO exceptions.
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Directory.hs8
-rw-r--r--Utility/Exception.hs39
-rw-r--r--Utility/Misc.hs21
-rw-r--r--Utility/TempFile.hs2
4 files changed, 44 insertions, 26 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index b5fedb9c7..e7b7c442b 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -16,11 +16,12 @@ import Control.Monad.IfElse
import Utility.SafeCommand
import Utility.TempFile
+import Utility.Exception
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}
moveFile :: FilePath -> FilePath -> IO ()
-moveFile src dest = try (rename src dest) >>= onrename
+moveFile src dest = tryIO (rename src dest) >>= onrename
where
onrename (Right _) = return ()
onrename (Left e)
@@ -40,11 +41,10 @@ moveFile src dest = try (rename src dest) >>= onrename
Param src, Param tmp]
unless ok $ do
-- delete any partial
- _ <- try $
- removeFile tmp
+ _ <- tryIO $ removeFile tmp
rethrow
isdir f = do
- r <- try (getFileStatus f)
+ r <- tryIO $ getFileStatus f
case r of
(Left _) -> return False
(Right s) -> return $ isDirectory s
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
new file mode 100644
index 000000000..7b6c9c999
--- /dev/null
+++ b/Utility/Exception.hs
@@ -0,0 +1,39 @@
+{- Simple IO exception handling
+ -
+ - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Exception where
+
+import Prelude hiding (catch)
+import Control.Exception
+import Control.Applicative
+
+{- Catches IO errors and returns a Bool -}
+catchBoolIO :: IO Bool -> IO Bool
+catchBoolIO a = catchDefaultIO a False
+
+{- Catches IO errors and returns a Maybe -}
+catchMaybeIO :: IO a -> IO (Maybe a)
+catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
+
+{- Catches IO errors and returns a default value. -}
+catchDefaultIO :: IO a -> a -> IO a
+catchDefaultIO a def = catchIO a (const $ return def)
+
+{- Catches IO errors and returns the error message. -}
+catchMsgIO :: IO a -> IO (Either String a)
+catchMsgIO a = dispatch <$> tryIO a
+ where
+ dispatch (Left e) = Left $ show e
+ dispatch (Right v) = Right v
+
+{- catch specialized for IO errors only -}
+catchIO :: IO a -> (IOException -> IO a) -> IO a
+catchIO = catch
+
+{- try specialized for IO errors only -}
+tryIO :: IO a -> IO (Either IOException a)
+tryIO = try
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index c9bfcb953..3ac5ca5c0 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -8,9 +8,7 @@
module Utility.Misc where
import System.IO
-import System.IO.Error (try)
import Control.Monad
-import Control.Applicative
{- A version of hgetContents that is not lazy. Ensures file is
- all read before it gets closed. -}
@@ -37,22 +35,3 @@ separate c l = unbreak $ break c l
{- Breaks out the first line. -}
firstLine :: String-> String
firstLine = takeWhile (/= '\n')
-
-{- Catches IO errors and returns a Bool -}
-catchBoolIO :: IO Bool -> IO Bool
-catchBoolIO a = catchDefaultIO a False
-
-{- Catches IO errors and returns a Maybe -}
-catchMaybeIO :: IO a -> IO (Maybe a)
-catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
-
-{- Catches IO errors and returns a default value. -}
-catchDefaultIO :: IO a -> a -> IO a
-catchDefaultIO a def = catch a (const $ return def)
-
-{- Catches IO errors and returns the error message. -}
-catchMsgIO :: IO a -> IO (Either String a)
-catchMsgIO a = dispatch <$> try a
- where
- dispatch (Left e) = Left $ show e
- dispatch (Right v) = Right v
diff --git a/Utility/TempFile.hs b/Utility/TempFile.hs
index 469d52e8c..4dcbf1cca 100644
--- a/Utility/TempFile.hs
+++ b/Utility/TempFile.hs
@@ -12,7 +12,7 @@ import System.IO
import System.Posix.Process hiding (executeFile)
import System.Directory
-import Utility.Misc
+import Utility.Exception
import Utility.Path
{- Runs an action like writeFile, writing to a temp file first and