diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/src/Twitch/Internal.hs b/src/Twitch/Internal.hs --- a/src/Twitch/Internal.hs +++ b/src/Twitch/Internal.hs @@ -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 (|#) diff --git a/src/Twitch/InternalRule.hs b/src/Twitch/InternalRule.hs --- a/src/Twitch/InternalRule.hs +++ b/src/Twitch/InternalRule.hs @@ -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 diff --git a/src/Twitch/Main.hs b/src/Twitch/Main.hs --- a/src/Twitch/Main.hs +++ b/src/Twitch/Main.hs @@ -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 - - + + diff --git a/src/Twitch/Rule.hs b/src/Twitch/Rule.hs --- a/src/Twitch/Rule.hs +++ b/src/Twitch/Rule.hs @@ -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 diff --git a/twitch.cabal b/twitch.cabal --- a/twitch.cabal +++ b/twitch.cabal @@ -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