{-# LANGUAGE CPP, ScopedTypeVariables, ExistentialQuantification, RankNTypes #-}
module System.FSNotify
(
Event(..)
, EventChannel
, eventIsDirectory
, eventTime
, eventPath
, Action
, ActionPredicate
, WatchManager
, withManager
, startManager
, stopManager
, defaultConfig
, WatchConfig(..)
, Debounce(..)
, withManagerConf
, startManagerConf
, StopListening
, isPollingManager
, watchDir
, watchDirChan
, watchTree
, watchTreeChan
) where
import Prelude hiding (FilePath)
import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import Data.Maybe
import System.FSNotify.Polling
import System.FSNotify.Types
import System.FilePath
import System.FSNotify.Listener (StopListening)
#ifdef OS_Linux
import System.FSNotify.Linux
#else
# ifdef OS_Win32
import System.FSNotify.Win32
# else
# ifdef OS_Mac
import System.FSNotify.OSX
# else
type NativeManager = PollManager
# endif
# endif
#endif
data WatchManager
= forall manager . FileListener manager
=> WatchManager
WatchConfig
manager
(MVar (Maybe (IO ())))
defaultConfig :: WatchConfig
defaultConfig :: WatchConfig
defaultConfig =
WatchConfig :: Debounce -> Int -> Bool -> WatchConfig
WatchConfig
{ confDebounce :: Debounce
confDebounce = Debounce
DebounceDefault
, confPollInterval :: Int
confPollInterval = Int
10Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)
, confUsePolling :: Bool
confUsePolling = Bool
False
}
withManager :: (WatchManager -> IO a) -> IO a
withManager :: (WatchManager -> IO a) -> IO a
withManager = WatchConfig -> (WatchManager -> IO a) -> IO a
forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf WatchConfig
defaultConfig
startManager :: IO WatchManager
startManager :: IO WatchManager
startManager = WatchConfig -> IO WatchManager
startManagerConf WatchConfig
defaultConfig
stopManager :: WatchManager -> IO ()
stopManager :: WatchManager -> IO ()
stopManager (WatchManager WatchConfig
_ manager
wm MVar (Maybe (IO ()))
cleanupVar) = do
Maybe (IO ())
mbCleanup <- MVar (Maybe (IO ())) -> Maybe (IO ()) -> IO (Maybe (IO ()))
forall a. MVar a -> a -> IO a
swapMVar MVar (Maybe (IO ()))
cleanupVar Maybe (IO ())
forall a. Maybe a
Nothing
IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (IO ())
mbCleanup
manager -> IO ()
forall sessionType.
FileListener sessionType =>
sessionType -> IO ()
killSession manager
wm
withManagerConf :: WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf :: WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf WatchConfig
conf = IO WatchManager
-> (WatchManager -> IO ()) -> (WatchManager -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (WatchConfig -> IO WatchManager
startManagerConf WatchConfig
conf) WatchManager -> IO ()
stopManager
startManagerConf :: WatchConfig -> IO WatchManager
startManagerConf :: WatchConfig -> IO WatchManager
startManagerConf WatchConfig
conf
| WatchConfig -> Bool
confUsePolling WatchConfig
conf = IO WatchManager
pollingManager
| Bool
otherwise = IO (Maybe NativeManager)
forall sessionType.
FileListener sessionType =>
IO (Maybe sessionType)
initSession IO (Maybe NativeManager)
-> (Maybe NativeManager -> IO WatchManager) -> IO WatchManager
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe NativeManager -> IO WatchManager
createManager
where
createManager :: Maybe NativeManager -> IO WatchManager
createManager :: Maybe NativeManager -> IO WatchManager
createManager (Just NativeManager
nativeManager) =
WatchConfig
-> NativeManager -> MVar (Maybe (IO ())) -> WatchManager
forall manager.
FileListener manager =>
WatchConfig -> manager -> MVar (Maybe (IO ())) -> WatchManager
WatchManager WatchConfig
conf NativeManager
nativeManager (MVar (Maybe (IO ())) -> WatchManager)
-> IO (MVar (Maybe (IO ()))) -> IO WatchManager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (MVar (Maybe (IO ())))
cleanupVar
createManager Maybe NativeManager
Nothing = IO WatchManager
pollingManager
pollingManager :: IO WatchManager
pollingManager =
WatchConfig -> PollManager -> MVar (Maybe (IO ())) -> WatchManager
forall manager.
FileListener manager =>
WatchConfig -> manager -> MVar (Maybe (IO ())) -> WatchManager
WatchManager WatchConfig
conf (PollManager -> MVar (Maybe (IO ())) -> WatchManager)
-> IO PollManager -> IO (MVar (Maybe (IO ())) -> WatchManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PollManager
createPollManager IO (MVar (Maybe (IO ())) -> WatchManager)
-> IO (MVar (Maybe (IO ()))) -> IO WatchManager
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar (Maybe (IO ())))
cleanupVar
cleanupVar :: IO (MVar (Maybe (IO ())))
cleanupVar = Maybe (IO ()) -> IO (MVar (Maybe (IO ())))
forall a. a -> IO (MVar a)
newMVar (IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
isPollingManager :: WatchManager -> Bool
isPollingManager :: WatchManager -> Bool
isPollingManager (WatchManager WatchConfig
_ manager
wm MVar (Maybe (IO ()))
_) = manager -> Bool
forall sessionType. FileListener sessionType => sessionType -> Bool
usesPolling manager
wm
watchDirChan :: WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
watchDirChan :: WatchManager
-> FilePath -> ActionPredicate -> EventChannel -> IO (IO ())
watchDirChan (WatchManager WatchConfig
db manager
wm MVar (Maybe (IO ()))
_) = WatchConfig
-> manager
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
listen WatchConfig
db manager
wm
watchTreeChan :: WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
watchTreeChan :: WatchManager
-> FilePath -> ActionPredicate -> EventChannel -> IO (IO ())
watchTreeChan (WatchManager WatchConfig
db manager
wm MVar (Maybe (IO ()))
_) = WatchConfig
-> manager
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
listenRecursive WatchConfig
db manager
wm
watchDir :: WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
watchDir :: WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchDir WatchManager
wm = (forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ()))
-> WatchManager
-> FilePath
-> ActionPredicate
-> Action
-> IO (IO ())
threadChan forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
listen WatchManager
wm
watchTree :: WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
watchTree :: WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchTree WatchManager
wm = (forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ()))
-> WatchManager
-> FilePath
-> ActionPredicate
-> Action
-> IO (IO ())
threadChan forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
listenRecursive WatchManager
wm
threadChan
:: (forall sessionType . FileListener sessionType =>
WatchConfig -> sessionType -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening)
-> WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
threadChan :: (forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ()))
-> WatchManager
-> FilePath
-> ActionPredicate
-> Action
-> IO (IO ())
threadChan forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
listenFn (WatchManager WatchConfig
db manager
listener MVar (Maybe (IO ()))
cleanupVar) FilePath
path ActionPredicate
actPred Action
action =
MVar (Maybe (IO ()))
-> (Maybe (IO ()) -> IO (Maybe (IO ()), IO ())) -> IO (IO ())
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe (IO ()))
cleanupVar ((Maybe (IO ()) -> IO (Maybe (IO ()), IO ())) -> IO (IO ()))
-> (Maybe (IO ()) -> IO (Maybe (IO ()), IO ())) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ \Maybe (IO ())
mbCleanup -> case Maybe (IO ())
mbCleanup of
Maybe (IO ())
Nothing -> (Maybe (IO ()), IO ()) -> IO (Maybe (IO ()), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IO ())
forall a. Maybe a
Nothing, () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
Just IO ()
cleanup -> do
EventChannel
chan <- IO EventChannel
forall a. IO (Chan a)
newChan
Async ()
asy <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ EventChannel -> Action -> IO ()
readEvents EventChannel
chan Action
action
IO ()
stopListener <- WatchConfig
-> manager
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
forall sessionType.
FileListener sessionType =>
WatchConfig
-> sessionType
-> FilePath
-> ActionPredicate
-> EventChannel
-> IO (IO ())
listenFn WatchConfig
db manager
listener FilePath
path ActionPredicate
actPred EventChannel
chan
let cleanThisUp :: IO ()
cleanThisUp = Async () -> IO ()
forall a. Async a -> IO ()
cancel Async ()
asy
(Maybe (IO ()), IO ()) -> IO (Maybe (IO ()), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return
( IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ IO ()
cleanup IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
cleanThisUp
, IO ()
stopListener IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
cleanThisUp
)
readEvents :: EventChannel -> Action -> IO ()
readEvents :: EventChannel -> Action -> IO ()
readEvents EventChannel
chan Action
action = IO ThreadId -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Event
event <- EventChannel -> IO Event
forall a. Chan a -> IO a
readChan EventChannel
chan
ThreadId
us <- IO ThreadId
myThreadId
IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (Action
action Event
event) ((Either SomeException () -> IO ()) -> IO ThreadId)
-> (Either SomeException () -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ThreadId -> SomeException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
us) (IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
#if !MIN_VERSION_base(4,6,0)
forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally action and_then =
mask $ \restore ->
forkIO $ try (restore action) >>= and_then
#endif