    --
    -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
    -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
    --
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}

    -- | This library does not currently report changes made to directories,
    -- only files within watched directories.
    --
    -- Minimal example:
    --
    -- >{-# LANGUAGE OverloadedStrings #-} -- for FilePath literals
    -- >
    -- >import System.FSNotify
    -- >import Control.Concurrent (threadDelay)
    -- >import Control.Monad (forever)
    -- >
    -- >main =
    -- >  withManager $ \mgr -> do
    -- >    -- start a watching job (in the background)
    -- >    watchDir
    -- >      mgr          -- manager
    -- >      "."          -- directory to watch
    -- >      (const True) -- predicate
    -- >      print        -- action
    -- >
    -- >    -- sleep forever (until interrupted)
    -- >    forever $ threadDelay 1000000

    module System.FSNotify (
      -- * Events
        Event(..)
      , EventIsDirectory(..)
      , EventChannel
      , Action
      , ActionPredicate

      -- * Starting/Stopping
      , WatchManager
      , withManager
      , startManager
      , stopManager

      -- * Configuration
      , defaultConfig
      , WatchConfig
      , confWatchMode
      , confThreadingMode
      , confOnHandlerException
      , WatchMode(..)
      , ThreadingMode(..)

      -- * Lower level
      , withManagerConf
      , startManagerConf
      , StopListening

      -- * Watching
      , watchDir
      , watchDirChan
      , watchTree
      , watchTreeChan
      ) where

    import Prelude hiding (FilePath)

    import Control.Concurrent
    import Control.Concurrent.Async
    import Control.Exception.Safe as E
    import Control.Monad
    import Control.Monad.IO.Class
    import qualified Data.Text as T
    import System.FSNotify.Polling
    import System.FSNotify.Types
    import System.FilePath

    import System.FSNotify.Listener (ListenFn, StopListening)

    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid
    #endif

    #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
    import System.FSNotify.Linux
    #endif

    #ifdef mingw32_HOST_OS
    import System.FSNotify.Win32
    #endif

    #ifdef darwin_HOST_OS
    import System.FSNotify.OSX
    #endif

    -- | Watch manager. You need one in order to create watching jobs.
    data WatchManager = forall manager argType. FileListener manager argType =>
      WatchManager {
        WatchManager -> WatchConfig
    watchManagerConfig :: WatchConfig
        , ()
    watchManagerManager :: manager
        , WatchManager -> Maybe (EventAndActionChannel, Async ())
    watchManagerGlobalChan :: Maybe (EventAndActionChannel, Async ())
        }

    -- | Default configuration
    --
    -- * Uses OS watch mode (if possible) and single thread.
    defaultConfig :: WatchConfig
    defaultConfig :: WatchConfig
    defaultConfig = WatchConfig {
    #ifndef HAVE_NATIVE_WATCHER
      confWatchMode = WatchModePoll 500000
    #else
      confWatchMode :: WatchMode
    confWatchMode = WatchMode
    WatchModeOS
    #endif
      , confThreadingMode :: ThreadingMode
    confThreadingMode = ThreadingMode
    SingleThread
      , confOnHandlerException :: SomeException -> IO ()
    confOnHandlerException = SomeException -> IO ()
    defaultOnHandlerException
      }

    defaultOnHandlerException :: SomeException -> IO ()
    defaultOnHandlerException :: SomeException -> IO ()
    defaultOnHandlerException SomeException
    e = String -> IO ()
    putStrLn (String
    "fsnotify: handler threw exception: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)

    -- | Perform an IO action with a WatchManager in place.
    -- Tear down the WatchManager after the action is complete.
    withManager :: (WatchManager -> IO a) -> IO a
    withManager :: forall a. (WatchManager -> IO a) -> IO a
    withManager  = WatchConfig -> (WatchManager -> IO a) -> IO a
    forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
    withManagerConf WatchConfig
    defaultConfig

    -- | Start a file watch manager.
    -- Directories can only be watched when they are managed by a started
    -- watch manager.
    -- When finished watching. you must release resources via 'stopManager'.
    -- It is preferrable if possible to use 'withManager' to handle this
    -- automatically.
    startManager :: IO WatchManager
    startManager :: IO WatchManager
    startManager = WatchConfig -> IO WatchManager
    startManagerConf WatchConfig
    defaultConfig

    -- | Stop a file watch manager.
    -- Stopping a watch manager will immediately stop
    -- watching for files and free resources.
    stopManager :: WatchManager -> IO ()
    stopManager :: WatchManager -> IO ()
    stopManager (WatchManager {manager
    Maybe (EventAndActionChannel, Async ())
    WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerManager :: ()
    watchManagerGlobalChan :: WatchManager -> Maybe (EventAndActionChannel, Async ())
    watchManagerConfig :: WatchConfig
    watchManagerManager :: manager
    watchManagerGlobalChan :: Maybe (EventAndActionChannel, Async ())
    ..}) = do
      IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ manager -> IO ()
    forall sessionType argType.
    FileListener sessionType argType =>
    sessionType -> IO ()
    killSession manager
    watchManagerManager
      case Maybe (EventAndActionChannel, Async ())
    watchManagerGlobalChan of
        Maybe (EventAndActionChannel, Async ())
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just (EventAndActionChannel
    _, Async ()
    t) -> Async () -> IO ()
    forall a. Async a -> IO ()
    cancel Async ()
    t

    -- | Like 'withManager', but configurable.
    withManagerConf :: WatchConfig -> (WatchManager -> IO a) -> IO a
    withManagerConf :: forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
    withManagerConf WatchConfig
    conf = IO WatchManager
    -> (WatchManager -> IO ()) -> (WatchManager -> IO a) -> IO a
    forall (m :: * -> *) a b c.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m b) -> (a -> m c) -> m c
    bracket (WatchConfig -> IO WatchManager
    startManagerConf WatchConfig
    conf) WatchManager -> IO ()
    stopManager

    -- | Like 'startManager', but configurable.
    startManagerConf :: WatchConfig -> IO WatchManager
    startManagerConf :: WatchConfig -> IO WatchManager
    startManagerConf WatchConfig
    conf = do
    # ifdef mingw32_HOST_OS
      -- See https://github.com/haskell-fswatch/hfsnotify/issues/50
      unless rtsSupportsBoundThreads $ throwIO $ userError "startManagerConf must be called with -threaded on Windows"
    # endif

      case WatchConfig -> WatchMode
    confWatchMode WatchConfig
    conf of
        WatchModePoll Int
    interval -> WatchConfig
    -> PollManager
    -> Maybe (EventAndActionChannel, Async ())
    -> WatchManager
    forall manager argType.
    FileListener manager argType =>
    WatchConfig
    -> manager
    -> Maybe (EventAndActionChannel, Async ())
    -> WatchManager
    WatchManager WatchConfig
    conf (PollManager
     -> Maybe (EventAndActionChannel, Async ()) -> WatchManager)
    -> IO PollManager
    -> IO (Maybe (EventAndActionChannel, Async ()) -> WatchManager)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO PollManager -> IO PollManager
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Int -> IO PollManager
    createPollManager Int
    interval) IO (Maybe (EventAndActionChannel, Async ()) -> WatchManager)
    -> IO (Maybe (EventAndActionChannel, Async ())) -> IO WatchManager
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO (Maybe (EventAndActionChannel, Async ()))
    forall {t} {a}. IO (Maybe (Chan (t, t -> IO ()), Async a))
    globalWatchChan
    #ifdef HAVE_NATIVE_WATCHER
        WatchMode
    WatchModeOS -> IO (Either Text NativeManager) -> IO (Either Text NativeManager)
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (() -> IO (Either Text NativeManager)
    forall sessionType argType.
    FileListener sessionType argType =>
    argType -> IO (Either Text sessionType)
    initSession ()) IO (Either Text NativeManager)
    -> (Either Text NativeManager -> IO WatchManager)
    -> IO WatchManager
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Either Text NativeManager -> IO WatchManager
    createManager
    #endif

      where
    #ifdef HAVE_NATIVE_WATCHER
        createManager :: Either T.Text NativeManager -> IO WatchManager
        createManager :: Either Text NativeManager -> IO WatchManager
    createManager (Right NativeManager
    nativeManager) = WatchConfig
    -> NativeManager
    -> Maybe (EventAndActionChannel, Async ())
    -> WatchManager
    forall manager argType.
    FileListener manager argType =>
    WatchConfig
    -> manager
    -> Maybe (EventAndActionChannel, Async ())
    -> WatchManager
    WatchManager WatchConfig
    conf NativeManager
    nativeManager (Maybe (EventAndActionChannel, Async ()) -> WatchManager)
    -> IO (Maybe (EventAndActionChannel, Async ())) -> IO WatchManager
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe (EventAndActionChannel, Async ()))
    forall {t} {a}. IO (Maybe (Chan (t, t -> IO ()), Async a))
    globalWatchChan
        createManager (Left Text
    err) = IOError -> IO WatchManager
    forall (m :: * -> *) e a.
    (HasCallStack, MonadThrow m, Exception e) =>
    e -> m a
    throwIO (IOError -> IO WatchManager) -> IOError -> IO WatchManager
    forall a b. (a -> b) -> a -> b
    $ String -> IOError
    userError (String -> IOError) -> String -> IOError
    forall a b. (a -> b) -> a -> b
    $ Text -> String
    T.unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ Text
    "Error: couldn't start native file manager: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    err
    #endif

        globalWatchChan :: IO (Maybe (Chan (t, t -> IO ()), Async a))
    globalWatchChan = case WatchConfig -> ThreadingMode
    confThreadingMode WatchConfig
    conf of
          ThreadingMode
    SingleThread -> do
            globalChan <- IO (Chan (t, t -> IO ()))
    forall a. IO (Chan a)
    newChan
            globalReaderThread <- async $ forever $ do
              (event, action) <- readChan globalChan
              tryAny (action event) >>= \case
                Left SomeException
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- TODO: surface the exception somehow?
                Right () -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            return $ Just (globalChan, globalReaderThread)
          ThreadingMode
    _ -> Maybe (Chan (t, t -> IO ()), Async a)
    -> IO (Maybe (Chan (t, t -> IO ()), Async a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Chan (t, t -> IO ()), Async a)
    forall a. Maybe a
    Nothing

    -- | Watch the immediate contents of a directory by streaming events to a Chan.
    -- Watching the immediate contents of a directory will only report events
    -- associated with files within the specified directory, and not files
    -- within its subdirectories.
    watchDirChan :: WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
    watchDirChan :: WatchManager
    -> String -> ActionPredicate -> EventChannel -> IO (IO ())
    watchDirChan (WatchManager {manager
    Maybe (EventAndActionChannel, Async ())
    WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerManager :: ()
    watchManagerGlobalChan :: WatchManager -> Maybe (EventAndActionChannel, Async ())
    watchManagerConfig :: WatchConfig
    watchManagerManager :: manager
    watchManagerGlobalChan :: Maybe (EventAndActionChannel, Async ())
    ..}) String
    path ActionPredicate
    actionPredicate EventChannel
    chan = WatchConfig
    -> manager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    forall sessionType argType.
    FileListener sessionType argType =>
    ListenFn sessionType argType
    listen WatchConfig
    watchManagerConfig manager
    watchManagerManager String
    path ActionPredicate
    actionPredicate (EventChannel -> EventCallback
    forall a. Chan a -> a -> IO ()
    writeChan EventChannel
    chan)

    -- | Watch all the contents of a directory by streaming events to a Chan.
    -- Watching all the contents of a directory will report events associated with
    -- files within the specified directory and its subdirectories.
    watchTreeChan :: WatchManager -> FilePath -> ActionPredicate -> EventChannel -> IO StopListening
    watchTreeChan :: WatchManager
    -> String -> ActionPredicate -> EventChannel -> IO (IO ())
    watchTreeChan (WatchManager {manager
    Maybe (EventAndActionChannel, Async ())
    WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerManager :: ()
    watchManagerGlobalChan :: WatchManager -> Maybe (EventAndActionChannel, Async ())
    watchManagerConfig :: WatchConfig
    watchManagerManager :: manager
    watchManagerGlobalChan :: Maybe (EventAndActionChannel, Async ())
    ..}) String
    path ActionPredicate
    actionPredicate EventChannel
    chan = WatchConfig
    -> manager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    forall sessionType argType.
    FileListener sessionType argType =>
    ListenFn sessionType argType
    listenRecursive WatchConfig
    watchManagerConfig manager
    watchManagerManager String
    path ActionPredicate
    actionPredicate (EventChannel -> EventCallback
    forall a. Chan a -> a -> IO ()
    writeChan EventChannel
    chan)

    -- | Watch the immediate contents of a directory by committing an Action for each event.
    -- Watching the immediate contents of a directory will only report events
    -- associated with files within the specified directory, and not files
    -- within its subdirectories.
    watchDir :: WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
    watchDir :: WatchManager
    -> String -> ActionPredicate -> EventCallback -> IO (IO ())
    watchDir wm :: WatchManager
    wm@(WatchManager {WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerConfig :: WatchConfig
    watchManagerConfig}) String
    fp ActionPredicate
    actionPredicate EventCallback
    action = (forall a b. ListenFn a b)
    -> WatchManager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    threadChan WatchConfig
    -> a -> String -> ActionPredicate -> EventCallback -> IO (IO ())
    forall a b. ListenFn a b
    forall sessionType argType.
    FileListener sessionType argType =>
    ListenFn sessionType argType
    listen WatchManager
    wm String
    fp ActionPredicate
    actionPredicate EventCallback
    wrappedAction
      where wrappedAction :: EventCallback
    wrappedAction Event
    x = (SomeException -> IO ()) -> IO () -> IO ()
    forall (m :: * -> *) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    (e -> m a) -> m a -> m a
    handle (WatchConfig -> SomeException -> IO ()
    confOnHandlerException WatchConfig
    watchManagerConfig) (EventCallback
    action Event
    x)

    -- | Watch all the contents of a directory by committing an Action for each event.
    -- Watching all the contents of a directory will report events associated with
    -- files within the specified directory and its subdirectories.
    watchTree :: WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
    watchTree :: WatchManager
    -> String -> ActionPredicate -> EventCallback -> IO (IO ())
    watchTree wm :: WatchManager
    wm@(WatchManager {WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerConfig :: WatchConfig
    watchManagerConfig}) String
    fp ActionPredicate
    actionPredicate EventCallback
    action = (forall a b. ListenFn a b)
    -> WatchManager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    threadChan WatchConfig
    -> a -> String -> ActionPredicate -> EventCallback -> IO (IO ())
    forall a b. ListenFn a b
    forall sessionType argType.
    FileListener sessionType argType =>
    ListenFn sessionType argType
    listenRecursive WatchManager
    wm String
    fp ActionPredicate
    actionPredicate EventCallback
    wrappedAction
      where wrappedAction :: EventCallback
    wrappedAction Event
    x = (SomeException -> IO ()) -> IO () -> IO ()
    forall (m :: * -> *) e a.
    (HasCallStack, MonadCatch m, Exception e) =>
    (e -> m a) -> m a -> m a
    handle (WatchConfig -> SomeException -> IO ()
    confOnHandlerException WatchConfig
    watchManagerConfig) (EventCallback
    action Event
    x)

    -- * Main threading logic

    threadChan :: (forall a b. ListenFn a b) -> WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
    threadChan :: (forall a b. ListenFn a b)
    -> WatchManager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    threadChan forall a b. ListenFn a b
    listenFn (WatchManager {watchManagerGlobalChan :: WatchManager -> Maybe (EventAndActionChannel, Async ())
    watchManagerGlobalChan=(Just (EventAndActionChannel
    globalChan, Async ()
    _)), manager
    WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerManager :: ()
    watchManagerConfig :: WatchConfig
    watchManagerManager :: manager
    ..}) String
    path ActionPredicate
    actPred EventCallback
    action =
      WatchConfig
    -> manager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    forall a b. ListenFn a b
    listenFn WatchConfig
    watchManagerConfig manager
    watchManagerManager String
    path ActionPredicate
    actPred (\Event
    event -> EventAndActionChannel -> (Event, EventCallback) -> IO ()
    forall a. Chan a -> a -> IO ()
    writeChan EventAndActionChannel
    globalChan (Event
    event, EventCallback
    action))
    threadChan forall a b. ListenFn a b
    listenFn (WatchManager {watchManagerGlobalChan :: WatchManager -> Maybe (EventAndActionChannel, Async ())
    watchManagerGlobalChan=Maybe (EventAndActionChannel, Async ())
    Nothing, manager
    WatchConfig
    watchManagerConfig :: WatchManager -> WatchConfig
    watchManagerManager :: ()
    watchManagerConfig :: WatchConfig
    watchManagerManager :: manager
    ..}) String
    path ActionPredicate
    actPred EventCallback
    action = do
      let wrappedAction :: EventCallback
    wrappedAction = case WatchConfig -> ThreadingMode
    confThreadingMode WatchConfig
    watchManagerConfig of
            ThreadingMode
    SingleThread -> String -> EventCallback
    forall a. HasCallStack => String -> a
    error String
    "Should never happen"
            ThreadingMode
    ThreadPerWatch -> EventCallback
    action
            ThreadingMode
    ThreadPerEvent -> IO (Async ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Async ()) -> IO ())
    -> (Event -> IO (Async ())) -> EventCallback
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO () -> IO (Async ())
    forall a. IO a -> IO (Async a)
    async (IO () -> IO (Async ())) -> EventCallback -> Event -> IO (Async ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EventCallback
    action
      WatchConfig
    -> manager
    -> String
    -> ActionPredicate
    -> EventCallback
    -> IO (IO ())
    forall a b. ListenFn a b
    listenFn WatchConfig
    watchManagerConfig manager
    watchManagerManager String
    path ActionPredicate
    actPred EventCallback
    wrappedAction