twitch 0.1.5.1 → 0.1.6.1

raw patch · 10 files changed

+237/−158 lines, 10 filesdep +QuickCheckdep +hspecdep +transformersdep −containersdep −mtldep ~Globdep ~basedep ~data-defaultPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, hspec, transformers

Dependencies removed: containers, mtl

Dependency ranges changed: Glob, base, data-default, directory, fsnotify, optparse-applicative, system-fileio, system-filepath, time

API changes (from Hackage documentation)

Files

• README.md +2/−1
• src/Twitch.hs +24/−4
• src/Twitch/Internal.hs +15/−23
• src/Twitch/InternalRule.hs +18/−18
• src/Twitch/Main.hs +107/−54
• src/Twitch/Path.hs +1/−6
• src/Twitch/Rule.hs +17/−23
• src/Twitch/Run.hs +15/−15
• tests/Main.hs +6/−0
• twitch.cabal +32/−14

@@ -1,4 +1,5 @@-![travis build status](https://travis-ci.org/jfischoff/twitch.svg?branch=master)+[![Hackage](https://img.shields.io/hackage/v/twitch.svg?style=flat)](https://hackage.haskell.org/package/twitch)+[![travis build status](https://travis-ci.org/jfischoff/twitch.svg?branch=master)](https://travis-ci.org/jfischoff/twitch/builds)  Twitch is monadic DSL and library for file watching. It conveniently utilizes 'do' notation in the style of

@@ -81,14 +81,34 @@   -- * Running as a library   , Issue (..)   , InternalRule+  , Rule+  , RuleIssue   , Config (..)   , run   , runWithConfig   -- * Extra   , DepM   ) where-import Twitch.Internal -import Twitch.InternalRule (Config (..), Issue (..), InternalRule)+import Twitch.Internal+    ( Dep,+      DepM,+      (|+),+      (|%),+      (|-),+      (|>),+      (|#),+      add,+      modify,+      delete,+      addModify,+      name )+import Twitch.InternalRule ( Config(..), Issue(..), InternalRule ) import Twitch.Main-import Twitch.Run-import Twitch.Rule (Rule, RuleAction, Name, PatternText)+    ( DebounceType(..),+      Options(Options, currentDir, debounce, debounceAmount, dirsToWatch,+              logFile, pollInterval, recurseThroughDirectories, usePolling),+      LoggerType(..),+      defaultMain,+      defaultMainWithOptions )+import Twitch.Run ( run, runWithConfig )+import Twitch.Rule ( Rule, RuleIssue )

@@ -1,37 +1,29 @@-{-# LANGUAGE RecordWildCards                 #-} {-# LANGUAGE GeneralizedNewtypeDeriving      #-} {-# LANGUAGE OverloadedStrings               #-} {-# LANGUAGE FlexibleInstances               #-} module Twitch.Internal where-import Data.Map (Map)-import Control.Applicative-import Control.Monad-import Filesystem.Path-import Filesystem.Path.CurrentOS-import Prelude hiding (FilePath)-import Data.List -import Control.Monad.Reader-import Control.Monad.State as State-import System.Directory-import System.FilePath.Glob+import Control.Applicative ( Applicative )+import Filesystem.Path ( FilePath )+import Control.Monad.Trans.State as State+    ( State, put, modify, execState ) import qualified Twitch.Rule as Rule-import Twitch.Rule (Rule)-import Data.Monoid-import Data.Time.Clock-import Data.String-import Data.Default-import Control.Arrow-import Data.Either-import System.FSNotify (WatchManager)+    ( addF, modifyF, deleteF, nameF )+import Twitch.Rule ( Rule )+import Data.Monoid ( Monoid(mempty, mappend) )+import Data.String ( IsString(..) )+import Prelude hiding (FilePath)  -- | A polymorphic 'Dep'. Exported for completeness, ignore.  newtype DepM a = DepM { unDepM :: State [Rule] a}   deriving ( Functor            , Applicative            , Monad-           , MonadState [Rule]            ) +instance Monoid a => Monoid (DepM a) where+  mempty = return mempty+  mappend x y = x >> y+ -- | This is the key type of the package, it is where rules are accumulated. type Dep = DepM () @@ -45,12 +37,12 @@ runDepWithState xs = flip execState xs . unDepM   addRule :: Rule -> Dep-addRule r = State.modify (r :)+addRule r = DepM $ State.modify (r :)  modHeadRule :: Dep -> (Rule -> Rule) -> Dep modHeadRule dep f = do    let res = runDep dep-  case res of+  DepM $ case res of     x:xs -> put $ f x : xs     r    -> put r 

@@ -1,20 +1,20 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Twitch.InternalRule where-import Filesystem.Path-import Data.Time.Clock-import System.FSNotify ( Event (..)-                       , WatchConfig-                       , watchDir-                       , startManagerConf-                       , WatchManager-                       , defaultConfig-                       )-import Data.Default-import Control.Monad-import Data.Monoid+import Filesystem.Path ( FilePath )+import Data.Time.Clock ( UTCTime )+import System.FSNotify+    ( Event(..),+      WatchConfig,+      watchDir,+      startManagerConf,+      WatchManager,+      defaultConfig )+import Data.Default ( Default(..) )+import Control.Monad ( when, void, forM_ )+import Data.Monoid ( Monoid(mempty), (<>) )+import Twitch.Rule ( Rule, RuleIssue ) import Prelude hiding (FilePath)-import Twitch.Rule (Rule, RuleIssue) import qualified Twitch.Rule as Rule  -- | The actions that are run when file events are triggered@@ -53,7 +53,7 @@ toInternalRule :: FilePath -> Rule -> Either RuleIssue InternalRule toInternalRule currentDir rule = do   test <- Rule.compilePattern currentDir $ Rule.pattern rule-  return $ InternalRule +  return InternalRule      { name     = Rule.name rule     , fileTest = \x _ -> test x     , add      = \x _ -> Rule.add    rule x@@ -109,9 +109,9 @@ -- | Run the Rule action associated with the an event  fireRule :: Event -> InternalRule -> IO () fireRule event rule = case event of-  Added    file time -> modify rule file time-  Modified file time -> add    rule file time-  Removed  file time -> delete rule file time+  Added    file tyme -> modify rule file tyme+  Modified file tyme -> add    rule file tyme+  Removed  file tyme -> delete rule file tyme  -- | Test to see if the rule should fire and fire it testAndFireRule :: Config -> Event -> InternalRule -> IO ()@@ -125,7 +125,7 @@ --      when appropiate -- | Start watching a directory, and run the rules on it. setupRuleForDir :: Config -> WatchManager -> [InternalRule] -> FilePath -> IO ()-setupRuleForDir config@(Config {..}) man rules dirPath = do+setupRuleForDir config@(Config {..}) man rules dirPath =   -- TODO Instead of const True, this should use the rule's fileTests   void $ watchDir man dirPath (const True) $ \event -> do      logger $ IEvent event

@@ -1,27 +1,54 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Twitch.Main where-import Data.Monoid+import Prelude hiding (log, FilePath)+import Data.Monoid ( (<>) ) import Options.Applicative-import Data.Default+    ( Applicative((<*>))+    , (<$>)+    , Parser+    , helper+    , execParser+    , value+    , short+    , progDesc+    , option+    , metavar+    , long+    , info+    , help+    , header+    , fullDesc+    , auto+    , eitherReader+    , many+    , switch+    , flag+    , ParserInfo+    )+import Data.Default ( Default(..) ) import qualified System.FSNotify as FS-import Twitch.Path+import Twitch.Path ( findAllDirs ) import qualified Twitch.InternalRule as IR import System.IO-import Data.Foldable (for_)-import Twitch.Run-import Twitch.Internal-import System.Directory-import Data.Maybe-import Prelude hiding (log)-import qualified Filesystem.Path as F+    ( IOMode(AppendMode),+      Handle,+      hPrint,+      openFile,+      hClose )+import Data.Foldable ( for_ )+import Twitch.Run ( runWithConfig )+import Twitch.Internal ( Dep )+import System.Directory ( getCurrentDirectory )+import Data.Maybe ( fromMaybe )+import Filesystem.Path (FilePath) import qualified Filesystem.Path.CurrentOS as F-import Data.Time.Clock-import Control.Concurrent+import Control.Monad ( liftM ) -- parse the command line -- -concatMapM f = fmap concat . mapM f+concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] +concatMapM f = liftM concat . mapM f  data LoggerType   = LogToStdout@@ -35,44 +62,45 @@ toLogger filePath lt = case lt of   LogToStdout -> return (print, Nothing)   LogToFile -> do-    handle <- openFile filePath AppendMode+    handle <- openFile (F.encodeString filePath) AppendMode     return (hPrint handle, Just handle)   NoLogger -> return (const $ return (), Nothing)  data Options = Options-  { log          :: LoggerType+  { log                       :: LoggerType   -- ^ The logger type.   --   This cooresponds to the --log or -l argument. The valid options   --   are "LogToStdout", "LogToFile", and "NoLogger"   --   If "LogToFile" a file can provide with the 'logFile' field.-  , logFile      :: Maybe FilePath+  , logFile                   :: Maybe FilePath   -- ^ The file to log to   --   This is only used if the 'log' field is set to "LogToFile".   --   This cooresponds to the --log-file or -f argument-  , dirsToWatch  :: [FilePath]+  , dirsToWatch               :: [FilePath]   -- ^ The directories to watch.-  --   This cooresponds to the --directories and -d argument+  --   This cooresponds to the --directories and -d argument.+  --   By default this is empty and the current directory is used   , recurseThroughDirectories :: Bool   -- ^ If true, main will recurse throug all subdirectories of the 'dirsToWatch'   --   field. Otherwise the 'dirsToWatch' will be used literally.-  --   By default this is empty and the currentDirectory is used.-  , debounce     :: DebounceType+  --   By default this is true, and disabled with the --no-recurse-flag+  , debounce                  :: DebounceType   -- ^ This corresponds to the debounce type used in the fsnotify library   --   The argument for default main is --debounce or -b .   --   Valid options are "DebounceDefault", "Debounce", "NoDebounce"   --   If "Debounce" is used then a debounce amount must be specified with the   --   'debounceAmount'-  , debounceAmount :: Double+  , debounceAmount            :: Double   -- ^ The amount to debounce. This is only meaningful when 'debounce' is set   --   to 'Debounce'.   --   It cooresponds to the --debounce-amount or -a argument-  , pollInterval :: Int+  , pollInterval              :: Int   -- ^ poll interval if polling is used.   --   This cooresponds to the --poll-interval or -i argument-  , usePolling   :: Bool-  -- ^ If true polling is used instead of events.-  --   This cooresponds to the --poll or -p argument-  , currentDir   :: Maybe FilePath+  , usePolling                :: Bool+  -- ^ Sets polling to true if used+  --   This cooresponds to the --should-poll or -p flag+  , currentDir                :: Maybe FilePath   -- ^ The current directory to append to the glob patterns. If Nothing then   --   the value is whatever is returned by 'getCurrentDirectory'   --   This cooresponds to the --current-dir or -c arguments@@ -84,6 +112,9 @@   | NoDebounce   deriving (Eq, Show, Read, Ord) +-- use the new vinyl for the options+-- the you get the monoid instance for free+ instance Default Options where   def = Options     { log                       = NoLogger@@ -97,6 +128,24 @@     , currentDir                = Nothing     } +dropDoubleQuotes :: String -> String+dropDoubleQuotes [] = []+dropDoubleQuotes (x : xs) +  | x == '\"' = xs+  | otherwise = x : xs++stripDoubleQuotes :: String -> String+stripDoubleQuotes = dropDoubleQuotes . reverse . dropDoubleQuotes . reverse+    +-- strip quotes if they are there+readFilePath :: String -> Either String FilePath+readFilePath xs = +  let filePath = F.decodeString $ stripDoubleQuotes xs+  in if F.valid filePath then+        Right filePath+     else+        Left $ "invalid filePath " ++ xs + pOptions :: Parser Options pOptions    =  Options@@ -107,32 +156,30 @@        <> help "Type of logger. Valid options are LogToStdout | LogToFile | NoLogger"        <> value (log def)         )-  <*> option auto+  <*> option (Just <$> eitherReader readFilePath)         ( long "log-file"        <> short 'f'        <> metavar "LOG_FILE"        <> help "Log file"        <> value (logFile def)         )-  <*> option auto-        ( long "directories"+  <*> many (option (eitherReader readFilePath)+        ( long "directory"        <> short 'd'        <> metavar "DIRECTORIES"        <> help "Directories to watch"-       <> value (dirsToWatch def)         )-  <*> option auto-        ( long "recurse"+      )+  <*> flag True False+        ( long "no-recurse"        <> short 'r'-       <> metavar "RECURSE"-       <> help "Boolean to recurse or directories or not"-       <> value (recurseThroughDirectories def)+       <> help "flag to turn off recursing"         )   <*> option auto         ( long "debounce"        <> short 'b'        <> metavar "DEBOUNCE"-       <> help "Target for the greeting"+       <> help "Type of debouncing. Valid choices are DebounceDefault | Debounce | NoDebounce"        <> value (debounce def)         )   <*> option auto@@ -149,14 +196,12 @@        <> help "Poll interval if polling is used"        <> value (pollInterval def)         )-  <*> option auto-        ( long "poll"+  <*> switch+        ( long "should-poll"        <> short 'p'-       <> metavar "POLL"-       <> help "Whether to use polling or not"-       <> value (usePolling def)+       <> help "Whether to use polling or not. Off by default"         )-  <*> option auto+  <*> option (Just <$> eitherReader readFilePath)         ( long "current-dir"        <> short 'c'        <> metavar "CURRENT_DIR"@@ -166,26 +211,33 @@  -- This is like run, but the config params can be over written from the defaults +toDB :: Real a => a -> DebounceType -> FS.Debounce toDB amount dbtype = case dbtype of   DebounceDefault -> FS.DebounceDefault   Debounce        -> FS.Debounce $ fromRational $ toRational amount   NoDebounce      -> FS.NoDebounce +makeAbsolute :: F.FilePath -> F.FilePath -> F.FilePath+makeAbsolute currentDir path = +  if F.relative path then+      currentDir F.</> path+  else +      path+ optionsToConfig :: Options -> IO (FilePath, IR.Config, Maybe Handle) optionsToConfig Options {..} = do-  actualCurrentDir <- getCurrentDirectory+  actualCurrentDir <- F.decodeString <$> getCurrentDirectory   let currentDir' = fromMaybe actualCurrentDir currentDir       dirsToWatch' = if null dirsToWatch then                        [currentDir']                      else-                       dirsToWatch+                       map (makeAbsolute currentDir') dirsToWatch    (logger, mhandle) <- toLogger (fromMaybe "log.txt" logFile) log-  let encodedDirs = map F.decodeString dirsToWatch'   dirsToWatch'' <- if recurseThroughDirectories then-                   (encodedDirs ++) <$> concatMapM findAllDirs encodedDirs+                   (dirsToWatch' ++) <$> concatMapM findAllDirs dirsToWatch'                  else-                   return encodedDirs+                   return dirsToWatch'    let watchConfig = FS.WatchConfig         { FS.confDebounce     = toDB debounceAmount debounce@@ -200,6 +252,13 @@         }   return (currentDir', config, mhandle) +opts :: ParserInfo Options+opts = info (helper <*> pOptions)+      ( fullDesc+     <> progDesc "twitch"+     <> header "a file watcher"+      )+ -- | Simplest way to create a file watcher app. Set your main equal to defaultMain --   and you are good to go. See the module documentation for examples. --@@ -208,11 +267,6 @@ --   executable made with defaultMain with the --help argument. defaultMain :: Dep -> IO () defaultMain dep = do-  let opts = info (helper <*> pOptions)-        ( fullDesc-       <> progDesc "twitch"-       <> header "a file watcher"-        )   options <- execParser opts   defaultMainWithOptions options dep @@ -220,8 +274,7 @@ defaultMainWithOptions :: Options -> Dep -> IO () defaultMainWithOptions options dep = do   (currentDir, config, mhandle) <- optionsToConfig options-  let currentDir' = F.decodeString currentDir-  manager <- runWithConfig currentDir' config dep+  manager <- runWithConfig currentDir config dep   putStrLn "Type anything to quit"   _ <- getLine   for_ mhandle hClose

@@ -12,14 +12,9 @@        , canonicalizeDirPath        , canonicalizePath        ) where-+import Filesystem.Path.CurrentOS ( FilePath, encodeString, decodeString, (</>) ) import Prelude hiding (FilePath)- import Control.Monad--- import Filesystem--- import Filesystem.Path hiding (concat)-import Filesystem.Path.CurrentOS hiding (concat)- import qualified Filesystem as FS import qualified Filesystem.Path as FP 

@@ -1,25 +1,17 @@-{-# LANGUAGE RecordWildCards                 #-}-{-# LANGUAGE GeneralizedNewtypeDeriving      #-} {-# LANGUAGE OverloadedStrings               #-} {-# LANGUAGE FlexibleInstances               #-} module Twitch.Rule where-import Data.Map (Map)-import Control.Applicative-import Control.Monad-import Filesystem.Path-import Filesystem.Path.CurrentOS import Prelude hiding (FilePath)-import System.Directory-import System.FilePath.Glob-import Data.Monoid-import Data.Time.Clock-import Data.String-import Data.Default-import Control.Arrow-import Data.Either-import Debug.Trace-import System.FSNotify (WatchManager)+import Control.Monad ( void )+import Filesystem.Path ( FilePath )+import Filesystem.Path.CurrentOS ( encodeString )+import System.FilePath.Glob ( simplify, match, tryCompileWith, compDefault )+import Data.Monoid ( (<>) )+import Data.String ( IsString(..) )+import Data.Default ( Default(..) )+import Control.Arrow ( ArrowChoice(left) ) + type Name        = String type PatternText = String @@ -80,12 +72,14 @@  -- Prefix API ----------------------------------------------------------------- addF, modifyF, deleteF, addModifyF :: (FilePath -> IO a) -> Rule -> Rule-addF      = flip (|+)-modifyF   = flip (|%)-deleteF   = flip (|-)-nameF     = flip (|#)+addF       = flip (|+)+modifyF    = flip (|%)+deleteF    = flip (|-) addModifyF = flip (|>) +nameF :: String -> Rule -> Rule+nameF = flip (|#)+ -- def & add foo & modify foo & delete foo & test tester -- def & add foo & modify foo & delete foo & pattern tester @@ -96,11 +90,11 @@ compilePattern :: FilePath                 -> PatternText                 -> Either RuleIssue (FilePath -> Bool)-compilePattern currentDir pattern = left (PatternCompliationFailed pattern) $ do +compilePattern currentDir pat = left (PatternCompliationFailed pat) $ do     -- TODO is this way of adding the current directory cross platfrom okay?    -- Does the globbing even work on windows    -   let absolutePattern = encodeString currentDir <> "/" <> pattern+   let absolutePattern = encodeString currentDir <> "/" <> pat    p <- tryCompileWith compDefault absolutePattern    let test = match $ simplify p    return $ \x -> test $ encodeString x

@@ -1,29 +1,29 @@ module Twitch.Run where-import Twitch.Internal-import Twitch.InternalRule-import Twitch.Rule (RuleIssue)-import Data.Either import Prelude hiding (FilePath, log)-import Filesystem.Path-import Filesystem.Path.CurrentOS-import Control.Applicative-import System.FSNotify-import System.Directory-import Twitch.Path-import Data.Default-import Debug.Trace+import Twitch.Internal ( Dep, runDep )+import Twitch.InternalRule+    ( Config(dirs, logger), InternalRule, toInternalRule, setupRules )+import Twitch.Rule ( RuleIssue )+import Data.Either ( partitionEithers )+import Filesystem.Path ( FilePath )+import Filesystem.Path.CurrentOS ( decodeString )+import Control.Applicative ( (<$>) )+import System.FSNotify ( WatchManager )+import System.Directory ( getCurrentDirectory )+import Twitch.Path ( findAllDirs )+import Data.Default ( Default(def) )  -- This the main interface for running a Dep  run :: Dep -> IO WatchManager run dep =  do   currentDir <- decodeString <$> getCurrentDirectory-  dirs       <- findAllDirs currentDir-  runWithConfig currentDir (def { logger = print, dirs = dirs }) dep+  dirs'       <- findAllDirs currentDir+  runWithConfig currentDir (def { logger = print, dirs = dirs' }) dep  runWithConfig :: FilePath -> Config -> Dep -> IO WatchManager runWithConfig currentDir config dep = do-  let (issues, rules) = depToRules currentDir dep+  let (_issues, rules) = depToRules currentDir dep   -- TODO handle the issues somehow   -- Log and perhaps error   setupRules config rules

@@ -0,0 +1,6 @@+module Main where+import Test.Hspec+import Tests.Twitch++main :: IO () +main = hspec tests

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                twitch-version:             0.1.5.1+version:             0.1.6.1 synopsis:            A high level file watcher DSL description:  Twitch is a monadic DSL and library for file watching.@@ -57,16 +57,34 @@                   , MultiParamTypeClasses                   , TypeSynonymInstances                   , TemplateHaskell-  build-depends: base >=4.5 && <4.8-               , containers >=0.5 && <0.6-               , system-filepath >=0.4 && <0.5-               , mtl >=2.1 && <2.2-               , directory >=1.2 && <1.3-               , Glob >=0.7 && <0.8-               , time >=1.4 && <1.5-               , data-default >=0.5 && <0.6-               , fsnotify >=0.1 && <0.2-               , optparse-applicative >=0.11 && <0.12-               , system-fileio >=0.3 && <0.4-  hs-source-dirs:      src-  default-language:    Haskell2010+  build-depends: base >=4.5 && <4.9+               , system-filepath+               , transformers +               , directory +               , Glob +               , time+               , data-default+               , fsnotify+               , optparse-applicative+               , system-fileio+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall+  +test-suite unit-tests+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: tests, src+  default-language: Haskell2010+  build-depends: base+               , hspec+               , QuickCheck >= 2.7+               , system-filepath+               , transformers +               , directory +               , Glob +               , time+               , data-default+               , fsnotify+               , optparse-applicative+               , system-fileio