aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Content.hs3
-rw-r--r--Annex/Journal.hs2
-rw-r--r--Annex/Ssh.hs4
-rw-r--r--Backend.hs3
-rw-r--r--CmdLine.hs3
-rw-r--r--Command/Fsck.hs2
-rw-r--r--Common.hs1
-rw-r--r--Remote/Bup.hs3
-rw-r--r--Upgrade/V0.hs4
-rw-r--r--Upgrade/V1.hs5
-rw-r--r--Utility/Directory.hs8
-rw-r--r--Utility/Exception.hs39
-rw-r--r--Utility/Misc.hs21
-rw-r--r--Utility/TempFile.hs2
14 files changed, 56 insertions, 44 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index dcfd43866..d10370bc9 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -25,7 +25,6 @@ module Annex.Content (
preseedTmp,
) where
-import System.IO.Error (try)
import Control.Exception (bracket_)
import System.Posix.Types
@@ -79,7 +78,7 @@ lockContent key a = do
where
lock Nothing = return Nothing
lock (Just l) = do
- v <- try $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
+ v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
case v of
Left _ -> error "content is locked"
Right _ -> return $ Just l
diff --git a/Annex/Journal.hs b/Annex/Journal.hs
index 9c5be89b1..34c4d98c8 100644
--- a/Annex/Journal.hs
+++ b/Annex/Journal.hs
@@ -91,4 +91,4 @@ lockJournal a = do
{- Runs an action, catching failure and running something to fix it up, and
- retrying if necessary. -}
doRedo :: IO a -> IO b -> IO a
-doRedo a b = catch a $ const $ b >> a
+doRedo a b = catchIO a $ const $ b >> a
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 14ea74e53..d6f36e868 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -11,7 +11,6 @@ module Annex.Ssh (
) where
import qualified Data.Map as M
-import System.IO.Error (try)
import Common.Annex
import Annex.LockPool
@@ -72,7 +71,8 @@ sshCleanup = do
let lockfile = socket2lock socketfile
unlockFile lockfile
fd <- liftIO $ openFd lockfile ReadWrite (Just stdFileMode) defaultFileFlags
- v <- liftIO $ try $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+ v <- liftIO $ tryIO $
+ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
case v of
Left _ -> return ()
Right _ -> stopssh socketfile
diff --git a/Backend.hs b/Backend.hs
index 003d62bfc..e351bb3b2 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -16,7 +16,6 @@ module Backend (
maybeLookupBackendName
) where
-import System.IO.Error (try)
import System.Posix.Files
import Common.Annex
@@ -77,7 +76,7 @@ genKey' (b:bs) file = do
- by examining what the file symlinks to. -}
lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile file = do
- tl <- liftIO $ try getsymlink
+ tl <- liftIO $ tryIO getsymlink
case tl of
Left _ -> return Nothing
Right l -> makekey l
diff --git a/CmdLine.hs b/CmdLine.hs
index 61e6c26bb..18bb5fe51 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -11,7 +11,6 @@ module CmdLine (
shutdown
) where
-import qualified System.IO.Error as IO
import qualified Control.Exception as E
import Control.Exception (throw)
import System.Console.GetOpt
@@ -74,7 +73,7 @@ tryRun' errnum _ cmd []
| otherwise = return ()
tryRun' errnum state cmd (a:as) = run >>= handle
where
- run = IO.try $ Annex.run state $ do
+ run = tryIO $ Annex.run state $ do
Annex.Queue.flushWhenFull
a
handle (Left err) = showerr err >> cont False state
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 59af29edb..469fad749 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -81,7 +81,7 @@ performRemote key file backend numcopies remote = do
t <- fromRepo gitAnnexTmpDir
let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
liftIO $ createDirectoryIfMissing True t
- let cleanup = liftIO $ catch (removeFile tmp) (const $ return ())
+ let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ())
cleanup
cleanup `after` a tmp
getfile tmp = do
diff --git a/Common.hs b/Common.hs
index fb998214b..cc6cf9252 100644
--- a/Common.hs
+++ b/Common.hs
@@ -21,6 +21,7 @@ import System.Posix.Process as X hiding (executeFile)
import System.Exit as X
import Utility.Misc as X
+import Utility.Exception as X
import Utility.SafeCommand as X
import Utility.Path as X
import Utility.Directory as X
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9b54d8c85..50c3b10b3 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -8,7 +8,6 @@
module Remote.Bup (remote) where
import qualified Data.ByteString.Lazy.Char8 as L
-import System.IO.Error
import qualified Data.Map as M
import System.Process
@@ -200,7 +199,7 @@ getBupUUID :: Git.Repo -> UUID -> Annex (UUID, Git.Repo)
getBupUUID r u
| Git.repoIsUrl r = return (u, r)
| otherwise = liftIO $ do
- ret <- try $ Git.Config.read r
+ ret <- tryIO $ Git.Config.read r
case ret of
Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r')
Left _ -> return (NoUUID, r)
diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs
index c5310c641..c439c7caa 100644
--- a/Upgrade/V0.hs
+++ b/Upgrade/V0.hs
@@ -7,8 +7,6 @@
module Upgrade.V0 where
-import System.IO.Error (try)
-
import Common.Annex
import Annex.Content
import qualified Upgrade.V1
@@ -47,7 +45,7 @@ getKeysPresent0 dir = do
return $ map fileKey0 files
where
present d = do
- result <- try $
+ result <- tryIO $
getFileStatus $ dir ++ "/" ++ takeFileName d
case result of
Right s -> return $ isRegularFile s
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index add50fcf3..ca2bff661 100644
--- a/Upgrade/V1.hs
+++ b/Upgrade/V1.hs
@@ -7,7 +7,6 @@
module Upgrade.V1 where
-import System.IO.Error (try)
import System.Posix.Types
import Data.Char
@@ -183,7 +182,7 @@ readLog1 file = catchDefaultIO (parseLog <$> readFileStrict file) []
lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend))
lookupFile1 file = do
- tl <- liftIO $ try getsymlink
+ tl <- liftIO $ tryIO getsymlink
case tl of
Left _ -> return Nothing
Right l -> makekey l
@@ -216,7 +215,7 @@ getKeyFilesPresent1' dir = do
liftIO $ filterM present files
where
present f = do
- result <- try $ getFileStatus f
+ result <- tryIO $ getFileStatus f
case result of
Right s -> return $ isRegularFile s
Left _ -> return False
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-10 11:36:39 +0000