diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +## 0.1.1.0 + +* Drop older GHC support +* Make test suite more reliable [#2](https://github.com/fpco/fsnotify-conduit/issues/2) +* Provide `acquireSourceFileChanges` + ## 0.1.0.0 * Initial release diff --git a/fsnotify-conduit.cabal b/fsnotify-conduit.cabal --- a/fsnotify-conduit.cabal +++ b/fsnotify-conduit.cabal @@ -1,48 +1,66 @@ -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 +-- This file has been generated from package.yaml by hpack version 0.28.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 7accb0cba2e3643d87a44e09c02d45c84caa55dd58836921394d14abd17f4c16 -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 +name: fsnotify-conduit +version: 0.1.1.0 +synopsis: Get filesystem notifications as a stream of events +description: Please see the README and docs at +category: Data, Conduit +homepage: https://github.com/fpco/fsnotify-conduit#readme +bug-reports: https://github.com/fpco/fsnotify-conduit/issues +author: Michael Snoyman +maintainer: michael@snoyman.com +copyright: 2016-2018 FP Complete +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 +extra-source-files: + ChangeLog.md + README.md source-repository head - type: git + type: git location: https://github.com/fpco/fsnotify-conduit + +library + exposed-modules: + Data.Conduit.FSNotify + other-modules: + Paths_fsnotify_conduit + hs-source-dirs: + src + build-depends: + base >=4.9 && <5 + , conduit >=1.2.8 + , directory + , filepath + , fsnotify >=0.2.1 + , resourcet + , transformers + default-language: Haskell2010 + +test-suite fsnotify-conduit-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Data.Conduit.FSNotifySpec + Paths_fsnotify_conduit + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.9 && <5 + , conduit >=1.2.8 + , directory + , filepath + , fsnotify >=0.2.1 + , fsnotify-conduit + , hspec + , resourcet + , temporary + , transformers + default-language: Haskell2010 diff --git a/src/Data/Conduit/FSNotify.hs b/src/Data/Conduit/FSNotify.hs --- a/src/Data/Conduit/FSNotify.hs +++ b/src/Data/Conduit/FSNotify.hs @@ -3,6 +3,7 @@ module Data.Conduit.FSNotify ( -- * Conduit API sourceFileChanges + , acquireSourceFileChanges , FileChangeSettings , mkFileChangeSettings @@ -22,14 +23,15 @@ import Control.Exception (assert) import Data.Conduit -import Control.Monad.Trans.Resource (MonadResource) -import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Resource (MonadResource, release) +import Control.Monad.IO.Class (MonadIO, 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) +import qualified Data.Acquire as A -- | Settings for watching for file changes, to be passed in to -- 'sourceFileChanges'. Should be created with 'mkFileChangeSettings'. @@ -101,14 +103,31 @@ -- @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 + -> ConduitM i FS.Event m () +sourceFileChanges fcs = do + (key, src) <- A.allocateAcquire $ acquireSourceFileChanges fcs + src + release key + +-- | The same as 'sourceFileChanges', but returned in an +-- 'A.Acquire'. This is slightly clunkier to use than +-- 'sourceFileChanges', but provides two benefits: +-- +-- * It does not require 'MonadResource' +-- +-- * You are guaranteed that the directory will be watched +-- immediately. With 'sourceFileChanges', watching will only +-- commence once you 'await' for the first change. +-- +-- @since 0.1.1.0 +acquireSourceFileChanges + :: MonadIO m + => FileChangeSettings + -> A.Acquire (ConduitM i FS.Event m ()) +acquireSourceFileChanges FileChangeSettings {..} = do + -- Safely acquire a manager, guaranteeing it will be released + man <- A.mkAcquire (FS.startManagerConf fcsWatchConfig) FS.stopManager + -- Get the absolute path of the root directory root' <- liftIO $ canonicalizePath fcsDir @@ -120,7 +139,10 @@ -- 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 + + _ <- A.mkAcquire (watchChan man root' fcsPredicate chan) id + + return $ forever $ do event <- liftIO $ readChan chan if fcsRelative diff --git a/test/Data/Conduit/FSNotifySpec.hs b/test/Data/Conduit/FSNotifySpec.hs --- a/test/Data/Conduit/FSNotifySpec.hs +++ b/test/Data/Conduit/FSNotifySpec.hs @@ -1,24 +1,18 @@ 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 (runConduit, (.|), await) 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) +import qualified Data.Acquire spec :: Spec spec = do it "sourceFileChanges" $ withSystemTempDirectory "source-file-changes" $ \root -> do - chan <- newChan let actions = [ ("foo", Just "hello") , ("bar", Just "world") @@ -26,14 +20,15 @@ , ("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 + go (path, mcontents) = do + liftIO $ threadDelay 10000 + liftIO $ 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) + Just contents -> writeFile (root path) contents + mnext <- await + case mnext of + Nothing -> error "Unexpected empty" + Just event -> liftIO $ eventPath event `shouldBe` path + Data.Acquire.with (acquireSourceFileChanges $ mkFileChangeSettings root) $ \src -> + runConduit $ src .| mapM_ go actions + return () :: IO () -- force the type