twitch 0.1.6.1 → 0.1.7.0

raw patch · 16 files changed

+348/−196 lines, 16 filesdep +filepathdep −QuickCheckdep −system-fileiodep −system-filepathnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: filepath

Dependencies removed: QuickCheck, system-fileio, system-filepath

API changes (from Hackage documentation)

Files

• README.md +3/−3
• src/Twitch.hs +1/−1
• src/Twitch/Internal.hs +7/−7
• src/Twitch/InternalRule.hs +14/−25
• src/Twitch/Main.hs +74/−88
• src/Twitch/Path.hs +24/−33
• src/Twitch/Rule.hs +16/−14
• src/Twitch/Run.hs +6/−15
• tests/Tests/Twitch.hs +18/−0
• tests/Tests/Twitch/Internal.hs +15/−0
• tests/Tests/Twitch/InternalRule.hs +5/−0
• tests/Tests/Twitch/Main.hs +65/−0
• tests/Tests/Twitch/Path.hs +5/−0
• tests/Tests/Twitch/Rule.hs +66/−0
• tests/Tests/Twitch/Run.hs +14/−0
• twitch.cabal +15/−10

@@ -14,15 +14,15 @@ ```haskell {-# LANGUAGE OverloadedStrings #-} import Twitch-import Filesystem.Path.CurrentOS+import System.Process ( system )  main = defaultMain $ do-   "*.md"   |> \filePath -> system $ "pandoc -t html " ++ encodeString filePath+   "*.md"   |> \filePath -> system $ "pandoc -t html " ++ filePath    "*.html" |> \_ -> system $ "osascript refreshSafari.AppleScript" ```  Rules are specified in the `Dep` (for Dependency) monad. The library takes advantage-of the *OverloadedStrings* extension to create a Dep value from a glob pattern.+of the *OverloadedStrings* extension to create a `Dep` value from a glob pattern.  After creating a `Dep` value using a glob, event callbacks are added using prefix or infix API.

@@ -105,7 +105,7 @@ import Twitch.InternalRule ( Config(..), Issue(..), InternalRule ) import Twitch.Main     ( DebounceType(..),-      Options(Options, currentDir, debounce, debounceAmount, dirsToWatch,+      Options(Options, debounce, debounceAmount, root,               logFile, pollInterval, recurseThroughDirectories, usePolling),       LoggerType(..),       defaultMain,

@@ -2,15 +2,15 @@ {-# LANGUAGE OverloadedStrings               #-} {-# LANGUAGE FlexibleInstances               #-} module Twitch.Internal where-import Control.Applicative ( Applicative )-import Filesystem.Path ( FilePath )+import System.FilePath ( FilePath ) import Control.Monad.Trans.State as State-    ( State, put, modify, execState )+    ( State, put, modify, execState, get ) import qualified Twitch.Rule as Rule     ( addF, modifyF, deleteF, nameF ) import Twitch.Rule ( Rule )-import Data.Monoid ( Monoid(mempty, mappend) ) import Data.String ( IsString(..) )+import Control.Applicative -- satisfy GHC < 7.10+import Data.Monoid         -- satisfy GHC < 7.10 import Prelude hiding (FilePath)  -- | A polymorphic 'Dep'. Exported for completeness, ignore. @@ -40,9 +40,9 @@ addRule r = DepM $ State.modify (r :)  modHeadRule :: Dep -> (Rule -> Rule) -> Dep-modHeadRule dep f = do -  let res = runDep dep-  DepM $ case res of+modHeadRule (DepM dep) f = DepM $ do+  dep+  get >>= \res -> case res of     x:xs -> put $ f x : xs     r    -> put r 

@@ -1,18 +1,21 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Twitch.InternalRule where-import Filesystem.Path ( FilePath )+import System.FilePath ( FilePath ) import Data.Time.Clock ( UTCTime ) import System.FSNotify-    ( Event(..),-      WatchConfig,-      watchDir,-      startManagerConf,-      WatchManager,-      defaultConfig )+  ( Event(..)+  , WatchConfig+  , WatchManager+  , defaultConfig+  , eventPath+  , eventTime+  , startManagerConf+  , watchDir+  ) import Data.Default ( Default(..) ) import Control.Monad ( when, void, forM_ )-import Data.Monoid ( Monoid(mempty), (<>) )+import Data.Monoid import Twitch.Rule ( Rule, RuleIssue ) import Prelude hiding (FilePath) import qualified Twitch.Rule as Rule@@ -52,7 +55,7 @@  toInternalRule :: FilePath -> Rule -> Either RuleIssue InternalRule toInternalRule currentDir rule = do-  test <- Rule.compilePattern currentDir $ Rule.pattern rule+  test <- Rule.compilePattern $ Rule.pattern $ Rule.makeAbsolute currentDir rule   return InternalRule      { name     = Rule.name rule     , fileTest = \x _ -> test x@@ -92,20 +95,6 @@   -- ^ logged every time an rule is fired   deriving Show --- | Retrieve the filePath of an Event-filePath :: Event -> FilePath-filePath e = case e of-  Added    x _ -> x-  Modified x _ -> x-  Removed  x _ -> x---- | Retrieve the time of an Event-time :: Event -> UTCTime-time e = case e of-  Added    _ x -> x-  Modified _ x -> x-  Removed  _ x -> x- -- | Run the Rule action associated with the an event  fireRule :: Event -> InternalRule -> IO () fireRule event rule = case event of@@ -116,13 +105,13 @@ -- | Test to see if the rule should fire and fire it testAndFireRule :: Config -> Event -> InternalRule -> IO () testAndFireRule Config {..} event rule = do-  let shouldFire = fileTest rule (filePath event) (time event)+  let shouldFire = fileTest rule (eventPath event) (eventTime event)   when shouldFire $ do      logger $ IRuleFired event rule     fireRule event rule   -- TODO in the future this should use the recursive directory functions---      when appropiate+--      when appropriate -- | Start watching a directory, and run the rules on it. setupRuleForDir :: Config -> WatchManager -> [InternalRule] -> FilePath -> IO () setupRuleForDir config@(Config {..}) man rules dirPath =

@@ -1,49 +1,53 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Twitch.Main where-import Prelude hiding (log, FilePath)-import Data.Monoid ( (<>) )+import Control.Applicative -- satisfy GHC < 7.10+import Data.Monoid import Options.Applicative-    ( Applicative((<*>))-    , (<$>)-    , Parser-    , helper-    , execParser-    , value-    , short-    , progDesc-    , option-    , metavar-    , long-    , info-    , help-    , header-    , fullDesc-    , auto-    , eitherReader-    , many-    , switch-    , flag-    , ParserInfo-    )+  ( Parser+  , helper+  , execParser+  , value+  , short+  , progDesc+  , option+  , metavar+  , long+  , info+  , help+  , header+  , fullDesc+  , auto+  , eitherReader+  , switch+  , flag+  , ParserInfo+  ) import Data.Default ( Default(..) ) import qualified System.FSNotify as FS import Twitch.Path ( findAllDirs ) import qualified Twitch.InternalRule as IR import System.IO-    ( IOMode(AppendMode),-      Handle,-      hPrint,-      openFile,-      hClose )+  ( 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 System.FilePath+  ( FilePath+  , (</>)+  , isRelative+  , isValid+  ) import Control.Monad ( liftM )+-- Moved here to suppress redundant import warnings for GHC > 7.10+import Prelude hiding (log, FilePath) -- parse the command line -- @@ -62,48 +66,44 @@ toLogger filePath lt = case lt of   LogToStdout -> return (print, Nothing)   LogToFile -> do-    handle <- openFile (F.encodeString filePath) AppendMode+    handle <- openFile filePath AppendMode     return (hPrint handle, Just handle)   NoLogger -> return (const $ return (), Nothing)  data Options = Options   { log                       :: LoggerType   -- ^ The logger type.-  --   This cooresponds to the --log or -l argument. The valid options+  --   This corresponds 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-  -- ^ The file to log to+  -- ^ 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]-  -- ^ The directories to watch.-  --   This cooresponds to the --directories and -d argument.-  --   By default this is empty and the current directory is used+  --   This corresponds to the --log-file or -f argument.+  , root                      :: Maybe FilePath+  -- ^ The root directory to watch.+  --   This corresponds to the --root and -r 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'+  -- ^ If true, main will recurse through all subdirectories of the 'dirsToWatch'   --   field. Otherwise the 'dirsToWatch' will be used literally.-  --   By default this is true, and disabled with the --no-recurse-flag+  --   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'+  --   Valid options are "DebounceDefault", "Debounce", "NoDebounce".+  --   If "Debounce" is used, then a debounce amount must be specified with the+  --   'debounceAmount'.   , 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+  --   It corresponds to the --debounce-amount or -a argument.   , pollInterval              :: Int   -- ^ poll interval if polling is used.-  --   This cooresponds to the --poll-interval or -i argument+  --   This corresponds to the --poll-interval or -i argument.   , 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+  -- ^ Sets polling to true if used.+  --   This corresponds to the --should-poll or -p flag.   }  data DebounceType@@ -119,13 +119,12 @@   def = Options     { log                       = NoLogger     , logFile                   = Nothing-    , dirsToWatch               = []+    , root                      = Nothing     , recurseThroughDirectories = True     , debounce                  = DebounceDefault     , debounceAmount            = 0     , pollInterval              = 10^(6 :: Int) -- 1 second     , usePolling                = False-    , currentDir                = Nothing     }  dropDoubleQuotes :: String -> String@@ -140,8 +139,8 @@ -- 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+  let filePath = stripDoubleQuotes xs+  in if isValid filePath then         Right filePath      else         Left $ "invalid filePath " ++ xs @@ -163,16 +162,16 @@        <> help "Log file"        <> value (logFile def)         )-  <*> many (option (eitherReader readFilePath)-        ( long "directory"-       <> short 'd'-       <> metavar "DIRECTORIES"-       <> help "Directories to watch"+  <*> option (Just <$> eitherReader readFilePath)+        ( long "root"+       <> short 'r'+       <> metavar "ROOT"+       <> help "Root directory to watch"+       <> value (root def)         )-      )   <*> flag True False         ( long "no-recurse"-       <> short 'r'+       <> short 'n'        <> help "flag to turn off recursing"         )   <*> option auto@@ -201,13 +200,6 @@        <> short 'p'        <> help "Whether to use polling or not. Off by default"         )-  <*> option (Just <$> eitherReader readFilePath)-        ( long "current-dir"-       <> short 'c'-       <> metavar "CURRENT_DIR"-       <> help "Directory to append to the glob patterns"-       <> value (currentDir def)-        )  -- This is like run, but the config params can be over written from the defaults @@ -217,27 +209,23 @@   Debounce        -> FS.Debounce $ fromRational $ toRational amount   NoDebounce      -> FS.NoDebounce -makeAbsolute :: F.FilePath -> F.FilePath -> F.FilePath+makeAbsolute :: FilePath -> FilePath -> FilePath makeAbsolute currentDir path = -  if F.relative path then-      currentDir F.</> path+  if isRelative path then+      currentDir </> path   else        path  optionsToConfig :: Options -> IO (FilePath, IR.Config, Maybe Handle) optionsToConfig Options {..} = do-  actualCurrentDir <- F.decodeString <$> getCurrentDirectory-  let currentDir' = fromMaybe actualCurrentDir currentDir-      dirsToWatch' = if null dirsToWatch then-                       [currentDir']-                     else-                       map (makeAbsolute currentDir') dirsToWatch+  currentDir <- getCurrentDirectory+  let root' = makeAbsolute currentDir $ fromMaybe currentDir root    (logger, mhandle) <- toLogger (fromMaybe "log.txt" logFile) log-  dirsToWatch'' <- if recurseThroughDirectories then-                   (dirsToWatch' ++) <$> concatMapM findAllDirs dirsToWatch'+  dirsToWatch <- if recurseThroughDirectories then+                   (root' :) <$> findAllDirs root'                  else-                   return dirsToWatch'+                   return [root']    let watchConfig = FS.WatchConfig         { FS.confDebounce     = toDB debounceAmount debounce@@ -247,10 +235,10 @@    let config = IR.Config         { logger      = logger-        , dirs        = dirsToWatch''+        , dirs        = dirsToWatch         , watchConfig = watchConfig         }-  return (currentDir', config, mhandle)+  return (root', config, mhandle)  opts :: ParserInfo Options opts = info (helper <*> pOptions)@@ -273,12 +261,10 @@ -- | A main file that uses manually supplied options instead of parsing the passed in arguments. defaultMainWithOptions :: Options -> Dep -> IO () defaultMainWithOptions options dep = do-  (currentDir, config, mhandle) <- optionsToConfig options-  manager <- runWithConfig currentDir config dep+  (root, config, mhandle) <- optionsToConfig options+  manager <- runWithConfig root config dep   putStrLn "Type anything to quit"   _ <- getLine   for_ mhandle hClose   FS.stopManager manager-- 

@@ -5,37 +5,38 @@ {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}  module Twitch.Path-       ( fp-       , findFiles+       ( findFiles        , findDirs        , findAllDirs        , canonicalizeDirPath        , canonicalizePath        ) where-import Filesystem.Path.CurrentOS ( FilePath, encodeString, decodeString, (</>) )-import Prelude hiding (FilePath)+import Control.Applicative -- satisfy GHC < 7.10 import Control.Monad-import qualified Filesystem as FS-import qualified Filesystem.Path as FP+import System.Directory+  ( canonicalizePath+  , doesDirectoryExist+  , doesFileExist+  , getDirectoryContents+  )+import System.FilePath+  ( FilePath+  , (</>)+  , addTrailingPathSeparator+  )+-- Moved here to suppress redundant import warnings for GHC > 7.10+import Prelude hiding (FilePath) --- This will ensure than any calls to fp for type coercion in FSNotify will not--- break when/if the dependent package moves from using String to the more--- efficient Filesystem.Path.FilePath-class ConvertFilePath a b where-  fp :: a -> b-instance ConvertFilePath FilePath String where fp   = encodeString-instance ConvertFilePath String FilePath where fp   = decodeString-instance ConvertFilePath String String where fp     = id-instance ConvertFilePath FilePath FilePath where fp = id  getDirectoryContentsPath :: FilePath -> IO [FilePath]-getDirectoryContentsPath path = fmap (map (path </>)) $ FS.listDirectory path+getDirectoryContentsPath path =+  map (path </>) . filter (`notElem` [".", ".."]) <$> getDirectoryContents path  fileDirContents :: FilePath -> IO ([FilePath],[FilePath]) fileDirContents path = do   contents <- getDirectoryContentsPath path-  files <- filterM FS.isFile contents-  dirs <- filterM FS.isDirectory contents+  files <- filterM doesFileExist contents+  dirs <- filterM doesDirectoryExist contents   return (files, dirs)  findAllFiles :: FilePath -> IO [FilePath]@@ -45,11 +46,11 @@   return (files ++ concat nestedFiles)  findImmediateFiles, findImmediateDirs :: FilePath -> IO [FilePath]-findImmediateFiles = getDirectoryContentsPath >=> filterM FS.isFile >=> canonicalize+findImmediateFiles = getDirectoryContentsPath >=> filterM doesFileExist >=> canonicalize   where     canonicalize :: [FilePath] -> IO [FilePath]-    canonicalize files = mapM FS.canonicalizePath files-findImmediateDirs  = getDirectoryContentsPath >=> filterM FS.isDirectory >=> canonicalize+    canonicalize files = mapM canonicalizePath files+findImmediateDirs  = getDirectoryContentsPath >=> filterM doesDirectoryExist >=> canonicalize   where     canonicalize :: [FilePath] -> IO [FilePath]     canonicalize dirs = mapM canonicalizeDirPath dirs@@ -62,23 +63,13 @@  findFiles :: Bool -> FilePath -> IO [FilePath] findFiles True path  = findAllFiles       =<< canonicalizeDirPath path-findFiles False path = findImmediateFiles =<<  canonicalizeDirPath path+findFiles False path = findImmediateFiles =<< canonicalizeDirPath path  findDirs :: Bool -> FilePath -> IO [FilePath] findDirs True path  = findAllDirs       =<< canonicalizeDirPath path findDirs False path = findImmediateDirs =<< canonicalizeDirPath path --- | add a trailing slash to ensure the path indicates a directory-addTrailingSlash :: FilePath -> FilePath-addTrailingSlash p =- if FP.null (FP.filename p) then p else-   p FP.</> FP.empty  canonicalizeDirPath :: FilePath -> IO FilePath-canonicalizeDirPath path = addTrailingSlash `fmap` FS.canonicalizePath path+canonicalizeDirPath path = addTrailingPathSeparator <$> canonicalizePath path --- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash-canonicalizePath :: FilePath -> IO FilePath-canonicalizePath path = let was_dir = FP.null (FP.filename path) in-  if not was_dir then FS.canonicalizePath path-  else canonicalizeDirPath path

@@ -3,10 +3,8 @@ module Twitch.Rule where import Prelude hiding (FilePath) import Control.Monad ( void )-import Filesystem.Path ( FilePath )-import Filesystem.Path.CurrentOS ( encodeString )+import System.FilePath ( FilePath, isRelative, (</>) ) import System.FilePath.Glob ( simplify, match, tryCompileWith, compDefault )-import Data.Monoid ( (<>) ) import Data.String ( IsString(..) ) import Data.Default ( Default(..) ) import Control.Arrow ( ArrowChoice(left) )@@ -85,16 +83,20 @@  data RuleIssue   = PatternCompliationFailed PatternText String-  deriving Show+  deriving (Show, Eq)+  +makeAbsolutePath :: FilePath -> FilePath -> FilePath+makeAbsolutePath currentDir path = +  if isRelative path then+    currentDir </> path+  else+    path+  +makeAbsolute :: FilePath -> Rule -> Rule+makeAbsolute currentDir rule +  = rule { pattern = makeAbsolutePath currentDir $ pattern rule } -compilePattern :: FilePath -               -> PatternText +compilePattern :: PatternText                 -> Either RuleIssue (FilePath -> Bool)-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 <> "/" <> pat-   p <- tryCompileWith compDefault absolutePattern-   let test = match $ simplify p-   return $ \x -> test $ encodeString x+compilePattern pat = left (PatternCompliationFailed pat) $ do +  tryCompileWith compDefault pat >>= return . match . simplify

@@ -5,9 +5,7 @@     ( 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.FilePath ( FilePath ) import System.FSNotify ( WatchManager ) import System.Directory ( getCurrentDirectory ) import Twitch.Path ( findAllDirs )@@ -17,29 +15,22 @@  run :: Dep -> IO WatchManager run dep =  do-  currentDir <- decodeString <$> getCurrentDirectory-  dirs'       <- findAllDirs currentDir+  currentDir <- getCurrentDirectory+  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+runWithConfig root config dep = do+  let (_issues, rules) = depToRules root dep   -- TODO handle the issues somehow   -- Log and perhaps error   setupRules config rules  depToRulesWithCurrentDir :: Dep -> IO ([RuleIssue], [InternalRule]) depToRulesWithCurrentDir dep = do -  currentDir <- decodeString <$> getCurrentDirectory +  currentDir <- getCurrentDirectory   return $ depToRules currentDir dep  depToRules :: FilePath -> Dep -> ([RuleIssue], [InternalRule]) depToRules currentDir    = partitionEithers . map (toInternalRule currentDir) . runDep---  ----  

@@ -0,0 +1,18 @@+module Tests.Twitch where+import Test.Hspec+import qualified Tests.Twitch.Internal     as Internal+import qualified Tests.Twitch.InternalRule as InternalRule+import qualified Tests.Twitch.Main         as Main+import qualified Tests.Twitch.Path         as Path+import qualified Tests.Twitch.Rule         as Rule+import qualified Tests.Twitch.Run          as Run++tests :: Spec +tests = foldl1 (>>) +    [ Internal.tests+    , InternalRule.tests+    , Main.tests+    , Path.tests+    , Rule.tests+    , Run.tests +    ]

@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+module Tests.Twitch.Internal where+import Control.Monad ( forM_ )+import Test.Hspec+import Twitch.Internal ( modHeadRule, runDep )+import Twitch.Rule ( Rule (pattern) )++tests :: Spec+tests = do+  describe "modHeadRule" $ it "should thread state correctly" $ do+    -- `patterns` is used as `[Rule]` and `[Dep]` here+    let patterns = ["*.md", "*.html", "*.hs", "*.cpp", "*.js"]+        dep      = forM_ patterns (flip modHeadRule id)+    fmap pattern (runDep dep) `shouldBe` fmap pattern (reverse patterns)

@@ -0,0 +1,5 @@+module Tests.Twitch.InternalRule where+import Test.Hspec++tests :: Spec+tests = return ()

@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+module Tests.Twitch.Main where+import Test.Hspec+import Options.Applicative.Extra+import Data.Monoid+import Twitch.Main+import Options.Applicative.Builder+import Prelude hiding (log)++runParser :: [String] -> Maybe Options+runParser xs = getParseResult $ execParserPure (prefs mempty) opts xs++-- testParser :: String -> +testParser f initial expected +  = fmap f (runParser [initial]) `shouldBe` Just expected+  +testParserMulti f xs expected +  = fmap f (runParser xs) `shouldBe` Just expected++tests :: Spec+tests = do+  describe "Command Line Parser" $ do+    it "parses the log option" $ do+      -- long+      testParser log "--log=LogToStdout" LogToStdout+      testParser log "--log=LogToFile"   LogToFile+      testParser log "--log=NoLogger"    NoLogger+      -- short+      testParser log "-lLogToStdout" LogToStdout+      testParser log "-lLogToFile"   LogToFile+      testParser log "-lNoLogger"    NoLogger+    +    it "parses the log-file option (long)" $ +      testParser logFile "--log-file=./log.txt" $ Just "./log.txt" +    it "parses the log-file option (short)" $ +      testParser logFile "-f./log.txt"          $ Just "./log.txt"+    +    it "parses the root option" $ do+      testParser root "--root=./src" $ Just "./src"+      testParser root "-r./src"      $ Just "./src"+    +    it "parses the recurse option" $ do+      testParser recurseThroughDirectories "--no-recurse" False+      testParser recurseThroughDirectories "-n"  False++    it "parses the debounce option" $ do+      testParser debounce "--debounce=DebounceDefault" DebounceDefault+      testParser debounce "--debounce=Debounce"        Debounce+      testParser debounce "--debounce=NoDebounce"      NoDebounce+    +      testParser debounce "-bDebounceDefault" DebounceDefault+      testParser debounce "-bDebounce"        Debounce+      testParser debounce "-bNoDebounce"      NoDebounce+    +    it "parses the debounce-amount option" $ do+      testParser debounceAmount "--debounce-amount=1.0" 1.0+      testParser debounceAmount "-a1.0" 1.0+    +    it "parses the poll-interval" $ do+      testParser pollInterval "--poll-interval=1" 1+      testParser pollInterval "-i1" 1+      +    it "parses the poll" $ do+      testParser usePolling "--should-poll" True      +      testParser usePolling "-p"     True

@@ -0,0 +1,5 @@+module Tests.Twitch.Path where+import Test.Hspec++tests :: Spec+tests = return ()

@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns  #-}+module Tests.Twitch.Rule where+import Test.Hspec+import Twitch.Rule  +import Data.IORef+import Data.Default++testSetter sel setter = do+  ref <- newIORef ""+  let rule = def `setter` writeIORef ref+      expected = "yo"+  sel rule expected+  actual <- readIORef ref+  actual `shouldBe` expected+  +testAddModify f = do+  ref <- newIORef ""+  +  let rule = def `f` writeIORef ref+      expected = "yo"+  +  add rule expected+  actual <- readIORef ref  +  actual `shouldBe` expected++  modify rule expected+  actual <- readIORef ref  +  actual `shouldBe` expected++testName :: (Rule -> String -> Rule) -> Expectation+testName f = name (f def "name") `shouldBe` "name"+++tests :: Spec+tests = do+  describe "|+" $ it " sets the add member"    $ testSetter add (|+)+  describe "|-" $ it " sets the delete member" $ testSetter delete (|-)+  describe "|%" $ it " sets the modify member" $ testSetter modify (|%)+  +  describe "|>" $ it " sets the add and modify member" $ testAddModify (|>)+  describe "|#" $ it " sets the name member" $ testName (|#)++  describe "addF"       $ it " sets the add member"    $ testSetter add $ flip addF+  describe "modifyF"    $ it " sets the modify member" $ testSetter modify $ flip modifyF+  describe "deleteF"    $ it " sets the delete member" $ testSetter delete $ flip deleteF+  describe "addModifyF" $ it " sets the add and modify member" $ +    testAddModify (flip addModifyF)+  describe "nameF" $ it " sets the name member" $ testName $ flip nameF+  +  describe "makeAbsolutePath" $ do+    it "doesn't change an absolute path" $ +      makeAbsolutePath "/usr" "/home" `shouldBe` "/home"+    it "adds the current directory if it is relative" $ do+      makeAbsolutePath "/usr" "./home" `shouldBe` "/usr/./home"+      makeAbsolutePath "/usr"   "home" `shouldBe` "/usr/home"+  +  describe "compilePattern" $ do+    it "'s happy path works" $ do+      let Right test = compilePattern "/home/*.js" +      test "/home/help.js" `shouldBe` True+      test "/usr/help.js"  `shouldBe` False++    it "with an invalid pattern fails" $ do+      let Left (PatternCompliationFailed !_ !_) = compilePattern "/home/****.js" +      return () :: IO ()

@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+module Tests.Twitch.Run where+import Test.Hspec+import Control.Arrow (second)+import qualified Twitch.InternalRule as IR+import Twitch.Run+import Twitch+-- test depToRules++tests :: Spec+tests = describe "Dep" $ do+  it "depToRules happy path" $ +    shouldBe (second (map IR.name) (depToRules "/usr/" ("*.js" |+ print)))  +             ([], ["*.js"])

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                twitch-version:             0.1.6.1+version:             0.1.7.0 synopsis:            A high level file watcher DSL description:  Twitch is a monadic DSL and library for file watching.@@ -17,19 +17,19 @@  @   -- Use OverloadedStrings. Can't get that to show up here :(   import Twitch-  import Filesystem.Path.CurrentOS+  import System.Process ( system )  .   main = defaultMain $ do-      "*.md"   |> \\filePath -> system $ "pandoc -t html " ++ encodeString filePath+      "*.md"   |> \\filePath -> system $ "pandoc -t html " ++ filePath       "*.html" |> \\_ -> system $ "osascript refreshSafari.AppleScript"  @  . homepage:            https://github.com/jfischoff/twitch license:             MIT license-file:        LICENSE-author:              Jonathan Fischoff+author:              Jonathan Fischoff, Andreas Schacker maintainer:          jonathangfischoff@gmail.com-copyright: (c) Jonathan Fischoff 2014+copyright: (c) Jonathan Fischoff 2015 category:            System build-type:          Simple extra-source-files:  README.md@@ -58,7 +58,8 @@                   , TypeSynonymInstances                   , TemplateHaskell   build-depends: base >=4.5 && <4.9-               , system-filepath+               , directory+               , filepath                , transformers                 , directory                 , Glob @@ -66,7 +67,6 @@                , data-default                , fsnotify                , optparse-applicative-               , system-fileio   hs-source-dirs: src   default-language: Haskell2010   ghc-options: -Wall@@ -76,10 +76,16 @@   main-is: Main.hs   hs-source-dirs: tests, src   default-language: Haskell2010+  other-modules: Tests.Twitch+               , Tests.Twitch.Internal+               , Tests.Twitch.InternalRule+               , Tests.Twitch.Main+               , Tests.Twitch.Path+               , Tests.Twitch.Rule+               , Tests.Twitch.Run   build-depends: base                , hspec-               , QuickCheck >= 2.7-               , system-filepath+               , filepath                , transformers                 , directory                 , Glob @@ -87,4 +93,3 @@                , data-default                , fsnotify                , optparse-applicative-               , system-fileio