twitch 0.1.4.0 → 0.1.5.0

raw patch · 6 files changed

+83/−86 lines, 6 filesdep −textdep ~basedep ~optparse-applicativePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: text

Dependency ranges changed: base, optparse-applicative

API changes (from Hackage documentation)

Files

• README.md +2/−0
• src/Twitch/Internal.hs +3/−5
• src/Twitch/InternalRule.hs +4/−7
• src/Twitch/Main.hs +47/−49
• src/Twitch/Rule.hs +9/−10
• twitch.cabal +18/−15

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

@@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards                 #-}-{-# LANGUAGE LambdaCase                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving      #-} {-# LANGUAGE OverloadedStrings               #-} {-# LANGUAGE FlexibleInstances               #-}@@ -11,8 +10,6 @@ import Filesystem.Path.CurrentOS import Prelude hiding (FilePath) import Data.List -import Data.Text (Text)-import qualified Data.Text as T import Control.Monad.Reader import Control.Monad.State as State import System.Directory@@ -47,6 +44,7 @@ runDepWithState :: [Rule] -> Dep -> [Rule]  runDepWithState xs = flip execState xs . unDepM  +addRule :: Rule -> Dep addRule r = State.modify (r :)  modHeadRule :: Dep -> (Rule -> Rule) -> Dep@@ -87,7 +85,7 @@ --   ex. -- --   > "*.md" |> [s|pandoc -t html $path|] |# "markdown to html"-(|#) :: Dep -> Text -> Dep+(|#) :: Dep -> String -> Dep r |# p = modHeadRule r $ Rule.nameF p  -- Prefix API -----------------------------------------------------------------@@ -117,5 +115,5 @@ --   ex. -- --   > name "markdown to html" $ addModify [s|pandoc -t html $path|] "*.md"-name :: Text -> Dep -> Dep+name :: String -> Dep -> Dep name = flip (|#)

@@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Twitch.InternalRule where import Filesystem.Path@@ -14,8 +13,6 @@ import Data.Default import Control.Monad import Data.Monoid-import qualified Data.Text as T-import Data.Text (Text) import Prelude hiding (FilePath) import Twitch.Rule (Rule, RuleIssue) import qualified Twitch.Rule as Rule@@ -26,7 +23,7 @@ type FileTest = FilePath -> UTCTime -> Bool  data InternalRule = InternalRule -  { name     :: Text+  { name     :: String   -- ^ A name for debugging mostly   , fileTest :: FileTest   -- ^ The test to determine if the rule actions should fire@@ -49,7 +46,7 @@  instance Show InternalRule where   show InternalRule {..} -    =  T.unpack $ "Rule { name = " +    =  "Rule { name = "      <> name      <> " }" @@ -97,14 +94,14 @@  -- | Retrieve the filePath of an Event filePath :: Event -> FilePath-filePath = \case+filePath e = case e of   Added    x _ -> x   Modified x _ -> x   Removed  x _ -> x  -- | Retrieve the time of an Event time :: Event -> UTCTime-time = \case+time e = case e of   Added    _ x -> x   Modified _ x -> x   Removed  _ x -> x

@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} module Twitch.Main where@@ -21,29 +20,29 @@ import Control.Concurrent.STM.TBMQueue import Control.Concurrent -- parse the command line--- +--  concatMapM f = fmap concat . mapM f -data LoggerType +data LoggerType   = LogToStdout   | LogToFile   | NoLogger   deriving (Eq, Show, Read, Ord) -toLogger :: FilePath +toLogger :: FilePath          -> LoggerType          -> IO (IR.Issue -> IO (), Maybe Handle)-toLogger filePath = \case+toLogger filePath lt = case lt of   LogToStdout -> return (print, Nothing)-  LogToFile -> do +  LogToFile -> do     handle <- openFile filePath AppendMode-    return (hPutStrLn handle . show, Just handle)+    return (hPrint handle, Just handle)   NoLogger -> return (const $ return (), Nothing) -data Options = Options +data Options = Options   { log          :: LoggerType-  -- ^ The logger type. +  -- ^ 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.@@ -52,21 +51,21 @@   --   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. +  -- ^ The directories to watch.   --   This cooresponds to the --directories and -d argument   , recurseThroughDirectories :: Bool-  -- ^ If true, main will recurse throug all subdirectories of the 'dirsToWatch' +  -- ^ 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   -- ^ 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 +  --   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'. +  --   to 'Debounce'.   --   It cooresponds to the --debounce-amount or -a argument   , pollInterval :: Int   -- ^ poll interval if polling is used.@@ -80,7 +79,7 @@   --   This cooresponds to the --current-dir or -c arguments   } -data DebounceType +data DebounceType   = DebounceDefault   | Debounce   | NoDebounce@@ -100,102 +99,101 @@     }  pOptions :: Parser Options-pOptions +pOptions    =  Options-  <$> option+  <$> option auto         ( long "log"        <> short 'l'        <> metavar "LOG_TYPE"-       <> help "Type of logger. Valid options are LogToStdout | LogToFile | NoLogger" +       <> help "Type of logger. Valid options are LogToStdout | LogToFile | NoLogger"        <> value (log def)         )-  <*> option+  <*> option auto         ( long "log-file"        <> short 'f'        <> metavar "LOG_FILE"-       <> help "Log file" +       <> help "Log file"        <> value (logFile def)         )-  <*> option+  <*> option auto         ( long "directories"        <> short 'd'        <> metavar "DIRECTORIES"        <> help "Directories to watch"        <> value (dirsToWatch def)         )-  <*> option+  <*> option auto         ( long "recurse"        <> short 'r'        <> metavar "RECURSE"-       <> help "Boolean to recurse or directories or not" +       <> help "Boolean to recurse or directories or not"        <> value (recurseThroughDirectories def)         )-  <*> option+  <*> option auto         ( long "debounce"        <> short 'b'        <> metavar "DEBOUNCE"-       <> help "Target for the greeting" +       <> help "Target for the greeting"        <> value (debounce def)         )-  <*> option+  <*> option auto         ( long "debounce-amount"        <> short 'a'        <> metavar "DEBOUNCE_AMOUNT"-       <> help "Target for the greeting" +       <> help "Target for the greeting"        <> value (debounceAmount def)         )-  <*> option+  <*> option auto         ( long "poll-interval"        <> short 'i'        <> metavar "POLL_INTERVAL"        <> help "Poll interval if polling is used"        <> value (pollInterval def)         )-  <*> option+  <*> option auto         ( long "poll"        <> short 'p'        <> metavar "POLL"-       <> help "Whether to use polling or not" +       <> help "Whether to use polling or not"        <> value (usePolling def)         )-  <*> nullOption +  <*> option auto         ( long "current-dir"        <> short 'c'        <> metavar "CURRENT_DIR"-       <> help "Director to append to the glob patterns" +       <> help "Directory to append to the glob patterns"        <> value (currentDir def)-       <> eitherReader (return . Just)         )  -- This is like run, but the config params can be over written from the defaults -toDB amount = \case+toDB amount dbtype = case dbtype of   DebounceDefault -> FS.DebounceDefault   Debounce        -> FS.Debounce $ fromRational $ toRational amount   NoDebounce      -> FS.NoDebounce  optionsToConfig :: Options -> IO (FilePath, IR.Config, Maybe Handle)-optionsToConfig Options {..} = do +optionsToConfig Options {..} = do   actualCurrentDir <- getCurrentDirectory   let currentDir' = fromMaybe actualCurrentDir currentDir       dirsToWatch' = if null dirsToWatch then                        [currentDir']                      else-                       dirsToWatch                 -                       -  (logger, mhandle) <- toLogger (fromMaybe "log.txt" logFile) log +                       dirsToWatch++  (logger, mhandle) <- toLogger (fromMaybe "log.txt" logFile) log   let encodedDirs = map F.decodeString dirsToWatch'-  dirsToWatch'' <- if recurseThroughDirectories then +  dirsToWatch'' <- if recurseThroughDirectories then                    (encodedDirs ++) <$> concatMapM findAllDirs encodedDirs-                 else +                 else                    return encodedDirs-  +   let watchConfig = FS.WatchConfig         { FS.confDebounce     = toDB debounceAmount debounce         , FS.confPollInterval = pollInterval         , FS.confUsePolling   = usePolling         }-  +   let config = IR.Config         { logger      = logger         , dirs        = dirsToWatch''@@ -203,18 +201,18 @@         }   return (currentDir', config, mhandle) --- | Simplest way to create a file watcher app. Set your main equal to defaultMain +-- | 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.--- +-- --   The command line is parsed to make 'Options' value. For more information on---   the arguments that can be passed see the doc for 'Options' and the run the ---   executable made with defaultMain with the --help argument. +--   the arguments that can be passed see the doc for 'Options' and the run the+--   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" +       <> header "a file watcher"         )   options <- execParser opts   defaultMainWithOptions options dep@@ -224,11 +222,11 @@ 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   FS.stopManager manager-   -  ++

@@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards                 #-}-{-# LANGUAGE LambdaCase                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving      #-} {-# LANGUAGE OverloadedStrings               #-} {-# LANGUAGE FlexibleInstances               #-}@@ -10,8 +9,6 @@ import Filesystem.Path import Filesystem.Path.CurrentOS import Prelude hiding (FilePath)-import Data.Text (Text)-import qualified Data.Text as T import System.Directory import System.FilePath.Glob import Data.Monoid@@ -23,8 +20,8 @@ import Debug.Trace import System.FSNotify (WatchManager) -type Name        = Text-type PatternText = Text+type Name        = String+type PatternText = String  -- | TODO maybe change this to have the timestamp type RuleAction = FilePath -> IO ()@@ -43,7 +40,7 @@ --    }  data Rule = Rule -  { name          :: Text+  { name          :: String   , pattern       :: PatternText   , add           :: RuleAction   , modify        :: RuleAction@@ -60,7 +57,7 @@           }  instance IsString Rule where-  fromString x = let packed = T.pack x in def { pattern = packed, name = packed} +  fromString x = def { pattern = x, name = x}   --- Infix API------------------------------------------------------------------ infixl 8 |+, |%, |-, |>, |#@@ -78,7 +75,7 @@ x |> f = x |+ f |% f  -- | Set the name-(|#) :: Rule -> Text -> Rule+(|#) :: Rule -> String -> Rule r |# p = r { name = p }  -- Prefix API -----------------------------------------------------------------@@ -96,12 +93,14 @@   = PatternCompliationFailed PatternText String   deriving Show -compilePattern :: FilePath -> PatternText -> Either RuleIssue (FilePath -> Bool)+compilePattern :: FilePath +               -> PatternText +               -> Either RuleIssue (FilePath -> Bool) compilePattern currentDir pattern = left (PatternCompliationFailed pattern) $ do     -- TODO is this way of adding the current directory cross platfrom okay?    -- Does the globbing even work on windows    -   let absolutePattern = traceShowId $ encodeString currentDir <> "/" <> T.unpack pattern+   let absolutePattern = encodeString currentDir <> "/" <> pattern    p <- tryCompileWith compDefault absolutePattern    let test = match $ simplify p    return $ \x -> test $ encodeString x

@@ -1,26 +1,26 @@--- Initial twitch.cabal generated by cabal init.  For further +-- Initial twitch.cabal generated by cabal init.  For further -- documentation, see http://haskell.org/cabal/users-guide/  name:                twitch-version:             0.1.4.0+version:             0.1.5.0 synopsis:            A high level file watcher DSL-description: - Twitch is a monadic DSL and library for file watching. - It conveniently utilizes 'do' notation in the style of +description:+ Twitch is a monadic DSL and library for file watching.+ It conveniently utilizes 'do' notation in the style of  Shake and clay to expose the functionality of the  fsnotify cross-platform file system watcher.  .  Here is an example that converts Markdown files to HTML and reloads Safari  whenever the input files change.- +  .  @   -- Use OverloadedStrings. Can't get that to show up here :(-  import Twitch +  import Twitch   import Filesystem.Path.CurrentOS- .  + .   main = defaultMain $ do-      "*.md"   |> \\filePath -> system $ "pandoc -t html " ++ encodeString filePath +      "*.md"   |> \\filePath -> system $ "pandoc -t html " ++ encodeString filePath       "*.html" |> \\_ -> system $ "osascript refreshSafari.AppleScript"  @  .@@ -29,21 +29,25 @@ license-file:        LICENSE author:              Jonathan Fischoff maintainer:          jonathangfischoff@gmail.com--- copyright:         +copyright: (c) Jonathan Fischoff 2014 category:            System build-type:          Simple extra-source-files:  README.md cabal-version:       >=1.10+source-repository head+  type:     git+  location: https://github.com/jfischoff/twitch.git ++ library-  exposed-modules: Twitch, Twitch.InternalRule +  exposed-modules: Twitch, Twitch.InternalRule   other-modules: Twitch.Internal                , Twitch.Main                , Twitch.Path                , Twitch.Rule                , Twitch.Run   other-extensions: RecordWildCards-                  , LambdaCase                   , GeneralizedNewtypeDeriving                   , OverloadedStrings                   , FlexibleInstances@@ -53,17 +57,16 @@                   , MultiParamTypeClasses                   , TypeSynonymInstances                   , TemplateHaskell-  build-depends: base >=4.7 && <4.8+  build-depends: base >=4.5 && <4.8                , containers >=0.5 && <0.6                , system-filepath >=0.4 && <0.5-               , text >=1.1 && <1.2                , 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.8 && <0.9+               , optparse-applicative >=0.11 && <0.12                , stm-chans >=3.0 && <3.1                , system-fileio >=0.3 && <0.4   hs-source-dirs:      src