fsnotify-conduit (empty) → 0.1.0.0

raw patch · 8 files changed

+293/−0 lines, 8 filesdep +asyncdep +basedep +conduitsetup-changed

Dependencies added: async, base, conduit, directory, filepath, fsnotify, fsnotify-conduit, hspec, resourcet, temporary, transformers

Files

• ChangeLog.md +3/−0
• LICENSE +21/−0
• README.md +34/−0
• Setup.hs +2/−0
• fsnotify-conduit.cabal +48/−0
• src/Data/Conduit/FSNotify.hs +145/−0
• test/Data/Conduit/FSNotifySpec.hs +39/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2016 FP Complete++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,34 @@+# fsnotify-conduit++Get filesystem notifications as a stream of events, using the conduit+package to handle the stream. This uses the+[fsnotify package](https://www.stackage.org/package/fsnotify), which+uses OS-specific file notification APIs for efficiency. Simple usage+example, a program which will print all events for the given directory+tree:++``` haskell+#!/usr/bin/env stack+{- stack+     --resolver lts-6.15+     --install-ghc+     runghc+     --package fsnotify-conduit+     --package conduit-combinators+ -}++import Conduit+import Data.Conduit.FSNotify+import System.Environment (getArgs)++main :: IO ()+main = do+    args <- getArgs+    dir <-+        case args of+            [dir] -> return dir+            _ -> error $ "Expected one argument (directory to watch)"+    runResourceT+        $ sourceFileChanges (setRelative False $ mkFileChangeSettings dir)+       $$ mapM_C (liftIO . print)+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,48 @@+name:                fsnotify-conduit+version:             0.1.0.0+synopsis:            Get filesystem notifications as a stream of events+description:         Please see README.md+homepage:            https://github.com/fpco/fsnotify-conduit#readme+license:             MIT+license-file:        LICENSE+author:              Michael Snoyman+maintainer:          michael@snoyman.com+copyright:           2016 FP Complete+category:            Data, Conduit+build-type:          Simple+extra-source-files:  README.md ChangeLog.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.Conduit.FSNotify+  build-depends:       base >= 4.7 && < 5+                     , conduit+                     , directory+                     , filepath+                     , fsnotify+                     , resourcet+                     , transformers+  default-language:    Haskell2010++test-suite fsnotify-conduit-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Data.Conduit.FSNotifySpec+  build-depends:       base+                     , async+                     , conduit+                     , directory+                     , filepath+                     , fsnotify-conduit+                     , hspec+                     , resourcet+                     , temporary+                     , transformers+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/fpco/fsnotify-conduit

@@ -0,0 +1,145 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+module Data.Conduit.FSNotify+    ( -- * Conduit API+      sourceFileChanges+    , FileChangeSettings+    , mkFileChangeSettings++      -- * Setters+    , setWatchConfig+    , setRelative+    , setRecursive+    , setPredicate++      -- * Re-exports+    , FS.Event (..)+    , FS.eventTime+    , FS.eventPath+    , FS.WatchConfig (..)+    , FS.Debounce (..)+    ) where++import Control.Exception (assert)+import Data.Conduit+import Control.Monad.Trans.Resource (MonadResource)+import Control.Monad.IO.Class (liftIO)+import Control.Monad (forever)+import qualified System.FSNotify as FS+import System.Directory (canonicalizePath)+import Control.Concurrent.Chan+import Data.List (stripPrefix)+import System.FilePath (addTrailingPathSeparator)++-- | Settings for watching for file changes, to be passed in to+-- 'sourceFileChanges'. Should be created with 'mkFileChangeSettings'.+--+-- @since 0.1.0.0+data FileChangeSettings = FileChangeSettings+    { fcsDir :: !FilePath+    , fcsWatchConfig :: !FS.WatchConfig+    , fcsRelative :: !Bool+    , fcsRecursive :: !Bool+    , fcsPredicate :: !(FS.Event -> Bool)+    }++-- | Override the 'FS.WatchConfig' when creating the 'FS.WatchManager'.+--+-- Default: 'FS.defaultConfig'+--+-- @since 0.1.0.0+setWatchConfig :: FS.WatchConfig -> FileChangeSettings -> FileChangeSettings+setWatchConfig x fcs = fcs { fcsWatchConfig = x }++-- | Whether to provide paths relative to the root directory (@True@)+-- or absolute paths (@False@).+--+-- Default: 'True' (relative paths)+--+-- @since 0.1.0.0+setRelative :: Bool -> FileChangeSettings -> FileChangeSettings+setRelative x fcs = fcs { fcsRelative = x }++-- | Recursively watch a directory tree?+--+-- Default: 'True'+--+-- @since 0.1.0.0+setRecursive :: Bool -> FileChangeSettings -> FileChangeSettings+setRecursive x fcs = fcs { fcsRecursive = x }++-- | Predicate used to filter events.+--+-- Default: @const True@ (allow all events)+--+-- @since 0.1.0.0+setPredicate :: (FS.Event -> Bool) -> FileChangeSettings -> FileChangeSettings+setPredicate x fcs = fcs { fcsPredicate = x }++-- | Create a 'FileChangeSettings' from a directory to watch. Provides+-- defaults which can be overridden by the setter functions in this+-- module, such as 'setRelative'.+--+-- @since 0.1.0.0+mkFileChangeSettings :: FilePath -- ^ directory to watch+                     -> FileChangeSettings+mkFileChangeSettings dir = FileChangeSettings+    { fcsDir = dir+    , fcsWatchConfig = FS.defaultConfig+    , fcsRelative = True+    , fcsRecursive = True+    , fcsPredicate = const True+    }++-- | Watch for changes to a directory, and yield the file paths+-- downstream. Typical usage would be:+--+-- @+-- sourceFileChanges (setRelative False $ mkFileChangeSettings dir)+-- @+--+-- @since 0.1.0.0+sourceFileChanges :: MonadResource m+                  => FileChangeSettings+                  -> Producer m FS.Event+sourceFileChanges FileChangeSettings {..} =+  -- The bracketP function allows us to safely allocate some resource+  -- and guarantee it will be cleaned up. In our case, we are calling+  -- startManager to allocate a file watching manager, and stopManager+  -- to clean it up. These functions will under the surface tie in to+  -- OS-specific file watch mechanisms, such as inotify on Linux.+  bracketP (FS.startManagerConf fcsWatchConfig) FS.stopManager $ \man -> do+    -- Get the absolute path of the root directory+    root' <- liftIO $ canonicalizePath fcsDir++    -- Create a channel for communication between two threads. Since+    -- file watch events come in asynchronously on separate threads,+    -- we want to fill up a channel with those events, and then below+    -- read the values off that channel.+    chan <- liftIO newChan++    -- Start watching a directory tree, accepting all events (const True).+    let watchChan = if fcsRecursive then FS.watchTreeChan else FS.watchDirChan+    bracketP (watchChan man root' fcsPredicate chan) id $ const $ forever $ do+        event <- liftIO $ readChan chan++        if fcsRelative+            then do+                -- The complete file path of the event.+                let fp = FS.eventPath event++                -- Since we want the path relative to the directory root,+                -- strip off the root from the file path+                case stripPrefix (addTrailingPathSeparator root') fp of+                    Nothing -> assert False $ return ()+                    Just suffix+                        -- Ignore changes to the root directory itself+                        | null suffix -> return ()++                        -- Got a change to the file, write it to the channel+                        | otherwise -> yield $+                            case event of+                                FS.Added _ time -> FS.Added suffix time+                                FS.Modified _ time -> FS.Modified suffix time+                                FS.Removed _ time -> FS.Removed suffix time+            else yield event

@@ -0,0 +1,39 @@+module Data.Conduit.FSNotifySpec where++import Test.Hspec (Spec, it, shouldBe)+import Data.Conduit (($$))+import qualified Data.Conduit.List as CL+import Control.Monad.Trans.Resource (runResourceT)+import Data.Conduit.FSNotify+import Control.Concurrent.Chan (newChan, writeChan, readChan)+import Control.Applicative ((<|>))+import Control.Monad (forM_)+import Control.Concurrent.Async (Concurrently (..))+import Control.Concurrent (threadDelay)+import System.FilePath ((</>))+import System.Directory (removeFile)+import System.IO.Temp (withSystemTempDirectory)+import Control.Monad.IO.Class (liftIO)++spec :: Spec+spec = do+    it "sourceFileChanges" $ withSystemTempDirectory "source-file-changes" $ \root -> do+        chan <- newChan+        let actions =+                [ ("foo", Just "hello")+                , ("bar", Just "world")+                , ("foo", Just "!")+                , ("bar", Nothing)+                , ("foo", Nothing)+                ]+        runConcurrently $+            Concurrently (runResourceT $ sourceFileChanges (mkFileChangeSettings root)+                                      $$ CL.mapM_ (liftIO . writeChan chan)) <|>+            Concurrently (forM_ actions $ \(path, mcontents) -> do+                threadDelay 100000+                case mcontents of+                    Nothing -> removeFile (root </> path)+                    Just contents -> writeFile (root </> path) contents) <|>+            Concurrently (forM_ actions $ \(expected, _) -> do+                event <- readChan chan+                eventPath event `shouldBe` expected)

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}