{-# 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
{ confDebounce :: Debounce
confDebounce = Debounce
DebounceDefault
, confPollInterval :: Int
confPollInterval = Int
10forall a b. (Num a, Integral b) => a -> b -> a
^(Int
6 :: Int)
, confUsePolling :: Bool
confUsePolling = Bool
False
}
withManager :: (WatchManager -> IO a) -> IO a
withManager :: forall a. (WatchManager -> IO a) -> IO a
withManager = 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 <- forall a. MVar a -> a -> IO a
swapMVar MVar (Maybe (IO ()))
cleanupVar forall a. Maybe a
Nothing
forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (IO ())
mbCleanup
forall sessionType.
FileListener sessionType =>
sessionType -> IO ()
killSession manager
wm
withManagerConf :: WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf :: forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf WatchConfig
conf = 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 = forall sessionType.
FileListener sessionType =>
IO (Maybe sessionType)
initSession 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) =
forall manager.
FileListener manager =>
WatchConfig -> manager -> MVar (Maybe (IO ())) -> WatchManager
WatchManager WatchConfig
conf NativeManager
nativeManager 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 =
forall manager.
FileListener manager =>
WatchConfig -> manager -> MVar (Maybe (IO ())) -> WatchManager
WatchManager WatchConfig
conf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PollManager
createPollManager forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar (Maybe (IO ())))
cleanupVar
cleanupVar :: IO (MVar (Maybe (IO ())))
cleanupVar = forall a. a -> IO (MVar a)
newMVar (forall a. a -> Maybe a
Just (forall (m :: * -> *) a. Monad m => a -> m a
return ()))
isPollingManager :: WatchManager -> Bool
isPollingManager :: WatchManager -> Bool
isPollingManager (WatchManager WatchConfig
_ manager
wm MVar (Maybe (IO ()))
_) = 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 ()))
_) = 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 ()))
_) = 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 =
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (Maybe (IO ()))
cleanupVar forall a b. (a -> b) -> a -> b
$ \Maybe (IO ())
mbCleanup -> case Maybe (IO ())
mbCleanup of
Maybe (IO ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall (m :: * -> *) a. Monad m => a -> m a
return ())
Just IO ()
cleanup -> do
EventChannel
chan <- forall a. IO (Chan a)
newChan
Async ()
asy <- forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ EventChannel -> Action -> IO ()
readEvents EventChannel
chan Action
action
IO ()
stopListener <- 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 = forall a. Async a -> IO ()
cancel Async ()
asy
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ IO ()
cleanup forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
cleanThisUp
, IO ()
stopListener 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 = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Event
event <- forall a. Chan a -> IO a
readChan EventChannel
chan
ThreadId
us <- IO ThreadId
myThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (Action
action Event
event) forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
us) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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