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 Common.Annex
|
||||||
import Command
|
import Command
|
||||||
import Utility.Inotify
|
import Utility.Inotify
|
||||||
|
import Utility.ThreadLock
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import qualified Command.Add as Add
|
import qualified Command.Add as Add
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
|
|
|
@ -10,12 +10,10 @@
|
||||||
module Utility.Inotify where
|
module Utility.Inotify where
|
||||||
|
|
||||||
import Common hiding (isDirectory)
|
import Common hiding (isDirectory)
|
||||||
|
import Utility.ThreadLock
|
||||||
|
|
||||||
import System.INotify
|
import System.INotify
|
||||||
import qualified System.Posix.Files as Files
|
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 ())
|
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
|
watchDir i dir ignored add addsymlink del deldir
|
||||||
| ignored dir = noop
|
| ignored dir = noop
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
mvar <- newEmptyMVar
|
lock <- newLock
|
||||||
void $ addWatch i watchevents dir $ \event ->
|
void $ addWatch i watchevents dir $ \event ->
|
||||||
serialized mvar (void $ go event)
|
withLock lock (void $ go event)
|
||||||
serialized mvar $
|
withLock lock $
|
||||||
mapM_ walk =<< filter (not . dirCruft) <$>
|
mapM_ walk =<< filter (not . dirCruft) <$>
|
||||||
getDirectoryContents dir
|
getDirectoryContents dir
|
||||||
where
|
where
|
||||||
|
@ -120,23 +118,3 @@ watchDir i dir ignored add addsymlink del deldir
|
||||||
indir f = dir </> f
|
indir f = dir </> f
|
||||||
|
|
||||||
filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir 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