refactor
This commit is contained in:
parent
ec98581112
commit
cbf16f1967
3 changed files with 41 additions and 27 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
35
Utility/ThreadLock.hs
Normal file
35
Utility/ThreadLock.hs
Normal 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
|
Loading…
Add table
Add a link
Reference in a new issue