convert from Utility.LockPool to Annex.LockPool everywhere
authorJoey Hess <joeyh@joeyh.name>
Thu, 12 Nov 2015 22:05:45 +0000 (18:05 -0400)
committerJoey Hess <joeyh@joeyh.name>
Thu, 12 Nov 2015 22:13:37 +0000 (18:13 -0400)
Annex/Content.hs
Annex/LockFile.hs
Annex/LockPool/PosixOrPid.hs
Annex/Ssh.hs
Annex/Transfer.hs
Logs/Transfer.hs
Remote/Helper/Hooks.hs
Types/LockCache.hs

index bc28cc6b4c9eda51e8949b63a053730812ff7cf1..5990d194a9b8e7a62087c84ceccae80b72bf3f34 100644 (file)
@@ -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
index 928b36ec5b3a51927f8ae4b3c7d8d3665853ee5b..40f9c6b2a6379d248c720f613cf42fb28083fa52 100644 (file)
@@ -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
index 71c4f0eee58b801b8860f76896b63e76dedb96b1..cc14118008c6735b7412a21b871a1e1a332c31fa 100644 (file)
@@ -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
index 9d716cdc89dc90975a62cc59f6b5347d2867d057..c9325bb7dcdaf46a7203fa01a33c749e70b754cd 100644 (file)
@@ -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
index e72f737ea7871d9dd75c7f1b1550abc8beee8959..2b0c12c8a168cce1bc117c37c55c059a39742eb3 100644 (file)
@@ -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
index af6d19da6145099ec19a879a8f7d86379632c92c..43d097354a884aaa8b971939466d85c247c0eac0 100644 (file)
@@ -17,7 +17,7 @@ import Utility.Metered
 import Utility.Percentage
 import Utility.QuickCheck
 import Utility.PID
-import Utility.LockPool
+import Annex.LockPool
 import Logs.TimeStamp
 
 import Data.Time.Clock
@@ -136,25 +136,24 @@ checkTransfer t = do
                void $ tryIO $ removeFile tfile
                void $ tryIO $ removeFile $ transferLockFile tfile
 #ifndef mingw32_HOST_OS
-       liftIO $ do
-               let lck = transferLockFile tfile
-               v <- getLockStatus lck
-               case v of
-                       StatusLockedBy pid -> catchDefaultIO Nothing $
-                               readTransferInfoFile (Just pid) tfile
-                       StatusNoLockFile -> return Nothing
-                       StatusUnLocked -> do
-                               -- Take a non-blocking lock while deleting
-                               -- the stale lock file. Ignore failure
-                               -- due to permissions problems, races, etc.
-                               void $ tryIO $ do
-                                       r <- tryLockExclusive Nothing lck
-                                       case r of
-                                               Just lockhandle -> do
-                                                       cleanstale
-                                                       dropLock lockhandle
-                                               _ -> noop
-                               return Nothing
+       let lck = transferLockFile tfile
+       v <- getLockStatus lck
+       case v of
+               StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $
+                       readTransferInfoFile (Just pid) tfile
+               StatusNoLockFile -> return Nothing
+               StatusUnLocked -> do
+                       -- Take a non-blocking lock while deleting
+                       -- the stale lock file. Ignore failure
+                       -- due to permissions problems, races, etc.
+                       void $ tryIO $ do
+                               r <- tryLockExclusive Nothing lck
+                               case r of
+                                       Just lockhandle -> liftIO $ do
+                                               cleanstale
+                                               dropLock lockhandle
+                                       _ -> noop
+                       return Nothing
 #else
        v <- liftIO $ lockShared $ transferLockFile tfile
        liftIO $ case v of
index 1f46eaa4b99ccd9f936ae7028f64b2ec3f3f7318..96cca242e053b6a8b4f63ee90715988b2cc696f5 100644 (file)
@@ -16,7 +16,7 @@ import Types.Remote
 import Types.CleanupActions
 import qualified Annex
 import Annex.LockFile
-import Utility.LockPool
+import Annex.LockPool
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 #endif
@@ -83,7 +83,7 @@ runHooks r starthook stophook a = do
                unlockFile lck
 #ifndef mingw32_HOST_OS
                mode <- annexFileMode
-               v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lck
+               v <- noUmask mode $ tryLockExclusive (Just mode) lck
 #else
                v <- liftIO $ lockExclusive lck
 #endif
index c1f394cf0ff0c493e23f933a6f8f9493f1cc9d6e..8e0fd2c3800c876ec312cc5caeb9810e73a4abe2 100644 (file)
@@ -11,6 +11,6 @@ module Types.LockCache (
 ) where
 
 import qualified Data.Map as M
-import Utility.LockPool
+import Utility.LockPool (LockHandle)
 
 type LockCache = M.Map FilePath LockHandle