packages feed

delta 0.1.2.0 → 0.2.0.0

raw patch · 7 files changed

+139/−96 lines, 7 filesdep +hfsevents

Dependencies added: hfsevents

Files

delta.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.2.0+version:             0.2.0.0  -- A short (one-line) description of the package. synopsis:            A library for detecting file changes@@ -51,11 +51,15 @@ -- extra-source-files:    -- Constraint on the version of Cabal needed to build this package.-cabal-version:       >= 1.18+cabal-version:       >= 1.16 +flag build_fs_events+  description: Build in FSEvents support (OS X)+  default: True+ source-repository head   type:              git-  location:          https://github.com/kryoxide/delta/+  location:          https://github.com/kryoxide/delta.git  library   -- Modules exported by the library.@@ -64,6 +68,10 @@                      , System.Delta.Callback                      , System.Delta.Class                      , System.Delta++  if os(darwin)+    exposed-modules: System.Delta.FSEvents+   -- Modules included in this library but not exported.   -- other-modules:          @@ -77,7 +85,9 @@                      , filepath >= 1.3                      , time >= 1.5                      , sodium >= 0.11-  +  if os(darwin)+    build-depends:     hfsevents >= 0.1.5+   -- Directories containing source files.   hs-source-dirs:      src
src/System/Delta.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RankNTypes, CPP #-} -------------------------------------------------------------------------------- -- | -- Module : System.Delta@@ -13,9 +13,13 @@ -- An umberella package for the delta library. This library can be used to monitor -- changed / new / deleted files in a given directory (or set of directories). ----- Currently this library polls the directories of interest recursively in certain--- intervals, but I will add OS-specific functionality to monitor the filesystem.+-- On non OS X systems this library polls the directories of interest+-- recursively in certain intervals, but I will add OS-specific functionality to+-- monitor the filesystem. --+-- On OS X this library can use the File System Events API to detect changes+-- without recursive directory traversal.+-- -- = Examples -- -- Create a watcher that prints a line if a new file is created in the monitored@@ -35,11 +39,9 @@                     , deltaDirWithCallbacks                      -- * FRP based interface-                    , module System.Delta.Class                     , FileWatcher(..)                      -- * Callback based interface-                    , module System.Delta.Callback                     , CallbackWatcher                     , CallbackId                     , withCallbacks@@ -50,18 +52,31 @@                     -- ** Removing callbacks                     , unregisterCallback                     , removeAllCallbacks-                    , closeCallbackWatcher+                    , closeCallbackWatcher                                     )where  import System.Delta.Base-import System.Delta.Poll import System.Delta.Class import System.Delta.Callback+import System.Delta.Poll+#if defined(__APPLE__)+import System.Delta.FSEvents+#endif --- | Build a file watcher, this method will change later-deltaDir :: FilePath -> IO PollWatcher-deltaDir path = defaultWatcher path+-- | Build a file watcher, the concrete implementation is operating system+-- dependent.+--+-- * The default uses polling ('createPollWatcher')+--+-- * The watcher for OS X uses the FS Events API 'createFSEventsWatcher'+deltaDir :: FilePath -> IO FileWatcher+deltaDir path = do+#if defined(__APPLE__)+  createFSEventsWatcher path+#else+  createPollWatcher 10 path+#endif  -- | Build a file watcher that allows to register callbacks-deltaDirWithCallbacks :: FilePath -> IO (CallbackWatcher PollWatcher)+deltaDirWithCallbacks :: FilePath -> IO CallbackWatcher deltaDirWithCallbacks path = deltaDir path >>= withCallbacks
src/System/Delta/Callback.hs view
@@ -31,23 +31,23 @@                    deriving (Eq, Ord)    -- | Provides a callback based interface to an FRP base 'FileWatcher'-data CallbackWatcher w where-  CallbackWatcher :: FileWatcher w => {-    baseWatcher :: w+data CallbackWatcher where+  CallbackWatcher :: {+    baseWatcher :: FileWatcher   , nextCallbackId :: MVar CallbackId   , watcherCallbacks :: MVar (M.Map CallbackId (IO ()))-  } -> CallbackWatcher w+  } -> CallbackWatcher   -- | Raise the callback id of a callback watcher-raiseId :: CallbackWatcher w -> IO (CallbackId)+raiseId :: CallbackWatcher -> IO (CallbackId) raiseId w = do   (CallbackId n) <- takeMVar $ nextCallbackId w   putMVar (nextCallbackId w) (CallbackId $ n+1)   return (CallbackId n)  -- | Add an action to unregister a callback-addCallbackUnregister :: CallbackWatcher w -> IO () -> IO CallbackId+addCallbackUnregister :: CallbackWatcher -> IO () -> IO CallbackId addCallbackUnregister w removeCallback = do   newId <- raiseId w   mp <- takeMVar $ watcherCallbacks w@@ -55,42 +55,39 @@   return newId    -- | Wrap a file watcher in a datatype that allows adding callbacks-withCallbacks :: (FileWatcher a) => a -> IO (CallbackWatcher a)+withCallbacks :: FileWatcher -> IO CallbackWatcher withCallbacks w = do   nextIdVar <- newMVar (CallbackId 0)   callbacks <- newMVar (M.empty)   return $ CallbackWatcher w nextIdVar callbacks  -- | Add a callback that is executed when file deletion is detected-withDeleteCallback :: (FileWatcher a)-                      => CallbackWatcher a-                        -> (FilePath -> IO ()) -- ^ An IO action on the deleted path-                        -> IO (CallbackId)+withDeleteCallback :: CallbackWatcher+                   -> (FilePath -> IO ()) -- ^ An IO action on the deleted path+                   -> IO (CallbackId) withDeleteCallback watcher action = do   unregisterCallback <- callbackOnEvent (deletedFiles $ baseWatcher watcher) action   addCallbackUnregister watcher unregisterCallback  -- | Add a callback that is executed when file creation is detected-withNewCallback :: (FileWatcher a)-                      => CallbackWatcher a-                        -> (FilePath -> IO ()) -- ^ An IO action on the new path-                        -> IO (CallbackId)+withNewCallback :: CallbackWatcher+                -> (FilePath -> IO ()) -- ^ An IO action on the new path+                -> IO (CallbackId) withNewCallback watcher action = do   unregisterCallback <- callbackOnEvent (newFiles $ baseWatcher watcher) action   addCallbackUnregister watcher unregisterCallback  -- | Add a callback on a changed file-withChangedCallback :: (FileWatcher a)-                      => CallbackWatcher a-                        -> (FileInfo -> IO ()) -- ^ Action on changed file-                        -> IO (CallbackId)+withChangedCallback :: CallbackWatcher+                    -> (FilePath -> IO ()) -- ^ Action on changed file+                    -> IO (CallbackId) withChangedCallback watcher action = do   unregisterCallback <- callbackOnEvent (changedFiles $ baseWatcher watcher) action   addCallbackUnregister watcher unregisterCallback  -- | Unregister the given CallbackId from the FileWatcher -- does nothing if the CallbackId is not in the watcher-unregisterCallback :: (FileWatcher a) => CallbackWatcher a -> CallbackId -> IO ()+unregisterCallback :: CallbackWatcher -> CallbackId -> IO () unregisterCallback watcher cId = do   mp <- takeMVar $ watcherCallbacks watcher   case M.lookup cId mp of@@ -99,14 +96,14 @@   putMVar (watcherCallbacks watcher) (M.delete cId mp)  -- | Remove all callbacks form the watcher. They will not be called after this-removeAllCallbacks :: (FileWatcher a) => CallbackWatcher a -> IO ()+removeAllCallbacks :: CallbackWatcher -> IO () removeAllCallbacks watcher = do   mp <- takeMVar $ watcherCallbacks watcher   putMVar (watcherCallbacks watcher) M.empty   sequence_ (M.elems mp)  -- | Remove all callbacks and close the underlying FileWatcher-closeCallbackWatcher :: FileWatcher a => CallbackWatcher a -> IO ()+closeCallbackWatcher :: CallbackWatcher -> IO () closeCallbackWatcher watcher = do   removeAllCallbacks watcher   cleanUpAndClose $ baseWatcher watcher
src/System/Delta/Class.hs view
@@ -5,39 +5,28 @@  import Control.Monad --- | A class for watching a directory based on functional reactive programming+-- | A type for watching a directory based on functional reactive programming -- At the core of this class are three event streams: ----- * @changedFiles@ is a stream of 'FileInfo's on changed files+-- * @changedFiles@ is a stream of canonicalized 'FilePath's on changed files -- -- * @newFiles@ is a stream of canonicalized 'FilePath's of newly created files -- -- * @deletedFiles@ is a stream of canonicalized 'FilePath's of deleted files-class FileWatcher a where-  -- | Each type provides a default watcher for a pass-  defaultWatcher  :: FilePath -> IO a--  -- | An event that gives some info on changed files (disjunct from-  -- deleted and new files)-  changedFiles    :: a -> Event FileInfo--  -- | An event that fires for each new file-  newFiles        :: a -> Event FilePath--  -- | An event that fires for each deleted path-  deletedFiles    :: a -> Event FilePath--  -- | Free all possibly used resources. No event will fire after-  -- this.-  cleanUpAndClose :: a -> IO ()--  -- | Merge two watchers that are watching different directories-  mergeWatchers :: a -> a -> a+data FileWatcher =+  FileWatcher { newFiles        :: Event FilePath -- ^ Newly created files, renamed+                                                  -- files+              , deletedFiles    :: Event FilePath -- ^ Deleted files, renamed files+              , changedFiles    :: Event FilePath -- ^ Changed files+              , cleanUpAndClose :: IO ()          -- ^ A function to clean and close+                                                  -- ^ this watcher+              }+-- | Merge two watchers that are watching different directories+mergeWatchers :: FileWatcher -> FileWatcher -> FileWatcher+mergeWatchers w1 w2 = FileWatcher{+    newFiles = (newFiles w1) `merge` (newFiles w2)+  , deletedFiles = (deletedFiles w1) `merge` (deletedFiles w2)+  , changedFiles = (changedFiles w1) `merge` (changedFiles w2)+  , cleanUpAndClose = cleanUpAndClose w1 >> cleanUpAndClose w2+  } -  -- | Create a watcher on all of the given paths-  watchPaths :: (FileWatcher a) => [FilePath] -> Maybe (IO a)-  watchPaths []    = Nothing-  watchPaths paths = Just $ do-    watchers <- mapM defaultWatcher paths-    let combinedWatcher = foldl1 mergeWatchers watchers-    return $ combinedWatcher
+ src/System/Delta/FSEvents.hs view
@@ -0,0 +1,55 @@+--------------------------------------------------------------------------------+-- |+-- Module: System.Delta.FSEvents+--+-- Uses the FSEvents API on MacOS to detect file changes.++--------------------------------------------------------------------------------+module System.Delta.FSEvents ( createFSEventsWatcher+                             ) where++import Control.Monad++import Data.Bits+import Data.Word++import qualified FRP.Sodium as Sodium+import FRP.Sodium (sync,merge)++import System.Delta.Class+import System.OSX.FSEvents++-- | Helper Method +(=<=) :: Event -> Word64 -> Bool+(Event{eventFlags=fls}) =<= flags = 0 < (fls .&. flags)++itemIsFile :: Event -> Bool+itemIsFile e = e =<= eventFlagItemIsFile++itemIsDir :: Event -> Bool+itemIsDir = (=<= eventFlagItemIsDir)++itemIsCreated :: Event -> Bool+itemIsCreated = (=<= eventFlagItemCreated)++itemIsRemoved :: Event -> Bool+itemIsRemoved = (=<= eventFlagItemRemoved)++itemIsChanged :: Event -> Bool+itemIsChanged = (=<= eventFlagItemModified)++createFSEventsWatcher path = do+    (changedEvent, pushChanged) <- sync $ Sodium.newEvent+    (deletedEvent, pushDeleted) <- sync $ Sodium.newEvent+    (newFileEvent, pushNewFile) <- sync $ Sodium.newEvent+    let callback = \e ->+                    when (itemIsFile e) $ do+                      when (itemIsCreated e) (sync $ pushNewFile $ eventPath e)+                      when (itemIsRemoved e) (sync $ pushDeleted $ eventPath e)+                      when (itemIsChanged e) (sync $ pushChanged $ eventPath e)+    evStream <- eventStreamCreate [path] 1 False False True callback+    return $ FileWatcher+               newFileEvent+               deletedEvent+               changedEvent+               (eventStreamDestroy evStream)
src/System/Delta/Poll.hs view
@@ -1,6 +1,5 @@-module System.Delta.Poll ( PollWatcher-                         , createPollWatcher-                         )where+module System.Delta.Poll ( createPollWatcher+                         ) where  import Control.Applicative ((<$>)) import Control.Concurrent@@ -19,40 +18,18 @@  import Data.List (isPrefixOf) -data PollWatcher = PollWatcher-                     [FilePath]-                     (Event FileInfo)-                     (Event FilePath)-                     (Event FilePath)-                     [ThreadId]--instance FileWatcher PollWatcher where-  defaultWatcher = createPollWatcher 3-  changedFiles (PollWatcher _ e _ _ _) = e-  newFiles     (PollWatcher _ _ e _ _) = e-  deletedFiles (PollWatcher _ _ _ e _) = e-  cleanUpAndClose (PollWatcher _ _ _ _ tIds) = mapM_ killThread tIds-  mergeWatchers (PollWatcher pA cA nA dA idsA) (PollWatcher pB cB nB dB idsB) =-    PollWatcher-      (pA ++ pB)-      (merge cA cB)-      (merge nA nB)-      (merge dA dB)-      (idsA ++ idsB)-    - -- | Watch files in this directory recursively for changes every -- n seconds. createPollWatcher :: Int      -- ^ seconds interval                   -> FilePath -- ^ path to watch-                  -> IO PollWatcher+                  -> IO FileWatcher createPollWatcher secs path = do   (changedEvent, pushChanged) <- sync $ newEvent   (deletedEvent, pushDeleted) <- sync $ newEvent   (newFileEvent, pushNewFile) <- sync $ newEvent   canonPath <- canonicalizePath path   watcherId <- startWatchThread canonPath pushNewFile pushDeleted pushChanged secs-  return $ PollWatcher [canonPath] changedEvent newFileEvent deletedEvent [watcherId]+  return $ FileWatcher newFileEvent deletedEvent changedEvent (killThread watcherId)  -- | Recursively traverse a folder, follow symbolic links but don't -- visit a file twice.@@ -107,7 +84,7 @@ startWatchThread :: FilePath                  -> (FilePath -> Reactive ()) -- ^ Push new files / dirs                  -> (FilePath -> Reactive ()) -- ^ Push deleted files / dirs-                 -> (FileInfo -> Reactive ()) -- ^ Push changed files / dirs+                 -> (FilePath -> Reactive ()) -- ^ Push changed files / dirs                  -> Int -- ^ Seconds between polls                  -> IO ThreadId startWatchThread path pushNew pushDeleted pushChanged secs = do@@ -117,7 +94,7 @@     go last = do       threadDelay $ secs * 1000 * 1000       curr <- recursiveDescent path-      sync $ mapM_ (pushChanged) (diffChangedFiles last curr)+      sync $ mapM_ (pushChanged) (fileInfoPath <$> diffChangedFiles last curr)       sync $ mapM_ (pushNew    ) (fileInfoPath <$> diffNewFiles last curr)       sync $ mapM_ (pushDeleted) (fileInfoPath <$> diffDeletedFiles last curr)       go curr
src/delta-cli/Main.hs view
@@ -13,7 +13,7 @@                 watcher <- deltaDirWithCallbacks path                 withNewCallback watcher (\x -> putStrLn $ "new:\t" ++ x)                 withDeleteCallback watcher (\x -> putStrLn $ "del:\t" ++ x)-                withChangedCallback watcher (\(FileInfo(x,_,_)) ->+                withChangedCallback watcher (\x ->                                               putStrLn $ "changed:\t" ++ x                                             )                 forever $ threadDelay (1000 * 1000)