summaryrefslogtreecommitdiff
path: root/Utility
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 /Utility
parentec98581112070244d5cdd69d4228aeab856ce3eb (diff)
refactor
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Inotify.hs32
-rw-r--r--Utility/ThreadLock.hs35
2 files changed, 40 insertions, 27 deletions
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