summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-04 19:43:29 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-04 19:43:29 -0400
commitcbf16f1967c247dfd41bc264fc994b6dae2620f9 (patch)
treee2401d09114e05fad32912db0a50a8af1ba404bc
parentec98581112070244d5cdd69d4228aeab856ce3eb (diff)
refactor
-rw-r--r--Command/Watch.hs1
-rw-r--r--Utility/Inotify.hs32
-rw-r--r--Utility/ThreadLock.hs35
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