This commit is contained in:
Joey Hess 2012-06-04 19:43:29 -04:00
parent ec98581112
commit cbf16f1967
3 changed files with 41 additions and 27 deletions

View file

@ -11,6 +11,7 @@ import CmdLine
import Common.Annex
import Command
import Utility.Inotify
import Utility.ThreadLock
import qualified Annex
import qualified Command.Add as Add
import qualified Git.Command

View file

@ -10,12 +10,10 @@
module Utility.Inotify where
import Common hiding (isDirectory)
import Utility.ThreadLock
import System.INotify
import qualified System.Posix.Files as Files
import System.Posix.Terminal
import Control.Concurrent.MVar
import System.Posix.Signals
import Control.Exception as E
type Hook = Maybe (FilePath -> IO ())
@ -53,10 +51,10 @@ watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Hook -> Hook -> Hook ->
watchDir i dir ignored add addsymlink del deldir
| ignored dir = noop
| otherwise = do
mvar <- newEmptyMVar
lock <- newLock
void $ addWatch i watchevents dir $ \event ->
serialized mvar (void $ go event)
serialized mvar $
withLock lock (void $ go event)
withLock lock $
mapM_ walk =<< filter (not . dirCruft) <$>
getDirectoryContents dir
where
@ -120,23 +118,3 @@ watchDir i dir ignored add addsymlink del deldir
indir f = dir </> f
filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
{- Uses an MVar to serialize an action, so that only one thread at a time
- runs it. -}
serialized :: MVar () -> IO () -> IO ()
serialized mvar a = void $ do
putMVar mvar () -- blocks if action already running
_ <- E.try a :: IO (Either E.SomeException ())
takeMVar mvar -- allow next action to run
{- Pauses the main thread, letting children run until program termination. -}
waitForTermination :: IO ()
waitForTermination = do
mvar <- newEmptyMVar
check softwareTermination mvar
whenM (queryTerminal stdInput) $
check keyboardSignal mvar
takeMVar mvar
where
check sig mvar = void $
installHandler sig (CatchOnce $ putMVar mvar ()) Nothing

35
Utility/ThreadLock.hs Normal file
View file

@ -0,0 +1,35 @@
{- locking between threads
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.ThreadLock where
import Common
import System.Posix.Terminal
import Control.Concurrent.MVar
import System.Posix.Signals
type Lock = MVar ()
newLock :: IO Lock
newLock = newMVar ()
{- Runs an action with a lock held, so only one thread at a time can run it. -}
withLock :: Lock -> IO a -> IO a
withLock lock = withMVar lock . const
{- Pauses the main thread, letting children run until program termination. -}
waitForTermination :: IO ()
waitForTermination = do
lock <- newEmptyMVar
check softwareTermination lock
whenM (queryTerminal stdInput) $
check keyboardSignal lock
takeMVar lock
where
check sig lock = void $
installHandler sig (CatchOnce $ putMVar lock ()) Nothing