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 Common.Annex
import Command import Command
import Utility.Inotify import Utility.Inotify
import Utility.ThreadLock
import qualified Annex import qualified Annex
import qualified Command.Add as Add import qualified Command.Add as Add
import qualified Git.Command import qualified Git.Command

View file

@ -10,12 +10,10 @@
module Utility.Inotify where module Utility.Inotify where
import Common hiding (isDirectory) import Common hiding (isDirectory)
import Utility.ThreadLock
import System.INotify import System.INotify
import qualified System.Posix.Files as Files 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 ()) 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 watchDir i dir ignored add addsymlink del deldir
| ignored dir = noop | ignored dir = noop
| otherwise = do | otherwise = do
mvar <- newEmptyMVar lock <- newLock
void $ addWatch i watchevents dir $ \event -> void $ addWatch i watchevents dir $ \event ->
serialized mvar (void $ go event) withLock lock (void $ go event)
serialized mvar $ withLock lock $
mapM_ walk =<< filter (not . dirCruft) <$> mapM_ walk =<< filter (not . dirCruft) <$>
getDirectoryContents dir getDirectoryContents dir
where where
@ -120,23 +118,3 @@ watchDir i dir ignored add addsymlink del deldir
indir f = dir </> f indir f = dir </> f
filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir 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