Remove accidentally committed fsnotify source; add to .gitignore

2026-05-11 10:05:06 -04:00
parent 77c6de303f
commit d6e15864f4
23 changed files with 1 additions and 2310 deletions
@@ -3,6 +3,7 @@
 bin/
 build/
 converge.cabal
 fsnotify-*/
 *.hi
 *.o
 dist/
@@ -1,124 +0,0 @@
 Changes
 =======
 Version 0.4.4.0
 ----------
 * Use hinotify and -DHAVE_NATIVE_WATCHER for FreeBSD (#121)
 * Start testing FreeBSD in CI (#122)
 Version 0.4.3.0
 ----------
 * Use polling as a generic fallback and add support for WASM (https://github.com/haskell-fswatch/hfsnotify/pull/110)
 * Gracefully handle broken symlinks (https://github.com/haskell-fswatch/hfsnotify/pull/120)
 Version 0.4.2.0
 ----------
 * Bump hfsevents constraint to >= 0.1.8 to pick up race condition fix (see https://github.com/luite/hfsevents/pull/19).
 * Compatibility with text-2.1.2 and an upper bound of 2.2.
 * Lots of CI and test improvements.
 Version 0.4.1.1
 ---------------
 * Document polling interval units (#111).
 * Fix compat with text-2.1.2 (closes #116).
 * Remove some redundant cleanup code paths.
 Version 0.4.1.0
 ---------------
 * Add `unliftio` lower bound (#106).
 * Change the tests back to a test-suite to avoid building for library users. (#107).
 * Fix up Windows compatibility.
 * Export `WatchConfig` type (#108).
 Version 0.4.0.1
 ---------------
 * Fix compatibility with *BSD.
 Version 0.4.0.0
 ---------------
 API breaking update.
 * New options for threading control (single-threaded, thread-per-watch, and thread-per-manager).
 * Revamp `WatchConfig` options to be less confusing and reduce boolean blindness.
 * Pull out debouncing stuff, since it was never correct as it simply took the last event affecting a given file in the debounce period. Debouncing is currently not included, and should be handled as an orthogonal concern. I'd like to include some debouncing logic, but didn't want to delay this release any longer.
  * We now expose `type DebounceFn = Action -> IO Action`, which represents an arbitrary debouncer. All debouncers should be in the form of one of these functions.
  * A robust state machine debouncer is in progress but not fully implemented yet; see the `state-machine` branch.
  * Contributions are welcome! We can potentially add multiple debouncers of different complexity as modules under `System.FSNotify.Debounce.*`.
 * Don't silently fall back to polling on failure of native watcher.
  Instead, throw an exception which the user can recover from by switching to polling.
 * Add ModifiedAttributes event type + Linux support.
 * Add confOnHandlerException to be able to control what happens when a handler throws an exception.
 * WatchConfig constructor is no longer exposed. Instead use `defaultConfig {...}` with the accessors.
 Version 0.3.0.0
 ---------------
 API breaking update with a number of bugfixes and improvements.
 * Now we can detect directory creation/deletion. A boolean flag has been added
  to `Event` to indicate if the event pertains to a directory or not. This is the
  only API change.
 * Test stability improvements + CI test suites now passing on Windows, Linux, and Mac.
 * Interpreting OSX hfsevents flags is more sane now (see comments in OSX.hs for details).
 * Improve a race condition when adding watches on Linux.
 * Improve robustness of the PollManager.
 * Fix double call to `closeHandle` on Windows.
 * Remove comments about locking from the documentation.
 Version 0.2.1.2
 ---------------
 Update to the new hinotify API (v0.3.10)
 Version 0.2.1.1
 ---------------
 Catch IO exceptions when initialising inotify on Linux
 Version 0.2.1
 -------------
 Don't use `system-filepath`
 Version 0.2
 -----------
 Use filepath instead of deprecated system-filepath
 Version 0.1.0.3
 ---------------
 * Fix the tests
 Version 0.1.0.2
 ---------------
 * Restore compatibility with GHC 7.4
 * Fix a bug in `treeExtAny`, which previously work identically to
  `treeExtExists`
 * Improve documentation
 Version 0.1.0.1
 ---------------
 Include CHANGELOG.md and README.md in the source distribution.
 Version 0.1
 -----------
 * Allow to stop a listening job. Note this changes the return type of watching
  functions from `()` to `IO ()`.
 * Previously, some care was taken to prevent multiple callbacks from running
  simultaneously. It is now the user's responsibility. See
  [#43](https://github.com/haskell-fswatch/hfsnotify/issues/43) for details.
 * Previously, paths returned to callbacks were relative on Windows. Now they are
  absolute, like on the other platforms.
 * The `WatchConfig` type has changed. Previously, it only specified debouncing
  parameters. Now it also contains polling parameters.
 * The `isPollingManager` function is added to determine, at runtime, whether the
  polling implementation is used.
@@ -1,30 +0,0 @@
 Copyright (c) 2012, Mark Dittmer
 All rights reserved.
 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are met:
    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.
    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.
    * Neither the name of Mark Dittmer nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -1,18 +0,0 @@
 ![CI](https://github.com/haskell-fswatch/hfsnotify/workflows/CI/badge.svg)
 =========
 Unified Haskell interface for basic file system notifications.
 This is a library. There are executables built on top of it.
 * [spy](https://hackage.haskell.org/package/spy)
 * [steeloverseer](https://github.com/schell/steeloverseer)
 Requirements
 ============
 Windows
 -------
 compile with -fthreaded
@@ -1,11 +0,0 @@
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 import Distribution.Simple
 main = defaultMain
@@ -1,35 +0,0 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Main where
 import Control.Concurrent
 import Data.String.Interpolate
 import System.FSNotify
 import System.FilePath
 import UnliftIO.Temporary
 main :: IO ()
 main = do
  withSystemTempDirectory "fsnotify-foo" $ \dir -> do
    putStrLn [i|Starting watch on dir: #{dir}|]
    let conf = defaultConfig
    withManagerConf conf $ \mgr -> do
      stop <- watchDir mgr dir (const True) $ \ev -> do
        putStrLn [i|Got event: #{ev}|]
      threadDelay 3_000_000
      putStrLn [i|Writing to #{dir </> "bar"}|]
      writeFile (dir </> "bar") "asdf"
      threadDelay 3_000_000
      putStrLn [i|Stopping|]
      stop
      putStrLn [i|Stopped|]
      threadDelay 3_000_000
    putStrLn [i|Exited withManagerConf|]
    threadDelay 3_000_000
@@ -1,148 +0,0 @@
 cabal-version: 1.12
 -- This file has been generated from package.yaml by hpack version 0.38.0.
 --
 -- see: https://github.com/sol/hpack
 name:           fsnotify
 version:        0.4.4.0
 synopsis:       Cross platform library for file change notification.
 description:    Cross platform library for file creation, modification, and deletion notification. This library builds upon existing libraries for platform-specific Windows, Mac, and Linux filesystem event notification.
 category:       Filesystem
 homepage:       https://github.com/haskell-fswatch/hfsnotify
 author:         Mark Dittmer <mark.s.dittmer@gmail.com>, Niklas Broberg
 maintainer:     Tom McLaughlin <tom@codedown.io>
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
    README.md
    CHANGELOG.md
    test/Main.hs
 library
  exposed-modules:
      System.FSNotify
      System.FSNotify.Devel
  other-modules:
      System.FSNotify.Find
      System.FSNotify.Listener
      System.FSNotify.Path
      System.FSNotify.Polling
      System.FSNotify.Types
  hs-source-dirs:
      src
  default-extensions:
      ScopedTypeVariables
  ghc-options: -Wall
  build-depends:
      async >=2.0.0.0
    , base >=4.8 && <5
    , bytestring >=0.10.2
    , containers >=0.4
    , directory >=1.3.0.0
    , filepath >=1.3.0.0
    , monad-control >=1.0.0.0
    , safe-exceptions >=0.1.0.0
    , text >=0.11.0 && <2.2
    , time >=1.1
    , unix-compat >=0.2
  default-language: Haskell2010
  if os(linux) || os(windows) || os(darwin) || os(freebsd)
    cpp-options: -DHAVE_NATIVE_WATCHER
  if os(linux) || os(freebsd)
    other-modules:
        System.FSNotify.Linux
        System.FSNotify.Linux.Util
    build-depends:
        unix >=2.7.1.0
  if os(linux) && impl(ghc >= 9.10)
    build-depends:
        hinotify >=0.4.2
  if os(linux) && impl(ghc < 9.10)
    build-depends:
        hinotify >=0.3.9
  if os(windows)
    other-modules:
        System.FSNotify.Win32
        System.Win32.FileNotify
        System.Win32.Notify
    hs-source-dirs:
        win-src
    build-depends:
        Win32
  if os(darwin)
    other-modules:
        System.FSNotify.OSX
    build-depends:
        hfsevents >=0.1.8
  if os(freebsd)
    build-depends:
        hinotify >=0.4.1
 executable example
  main-is: Main.hs
  other-modules:
      Paths_fsnotify
  hs-source-dirs:
      example
  default-extensions:
      ScopedTypeVariables
  ghc-options: -Wall
  build-depends:
      base
    , directory
    , exceptions
    , filepath
    , fsnotify
    , monad-logger
    , random
    , retry
    , safe-exceptions
    , string-interpolate
    , temporary
    , unix-compat
    , unliftio
  default-language: Haskell2010
  if os(linux) || os(windows) || os(darwin) || os(freebsd)
    cpp-options: -DHAVE_NATIVE_WATCHER
  if !arch(wasm32)
    ghc-options: -threaded
 test-suite tests
  type: exitcode-stdio-1.0
  main-is: Main.hs
  other-modules:
      FSNotify.Test.EventTests
      FSNotify.Test.Util
      Paths_fsnotify
  hs-source-dirs:
      test
  default-extensions:
      ScopedTypeVariables
  ghc-options: -threaded -Wall
  build-depends:
      async >=2
    , base >=4.3.1.0
    , directory
    , exceptions
    , filepath
    , fsnotify
    , monad-logger
    , random
    , retry
    , safe-exceptions
    , string-interpolate
    , temporary
    , unix-compat
    , unliftio >=0.2.20
  default-language: Haskell2010
  if os(linux) || os(windows) || os(darwin) || os(freebsd)
    cpp-options: -DHAVE_NATIVE_WATCHER
  if os(windows)
    build-depends:
        Win32
      , sandwich >=0.1.1.1
  else
    build-depends:
        sandwich
@@ -1,226 +0,0 @@
 --
 -- 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 {
    watchManagerConfig :: WatchConfig
    , watchManagerManager :: manager
    , watchManagerGlobalChan :: Maybe (EventAndActionChannel, Async ())
    }
 -- | Default configuration
 --
 -- * Uses OS watch mode (if possible) and single thread.
 defaultConfig :: WatchConfig
 defaultConfig = WatchConfig {
 #ifndef HAVE_NATIVE_WATCHER
  confWatchMode = WatchModePoll 500000
 #else
  confWatchMode = WatchModeOS
 #endif
  , confThreadingMode = SingleThread
  , confOnHandlerException = defaultOnHandlerException
  }
 defaultOnHandlerException :: SomeException -> IO ()
 defaultOnHandlerException e = putStrLn ("fsnotify: handler threw exception: " <> show 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  = withManagerConf 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 = startManagerConf defaultConfig
 -- | Stop a file watch manager.
 -- Stopping a watch manager will immediately stop
 -- watching for files and free resources.
 stopManager :: WatchManager -> IO ()
 stopManager (WatchManager {..}) = do
  liftIO $ killSession watchManagerManager
  case watchManagerGlobalChan of
    Nothing -> return ()
    Just (_, t) -> cancel t
 -- | Like 'withManager', but configurable.
 withManagerConf :: WatchConfig -> (WatchManager -> IO a) -> IO a
 withManagerConf conf = bracket (startManagerConf conf) stopManager
 -- | Like 'startManager', but configurable.
 startManagerConf :: WatchConfig -> IO WatchManager
 startManagerConf 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 confWatchMode conf of
    WatchModePoll interval -> WatchManager conf <$> liftIO (createPollManager interval) <*> globalWatchChan
 #ifdef HAVE_NATIVE_WATCHER
    WatchModeOS -> liftIO (initSession ()) >>= createManager
 #endif
  where
 #ifdef HAVE_NATIVE_WATCHER
    createManager :: Either T.Text NativeManager -> IO WatchManager
    createManager (Right nativeManager) = WatchManager conf nativeManager <$> globalWatchChan
    createManager (Left err) = throwIO $ userError $ T.unpack $ "Error: couldn't start native file manager: " <> err
 #endif
    globalWatchChan = case confThreadingMode conf of
      SingleThread -> do
        globalChan <- newChan
        globalReaderThread <- async $ forever $ do
          (event, action) <- readChan globalChan
          tryAny (action event) >>= \case
            Left _ -> return () -- TODO: surface the exception somehow?
            Right () -> return ()
        return $ Just (globalChan, globalReaderThread)
      _ -> return 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 {..}) path actionPredicate chan = listen watchManagerConfig watchManagerManager path actionPredicate (writeChan 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 {..}) path actionPredicate chan = listenRecursive watchManagerConfig watchManagerManager path actionPredicate (writeChan 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 wm@(WatchManager {watchManagerConfig}) fp actionPredicate action = threadChan listen wm fp actionPredicate wrappedAction
  where wrappedAction x = handle (confOnHandlerException watchManagerConfig) (action 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 wm@(WatchManager {watchManagerConfig}) fp actionPredicate action = threadChan listenRecursive wm fp actionPredicate wrappedAction
  where wrappedAction x = handle (confOnHandlerException watchManagerConfig) (action x)
 -- * Main threading logic
 threadChan :: (forall a b. ListenFn a b) -> WatchManager -> FilePath -> ActionPredicate -> Action -> IO StopListening
 threadChan listenFn (WatchManager {watchManagerGlobalChan=(Just (globalChan, _)), ..}) path actPred action =
  listenFn watchManagerConfig watchManagerManager path actPred (\event -> writeChan globalChan (event, action))
 threadChan listenFn (WatchManager {watchManagerGlobalChan=Nothing, ..}) path actPred action = do
  let wrappedAction = case confThreadingMode watchManagerConfig of
        SingleThread -> error "Should never happen"
        ThreadPerWatch -> action
        ThreadPerEvent -> void . async . action
  listenFn watchManagerConfig watchManagerManager path actPred wrappedAction
@@ -1,73 +0,0 @@
 {-# LANGUAGE FlexibleContexts #-}
 -- | Some additional functions on top of "System.FSNotify".
 --
 -- Example of compiling scss files with compass
 --
 -- @
 -- compass :: WatchManager -> FilePath -> m ()
 -- compass man dir = do
 --  putStrLn $ "compass " ++ encodeString dir
 --  treeExtExists man dir "scss" $ \fp ->
 --    when ("deploy" `notElem` splitDirectories fp) $ do
 --     let d = encodeString $ head (splitDirectories rel)
 --     system "cd " ++ d ++ "&& bundle exec compass compile"
 --  return ()
 -- @
 {-# LANGUAGE NamedFieldPuns #-}
 module System.FSNotify.Devel (
  treeExtAny
  , treeExtExists
  , doAllEvents
  , allEvents
  , existsEvents
  ) where
 import Data.Text
 import Prelude hiding (FilePath)
 import System.FSNotify
 import System.FSNotify.Path (hasThisExtension)
 import System.FilePath
 -- | In the given directory tree, watch for any 'Added' and 'Modified'
 -- events (but ignore 'Removed' events) for files with the given file
 -- extension
 treeExtExists :: WatchManager
              -> FilePath -- ^ Directory to watch
              -> Text -- ^ extension
              -> (FilePath -> IO ()) -- ^ action to run on file
              -> IO StopListening
 treeExtExists man dir ext action =
  watchTree man dir (existsEvents $ flip hasThisExtension ext) (doAllEvents action)
 -- | In the given directory tree, watch for any events for files with the
 -- given file extension
 treeExtAny :: WatchManager
           -> FilePath -- ^ Directory to watch
           -> Text -- ^ extension
           -> (FilePath -> IO ()) -- ^ action to run on file
           -> IO StopListening
 treeExtAny man dir ext action =
  watchTree man dir (allEvents $ flip hasThisExtension ext) (doAllEvents action)
 -- | Turn a 'FilePath' callback into an 'Event' callback that ignores the
 -- 'Event' type and timestamp
 doAllEvents :: Monad m => (FilePath -> m ()) -> Event -> m ()
 doAllEvents action = action . eventPath
 -- | Turn a 'FilePath' predicate into an 'Event' predicate that accepts
 -- only 'Added', 'Modified', and 'ModifiedAttributes' event types
 existsEvents :: (FilePath -> Bool) -> (Event -> Bool)
 existsEvents filt event =
  case event of
    Added {eventPath} -> filt eventPath
    Modified {eventPath} -> filt eventPath
    ModifiedAttributes {eventPath} -> filt eventPath
    _ -> False
 -- | Turn a 'FilePath' predicate into an 'Event' predicate that accepts
 -- any event types
 allEvents :: (FilePath -> Bool) -> (Event -> Bool)
 allEvents filt = filt . eventPath
@@ -1,32 +0,0 @@
 -- | Adapted from how Shelly does finding in Shelly.Find
 -- (shelly is BSD-licensed)
 module System.FSNotify.Find where
 import Control.Monad
 import Control.Monad.IO.Class
 import System.Directory (doesDirectoryExist, listDirectory, pathIsSymbolicLink)
 import System.FilePath
 find :: Bool -> FilePath -> IO [FilePath]
 find followSymlinks = find' followSymlinks  []
 find' :: Bool -> [FilePath] -> FilePath -> IO [FilePath]
 find' followSymlinks startValue dir = do
  (rPaths, aPaths) <- lsRelAbs dir
  foldM visit startValue (zip rPaths aPaths)
  where
    visit acc (relativePath, absolutePath) = do
      isDir <- liftIO $ doesDirectoryExist absolutePath
      sym <- liftIO $ pathIsSymbolicLink absolutePath
      let newAcc = relativePath : acc
      if isDir && (followSymlinks || not sym)
        then find' followSymlinks newAcc relativePath
        else return newAcc
 lsRelAbs :: FilePath -> IO ([FilePath], [FilePath])
 lsRelAbs fp = do
  files <- liftIO $ listDirectory fp
  let absolute = map (fp </>) files
  let relativized = map (\p -> joinPath [fp, p]) files
  return (relativized, absolute)
@@ -1,180 +0,0 @@
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module System.FSNotify.Linux (
  FileListener(..)
  , NativeManager
  ) where
 import Control.Concurrent.MVar
 import Control.Exception.Safe as E
 import Control.Monad
 import Data.Function
 import Data.Monoid
 import Data.String
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.POSIX
 import Prelude hiding (FilePath)
 import System.FSNotify.Find
 import System.FSNotify.Linux.Util
 import System.FSNotify.Listener
 import System.FSNotify.Types
 import System.FilePath ((</>))
 import qualified System.INotify as INo
 import System.Posix.ByteString (RawFilePath)
 import System.Posix.Files (getFileStatus, isDirectory, modificationTimeHiRes)
 data INotifyListener = INotifyListener { listenerINotify :: INo.INotify }
 type NativeManager = INotifyListener
 data EventVarietyMismatchException = EventVarietyMismatchException deriving (Show, Typeable)
 instance Exception EventVarietyMismatchException
 fsnEvents :: RawFilePath -> UTCTime -> INo.Event -> IO [Event]
 fsnEvents basePath' timestamp (INo.Attributes (boolToIsDirectory -> isDir) (Just raw)) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [ModifiedAttributes (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp (INo.Modified (boolToIsDirectory -> isDir) (Just raw)) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [Modified (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp (INo.Closed (boolToIsDirectory -> isDir) (Just raw) True) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [CloseWrite (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp (INo.Created (boolToIsDirectory -> isDir) raw) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [Added (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp (INo.MovedOut (boolToIsDirectory -> isDir) raw _cookie) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [Removed (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp (INo.MovedIn (boolToIsDirectory -> isDir) raw _cookie) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [Added (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp (INo.Deleted (boolToIsDirectory -> isDir) raw) = do
  basePath <- fromRawFilePath basePath'
  fromHinotifyPath raw >>= \name -> return [Removed (basePath </> name) timestamp isDir]
 fsnEvents basePath' timestamp INo.DeletedSelf = do
  basePath <- fromRawFilePath basePath'
  return [WatchedDirectoryRemoved basePath timestamp IsDirectory]
 fsnEvents _ _ INo.Ignored = return []
 fsnEvents basePath' timestamp inoEvent = do
  basePath <- fromRawFilePath basePath'
  return [Unknown basePath timestamp IsFile (show inoEvent)]
 handleInoEvent :: ActionPredicate -> EventCallback -> RawFilePath -> MVar Bool -> INo.Event -> IO ()
 handleInoEvent actPred callback basePath watchStillExistsVar inoEvent = do
  when (INo.DeletedSelf == inoEvent) $ modifyMVar_ watchStillExistsVar $ const $ return False
  currentTime <- getCurrentTime
  events <- fsnEvents basePath currentTime inoEvent
  forM_ events $ \event -> when (actPred event) $ callback event
 varieties :: [INo.EventVariety]
 varieties = [INo.Create, INo.Delete, INo.MoveIn, INo.MoveOut, INo.Attrib, INo.Modify, INo.CloseWrite, INo.DeleteSelf]
 instance FileListener INotifyListener () where
  initSession _ = E.handle (\(e :: IOException) -> return $ Left $ fromString $ show e) $ do
    inotify <- INo.initINotify
    return $ Right $ INotifyListener inotify
  killSession (INotifyListener {listenerINotify}) = INo.killINotify listenerINotify
  listen _conf (INotifyListener {listenerINotify}) path actPred callback = do
    rawPath <- toRawFilePath path
    canonicalRawPath <- canonicalizeRawDirPath rawPath
    watchStillExistsVar <- newMVar True
    hinotifyPath <- rawToHinotifyPath canonicalRawPath
    wd <- INo.addWatch listenerINotify varieties hinotifyPath (handleInoEvent actPred callback canonicalRawPath watchStillExistsVar)
    return $
      modifyMVar_ watchStillExistsVar $ \wse -> do
        when wse $ INo.removeWatch wd
        return False
  listenRecursive _conf listener initialPath actPred callback = do
    -- wdVar stores the list of created watch descriptors. We use it to
    -- cancel the whole recursive listening task.
    --
    -- To avoid a race condition (when a new watch is added right after
    -- we've stopped listening), we replace the MVar contents with Nothing
    -- to signify that the listening task is cancelled, and no new watches
    -- should be added.
    wdVar <- newMVar (Just [])
    let
      removeWatches wds = forM_ wds $ \(wd, watchStillExistsVar) ->
        modifyMVar_ watchStillExistsVar $ \wse -> do
          when wse $
            handle (\(e :: SomeException) -> putStrLn ("Error removing watch: " <> show wd <> " (" <> show e <> ")"))
                   (INo.removeWatch wd)
          return False
      stopListening = modifyMVar_ wdVar $ \x -> maybe (return ()) removeWatches x >> return Nothing
    -- Add watches to this directory plus every sub-directory
    rawInitialPath <- toRawFilePath initialPath
    rawCanonicalInitialPath <- canonicalizeRawDirPath rawInitialPath
    watchDirectoryRecursively listener wdVar actPred callback True rawCanonicalInitialPath
    traverseAllDirs rawCanonicalInitialPath $ \subPath ->
      watchDirectoryRecursively listener wdVar actPred callback False subPath
    return stopListening
 type RecursiveWatches = MVar (Maybe [(INo.WatchDescriptor, MVar Bool)])
 watchDirectoryRecursively :: INotifyListener -> RecursiveWatches -> ActionPredicate -> EventCallback -> Bool -> RawFilePath -> IO ()
 watchDirectoryRecursively listener@(INotifyListener {listenerINotify}) wdVar actPred callback isRootWatchedDir rawFilePath = do
  modifyMVar_ wdVar $ \case
    Nothing -> return Nothing
    Just wds -> do
      watchStillExistsVar <- newMVar True
      hinotifyPath <- rawToHinotifyPath rawFilePath
      wd <- INo.addWatch listenerINotify varieties hinotifyPath (handleRecursiveEvent rawFilePath actPred callback watchStillExistsVar isRootWatchedDir listener wdVar)
      return $ Just ((wd, watchStillExistsVar):wds)
 handleRecursiveEvent :: RawFilePath -> ActionPredicate -> EventCallback -> MVar Bool -> Bool -> INotifyListener -> RecursiveWatches -> INo.Event -> IO ()
 handleRecursiveEvent baseDir actPred callback watchStillExistsVar isRootWatchedDir listener wdVar event = do
  case event of
    (INo.Created True hiNotifyPath) -> do
      -- A new directory was created, so add recursive inotify watches to it
      rawDirPath <- rawFromHinotifyPath hiNotifyPath
      let newRawDir = baseDir <//> rawDirPath
      timestampBeforeAddingWatch <- getPOSIXTime
      watchDirectoryRecursively listener wdVar actPred callback False newRawDir
      newDir <- fromRawFilePath newRawDir
      -- Find all files/folders that might have been created *after* the timestamp, and hence might have been
      -- missed by the watch
      -- TODO: there's a chance of this generating double events, fix
      files <- find False newDir -- TODO: expose the ability to set followSymlinks to True?
      forM_ files $ \newPath -> do
        fileStatus <- getFileStatus newPath
        let modTime = modificationTimeHiRes fileStatus
        when (modTime > timestampBeforeAddingWatch) $ do
          let isDir = if isDirectory fileStatus then IsDirectory else IsFile
          let addedEvent = (Added (newDir </> newPath) (posixSecondsToUTCTime timestampBeforeAddingWatch) isDir)
          when (actPred addedEvent) $ callback addedEvent
    _ -> return ()
  -- If the watched directory was removed, mark the watch as already removed
  case event of
    INo.DeletedSelf -> modifyMVar_ watchStillExistsVar $ const $ return False
    _ -> return ()
  -- Forward the event. Ignore a DeletedSelf if we're not on the root directory,
  -- since the watch above us will pick up the delete of that directory.
  case event of
    INo.DeletedSelf | not isRootWatchedDir -> return ()
    _ -> handleInoEvent actPred callback baseDir watchStillExistsVar event
@@ -1,100 +0,0 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
 module System.FSNotify.Linux.Util (
  canonicalizePath
  , canonicalizeRawDirPath
  , (<//>)
  , traverseAllDirs
  , boolToIsDirectory
  , fromRawFilePath
  , toRawFilePath
  , fromHinotifyPath
  , rawToHinotifyPath
  , rawFromHinotifyPath
  ) where
 import Control.Exception.Safe as E
 import Control.Monad
 import qualified Data.ByteString as BS
 import Data.Function
 import Data.Monoid
 import qualified GHC.Foreign as F
 import GHC.IO.Encoding (getFileSystemEncoding)
 import Prelude hiding (FilePath)
 import System.Directory (canonicalizePath)
 import System.FSNotify.Types
 import System.FilePath (FilePath)
 import System.Posix.ByteString (RawFilePath)
 import System.Posix.Directory.ByteString (openDirStream, readDirStream, closeDirStream)
 import System.Posix.Files (getSymbolicLinkStatus, isDirectory)
 canonicalizeRawDirPath :: RawFilePath -> IO RawFilePath
 canonicalizeRawDirPath p = fromRawFilePath p >>= canonicalizePath >>= toRawFilePath
 -- | Same as </> but for RawFilePath
 -- TODO: make sure this is correct or find in a library
 (<//>) :: RawFilePath -> RawFilePath -> RawFilePath
 x <//> y = x <> "/" <> y
 traverseAllDirs :: RawFilePath -> (RawFilePath -> IO ()) -> IO ()
 traverseAllDirs dir cb = traverseAll dir $ \subPath ->
  -- TODO: wish we didn't need fromRawFilePath here
  -- TODO: should this follow symlinks? (What then about symlinks that escape the parent?)
  fromRawFilePath subPath >>= getSymbolicLinkStatus >>= \case
    (isDirectory -> True) -> cb subPath >> return True
    _ -> return False
 traverseAll :: RawFilePath -> (RawFilePath -> IO Bool) -> IO ()
 traverseAll dir cb = bracket (openDirStream dir) closeDirStream $ \dirStream ->
  fix $ \loop -> do
    readDirStream dirStream >>= \case
      x | BS.null x -> return ()
      "." -> loop
      ".." -> loop
      subDir -> flip finally loop $ do
        -- TODO: canonicalize?
        let fullSubDir = dir <//> subDir
        shouldRecurse <- cb fullSubDir
        when shouldRecurse $ traverseAll fullSubDir cb
 boolToIsDirectory :: Bool -> EventIsDirectory
 boolToIsDirectory False = IsFile
 boolToIsDirectory True = IsDirectory
 toRawFilePath :: FilePath -> IO BS.ByteString
 toRawFilePath fp = do
  enc <- getFileSystemEncoding
  F.withCString enc fp BS.packCString
 fromRawFilePath :: BS.ByteString -> IO FilePath
 fromRawFilePath bs = do
  enc <- getFileSystemEncoding
  BS.useAsCString bs (F.peekCString enc)
 #if MIN_VERSION_hinotify(0, 3, 10)
 fromHinotifyPath :: BS.ByteString -> IO FilePath
 fromHinotifyPath = fromRawFilePath
 rawToHinotifyPath :: BS.ByteString -> IO BS.ByteString
 rawToHinotifyPath = return
 rawFromHinotifyPath :: BS.ByteString -> IO BS.ByteString
 rawFromHinotifyPath = return
 #else
 fromHinotifyPath :: FilePath -> IO FilePath
 fromHinotifyPath = return
 rawToHinotifyPath :: BS.ByteString -> IO FilePath
 rawToHinotifyPath = fromRawFilePath
 rawFromHinotifyPath :: FilePath -> IO BS.ByteString
 rawFromHinotifyPath = toRawFilePath
 #endif
@@ -1,48 +0,0 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 module System.FSNotify.Listener (
  FileListener(..)
  , StopListening
  , ListenFn
  ) where
 import Data.Text
 import Prelude hiding (FilePath)
 import System.FSNotify.Types
 import System.FilePath
 -- | An action that cancels a watching/listening job.
 type StopListening = IO ()
 type ListenFn sessionType argType = FileListener sessionType argType => WatchConfig -> sessionType -> FilePath -> ActionPredicate -> EventCallback -> IO StopListening
 -- | A typeclass that imposes structure on watch managers capable of listening
 -- for events, or simulated listening for events.
 class FileListener sessionType argType | sessionType -> argType where
  -- | Initialize a file listener instance.
  initSession :: argType -> IO (Either Text sessionType)
  -- ^ An initialized file listener, or a reason why one wasn't able to start.
  -- | Kill a file listener instance.
  -- This will immediately stop acting on events for all directories being
  -- watched.
  killSession :: sessionType -> IO ()
  -- | Listen for file events associated with the immediate contents of a directory.
  -- Listening for events associated with immediate contents of a directory will
  -- only report events associated with files within the specified directory, and
  -- not files within its subdirectories.
  listen :: ListenFn sessionType argType
  -- | Listen for file events associated with all the contents of a directory.
  -- Listening for events associated with all the contents of a directory will
  -- report events associated with files within the specified directory and its
  -- subdirectories.
  listenRecursive :: ListenFn sessionType argType
@@ -1,140 +0,0 @@
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 module System.FSNotify.OSX (
  FileListener(..)
  , NativeManager
  ) where
 import Control.Concurrent
 import Control.Monad
 import Data.Bits
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Time.Clock (UTCTime, getCurrentTime)
 import Data.Unique
 import Data.Word
 import Prelude hiding (FilePath)
 import System.Directory
 import System.FSNotify.Listener
 import System.FSNotify.Path (canonicalizeDirPath)
 import System.FSNotify.Types
 import System.FilePath
 import qualified System.OSX.FSEvents as FSE
 data WatchData = WatchData FSE.EventStream EventCallback
 type WatchMap = Map Unique WatchData
 data OSXManager = OSXManager (MVar WatchMap)
 type NativeManager = OSXManager
 nil :: Word64
 nil = 0x00
 -- OS X reports the absolute (canonical) path without a trailing slash. Add
 -- the trailing slash when the path refers to a directory
 canonicalEventPath :: FSE.Event -> FilePath
 canonicalEventPath event =
  if flags .&. dirFlag /= nil then addTrailingPathSeparator path else path
  where
    flags = FSE.eventFlags event
    dirFlag = FSE.eventFlagItemIsDir
    path = FSE.eventPath event
 -- We have to be careful about interpreting the flags in a given event, because
 -- "really it's an OR of all the changes made since the FSEventsListener is created"
 -- See https://stackoverflow.com/questions/18415285/osx-fseventstreameventflags-not-working-correctly
 -- Thus, we try to look at whether the path exists or not to determine whether it was created, modified, etc.
 -- Note that there's still some bugs possible due to event coalescing, which the docs say is a possibility:
 -- for example, a file could be created and modified within a short time interval, and then we'd only emit one
 -- event (the "modified" one, given the logic below)
 -- See https://developer.apple.com/library/content/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html
 fsnEvents :: UTCTime -> FSE.Event -> IO [Event]
 fsnEvents timestamp e = do
  -- Note: we *don't* want to use the canonical event path in the existence check, because of the aforementioned crazy event coalescing.
  -- For example, suppose a directory is created and deleted, and then a file is created with the same name. This means the isDirectory flag might
  -- still be turned on, which could lead us to construct a canonical event path with a trailing slash, which would then cause the existence
  -- check to fail and make us think the file was removed.
  -- The upshot of this is that the canonical event paths in the events we emit can't really be trusted, but hey, that's what the extra flag
  -- on the event is for :(
  exists <- doesPathExist $ FSE.eventPath e
  -- Uncomment for an easy way to see flag activity when testing manually
  -- putStrLn $ show ["Event", show e, "isDirectory", show isDirectory, "isFile", show isFile, "isModified", show isModified, "isCreated", show isCreated, "path", path e, "exists", show exists]
  return $ if | exists && isModified -> [Modified (path e) timestamp isDirectory]
              | exists && isModifiedAttributes -> [ModifiedAttributes (path e) timestamp isDirectory]
              | exists && isCreated -> [Added (path e) timestamp isDirectory]
              | (not exists) && hasFlag e FSE.eventFlagItemRemoved -> [Removed (path e) timestamp isDirectory]
              -- Rename stuff
              | exists && isRenamed -> [Added (path e) timestamp isDirectory]
              | (not exists) && isRenamed -> [Removed (path e) timestamp isDirectory]
              | otherwise -> []
  where
    isDirectory = if hasFlag e FSE.eventFlagItemIsDir then IsDirectory else IsFile
    isFile = hasFlag e FSE.eventFlagItemIsFile
    isCreated = hasFlag e FSE.eventFlagItemCreated
    isRenamed = hasFlag e FSE.eventFlagItemRenamed
    isModified = hasFlag e FSE.eventFlagItemModified
    isModifiedAttributes = hasFlag e FSE.eventFlagItemInodeMetaMod
    path = canonicalEventPath
    hasFlag event flag = FSE.eventFlags event .&. flag /= 0
 handleFSEEvent :: Bool -> ActionPredicate -> EventCallback -> FilePath -> FSE.Event -> IO ()
 handleFSEEvent isRecursive actPred callback dirPath fseEvent = do
  currentTime <- getCurrentTime
  events <- fsnEvents currentTime fseEvent
  forM_ events $ \event ->
    when (actPred event && (isRecursive || (isDirectlyInside dirPath event))) $
      callback event
 -- | For non-recursive monitoring, test if an event takes place directly inside the monitored folder
 isDirectlyInside :: FilePath -> Event -> Bool
 isDirectlyInside dirPath event = isRelevantFileEvent || isRelevantDirEvent
  where
    isRelevantFileEvent = (eventIsDirectory event == IsFile) && (takeDirectory dirPath == (takeDirectory $ eventPath event))
    isRelevantDirEvent = (eventIsDirectory event == IsDirectory) && (takeDirectory dirPath == (takeDirectory $ takeDirectory $ eventPath event))
 listenFn :: (
  ActionPredicate -> EventCallback -> FilePath -> FSE.Event -> IO a
  )
  -> WatchConfig
  -> OSXManager
  -> FilePath
  -> ActionPredicate
  -> EventCallback
  -> IO StopListening
 listenFn handler conf (OSXManager mvarMap) path actPred callback = do
  path' <- canonicalizeDirPath path
  unique <- newUnique
  eventStream <- FSE.eventStreamCreate [path'] 0.0 True False True (handler actPred callback path')
  modifyMVar_ mvarMap $ \watchMap -> return (Map.insert unique (WatchData eventStream callback) watchMap)
  return $ do
    FSE.eventStreamDestroy eventStream
    modifyMVar_ mvarMap $ \watchMap -> return $ Map.delete unique watchMap
 instance FileListener OSXManager () where
  initSession _ = do
    (v1, v2, _) <- FSE.osVersion
    if not $ v1 > 10 || (v1 == 10 && v2 > 6) then return $ Left "Unsupported OS version" else
      (Right . OSXManager) <$> newMVar Map.empty
  killSession (OSXManager mvarMap) = do
    watchMap <- readMVar mvarMap
    forM_ (Map.elems watchMap) eventStreamDestroy'
    where
      eventStreamDestroy' :: WatchData -> IO ()
      eventStreamDestroy' (WatchData eventStream _) = FSE.eventStreamDestroy eventStream
  listen = listenFn $ handleFSEEvent False
  listenRecursive = listenFn $ handleFSEEvent True
@@ -1,83 +0,0 @@
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE CPP #-}
 module System.FSNotify.Path (
  findFiles
  , findFilesAndDirs
  , canonicalizeDirPath
  , canonicalizePath
  , hasThisExtension
  ) where
 import Control.Monad
 import qualified Data.Text as T
 import Prelude hiding (FilePath)
 import qualified System.Directory as D
 import System.FilePath
 import System.PosixCompat.Files as PF
 getDirectoryContentsPath :: FilePath -> IO [FilePath]
 getDirectoryContentsPath path =
  ((map (path </>)) . filter (not . dots) <$> D.getDirectoryContents path) >>= filterM exists
  where
 #if MIN_VERSION_directory(1, 2, 7)
    exists x = D.doesPathExist x
 #else
    exists x = (||) <$> D.doesFileExist x <*> D.doesDirectoryExist x
 #endif
    dots "."  = True
    dots ".." = True
    dots _    = False
 fileDirContents :: FilePath -> IO ([FilePath], [FilePath])
 fileDirContents path = do
  contents <- getDirectoryContentsPath path
  stats <- mapM getFileStatus contents
  let pairs = zip stats contents
  let files = [ f | (s, f) <- pairs, PF.isRegularFile s]
  let dirs = [ d | (s, d) <- pairs, PF.isDirectory s]
  return (files, dirs)
 findAllFiles :: FilePath -> IO [FilePath]
 findAllFiles path = do
  (files, dirs) <- fileDirContents path
  nestedFiles <- mapM findAllFiles dirs
  return (files ++ concat nestedFiles)
 findImmediateFiles :: FilePath -> IO [FilePath]
 findImmediateFiles = fileDirContents >=> mapM D.canonicalizePath . fst
 -- * Exported functions below this point
 findFiles :: Bool -> FilePath -> IO [FilePath]
 findFiles True path  = findAllFiles       =<< canonicalizeDirPath path
 findFiles False path = findImmediateFiles =<<  canonicalizeDirPath path
 findFilesAndDirs :: Bool -> FilePath -> IO [FilePath]
 findFilesAndDirs False path = getDirectoryContentsPath =<< canonicalizeDirPath path
 findFilesAndDirs True path = do
  (files, dirs) <- fileDirContents path
  nestedFilesAndDirs <- concat <$> mapM (findFilesAndDirs False) dirs
  return (files ++ dirs ++ nestedFilesAndDirs)
 -- | add a trailing slash to ensure the path indicates a directory
 addTrailingSlash :: FilePath -> FilePath
 addTrailingSlash = addTrailingPathSeparator
 canonicalizeDirPath :: FilePath -> IO FilePath
 canonicalizeDirPath path = addTrailingSlash `fmap` D.canonicalizePath path
 -- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash
 canonicalizePath :: FilePath -> IO FilePath
 canonicalizePath path = let was_dir = null (takeFileName path) in
  if not was_dir then D.canonicalizePath path
  else canonicalizeDirPath path
 hasThisExtension :: FilePath -> T.Text -> Bool
 hasThisExtension p ext = takeExtension p == T.unpack ext
@@ -1,147 +0,0 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 module System.FSNotify.Polling (
  createPollManager
  , PollManager(..)
  , FileListener(..)
  ) where
 import Control.Concurrent
 import Control.Exception.Safe
 import Control.Monad (forM_)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.Time.Clock (UTCTime)
 import Data.Time.Clock.POSIX
 import Prelude hiding (FilePath)
 import System.Directory (doesDirectoryExist)
 import System.FSNotify.Listener
 import System.FSNotify.Path (findFilesAndDirs, canonicalizeDirPath)
 import System.FSNotify.Types
 import System.FilePath
 import System.PosixCompat.Files
 import System.PosixCompat.Types
 data EventType = AddedEvent
               | ModifiedEvent
               | RemovedEvent
 newtype WatchKey = WatchKey ThreadId deriving (Eq, Ord)
 data WatchData = WatchData FilePath EventCallback
 type WatchMap = Map WatchKey WatchData
 data PollManager = PollManager {
  pollManagerWatchMap :: MVar WatchMap
  , pollManagerInterval :: Int
  }
 generateEvent :: UTCTime -> EventIsDirectory -> EventType -> FilePath -> Maybe Event
 generateEvent timestamp isDir AddedEvent filePath = Just (Added filePath timestamp isDir)
 generateEvent timestamp isDir ModifiedEvent filePath = Just (Modified filePath timestamp isDir)
 generateEvent timestamp isDir RemovedEvent filePath = Just (Removed filePath timestamp isDir)
 generateEvents :: UTCTime -> EventType -> [(FilePath, EventIsDirectory)] -> [Event]
 generateEvents timestamp eventType = mapMaybe (\(path, isDir) -> generateEvent timestamp isDir eventType path)
 -- | Do not return modified events for directories.
 -- These can arise when files are created inside subdirectories, resulting in the modification time
 -- of the directory being bumped. However, to increase consistency with the other FileListeners,
 -- we ignore these events.
 handleEvent :: EventCallback -> ActionPredicate -> Event -> IO ()
 handleEvent _ _ (Modified _ _ IsDirectory) = return ()
 handleEvent callback actPred event
  | actPred event = callback event
  | otherwise = return ()
 pathModMap :: Bool -> FilePath -> IO (Map FilePath (UTCTime, EventIsDirectory))
 pathModMap recursive path = findFilesAndDirs recursive path >>= pathModMap'
  where
    pathModMap' :: [FilePath] -> IO (Map FilePath (UTCTime, EventIsDirectory))
    pathModMap' files = (Map.fromList . catMaybes) <$> mapM pathAndInfo files
    pathAndInfo :: FilePath -> IO (Maybe (FilePath, (UTCTime, EventIsDirectory)))
    pathAndInfo p = handle (\(_ :: IOException) -> return Nothing) $ do
      modTime <- getModificationTime p
      isDir <- doesDirectoryExist p
      return $ Just (p, (modTime, if isDir then IsDirectory else IsFile))
 pollPath :: Int -> Bool -> EventCallback -> FilePath -> ActionPredicate -> Map FilePath (UTCTime, EventIsDirectory) -> IO ()
 pollPath interval recursive callback filePath actPred oldPathMap = do
  threadDelay interval
  maybeNewPathMap <- handle (\(_ :: IOException) -> return Nothing) (Just <$> pathModMap recursive filePath)
  case maybeNewPathMap of
    -- Something went wrong while listing directories; we'll try again on the next poll
    Nothing -> pollPath interval recursive callback filePath actPred oldPathMap
    Just newPathMap -> do
      currentTime <- getCurrentTime
      let deletedMap = Map.difference oldPathMap newPathMap
          createdMap = Map.difference newPathMap oldPathMap
          modifiedAndCreatedMap = Map.differenceWith modifiedDifference newPathMap oldPathMap
          modifiedMap = Map.difference modifiedAndCreatedMap createdMap
          generateEvents' = generateEvents currentTime
      handleEvents $ generateEvents' AddedEvent [(path, isDir) | (path, (_, isDir)) <- Map.toList createdMap]
      handleEvents $ generateEvents' ModifiedEvent [(path, isDir) | (path, (_, isDir)) <- Map.toList modifiedMap]
      handleEvents $ generateEvents' RemovedEvent [(path, isDir) | (path, (_, isDir)) <- Map.toList deletedMap]
      pollPath interval recursive callback filePath actPred newPathMap
  where
    modifiedDifference :: (UTCTime, EventIsDirectory) -> (UTCTime, EventIsDirectory) -> Maybe (UTCTime, EventIsDirectory)
    modifiedDifference (newTime, isDir1) (oldTime, isDir2)
      | oldTime /= newTime || isDir1 /= isDir2 = Just (newTime, isDir1)
      | otherwise = Nothing
    handleEvents :: [Event] -> IO ()
    handleEvents = mapM_ (handleEvent callback actPred)
 -- Additional init function exported to allow startManager to unconditionally
 -- create a poll manager as a fallback when other managers will not instantiate.
 createPollManager :: Int -> IO PollManager
 createPollManager interval  = PollManager <$> newMVar Map.empty <*> pure interval
 killWatchingThread :: WatchKey -> IO ()
 killWatchingThread (WatchKey threadId) = killThread threadId
 killAndUnregister :: MVar WatchMap -> WatchKey -> IO ()
 killAndUnregister mvarMap wk = do
  _ <- withMVar mvarMap $ \m -> do
    killWatchingThread wk
    return $ Map.delete wk m
  return ()
 listen' :: Bool -> WatchConfig -> PollManager -> FilePath -> ActionPredicate -> EventCallback -> IO (IO ())
 listen' isRecursive _conf (PollManager mvarMap interval) path actPred callback = do
  path' <- canonicalizeDirPath path
  pmMap <- pathModMap isRecursive path'
  threadId <- forkIO $ pollPath interval isRecursive callback path' actPred pmMap
  let wk = WatchKey threadId
  modifyMVar_ mvarMap $ return . Map.insert wk (WatchData path' callback)
  return $ killAndUnregister mvarMap wk
 instance FileListener PollManager Int where
  initSession interval = Right <$> createPollManager interval
  killSession (PollManager mvarMap _) = do
    watchMap <- readMVar mvarMap
    forM_ (Map.keys watchMap) killWatchingThread
  listen = listen' False
  listenRecursive = listen' True
 getModificationTime :: FilePath -> IO UTCTime
 getModificationTime p = fromEpoch . modificationTime <$> getFileStatus p
 fromEpoch :: EpochTime -> UTCTime
 fromEpoch = posixSecondsToUTCTime . realToFrac
@@ -1,102 +0,0 @@
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 {-# LANGUAGE CPP #-}
 module System.FSNotify.Types (
  act
  , ActionPredicate
  , Action
  , DebounceFn
  , WatchConfig(..)
  , WatchMode(..)
  , ThreadingMode(..)
  , Event(..)
  , EventIsDirectory(..)
  , EventCallback
  , EventChannel
  , EventAndActionChannel
  , IOEvent
  ) where
 import Control.Concurrent.Chan
 import Control.Exception.Safe
 import Data.IORef (IORef)
 import Data.Time.Clock (UTCTime)
 import Prelude hiding (FilePath)
 import System.FilePath
 data EventIsDirectory = IsFile | IsDirectory
  deriving (Show, Eq)
 -- | A file event reported by a file watcher. Each event contains the
 -- canonical path for the file and a timestamp guaranteed to be after the
 -- event occurred (timestamps represent current time when FSEvents receives
 -- it from the OS and/or platform-specific Haskell modules).
 data Event =
    Added { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory }
  | Modified { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory }
  | ModifiedAttributes { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory }
  | Removed { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory }
  -- | Note: Linux-only
  | WatchedDirectoryRemoved  { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory }
  -- | Note: Linux-only
  | CloseWrite  { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory }
  -- | Note: Linux-only
  | Unknown  { eventPath :: FilePath, eventTime :: UTCTime, eventIsDirectory :: EventIsDirectory, eventString :: String }
  deriving (Eq, Show)
 type EventChannel = Chan Event
 type EventCallback = Event -> IO ()
 type EventAndActionChannel = Chan (Event, Action)
 -- | Method of watching for changes.
 data WatchMode =
  WatchModePoll {
    watchModePollInterval :: Int
    -- ^ Polling interval in microseconds.
  }
  -- ^ Detect changes by polling the filesystem. Less efficient and may miss fast changes. Not recommended
  -- unless you're experiencing problems with 'WatchModeOS' (or 'WatchModeOS' is not supported on your platform).
 #ifdef HAVE_NATIVE_WATCHER
  | WatchModeOS
  -- ^ Use OS-specific mechanisms to be notified of changes (inotify on Linux, FSEvents on OSX, etc.).
  -- Not currently available on e.g. *BSD and Wasm/WASI.
 #endif
 data ThreadingMode =
  SingleThread
  -- ^ Use a single thread for the entire 'Manager'. Event handler callbacks will run sequentially.
  | ThreadPerWatch
  -- ^ Use a single thread for each watch (i.e. each call to 'watchDir', 'watchTree', etc.).
  -- Callbacks within a watch will run sequentially but callbacks from different watches may be interleaved.
  | ThreadPerEvent
  -- ^ Launch a separate thread for every event handler.
 -- | Watch configuration.
 data WatchConfig = WatchConfig
  { confWatchMode :: WatchMode
    -- ^ Watch mode to use.
  , confThreadingMode :: ThreadingMode
    -- ^ Threading mode to use.
  , confOnHandlerException :: SomeException -> IO ()
    -- ^ Called when a handler throws an exception.
  }
 type IOEvent = IORef Event
 -- | A predicate used to determine whether to act on an event.
 type ActionPredicate = Event -> Bool
 -- | An action to be performed in response to an event.
 type Action = Event -> IO ()
 -- | A general debouncing function.
 type DebounceFn = Action -> IO Action
 -- | Predicate to always act.
 act :: ActionPredicate
 act _ = True
@@ -1,72 +0,0 @@
 --
 -- Copyright (c) 2012 Mark Dittmer - http://www.markdittmer.org
 -- Developed for a Google Summer of Code project - http://gsoc2012.markdittmer.org
 --
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module System.FSNotify.Win32 (
  FileListener(..)
  , NativeManager
  ) where
 import Control.Concurrent
 import Control.Monad (when)
 import Data.Bits
 import qualified Data.Map as Map
 import Data.Time (getCurrentTime, UTCTime)
 import Prelude
 import System.FSNotify.Listener
 import System.FSNotify.Path (canonicalizeDirPath)
 import System.FSNotify.Types
 import System.FilePath
 import qualified System.Win32.Notify as WNo
 type NativeManager = WNo.WatchManager
 -- Win32-notify has (temporarily?) dropped support for Renamed events.
 fsnEvent :: EventIsDirectory -> FilePath -> UTCTime -> WNo.Event -> Event
 fsnEvent isDirectory basedir timestamp (WNo.Created name) = Added (normalise (basedir </> name)) timestamp isDirectory
 fsnEvent isDirectory basedir timestamp (WNo.Modified name) = Modified (normalise (basedir </> name)) timestamp isDirectory
 fsnEvent isDirectory basedir timestamp (WNo.Deleted name) = Removed (normalise (basedir </> name)) timestamp isDirectory
 handleWNoEvent :: EventIsDirectory -> FilePath -> ActionPredicate -> EventCallback -> WNo.Event -> IO ()
 handleWNoEvent isDirectory basedir actPred callback inoEvent = do
  currentTime <- getCurrentTime
  let event = fsnEvent isDirectory basedir currentTime inoEvent
  when (actPred event) $ callback event
 watchDirectory :: Bool -> WatchConfig -> WNo.WatchManager -> FilePath -> ActionPredicate -> EventCallback -> IO (IO ())
 watchDirectory isRecursive _conf watchManager@(WNo.WatchManager mvarMap) path actPred callback = do
  path' <- canonicalizeDirPath path
  let fileFlags = foldl (.|.) 0 [WNo.fILE_NOTIFY_CHANGE_FILE_NAME
                                , WNo.fILE_NOTIFY_CHANGE_SIZE
                                , WNo.fILE_NOTIFY_CHANGE_ATTRIBUTES]
  let dirFlags = foldl (.|.) 0 [WNo.fILE_NOTIFY_CHANGE_DIR_NAME]
  -- Start one watch for file events and one for directory events
  -- (There seems to be no other way to provide isDirectory information)
  wid1 <- WNo.watchDirectory watchManager path' isRecursive fileFlags (handleWNoEvent IsFile path' actPred callback)
  wid2 <- WNo.watchDirectory watchManager path' isRecursive dirFlags (handleWNoEvent IsDirectory path' actPred callback)
  -- The StopListening action should make sure to remove the watches from the manager after they're killed.
  -- Otherwise, a call to killSession would cause us to try to kill them again, resulting in an invalid handle error.
  return $ do
    WNo.killWatch wid1
    modifyMVar_ mvarMap $ \watchMap -> return (Map.delete wid1 watchMap)
    WNo.killWatch wid2
    modifyMVar_ mvarMap $ \watchMap -> return (Map.delete wid2 watchMap)
 instance FileListener WNo.WatchManager () where
  -- TODO: This should actually lookup a Windows API version and possibly return
  -- Nothing the calls we need are not available. This will require that API
  -- version information be exposed by Win32-notify.
  initSession _ = Right <$> WNo.initWatchManager
  killSession = WNo.killWatchManager
  listen = watchDirectory False
  listenRecursive = watchDirectory True
@@ -1,165 +0,0 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# HLINT ignore "Redundant multi-way if" #-}
 module FSNotify.Test.EventTests where
 import Control.Exception.Safe (MonadThrow)
 import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.List as L
 import Data.Monoid
 import Data.Ord (comparing)
 import FSNotify.Test.Util
 import Prelude hiding (FilePath)
 import System.FSNotify
 import System.FilePath
 import System.IO (hPutStr)
 import Test.Sandwich
 import UnliftIO hiding (poll)
 import UnliftIO.Directory
 eventTests :: (
  MonadUnliftIO m, MonadThrow m
  ) => TestFolderGenerator -> ThreadingMode -> SpecFree context m ()
 eventTests testFolderGenerator threadingMode = describe "Tests" $ parallelWithoutDirectory $ do
  let pollOptions = if haveNativeWatcher then [False, True] else [True]
  forM_ pollOptions $ \poll -> describe (if poll then "Polling" else "Native") $ parallelWithoutDirectory $ do
    forM_ [False, True] $ \recursive -> describe (if recursive then "Recursive" else "Non-recursive") $ parallelWithoutDirectory $
      forM_ [False, True] $ \nested -> describe (if nested then "Nested" else "Non-nested") $ parallelWithoutDirectory $
        eventTests' testFolderGenerator threadingMode poll recursive nested
 eventTests' :: (
  MonadUnliftIO m, MonadThrow m
  ) => TestFolderGenerator -> ThreadingMode -> Bool -> Bool -> Bool -> SpecFree context m ()
 eventTests' testFolderGenerator threadingMode poll recursive nested = do
  let withFolder' = withTestFolder testFolderGenerator threadingMode poll recursive nested
  let withFolder action = withFolder' (const $ return ()) (\() ctx -> action ctx)
  let waitForEvents getEvents action = waitUntil 5.0 (liftIO getEvents >>= action)
  unless (nested || poll || isMac || isWin) $ it "deletes the watched directory" $ withFolder $ \(TestFolderContext watchedDir _f getEvents _clearEvents) -> do
    removeDirectory watchedDir
    waitForEvents getEvents $ \case
      [WatchedDirectoryRemoved {..}] | eventPath `equalFilePath` watchedDir && eventIsDirectory == IsDirectory -> return ()
      events -> expectationFailure $ "Got wrong events: " <> show events
  it "works with a new file" $ withFolder $ \(TestFolderContext _watchedDir f getEvents _clearEvents) -> do
    let wrapper action = if | isWin -> liftIO (writeFile f "foo") >> action
                            | otherwise -> withFile f AppendMode $ \_ -> action
    wrapper $
      waitForEvents getEvents $ \events ->
        if | nested && not recursive -> events `shouldBe` []
           | isWin && not poll -> case events of
               -- On Windows, we sometimes get an extra modified event
               (sortEvents -> [Added {..}, Modified {}]) | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
               _ -> expectationFailure $ "Got wrong events: " <> show events
           | otherwise -> case events of
               [Added {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
               _ -> expectationFailure $ "Got wrong events: " <> show events
  it "works with a new directory" $ withFolder $ \(TestFolderContext _watchedDir f getEvents _clearEvents) -> do
    createDirectory f
    waitForEvents getEvents $ \events ->
      if | nested && not recursive -> events `shouldBe` []
         | otherwise -> case events of
             [Added {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsDirectory -> return ()
             _ -> expectationFailure $ "Got wrong events: " <> show events
  it "works with a deleted file" $ withFolder' (\f -> liftIO $ writeFile f "") $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do
    removeFile f
    waitForEvents getEvents $ \events ->
      if | nested && not recursive -> events `shouldBe` []
         | otherwise -> case events of
             [Removed {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
             _ -> expectationFailure $ "Got wrong events: " <> show events
  unless isWin $ do
    it "works if there is bad symlink" $ withFolder' (\f -> liftIO $ createSymLink (f <> ".doesNotExist") f) $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do
      waitForEvents getEvents $ \events -> events `shouldBe` []
  it "works with a deleted directory" $ withFolder' (\f -> liftIO $ createDirectory f) $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do
    removeDirectory f
    waitForEvents getEvents $ \events ->
      if | nested && not recursive -> events `shouldBe` []
         | otherwise -> case events of
             [Removed {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsDirectory -> return ()
             _ -> expectationFailure $ "Got wrong events: " <> show events
  it "works with modified file attributes" $ withFolder' (\f -> liftIO $ writeFile f "") $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do
    liftIO $ changeFileAttributes f
    -- This test is disabled when polling because the PollManager only keeps track of
    -- modification time, so it won't catch an unrelated file attribute change
    waitForEvents getEvents $ \events ->
      if | poll -> return ()
         | nested && not recursive -> events `shouldBe` []
         | isWin -> case events of
             [Modified {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
             _ -> expectationFailure $ "Got wrong events: " <> show events
         | otherwise -> case events of
             [ModifiedAttributes {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
             _ -> expectationFailure $ "Got wrong events: " <> show events
  it "works with a modified file" $ withFolder' (\f -> liftIO $ writeFile f "") $ \() (TestFolderContext _watchedDir f getEvents _clearEvents) -> do
    (if isWin then withSingleWriteFile f "foo" else withOpenWritableAndWrite f "foo") $
      waitForEvents getEvents $ \events ->
        if | nested && not recursive -> events `shouldBe` []
           | isMac || isFreeBSD -> case events of
               [Modified {..}] | poll && eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
               [ModifiedAttributes {..}] | not poll && eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
               _ -> expectationFailure $ "Got wrong events: " <> show events <> " (wanted file path " <> show f <> ")"
           | otherwise -> case events of
               [Modified {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
               _ -> expectationFailure $ "Got wrong events: " <> show events <> " (wanted file path " <> show f <> ")"
  when (isLinux || isFreeBSD) $ unless poll $ do
    let setup f = liftIO $ do
          h <- openFile f WriteMode
          hPutStr h "asdf" >> hFlush h
          return h
    it "gets a close_write" $ withFolder' setup $ \h (TestFolderContext _watchedDir f getEvents _clearEvents) -> do
      liftIO $ hClose h
      waitForEvents getEvents $ \events ->
        if | nested && not recursive -> events `shouldBe` []
           | otherwise -> case events of
               [CloseWrite {..}] | eventPath `equalFilePath` f && eventIsDirectory == IsFile -> return ()
               _ -> expectationFailure $ "Got wrong events: " <> show events
 withSingleWriteFile :: MonadIO m => FilePath -> String -> m b -> m b
 withSingleWriteFile fp contents action = do
  liftIO $ writeFile fp contents
  action
 withOpenWritableAndWrite :: MonadUnliftIO m => FilePath -> String -> m b -> m b
 withOpenWritableAndWrite fp contents action = do
  withFile fp WriteMode $ \h ->
    flip finally (hClose h) $ do
      liftIO $ hPutStr h contents
      action
 sortEvents :: [Event] -> [Event]
 sortEvents = L.sortBy (comparing eventToNum)
  where
    eventToNum :: Event -> Int
    eventToNum (Added {}) = 1
    eventToNum (Modified {}) = 2
    eventToNum (ModifiedAttributes {}) = 3
    eventToNum (Removed {}) = 4
    eventToNum (WatchedDirectoryRemoved {}) = 5
    eventToNum (CloseWrite {}) = 6
    eventToNum (Unknown {}) = 7
@@ -1,207 +0,0 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ViewPatterns #-}
 module FSNotify.Test.Util where
 import Control.Exception.Safe (Handler(..))
 import Control.Monad.Logger
 import Control.Retry
 import Data.String.Interpolate
 import System.FSNotify
 import System.FilePath
 import Test.Sandwich
 import UnliftIO hiding (poll, Handler)
 import UnliftIO.Concurrent
 import UnliftIO.Directory
 #if !MIN_VERSION_base(4,11,0)
 import Data.Monoid
 #endif
 #ifdef mingw32_HOST_OS
 import Data.Bits
 import System.Win32.File (getFileAttributes, setFileAttributes, fILE_ATTRIBUTE_TEMPORARY)
 import System.Win32.SymbolicLink (createSymbolicLinkFile)
 -- Perturb the file's attributes, to check that a modification event is emitted
 changeFileAttributes :: FilePath -> IO ()
 changeFileAttributes file = do
  attrs <- getFileAttributes file
  setFileAttributes file (attrs `xor` fILE_ATTRIBUTE_TEMPORARY)
 createSymLink :: FilePath -> FilePath -> IO ()
 #if __GLASGOW_HASKELL__ < 900
 createSymLink file1 file2 = createSymbolicLinkFile file1 file2
 #else
 createSymLink file1 file2 = createSymbolicLinkFile file1 file2 True
 #endif
 #else
 import System.PosixCompat.Files (touchFile, createSymbolicLink)
 changeFileAttributes :: FilePath -> IO ()
 changeFileAttributes = touchFile
 createSymLink :: FilePath -> FilePath -> IO ()
 createSymLink = createSymbolicLink
 #endif
 isMac :: Bool
 #ifdef darwin_HOST_OS
 isMac = True
 #else
 isMac = False
 #endif
 isWin :: Bool
 #ifdef mingw32_HOST_OS
 isWin = True
 #else
 isWin = False
 #endif
 isLinux :: Bool
 #ifdef linux_HOST_OS
 isLinux = True
 #else
 isLinux = False
 #endif
 isFreeBSD :: Bool
 #ifdef freebsd_HOST_OS
 isFreeBSD = True
 #else
 isFreeBSD = False
 #endif
 haveNativeWatcher :: Bool
 #ifdef HAVE_NATIVE_WATCHER
 haveNativeWatcher = True
 #else
 haveNativeWatcher = False
 #endif
 waitUntil :: MonadUnliftIO m => Double -> m a -> m a
 #if MIN_VERSION_retry(0, 7, 0)
 waitUntil timeInSeconds action = withRunInIO $ \runInIO ->
  recovering policy [\_ -> Handler handleFn] (\_ -> runInIO action)
 #else
 waitUntil timeInSeconds action = withRunInIO $ \runInIO ->
  recovering policy [\_ -> Handler handleFn] (runInIO action)
 #endif
  where
    handleFn :: SomeException -> IO Bool
    handleFn (fromException -> Just (_ :: FailureReason)) = return True
    handleFn _ = return False
    policy = limitRetriesByCumulativeDelay (round (timeInSeconds * 1000000.0)) $ capDelay 1000000 $ exponentialBackoff 1000
 data TestFolderContext = TestFolderContext {
  watchedDir :: FilePath
  , filePath :: FilePath
  , getEvents :: IO [Event]
  , clearEvents :: IO ()
  }
 data TestFolderGenerator = TestFolderGenerator {
  testFolderGeneratorRootDir :: FilePath
  , testFolderGeneratorId :: MVar Int
  }
 newTestFolderGenerator :: MonadUnliftIO m => FilePath -> m TestFolderGenerator
 newTestFolderGenerator dir = TestFolderGenerator dir <$> newMVar 0
 withTestFolderGenerator :: MonadUnliftIO m => (TestFolderGenerator -> m a) -> m a
 withTestFolderGenerator action = do
  withSystemTempDirectory "hfsnotify-tests" $ \dir ->
    newTestFolderGenerator dir >>= action
 withRandomTempDirectory :: MonadUnliftIO m => TestFolderGenerator -> (FilePath -> m a) -> m a
 withRandomTempDirectory (TestFolderGenerator {..}) action = do
  testId <- modifyMVar testFolderGeneratorId $ \x ->
    return (x + 1, x)
  let dir = testFolderGeneratorRootDir </> ("test_" <> show testId)
  bracket_ (createDirectory dir)
           (removePathForcibly dir)
           (action dir)
 withTestFolder :: (
  MonadUnliftIO m, MonadLogger m
  )
  => TestFolderGenerator
  -> ThreadingMode
  -> Bool
  -> Bool
  -> Bool
  -> (FilePath -> m b)
  -> (b -> TestFolderContext -> m a)
  -> m a
 withTestFolder testFolderGenerator threadingMode poll recursive nested setup action = do
  withRandomTempDirectory testFolderGenerator $ \watchedDir' -> do
    info [i|Got temp directory: #{watchedDir'}|]
    let fileName = "testfile"
    let baseDir = if nested then watchedDir' </> "subdir" else watchedDir'
    let watchFn = if recursive then watchTree else watchDir
    createDirectoryIfMissing True baseDir
    let p = normalise $ baseDir </> fileName
    setupResult <- setup p
    let pollInterval = 2 * 10^(5 :: Int)
    -- Delay before starting the watcher to make sure setup events picked up.
    --
    -- For MacOS, we can apparently get an event for the creation of "subdir" when doing nested tests,
    -- even though we create the watcher after this.
    --
    -- On Windows, we occasionally see a test flake when there's no pause here.
    --
    -- So, let's put a healthy sleep between the setup actions and the watcher initialization.
    --
    -- When polling, we want to ensure we wait at least as long as the effective filesystem modification
    -- time granularity (which on Linux can be on the order of 10 milliseconds), *or*
    -- the poll interval, whichever is greater.
    threadDelay (max 5_000_000 (3 * pollInterval))
    let conf = defaultConfig {
 #ifndef HAVE_NATIVE_WATCHER
          confWatchMode = if poll then WatchModePoll pollInterval else error "No native watcher available."
 #else
          confWatchMode = if poll then WatchModePoll pollInterval else WatchModeOS
 #endif
          , confThreadingMode = threadingMode
          }
    withRunInIO $ \runInIO ->
      withManagerConf conf $ \mgr -> do
        eventsVar <- newIORef []
        bracket
          (watchFn mgr watchedDir' (const True) (\ev -> atomicModifyIORef eventsVar (\evs -> (ev:evs, ()))))
          (\stop -> stop)
          (\_ -> runInIO $ action setupResult $ TestFolderContext {
            watchedDir = watchedDir'
            , filePath = p
            , getEvents = readIORef eventsVar
            , clearEvents = atomicWriteIORef eventsVar []
            }
          )
 parallelWithoutDirectory :: SpecFree context m () -> SpecFree context m ()
 parallelWithoutDirectory = parallel' (defaultNodeOptions {
                                         nodeOptionsCreateFolder = False
                                         , nodeOptionsVisibilityThreshold = 70
                                         })
@@ -1,50 +0,0 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Main where
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.String.Interpolate
 import FSNotify.Test.EventTests
 import FSNotify.Test.Util
 import Prelude hiding (FilePath)
 import System.FSNotify
 import System.FilePath
 import Test.Sandwich
 import UnliftIO.IORef
 main :: IO ()
 main =
  withTestFolderGenerator $ \testFolderGenerator ->
  runSandwichWithCommandLineArgs defaultOptions $ parallelN 20 $ do
    describe "Configuration" $ do
      it "respects the confOnHandlerException option" $ do
        withRandomTempDirectory testFolderGenerator $ \watchedDir' -> do
          info [i|Got temp dir: #{watchedDir'}|]
          exceptions <- newIORef (0 :: Int)
          let conf = defaultConfig { confOnHandlerException = \_ -> modifyIORef exceptions (+ 1) }
          liftIO $ withManagerConf conf $ \mgr -> do
            stop <- watchDir mgr watchedDir' (const True) $ \ev -> do
              case ev of
 #ifdef darwin_HOST_OS
                Modified {} -> expectationFailure "Oh no!"
 #else
                Added {} -> expectationFailure "Oh no!"
 #endif
                _ -> return ()
            writeFile (watchedDir' </> "testfile") "foo"
            waitUntil 5.0 $
              readIORef exceptions >>= (`shouldBe` 1)
            stop
    describe "SingleThread" $ eventTests testFolderGenerator SingleThread
    describe "ThreadPerWatch" $ eventTests testFolderGenerator ThreadPerWatch
    describe "ThreadPerEvent" $ eventTests testFolderGenerator ThreadPerEvent
@@ -1,196 +0,0 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 #if __GLASGOW_HASKELL__ >= 701
 {-# LANGUAGE InterruptibleFFI #-}
 #endif
 {-# LANGUAGE LambdaCase #-}
 module System.Win32.FileNotify (
  Handle
  , Action(..)
  , getWatchHandle
  , readDirectoryChanges
  ) where
 import Data.Char (isSpace)
 import Foreign ((.|.), Ptr, FunPtr, alloca, allocaBytes, castPtr, nullFunPtr, peekByteOff, plusPtr)
 import Foreign.C (peekCWStringLen)
 import Numeric (showHex)
 import System.Win32.File (
  FileNotificationFlag
  , LPOVERLAPPED
  , createFile
  , oPEN_EXISTING
  , fILE_FLAG_BACKUP_SEMANTICS
  , fILE_LIST_DIRECTORY
  , fILE_SHARE_READ
  , fILE_SHARE_WRITE
  )
 import System.Win32.Types (
  BOOL
  , DWORD
  , ErrCode
  , HANDLE
  , LPDWORD
  , LPVOID
  , getErrorMessage
  , getLastError
  , localFree
  , nullPtr
  )
 import System.Win32.Types (peekTString)
 #include <windows.h>
 type Handle = HANDLE
 getWatchHandle :: FilePath -> IO Handle
 getWatchHandle dir = createFile dir
  fILE_LIST_DIRECTORY -- Access mode
  (fILE_SHARE_READ .|. fILE_SHARE_WRITE) -- Share mode
  Nothing -- security attributes
  oPEN_EXISTING -- Create mode, we want to look at an existing directory
  fILE_FLAG_BACKUP_SEMANTICS -- File attribute, nb NOT using OVERLAPPED since we work synchronously
  Nothing -- No template file
 readDirectoryChanges :: Handle -> Bool -> FileNotificationFlag -> IO (Either (ErrCode, String) [(Action, String)])
 readDirectoryChanges h watchSubTree mask = do
  let maxBuf = 16384
  allocaBytes maxBuf $ \buffer -> do
    alloca $ \bret -> do
      readDirectoryChangesW h buffer (toEnum maxBuf) watchSubTree mask bret >>= \case
        Left err -> return $ Left err
        Right () -> Right <$> readChanges buffer
 data Action = FileAdded | FileRemoved | FileModified | FileRenamedOld | FileRenamedNew
  deriving (Show, Read, Eq, Ord, Enum)
 readChanges :: Ptr FILE_NOTIFY_INFORMATION -> IO [(Action, String)]
 readChanges pfni = do
  fni <- peekFNI pfni
  let entry = (faToAction $ fniAction fni, fniFileName fni)
      nioff = fromEnum $ fniNextEntryOffset fni
  entries <- if nioff == 0 then return [] else readChanges $ pfni `plusPtr` nioff
  return $ entry:entries
 faToAction :: FileAction -> Action
 faToAction fa = toEnum $ fromEnum fa - 1
 -------------------------------------------------------------------
 -- Low-level stuff that binds to notifications in the Win32 API
 -- Defined in System.Win32.File, but with too few cases:
 -- type AccessMode = UINT
 #if !(MIN_VERSION_Win32(2,4,0))
 #{enum AccessMode,
 , fILE_LIST_DIRECTORY = FILE_LIST_DIRECTORY
 }
 -- there are many more cases but I only need this one.
 #endif
 type FileAction = DWORD
 #{enum FileAction,
 , _fILE_ACTION_ADDED            = FILE_ACTION_ADDED
 , _fILE_ACTION_REMOVED          = FILE_ACTION_REMOVED
 , _fILE_ACTION_MODIFIED         = FILE_ACTION_MODIFIED
 , _fILE_ACTION_RENAMED_OLD_NAME = FILE_ACTION_RENAMED_OLD_NAME
 , _fILE_ACTION_RENAMED_NEW_NAME = FILE_ACTION_RENAMED_NEW_NAME
 }
 -- type WCHAR = Word16
 -- This is a bit overkill for now, I'll only use nullFunPtr anyway,
 -- but who knows, maybe someday I'll want asynchronous callbacks on the OS level.
 type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
 data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
    { fniNextEntryOffset, fniAction :: DWORD
    , fniFileName :: String
    }
 -- instance Storable FILE_NOTIFY_INFORMATION where
 -- ... well, we can't write an instance since the struct is not of fix size,
 -- so we'll have to do it the hard way, and not get anything for free. Sigh.
 -- sizeOfFNI :: FILE_NOTIFY_INFORMATION -> Int
 -- sizeOfFNI fni =  (#size FILE_NOTIFY_INFORMATION) + (#size WCHAR) * (length (fniFileName fni) - 1)
 peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
 peekFNI buf = do
  neof <- (#peek FILE_NOTIFY_INFORMATION, NextEntryOffset) buf
  acti <- (#peek FILE_NOTIFY_INFORMATION, Action) buf
  fnle <- (#peek FILE_NOTIFY_INFORMATION, FileNameLength) buf
  fnam <- peekCWStringLen
            (buf `plusPtr` (#offset FILE_NOTIFY_INFORMATION, FileName), -- start of array
            fromEnum (fnle :: DWORD) `div` 2 ) -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
  return $ FILE_NOTIFY_INFORMATION neof acti fnam
 readDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag -> LPDWORD -> IO (Either (ErrCode, String) ())
 readDirectoryChangesW h buf bufSize watchSubTree f br =
  c_ReadDirectoryChangesW h (castPtr buf) bufSize watchSubTree f br nullPtr nullFunPtr >>= \case
    True -> return $ Right ()
    False -> do
      -- Extract the failure message, as done in https://hackage.haskell.org/package/Win32-2.14.0.0/docs/src/System.Win32.WindowsString.Types.html#errorWin
      err_code <- getLastError
      msg <- getErrorMessage err_code >>= \case
        x | x == nullPtr -> return $ "Error 0x" ++ Numeric.showHex err_code ""
        c_msg -> do
          msg <- peekTString c_msg
          -- We ignore failure of freeing c_msg, given we're already failing
          _ <- localFree c_msg
          return msg
      let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n
      return $ Left (err_code, msg')
 {-
 asynchReadDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag
                                -> LPOVERLAPPED -> IO ()
 asynchReadDirectoryChangesW h buf bufSize watchSubTree f over =
  failIfFalse_ "ReadDirectoryChangesW" $ c_ReadDirectoryChangesW h (castPtr buf) bufSize watchSubTree f nullPtr over nullFunPtr
 cbReadDirectoryChangesW :: Handle -> Ptr FILE_NOTIFY_INFORMATION -> DWORD -> BOOL -> FileNotificationFlag
                                -> LPOVERLAPPED -> IO BOOL
 cbReadDirectoryChanges
 -}
 -- The interruptible qualifier will keep threads listening for events from hanging blocking when killed
 #if __GLASGOW_HASKELL__ >= 701
 foreign import stdcall interruptible "windows.h ReadDirectoryChangesW"
 #else
 foreign import stdcall safe "windows.h ReadDirectoryChangesW"
 #endif
  c_ReadDirectoryChangesW :: Handle -> LPVOID -> DWORD -> BOOL -> DWORD -> LPDWORD -> LPOVERLAPPED -> LPOVERLAPPED_COMPLETION_ROUTINE -> IO BOOL
 {-
 type CompletionRoutine :: (DWORD, DWORD, LPOVERLAPPED) -> IO ()
 foreign import ccall "wrapper"
    mkCompletionRoutine :: CompletionRoutine -> IO (FunPtr CompletionRoutine)
 type LPOVERLAPPED = Ptr OVERLAPPED
 type LPOVERLAPPED_COMPLETION_ROUTINE = FunPtr CompletionRoutine
 data OVERLAPPED = OVERLAPPED
    {
    }
 -- In System.Win32.File, but missing a crucial case:
 -- type FileNotificationFlag = DWORD
 -}
 -- See https://msdn.microsoft.com/en-us/library/windows/desktop/aa365465(v=vs.85).aspx
 #{enum FileNotificationFlag,
 , _fILE_NOTIFY_CHANGE_FILE_NAME = FILE_NOTIFY_CHANGE_FILE_NAME
 , _fILE_NOTIFY_CHANGE_DIR_NAME = FILE_NOTIFY_CHANGE_DIR_NAME
 , _fILE_NOTIFY_CHANGE_ATTRIBUTES = FILE_NOTIFY_CHANGE_ATTRIBUTES
 , _fILE_NOTIFY_CHANGE_SIZE = FILE_NOTIFY_CHANGE_SIZE
 , _fILE_NOTIFY_CHANGE_LAST_WRITE = FILE_NOTIFY_CHANGE_LAST_WRITE
 , _fILE_NOTIFY_CHANGE_LAST_ACCESS = FILE_NOTIFY_CHANGE_LAST_ACCESS
 , _fILE_NOTIFY_CHANGE_CREATION = FILE_NOTIFY_CHANGE_CREATION
 , _fILE_NOTIFY_CHANGE_SECURITY = FILE_NOTIFY_CHANGE_SECURITY
 }
@@ -1,123 +0,0 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuasiQuotes #-}
 module System.Win32.Notify (
  Event(..)
  , EventVariety(..)
  , Handler
  , WatchId(..)
  , WatchManager(..)
  , initWatchManager
  , killWatch
  , killWatchManager
  , watch
  , watchDirectory
  , fILE_NOTIFY_CHANGE_FILE_NAME
  , fILE_NOTIFY_CHANGE_DIR_NAME
  , fILE_NOTIFY_CHANGE_ATTRIBUTES
  , fILE_NOTIFY_CHANGE_SIZE
  , fILE_NOTIFY_CHANGE_LAST_WRITE
  -- , fILE_NOTIFY_CHANGE_LAST_ACCESS
  -- , fILE_NOTIFY_CHANGE_CREATION
  , fILE_NOTIFY_CHANGE_SECURITY
  ) where
 import Control.Concurrent
 import Control.Exception.Safe (SomeException, catch, throwIO)
 import Control.Monad (forM_, forever)
 import Data.Function (fix)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Foreign.C.Error (errnoToIOError)
 import System.FilePath
 import System.IO.Error (ioeSetErrorString)
 import System.Win32.File
 import System.Win32.FileNotify
 import System.Win32.Types (c_maperrno_func)
 data EventVariety =
  Modify
  | Create
  | Delete
  | Move
  deriving Eq
 data Event
  -- | A file was modified. @Modified isDirectory file@
  = Modified { filePath :: FilePath }
  -- | A file was created. @Created isDirectory file@
  | Created { filePath :: FilePath }
  -- | A file was deleted. @Deleted isDirectory file@
  | Deleted { filePath :: FilePath }
  deriving (Eq, Show)
 type Handler = Event -> IO ()
 data WatchId = WatchId [ThreadId] Handle deriving (Eq, Ord, Show)
 type WatchMap = Map WatchId Handler
 data WatchManager = WatchManager { watchManagerWatchMap :: MVar WatchMap }
 initWatchManager :: IO WatchManager
 initWatchManager = WatchManager <$> newMVar Map.empty
 killWatchManager :: WatchManager -> IO ()
 killWatchManager (WatchManager mvarMap) = do
  modifyMVar_ mvarMap $ \watchMap -> do
    forM_ (Map.keys watchMap) killWatch
    return mempty
 watchDirectory :: WatchManager -> FilePath -> Bool -> FileNotificationFlag -> Handler -> IO WatchId
 watchDirectory (WatchManager mvarMap) dir watchSubTree flags handler = do
  watchHandle <- getWatchHandle dir
  chanEvents <- newChan
  tid1 <- forkIO $ dispatcher chanEvents
  tid2 <- forkIO $ osEventsReader dir watchSubTree flags watchHandle chanEvents
  let wid = WatchId [tid1, tid2] watchHandle
  modifyMVar mvarMap $ \watchMap ->
    return (Map.insert wid handler watchMap, wid)
  where
    dispatcher :: Chan [Event] -> IO ()
    dispatcher chanEvents = forever $ readChan chanEvents >>= mapM_ handler
 watch :: WatchManager -> FilePath -> Bool -> FileNotificationFlag -> IO (WatchId, Chan [Event])
 watch (WatchManager mvarMap) dir watchSubTree flags = do
  watchHandle <- getWatchHandle dir
  chanEvents <- newChan
  tid <- forkIO $ osEventsReader dir watchSubTree flags watchHandle chanEvents
  let wid = WatchId [tid] watchHandle
  modifyMVar_ mvarMap $ \watchMap ->
    return (Map.insert wid (const $ return ()) watchMap)
  return (wid, chanEvents)
 osEventsReader :: FilePath -> Bool -> FileNotificationFlag -> Handle -> Chan [Event] -> IO ()
 osEventsReader dir watchSubTree flags watchHandle chanEvents = fix $ \loop ->
  readDirectoryChanges watchHandle watchSubTree flags >>= \case
    -- ERROR_OPERATION_ABORTED: this happens when the event read thread is killed.
    -- https://learn.microsoft.com/en-us/windows/win32/debug/system-error-codes--500-999-
    -- Just return silently.
    Left (995, _) -> return ()
    Left (err_code, msg) -> do
      errno <- c_maperrno_func err_code
      throwIO (errnoToIOError "ReadDirectoryChangesW" errno Nothing Nothing `ioeSetErrorString` msg)
    Right events -> actsToEvents dir events >>= writeChan chanEvents >> loop
 killWatch :: WatchId -> IO ()
 killWatch (WatchId tids handle) = do
  forM_ tids killThread
  -- catch (closeHandle handle) $ \(e :: SomeException) ->
  --   putStrLn ([i|Failed to kill watch #{handle}: #{e}|])
  catch (closeHandle handle) $ \(_ :: SomeException) -> return ()
 actsToEvents :: FilePath -> [(Action, String)] -> IO [Event]
 actsToEvents baseDir = mapM actToEvent
  where
    actToEvent (act, fn) = do
      case act of
        FileModified -> return $ Modified $ baseDir </> fn
        FileAdded -> return $ Created $ baseDir </> fn
        FileRemoved -> return $ Deleted $ baseDir </> fn
        FileRenamedOld -> return $ Deleted $ baseDir </> fn
        FileRenamedNew -> return $ Created $ baseDir </> fn