diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Paulo Tanimoto + +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 Paulo Tanimoto 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Main +-- Copyright : (c) 2014 Paulo Tanimoto +-- License : BSD3 +-- +-- Maintainer : Paulo Tanimoto +-- +------------------------------------------------------------------------------- + +module Main + ( main + ) where + + +------------------------------------------------------------------------------- + +import WatchIt (defaultMain) + + +------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain diff --git a/src/WatchIt.hs b/src/WatchIt.hs new file mode 100644 --- /dev/null +++ b/src/WatchIt.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------- +-- | +-- Module : WatchIt +-- Copyright : (c) 2014 Paulo Tanimoto +-- License : BSD3 +-- +-- Maintainer : Paulo Tanimoto +-- +------------------------------------------------------------------------------- + +module WatchIt + ( defaultMain + , watchIt + ) where + + +------------------------------------------------------------------------------- + +import WatchIt.Options +import WatchIt.Types + +import Control.Concurrent (threadDelay) +import Control.Monad (forever, void, when) + +import Data.Pool (Pool (..), createPool, tryWithResource) +import Data.Streaming.Process (Inherited (..), shell, streamingProcess, + waitForStreamingProcess) +import qualified Data.Text as Text + +import qualified Filesystem.Path.CurrentOS as FS + +import Options.Applicative (execParser) + +import System.FSNotify (eventPath, watchDir, watchTree, + withManager) + + +------------------------------------------------------------------------------- + +defaultMain :: IO () +defaultMain = do + options <- execParser infoOptions + watchIt $ parseConfig options + + +------------------------------------------------------------------------------- + +parseConfig :: Options -> Config +parseConfig options = Config + { configPath = withDef configPath optionsPath FS.decodeString + , configFilter = withDef configFilter optionsExt + (flip FS.hasExtension . Text.pack) + , configAction = withDef configAction optionsCmd (const . run) + , configForce = withDef configForce optionsForce id + , configNumJobs = withDef configNumJobs optionsNumJobs id + , configRecur = withDef configRecur optionsNotRec not + } + where + withDef conf opt f = maybe (conf defaultConfig) f (opt options) + + +watchIt :: Config -> IO () +watchIt config = do + -- Set up Config + let path = configPath config + let filterEvent = configFilter config . eventPath + let numJobs = configNumJobs config + pool <- createWorkerPool numJobs + let action = configAction config + let handleEvent = withPool pool action . eventPath + let forced = configForce config + let watch = if configRecur config then watchTree else watchDir + let longDelay = 12 * 3600 * 10000 -- maxBound + + -- Watch it + putStrLn "watchit started..." + withManager $ \man -> do + when forced $ action FS.empty + void $ watch man path + filterEvent + handleEvent + forever $ threadDelay longDelay + + +-------------------------------------------------------------------------------- + +createWorkerPool :: Int -> IO (Pool ()) +createWorkerPool stripes = + createPool + (return ()) + (const $ return ()) + stripes timeLeftOpen numPerStripe + where + timeLeftOpen = 1 + numPerStripe = 1 + + +withPool :: Pool a -> (FS.FilePath -> IO ()) -> FS.FilePath -> IO () +withPool pool f file = + void $ tryWithResource pool $ const $ f file + + +-------------------------------------------------------------------------------- + +run :: String -> IO () +run cmd = do + putStrLn $ replicate 72 '-' + (Inherited, Inherited, Inherited, handle) <- + streamingProcess (shell cmd) + waitForStreamingProcess handle >>= print diff --git a/src/WatchIt/Options.hs b/src/WatchIt/Options.hs new file mode 100644 --- /dev/null +++ b/src/WatchIt/Options.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------- +-- | +-- Module : WatchIt.Options +-- Copyright : (c) 2014 Paulo Tanimoto +-- License : BSD3 +-- +-- Maintainer : Paulo Tanimoto +-- +------------------------------------------------------------------------------- + +module WatchIt.Options + ( Options (..) + , defaultOptions + , parseOptions + , infoOptions + ) where + +------------------------------------------------------------------------------- + +import Options.Applicative + + +------------------------------------------------------------------------------- + +data Options = Options + { optionsPath :: Maybe String + , optionsExt :: Maybe String + , optionsForce :: Maybe Bool + , optionsNumJobs :: Maybe Int + , optionsNotRec :: Maybe Bool + , optionsCmd :: Maybe String + } + deriving (Eq, Show) + + +------------------------------------------------------------------------------- + +defaultOptions :: Options +defaultOptions = Options + { optionsPath = Nothing + , optionsExt = Nothing + , optionsForce = Nothing + , optionsNumJobs = Nothing + , optionsNotRec = Nothing + , optionsCmd = Nothing + } + + +parseOptions :: Parser Options +parseOptions = Options + <$> optional (strOption + ( long "path" + <> metavar "PATH" + <> help "Directory to watch")) + <*> optional (strOption + ( long "extension" + <> metavar "EXTENSION" + <> help "File extension to watch")) + <*> optional (switch + ( long "force" + <> short 'f' + <> help "Force command to run right away")) + <*> optional (option auto + ( long "num-jobs" + <> short 'j' + <> metavar "JOBS" + <> help "Number of concurrent jobs")) + <*> optional (switch + ( long "not-recursive" + <> help "Do not watch directory recursively")) + <*> optional (argument str + ( metavar "COMMAND" + <> help "Command to run")) + + +infoOptions :: ParserInfo Options +infoOptions = + info (helper <*> parseOptions) + ( fullDesc + <> progDesc "Watch a directory and run a command whenever a file changes" + <> header "watchit" ) diff --git a/src/WatchIt/Types.hs b/src/WatchIt/Types.hs new file mode 100644 --- /dev/null +++ b/src/WatchIt/Types.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------------------- +-- | +-- Module : WatchIt.Types +-- Copyright : (c) 2014 Paulo Tanimoto +-- License : BSD3 +-- +-- Maintainer : Paulo Tanimoto +-- +------------------------------------------------------------------------------- + +module WatchIt.Types + ( Config (..) + , defaultConfig + ) where + +------------------------------------------------------------------------------- + +import qualified Filesystem.Path.CurrentOS as FS + + +------------------------------------------------------------------------------- + +data Config = Config + { configPath :: FS.FilePath + , configFilter :: FS.FilePath -> Bool + , configAction :: FS.FilePath -> IO () + , configForce :: Bool + , configNumJobs :: Int + , configRecur :: Bool + } + + +------------------------------------------------------------------------------- + +defaultConfig :: Config +defaultConfig = Config + { configPath = "." + , configFilter = const True + , configAction = printFile + , configForce = False + , configNumJobs = 1 + , configRecur = True + } + + +printFile :: FS.FilePath -> IO () +printFile = putStrLn . FS.encodeString diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} + +------------------------------------------------------------------------------- +-- | +-- Module : Test +-- Copyright : (c) 2014 Paulo Tanimoto +-- License : BSD3 +-- +-- Maintainer : Paulo Tanimoto +-- +------------------------------------------------------------------------------- + +module Main where + +------------------------------------------------------------------------------- + +import WatchIt +import WatchIt.Types + +import qualified Data.ByteString as B + +import Control.Concurrent (newEmptyMVar, readMVar, putMVar, + threadDelay) +import Control.Concurrent.Async (withAsync) +import Control.Exception (bracket) + +import qualified Filesystem as FS +import qualified Filesystem.Path.CurrentOS as FS + +import System.Timeout (timeout) + +import Test.Tasty as Tasty +import Test.Tasty.HUnit + +------------------------------------------------------------------------------- + +main :: IO () +main = Tasty.defaultMain testSuite + +------------------------------------------------------------------------------- + +testSuite :: TestTree +testSuite = testGroup "Test Suite" + [ properties + , unitTests + , integrationTests + ] + +------------------------------------------------------------------------------- + +properties :: TestTree +properties = testGroup "Properties" + [ + ] + +------------------------------------------------------------------------------- + +unitTests :: TestTree +unitTests = testGroup "Unit Tests" + [ + ] + +------------------------------------------------------------------------------- + +integrationTests :: TestTree +integrationTests = testGroup "Integration Tests" + [ testWatchFileAdded + ] + + +testWatchFileAdded :: TestTree +testWatchFileAdded = + testCase "Watching should receive notification of a file change" $ do + actual <- bracket acquire release between + assertEqual "" (Just ()) actual + where + acquire = do + let path = "dist/tmp" + FS.createTree path + return path + release path = do + FS.removeTree path + between path = do + mvar <- newEmptyMVar + let config = defaultConfig + { configPath = path + , configAction = \_ -> putMVar mvar () + } + withAsync (watchIt config) $ \_ -> do + threadDelay (1*1000*1000) + FS.writeFile (path FS. "test") B.empty + timeout (15*1000*1000) $ do + readMVar mvar diff --git a/watchit.cabal b/watchit.cabal new file mode 100644 --- /dev/null +++ b/watchit.cabal @@ -0,0 +1,102 @@ +Name: watchit +Version: 0.1.0.0 +Synopsis: File change watching utility +Description: Watch a directory and run a command whenever a file changes. +License: BSD3 +License-File: LICENSE +Author: Paulo Tanimoto +Maintainer: ptanimoto@gmail.com +Category: Development +Build-Type: Simple +Cabal-version: >= 1.10 + + +------------------------------------------------------------------------------- +Source-Repository head + Type: git + Location: https://github.com/tanimoto/watchit + + +------------------------------------------------------------------------------- +Library + Hs-Source-Dirs: + src + + Exposed-Modules: + WatchIt + WatchIt.Options + WatchIt.Types + + Build-Depends: + base >= 4.0 && < 5.0 + , fsnotify >= 0.1 + , optparse-applicative >= 0.11 + , process >= 1.1 + , resource-pool >= 0.2 + , streaming-commons >= 0.1 + , system-filepath >= 0.3 + , text >= 1.1 + + Ghc-Options: + -Wall + + Default-Language: Haskell2010 + + +------------------------------------------------------------------------------- +Executable watchit + Hs-Source-Dirs: + src + + Main-is: + Main.hs + + Build-Depends: + base >= 4.0 && < 5.0 + , fsnotify >= 0.1 + , optparse-applicative >= 0.11 + , process >= 1.1 + , resource-pool >= 0.2 + , streaming-commons >= 0.1 + , system-filepath >= 0.3 + , text >= 1.1 + + Ghc-Options: + -Wall + -threaded + -rtsopts + + Default-Language: Haskell2010 + + +------------------------------------------------------------------------------- +Test-Suite Tests + Hs-Source-Dirs: + test + + Main-is: + Test.hs + + Type: + exitcode-stdio-1.0 + + Build-Depends: + watchit + , base >= 4.0 && < 5.0 + , bytestring >= 0.9 + , async >= 2.0 + , system-fileio >= 0.3 + , system-filepath >= 0.3 + + , tasty >= 0.10 + , tasty-hunit >= 0.9 + , tasty-quickcheck >= 0.8 + , tasty-smallcheck >= 0.8 + , HUnit >= 1.2 + , QuickCheck >= 2.7 + , smallcheck >= 1.1 + + Ghc-Options: + -Wall + + Default-Language: Haskell2010