From cbf16f1967c247dfd41bc264fc994b6dae2620f9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 4 Jun 2012 19:43:29 -0400
Subject: refactor

---
 Command/Watch.hs      |  1 +
 Utility/Inotify.hs    | 32 +++++---------------------------
 Utility/ThreadLock.hs | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 27 deletions(-)
 create mode 100644 Utility/ThreadLock.hs

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
-- 
cgit v1.2.3