From 6b074fb7e741020b81d696bd66e62f75fd472966 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 12 Nov 2015 18:05:45 -0400 Subject: convert from Utility.LockPool to Annex.LockPool everywhere --- Annex/Content.hs | 16 ++++++++-------- Annex/LockFile.hs | 12 ++++++------ Annex/LockPool/PosixOrPid.hs | 14 +++++++++++++- Annex/Ssh.hs | 4 ++-- Annex/Transfer.hs | 14 ++++++++------ 5 files changed, 37 insertions(+), 23 deletions(-) (limited to 'Annex') diff --git a/Annex/Content.hs b/Annex/Content.hs index bc28cc6b4..5990d194a 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -62,7 +62,7 @@ import Annex.Perms import Annex.Link import Annex.Content.Direct import Annex.ReplaceFile -import Utility.LockPool +import Annex.LockPool import Messages.Progress import qualified Types.Remote import qualified Types.Backend @@ -113,12 +113,12 @@ inAnnexSafe key = inAnnex' (fromMaybe True) (Just False) go key =<< contentLockFile key #ifndef mingw32_HOST_OS - checkindirect contentfile = liftIO $ checkOr is_missing contentfile + checkindirect contentfile = checkOr is_missing contentfile {- In direct mode, the content file must exist, but - the lock file generally won't exist unless a removal is in - process. -} - checkdirect contentfile lockfile = liftIO $ - ifM (doesFileExist contentfile) + checkdirect contentfile lockfile = + ifM (liftIO $ doesFileExist contentfile) ( checkOr is_unlocked lockfile , return is_missing ) @@ -186,7 +186,7 @@ lockContentShared key a = lockContentUsing lock key $ do withVerifiedCopy LockedCopy u (return True) a where #ifndef mingw32_HOST_OS - lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile + lock contentfile Nothing = tryLockShared Nothing contentfile lock _ (Just lockfile) = posixLocker tryLockShared lockfile #else lock = winLocker lockShared @@ -205,7 +205,7 @@ lockContentForRemoval key a = lockContentUsing lock key $ lock contentfile Nothing = bracket_ (thawContent contentfile) (freezeContent contentfile) - (liftIO $ tryLockExclusive Nothing contentfile) + (tryLockExclusive Nothing contentfile) lock _ (Just lockfile) = posixLocker tryLockExclusive lockfile #else lock = winLocker lockExclusive @@ -216,11 +216,11 @@ lockContentForRemoval key a = lockContentUsing lock key $ type ContentLocker = FilePath -> Maybe LockFile -> Annex (Maybe LockHandle) #ifndef mingw32_HOST_OS -posixLocker :: (Maybe FileMode -> LockFile -> IO (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle) +posixLocker :: (Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle) posixLocker takelock lockfile = do mode <- annexFileMode modifyContent lockfile $ - liftIO $ takelock (Just mode) lockfile + takelock (Just mode) lockfile #else winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index 928b36ec5..40f9c6b2a 100644 --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -20,7 +20,7 @@ import Annex import Types.LockCache import qualified Git import Annex.Perms -import Utility.LockPool +import Annex.LockPool import qualified Data.Map as M @@ -33,7 +33,7 @@ lockFileCached file = go =<< fromLockCache file go Nothing = do #ifndef mingw32_HOST_OS mode <- annexFileMode - lockhandle <- liftIO $ noUmask mode $ lockShared (Just mode) file + lockhandle <- noUmask mode $ lockShared (Just mode) file #else lockhandle <- liftIO $ waitToLock $ lockShared file #endif @@ -64,12 +64,12 @@ withExclusiveLock getlockfile a = do lockfile <- fromRepo getlockfile createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode - bracketIO (lock mode lockfile) dropLock (const a) + bracket (lock mode lockfile) (liftIO . dropLock) (const a) where #ifndef mingw32_HOST_OS lock mode = noUmask mode . lockExclusive (Just mode) #else - lock _mode = waitToLock . lockExclusive + lock _mode = liftIO . waitToLock . lockExclusive #endif {- Tries to take an exclusive lock and run an action. If the lock is @@ -79,12 +79,12 @@ tryExclusiveLock getlockfile a = do lockfile <- fromRepo getlockfile createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode - bracketIO (lock mode lockfile) unlock go + bracket (lock mode lockfile) (liftIO . unlock) go where #ifndef mingw32_HOST_OS lock mode = noUmask mode . tryLockExclusive (Just mode) #else - lock _mode = lockExclusive + lock _mode = liftIO . lockExclusive #endif unlock = maybe noop dropLock go Nothing = return Nothing diff --git a/Annex/LockPool/PosixOrPid.hs b/Annex/LockPool/PosixOrPid.hs index 71c4f0eee..cc1411800 100644 --- a/Annex/LockPool/PosixOrPid.hs +++ b/Annex/LockPool/PosixOrPid.hs @@ -6,7 +6,19 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.LockPool.PosixOrPid where +module Annex.LockPool.PosixOrPid ( + LockFile, + LockHandle, + lockShared, + lockExclusive, + tryLockShared, + tryLockExclusive, + dropLock, + checkLocked, + LockStatus(..), + getLockStatus, + checkSaneLock, +) where import Common.Annex import qualified Annex diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 9d716cdc8..c9325bb7d 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -37,7 +37,7 @@ import Types.CleanupActions import Annex.Index (addGitEnv) #ifndef mingw32_HOST_OS import Annex.Perms -import Utility.LockPool +import Annex.LockPool #endif {- Generates parameters to ssh to a given host (or user@host) on a given @@ -159,7 +159,7 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles let lockfile = socket2lock socketfile unlockFile lockfile mode <- annexFileMode - v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lockfile + v <- noUmask mode $ tryLockExclusive (Just mode) lockfile case v of Nothing -> noop Just lck -> do diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index e72f737ea..2b0c12c8a 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -23,7 +23,7 @@ import Logs.Transfer as X import Annex.Notification as X import Annex.Perms import Utility.Metered -import Utility.LockPool +import Annex.LockPool import Types.Remote (Verification(..)) import Control.Concurrent @@ -79,7 +79,7 @@ runTransfer' ignorelock t file shouldretry transferobserver transferaction = do info <- liftIO $ startTransferInfo file (meter, tfile, metervar) <- mkProgressUpdater t info mode <- annexFileMode - (lck, inprogress) <- liftIO $ prep tfile mode info + (lck, inprogress) <- prep tfile mode info if inprogress && not ignorelock then do showNote "transfer already in progress, or unable to take transfer lock" @@ -96,21 +96,23 @@ runTransfer' ignorelock t file shouldretry transferobserver transferaction = do r <- tryLockExclusive (Just mode) lck case r of Nothing -> return (Nothing, True) - Just lockhandle -> ifM (checkSaneLock lck lockhandle) + Just lockhandle -> ifM (liftIO $ checkSaneLock lck lockhandle) ( do - void $ tryIO $ writeTransferInfoFile info tfile + void $ liftIO $ tryIO $ + writeTransferInfoFile info tfile return (Just lockhandle, False) , return (Nothing, True) ) #else - prep tfile _mode info = do + prep tfile _mode info = liftIO $ do let lck = transferLockFile tfile v <- catchMaybeIO $ lockExclusive lck case v of Nothing -> return (Nothing, False) Just Nothing -> return (Nothing, True) Just (Just lockhandle) -> do - void $ tryIO $ writeTransferInfoFile info tfile + void $ liftIO $ tryIO $ + writeTransferInfoFile info tfile return (Just lockhandle, False) #endif cleanup _ Nothing = noop -- cgit v1.2.3