diff options
author | Joey Hess <joey@kitenet.net> | 2012-06-04 19:43:29 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-06-04 19:43:29 -0400 |
commit | cbf16f1967c247dfd41bc264fc994b6dae2620f9 (patch) | |
tree | e2401d09114e05fad32912db0a50a8af1ba404bc | |
parent | ec98581112070244d5cdd69d4228aeab856ce3eb (diff) |
refactor
-rw-r--r-- | Command/Watch.hs | 1 | ||||
-rw-r--r-- | Utility/Inotify.hs | 32 | ||||
-rw-r--r-- | Utility/ThreadLock.hs | 35 |
3 files changed, 41 insertions, 27 deletions
diff --git a/Command/Watch.hs b/Command/Watch.hs index 4a0ee6640..31f171669 100644 --- a/Command/Watch.hs +++ b/Command/Watch.hs @@ -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 diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs index ff3de81b1..3c69a7ee2 100644 --- a/Utility/Inotify.hs +++ b/Utility/Inotify.hs @@ -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 diff --git a/Utility/ThreadLock.hs b/Utility/ThreadLock.hs new file mode 100644 index 000000000..4285c0ec5 --- /dev/null +++ b/Utility/ThreadLock.hs @@ -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 |