fsnotify 0.1.0.3 → 0.2

raw patch · 12 files changed

+144/−84 lines, 12 filesdep +filepathdep +unix-compatdep −system-fileiodep −system-filepathdep ~directoryPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, unix-compat

Dependencies removed: system-fileio, system-filepath

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +15/−0
• fsnotify.cabal +7/−5
• src/System/FSNotify.hs +12/−3
• src/System/FSNotify/Devel.hs +4/−3
• src/System/FSNotify/Linux.hs +10/−10
• src/System/FSNotify/Listener.hs +2/−3
• src/System/FSNotify/Path.hs +25/−32
• src/System/FSNotify/Polling.hs +14/−3
• src/System/FSNotify/Types.hs +14/−4
• test/EventUtils.hs +7/−5
• test/test.hs +29/−16

@@ -1,6 +1,11 @@ Changes ======= +Version 0.2+-----------++Use filepath instead of deprecated system-filepath+ Version 0.1.0.3 --------------- 

@@ -2,3 +2,18 @@ =========  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,5 +1,5 @@ Name:                   fsnotify-Version:                0.1.0.3+Version:                0.2 Author:                 Mark Dittmer <mark.s.dittmer@gmail.com> Maintainer:             Greg Weber <greg@gregweber.info>, Roman Cheplyaka <roma@ro-che.info> License:                BSD3@@ -12,6 +12,7 @@ Category:               Filesystem Cabal-Version:          >= 1.8 Build-Type:             Simple+Homepage:               https://github.com/haskell-fswatch/hfsnotify Extra-Source-Files:   README.md   CHANGELOG.md@@ -22,11 +23,12 @@ Library   Build-Depends:          base >= 4.3.1 && < 5                         , containers >= 0.4-                        , system-fileio >= 0.3.8-                        , system-filepath >= 0.4.6+                        , directory >= 1.1.0.0+                        , filepath >= 1.3.0.0                         , text >= 0.11.0                         , time >= 1.1                         , async >= 2.0.1+                        , unix-compat >= 0.2   Exposed-Modules:        System.FSNotify                         , System.FSNotify.Devel   Other-Modules:          System.FSNotify.Listener@@ -59,9 +61,9 @@   Build-depends:          base >= 4.3.1.0                         , tasty >= 0.5                         , tasty-hunit-                        , system-filepath >= 0.4.7-                        , system-fileio >= 0.3.11                         , directory+                        , filepath+                        , unix-compat                         , fsnotify                         , async >= 2                         , temporary-rc

@@ -4,8 +4,11 @@ -- {-# LANGUAGE CPP, ScopedTypeVariables, ExistentialQuantification, RankNTypes #-} --- | Minimal example:+-- | NOTE: 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@@ -22,7 +25,7 @@ -- >      print        -- action -- > -- >    -- sleep forever (until interrupted)--- >    forever $ threadDelay maxBound+-- >    forever $ threadDelay 1000000  module System.FSNotify        (@@ -63,7 +66,7 @@ import Control.Exception import Control.Applicative import Control.Monad-import Filesystem.Path.CurrentOS+import System.FilePath import System.FSNotify.Polling import System.FSNotify.Types @@ -92,6 +95,12 @@        (MVar (Maybe (IO ()))) -- cleanup action, or Nothing if the manager is stopped  -- | Default configuration+--+-- * Debouncing is enabled with a time interval of 1 millisecond+--+-- * Polling is disabled+--+-- * The polling interval defaults to 1 second defaultConfig :: WatchConfig defaultConfig =   WatchConfig

@@ -22,8 +22,9 @@ import Prelude hiding (FilePath)  import Data.Text-import Filesystem.Path.CurrentOS+import System.FilePath import System.FSNotify+import System.FSNotify.Path (hasThisExtension)  -- | In the given directory tree, watch for any 'Added' and 'Modified' -- events (but ignore 'Removed' events) for files with the given file@@ -34,7 +35,7 @@          -> (FilePath -> IO ()) -- ^ action to run on file          -> IO StopListening treeExtExists man dir ext action =-  watchTree man dir (existsEvents $ flip hasExtension ext) (doAllEvents 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@@ -44,7 +45,7 @@          -> (FilePath -> IO ()) -- ^ action to run on file          -> IO StopListening treeExtAny man dir ext action =-  watchTree man dir (allEvents $ flip hasExtension ext) (doAllEvents 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

@@ -20,9 +20,9 @@ import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Typeable -- import Debug.Trace (trace)-import Filesystem.Path.CurrentOS+import System.FilePath import System.FSNotify.Listener-import System.FSNotify.Path (findDirs, fp, canonicalizeDirPath)+import System.FSNotify.Path (findDirs, canonicalizeDirPath) import System.FSNotify.Types import qualified System.INotify as INo @@ -34,11 +34,11 @@ -- Note that INo.Closed in this context is "modified" because we listen to -- CloseWrite events. fsnEvent :: FilePath -> UTCTime -> INo.Event -> Maybe Event-fsnEvent basePath timestamp (INo.Created  False       name   ) = Just (Added    (basePath </> (fp name)) timestamp)-fsnEvent basePath timestamp (INo.Closed   False (Just name) _) = Just (Modified (basePath </> (fp name)) timestamp)-fsnEvent basePath timestamp (INo.MovedOut False       name  _) = Just (Removed  (basePath </> (fp name)) timestamp)-fsnEvent basePath timestamp (INo.MovedIn  False       name  _) = Just (Added    (basePath </> (fp name)) timestamp)-fsnEvent basePath timestamp (INo.Deleted  False       name   ) = Just (Removed  (basePath </> (fp name)) timestamp)+fsnEvent basePath timestamp (INo.Created  False       name   ) = Just (Added    (basePath </> name) timestamp)+fsnEvent basePath timestamp (INo.Closed   False (Just name) _) = Just (Modified (basePath </> name) timestamp)+fsnEvent basePath timestamp (INo.MovedOut False       name  _) = Just (Removed  (basePath </> name) timestamp)+fsnEvent basePath timestamp (INo.MovedIn  False       name  _) = Just (Added    (basePath </> name) timestamp)+fsnEvent basePath timestamp (INo.Deleted  False       name   ) = Just (Removed  (basePath </> name) timestamp) fsnEvent _        _         _                                  = Nothing  handleInoEvent :: ActionPredicate -> EventChannel -> FilePath -> DebouncePayload -> INo.Event -> IO ()@@ -73,7 +73,7 @@   listen conf iNotify path actPred chan = do     path' <- canonicalizeDirPath path     dbp <- newDebouncePayload $ confDebounce conf-    wd <- INo.addWatch iNotify varieties (encodeString path') (handler path' dbp)+    wd <- INo.addWatch iNotify varieties path' (handler path' dbp)     return $ INo.removeWatch wd     where       handler :: FilePath -> DebouncePayload -> INo.Event -> IO ()@@ -116,12 +116,12 @@           case mbWds of             Nothing -> return mbWds             Just wds -> do-              wd <- INo.addWatch iNotify varieties (fp filePath) (handler filePath dbp)+              wd <- INo.addWatch iNotify varieties filePath (handler filePath dbp)               return $ Just (wd:wds)         where           handler :: FilePath -> DebouncePayload -> INo.Event -> IO ()           handler baseDir _   (INo.Created True dirPath) = do-            listenRec (baseDir </> fp dirPath) wdVar+            listenRec (baseDir </> dirPath) wdVar           handler baseDir dbp event                      =             handleInoEvent actPred chan baseDir dbp event 

@@ -16,8 +16,7 @@ import Data.IORef (newIORef) import Data.Time (diffUTCTime, NominalDiffTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Filesystem.Path.CurrentOS-import System.FSNotify.Path (fp)+import System.FilePath import System.FSNotify.Types  -- | An action that cancels a watching/listening job@@ -58,7 +57,7 @@  -- | The default event that provides a basis for comparison. eventDefault :: Event-eventDefault = Added (fp "") (posixSecondsToUTCTime 0)+eventDefault = Added "" (posixSecondsToUTCTime 0)  -- | A predicate indicating whether two events may be considered "the same -- event". This predicate is applied to the most recent dispatched event and

@@ -5,41 +5,39 @@ {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}
 
 module System.FSNotify.Path
-       ( fp
-       , findFiles
+       ( findFiles
        , findDirs
        , canonicalizeDirPath
        , canonicalizePath
+       , hasThisExtension
        ) where
 
 import Prelude hiding (FilePath)
 
+import Control.Applicative
 import Control.Monad
 -- import Filesystem
 -- import Filesystem.Path hiding (concat)
-import Filesystem.Path.CurrentOS hiding (concat)
 
-import qualified Filesystem as FS
-import qualified Filesystem.Path as FP
-
--- This will ensure than any calls to fp for type coercion in FSNotify will not
--- break when/if the dependent package moves from using String to the more
--- efficient Filesystem.Path.FilePath
-class ConvertFilePath a b where
-  fp :: a -> b
-instance ConvertFilePath FilePath String where fp   = encodeString
-instance ConvertFilePath String FilePath where fp   = decodeString
-instance ConvertFilePath String String where fp     = id
-instance ConvertFilePath FilePath FilePath where fp = id
+import qualified Data.Text as T
+import qualified System.Directory as D
+import System.PosixCompat.Files as PF
+import System.FilePath
 
 getDirectoryContentsPath :: FilePath -> IO [FilePath]
-getDirectoryContentsPath path = fmap (map (path </>)) $ FS.listDirectory path
+getDirectoryContentsPath path = (map (path </>)) . filter (not . dots) <$> D.getDirectoryContents path
+  where
+    dots "."  = True
+    dots ".." = True
+    dots _    = False
 
 fileDirContents :: FilePath -> IO ([FilePath],[FilePath])
 fileDirContents path = do
   contents <- getDirectoryContentsPath path
-  files <- filterM FS.isFile contents
-  dirs <- filterM FS.isDirectory contents
+  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]
@@ -49,14 +47,8 @@   return (files ++ concat nestedFiles)
 
 findImmediateFiles, findImmediateDirs :: FilePath -> IO [FilePath]
-findImmediateFiles = getDirectoryContentsPath >=> filterM FS.isFile >=> canonicalize
-  where
-    canonicalize :: [FilePath] -> IO [FilePath]
-    canonicalize files = mapM FS.canonicalizePath files
-findImmediateDirs  = getDirectoryContentsPath >=> filterM FS.isDirectory >=> canonicalize
-  where
-    canonicalize :: [FilePath] -> IO [FilePath]
-    canonicalize dirs = mapM canonicalizeDirPath dirs
+findImmediateFiles = fileDirContents >=> mapM D.canonicalizePath . fst
+findImmediateDirs  = fileDirContents >=> mapM D.canonicalizePath . snd
 
 findAllDirs :: FilePath -> IO [FilePath]
 findAllDirs path = do
@@ -74,15 +66,16 @@ 
 -- | add a trailing slash to ensure the path indicates a directory
 addTrailingSlash :: FilePath -> FilePath
-addTrailingSlash p =
- if FP.null (FP.filename p) then p else
-   p FP.</> FP.empty
+addTrailingSlash = addTrailingPathSeparator
 
 canonicalizeDirPath :: FilePath -> IO FilePath
-canonicalizeDirPath path = addTrailingSlash `fmap` FS.canonicalizePath path
+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 = FP.null (FP.filename path) in
-  if not was_dir then FS.canonicalizePath path
+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

@@ -11,16 +11,19 @@  import Prelude hiding (FilePath) +import Control.Applicative import Control.Concurrent import Data.Map (Map) import Data.Maybe import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Time.Clock.POSIX -- import Debug.Trace (trace)-import Filesystem hiding (canonicalizePath)-import Filesystem.Path+import System.FilePath import System.FSNotify.Listener import System.FSNotify.Path (findFiles, canonicalizeDirPath) import System.FSNotify.Types+import System.PosixCompat.Files+import System.PosixCompat.Types import qualified Data.Map as Map import Control.Monad (forM_) @@ -56,7 +59,7 @@   where     pathAndTime :: FilePath -> IO (FilePath, UTCTime)     pathAndTime path = do-      modTime <- getModified path+      modTime <- getModificationTime path       return (path, modTime)  pollPath :: Int -> Bool -> EventChannel -> FilePath -> ActionPredicate -> Map FilePath UTCTime -> IO ()@@ -125,3 +128,11 @@     return $ killAndUnregister mvarMap wk    usesPolling = const True+++getModificationTime :: FilePath -> IO UTCTime+getModificationTime p = fromEpoch . modificationTime <$> getFileStatus p+++fromEpoch :: EpochTime -> UTCTime+fromEpoch = posixSecondsToUTCTime . realToFrac

@@ -24,7 +24,7 @@ import Data.IORef (IORef) import Data.Time (NominalDiffTime) import Data.Time.Clock (UTCTime)-import Filesystem.Path.CurrentOS+import System.FilePath  -- | 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@@ -61,11 +61,21 @@     -- available. This is mostly for testing purposes.   } --- | This specifies whether events close to each other should be collapsed--- together, and how close is close enough.+-- | This specifies whether multiple events from the same file should be+-- collapsed together, and how close is close enough.+--+-- This is performed by ignoring any event that occurs to the same file+-- until the specified time interval has elapsed.+--+-- Note that the current debouncing logic may fail to report certain changes+-- to a file, potentially leaving your program in a state that is not+-- consistent with the filesystem.+--+-- Make sure that if you are using this feature, all changes you make as a+-- result of an 'Event' notification are both non-essential and idempotent. data Debounce   = DebounceDefault-    -- ^ perform debouncing based on the default time interval+    -- ^ perform debouncing based on the default time interval of 1 millisecond   | Debounce NominalDiffTime     -- ^ perform debouncing based on the specified time interval   | NoDebounce

@@ -4,14 +4,13 @@ import Prelude hiding (FilePath) import Test.Tasty.HUnit import Control.Concurrent-import Control.Concurrent.Async+import Control.Concurrent.Async hiding (poll) import Control.Applicative import Control.Monad import Data.IORef import Data.List (sortBy) import Data.Ord (comparing)-import Filesystem.Path-import Filesystem.Path.CurrentOS+import System.FilePath import System.FSNotify import System.IO.Unsafe import System.Directory@@ -73,7 +72,7 @@   mgr <- startManagerConf defaultConfig     { confDebounce = NoDebounce     , confUsePolling = poll-    , confPollInterval = 2 * 10^5+    , confPollInterval = 2 * 10^(5 :: Int)     }   eventsVar <- newIORef []   stop <- watch mgr path (const True) (\ev -> atomicModifyIORef eventsVar (\evs -> (ev:evs, ())))@@ -94,7 +93,10 @@   matchEvents pats $ sortBy (comparing eventTime) evs  testDirPath :: FilePath-testDirPath = decodeString (unsafePerformIO getCurrentDirectory) </> "testdir"+testDirPath = (unsafePerformIO getCurrentDirectory) </> "testdir" +expectEventsHere :: (?timeInterval::Int) => Bool -> [EventPattern] -> IO () -> Assertion expectEventsHere poll = expectEvents poll watchDir testDirPath++expectEventsHereRec :: (?timeInterval::Int) => Bool -> [EventPattern] -> IO () -> Assertion expectEventsHereRec poll = expectEvents poll watchTree testDirPath

@@ -1,14 +1,15 @@-{-# LANGUAGE OverloadedStrings, ImplicitParams, ViewPatterns #-}+{-# LANGUAGE OverloadedStrings, ImplicitParams #-} import Prelude hiding-  ( FilePath, writeFile, writeFile )+  ( FilePath )+import Control.Applicative import Test.Tasty import Test.Tasty.HUnit-import Filesystem-import Filesystem.Path-import Filesystem.Path.CurrentOS+import System.Directory+import System.FilePath import System.FSNotify+import System.IO.Error import System.IO.Temp-import Text.Printf+import System.PosixCompat.Files import Control.Monad import Control.Exception import Control.Concurrent@@ -21,16 +22,18 @@   stopManager mgr   return $ not $ isPollingManager mgr +main :: IO () main = do   hasNative <- nativeMgrSupported   unless hasNative $     putStrLn "WARNING: native manager cannot be used or tested on this platform"   defaultMain $     withResource-      (createTree testDirPath)-      (const $ removeTree testDirPath) $+      (createDirectoryIfMissing True testDirPath)+      (const $ removeDirectoryRecursive testDirPath) $       const $ tests hasNative +tests :: Bool -> TestTree tests hasNative = testGroup "Tests" $ do   poll <-     if hasNative@@ -38,8 +41,8 @@       else [True]   let ?timeInterval =         if poll-          then 2*10^6-          else 5*10^5+          then 2*10^(6 :: Int)+          else 5*10^(5 :: Int)   return $ testGroup (if poll then "Polling" else "Native") $ do   recursive <- [False, True]   return $ testGroup (if recursive then "Recursive" else "Non-recursive") $ do@@ -51,25 +54,35 @@         (const $ return ())         (\f -> writeFile f "foo")     , mkTest "modify file" [evModified] (\f -> writeFile f "")-        (\f -> when poll (threadDelay $ 10^6) >> writeFile f "foo")+        (\f -> when poll (threadDelay $ 10^(6 :: Int)) >> writeFile f "foo")     , mkTest "delete file" [evRemoved] (\f -> writeFile f "") (\f -> removeFile f)     , mkTest "directories are ignored" [] (const $ return ())-        (\f -> createDirectory False f >> removeDirectory f)+        (\f -> createDirectory f >> removeDirectory f)     ]   return $ t nested recursive poll   where     mkTest title evs prepare action nested recursive poll =       testCase title $-        withTempDirectory (encodeString testDirPath) "test." $ \(decodeString -> watchedDir) -> do+        withTempDirectory testDirPath "test." $ \watchedDir -> do         let baseDir = if nested then watchedDir </> "subdir" else watchedDir-            f = baseDir </> filename+            f = baseDir </> fileName             expect =               expectEvents poll                 (if recursive then watchTree else watchDir)                 watchedDir-        createDirectory True baseDir+        createDirectoryIfMissing True baseDir         (prepare f >>          expect (if not nested || recursive then map ($ f) evs else []) (action f))           `finally` (isFile f >>= \b -> when b (removeFile f)) -    filename = "testfile"+    fileName = "testfile"+++-------------------------------------------------------------------------------+isFile :: FilePath -> IO Bool+isFile p = handleJust h return checkFile+  where+    h e = if isDoesNotExistError e+          then Just False+          else Nothing+    checkFile = isRegularFile <$> getFileStatus p