watchit (empty) → 0.1.0.0
raw patch · 8 files changed
+498/−0 lines, 8 filesdep +HUnitdep +QuickCheckdep +asyncsetup-changed
Dependencies added: HUnit, QuickCheck, async, base, bytestring, fsnotify, optparse-applicative, process, resource-pool, smallcheck, streaming-commons, system-fileio, system-filepath, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, text, watchit
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Main.hs +26/−0
- src/WatchIt.hs +112/−0
- src/WatchIt/Options.hs +83/−0
- src/WatchIt/Types.hs +49/−0
- test/Test.hs +94/−0
- watchit.cabal +102/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Main.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------+-- |+-- Module : Main+-- Copyright : (c) 2014 Paulo Tanimoto+-- License : BSD3+--+-- Maintainer : Paulo Tanimoto <ptanimoto@gmail.com>+--+-------------------------------------------------------------------------------++module Main+ ( main+ ) where+++-------------------------------------------------------------------------------++import WatchIt (defaultMain)+++-------------------------------------------------------------------------------++main :: IO ()+main = defaultMain
+ src/WatchIt.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------+-- |+-- Module : WatchIt+-- Copyright : (c) 2014 Paulo Tanimoto+-- License : BSD3+--+-- Maintainer : Paulo Tanimoto <ptanimoto@gmail.com>+--+-------------------------------------------------------------------------------++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
+ src/WatchIt/Options.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------+-- |+-- Module : WatchIt.Options+-- Copyright : (c) 2014 Paulo Tanimoto+-- License : BSD3+--+-- Maintainer : Paulo Tanimoto <ptanimoto@gmail.com>+--+-------------------------------------------------------------------------------++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" )
+ src/WatchIt/Types.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++-------------------------------------------------------------------------------+-- |+-- Module : WatchIt.Types+-- Copyright : (c) 2014 Paulo Tanimoto+-- License : BSD3+--+-- Maintainer : Paulo Tanimoto <ptanimoto@gmail.com>+--+-------------------------------------------------------------------------------++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
+ test/Test.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}++-------------------------------------------------------------------------------+-- |+-- Module : Test+-- Copyright : (c) 2014 Paulo Tanimoto+-- License : BSD3+--+-- Maintainer : Paulo Tanimoto <ptanimoto@gmail.com>+--+-------------------------------------------------------------------------------++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
+ watchit.cabal view
@@ -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