diff --git a/Commando.cabal b/Commando.cabal --- a/Commando.cabal +++ b/Commando.cabal @@ -1,7 +1,6 @@ name: Commando -version: 0.1.0.0 +version: 1.0.0.0 synopsis: Watch some files; Rerun a command -description: Watch some files; Rerun a command homepage: https://github.com/sordina/Commando license: MIT license-file: LICENSE @@ -10,9 +9,41 @@ category: Development build-type: Simple cabal-version: >=1.8 +description: + Commando comes in two forms - A library and an executable. + . + * Executable + . + Watch a directory, and when changes occur, run a command. + . + From the commandline the program is used like so: + . + > commando -c echo + . + This will watch the current directory, and when an event occurs, pass the serialized + representation of the event as an argument to `echo`. + . + * Library + . + To use the library just + . + > import System.Commando + . + See the "System.Commando" module documentation for more details. executable commando main-is: Commando.hs + build-depends: + base >= 4.0 && < 5.0, + text >= 0.10 && < 0.12, + system-filepath >= 0.4 && < 0.5, + optparse-applicative >= 0.5 && < 0.6, + system-fileio >= 0.3 && < 0.4, + fsnotify >= 0.0.10 && < 0.1, + process >= 1.1 && < 1.2 + +library + exposed-modules: System.Commando build-depends: base >= 4.0 && < 5.0, text >= 0.10 && < 0.12, diff --git a/Commando.hs b/Commando.hs --- a/Commando.hs +++ b/Commando.hs @@ -2,100 +2,17 @@ module Main where -import Prelude hiding (FilePath) -import Control.Monad (void, when) -import System.Process (rawSystem, runCommand, runInteractiveCommand) -import System.FSNotify (startManager, watchTree, stopManager) -import Filesystem.Path.CurrentOS (FilePath, fromText) -import Data.Text (pack) -import System.IO (hPutStrLn, hGetContents, hSetBuffering, BufferMode(..)) -import GHC.IO.Handle (hClose, hFlush) -import GHC.IO.Handle.Types (Handle) -import System.Process.Internals (ProcessHandle) -import Control.Applicative ((<$>), (<*>)) -import Data.Monoid (mempty, Monoid, (<>)) -import Control.Concurrent (forkIO) -import Data.Maybe (fromMaybe) - -import qualified Options.Applicative.Builder.Internal as X -import qualified Options.Applicative as O - -type RunningProcess = (Handle, Handle, Handle, ProcessHandle) +import System.Commando +import Control.Monad (when) +import Control.Applicative ((<*>)) +import Data.Monoid (mempty) -data Options = Options { command :: String - , quiet :: Bool - , consumer :: Bool - , stdin :: Bool - , persist :: Bool - , directory :: FilePath - } deriving Show +import qualified Options.Applicative as O main :: IO () -main = O.execParser (O.info (O.helper <*> options) mempty) >>= start - -options :: O.Parser Options -options = Options - <$> defStr "echo event" ( O.metavar "COMMAND" <> O.help "Command run on events") - <*> O.switch ( O.short 'q' <> O.long "quiet" <> O.help "Hide non-essential output") - <*> O.switch ( O.short 'c' <> O.long "consumer" <> O.help "Pass events as argument to command") - <*> O.switch ( O.short 'i' <> O.long "stdin" <> O.help "Pipe events to command") - <*> O.switch ( O.short 'p' <> O.long "persist" <> O.help "Pipe events to persistent command") - <*> (dir <$> defStr "." ( O.metavar "DIRECTORY" <> O.help "Directory to monitor" )) - -defStr :: String -> X.Mod X.ArgumentFields String -> O.Parser String -defStr a = def a . O.argument O.str - -def :: a -> O.Parser a -> O.Parser a -def a = fmap (fromMaybe a) . O.optional - -dir :: String -> FilePath -dir = fromText . pack - -start :: Options -> IO () -start o = do - man <- startManager - rc <- if persist o then Just <$> startPipe (command o) - else return Nothing - - void $ forkIO $ whenM rc $ \(_,so,_,_) -> hGetContents so >>= putStr - - when (not $ quiet o) $ putStrLn "press return to stop" - - let cmd = command o - - void $ watchTree man (directory o) (const True) - $ case (consumer o, stdin o || persist o ) - of (True , _ ) -> void . rawSystem cmd . return . show - (_ , True ) -> void . pipe rc cmd . show - (_ , _ ) -> const $ void $ runCommand cmd - - void $ getLine - - void $ stopManager man - - whenM rc pipeClose - -whenM :: Monad m => Maybe a -> (a -> m ()) -> m () -whenM m f = maybe (return ()) f m - -startPipe :: String -> IO RunningProcess -startPipe cmd = do - rc@(hStdIn,_,_,_) <- runInteractiveCommand cmd - hSetBuffering hStdIn NoBuffering - return rc - -pipe :: Maybe RunningProcess -> String -> String -> IO () -pipe Nothing cmd arg = startPipe cmd >>= pipeSend arg >>= pipeOutput >>= pipeClose -pipe (Just rp) _ arg = void $ pipeSend arg rp - -pipeOutput :: RunningProcess -> IO RunningProcess -pipeOutput r@(_,so,_,_) = hGetContents so >>= putStr >> return r +main = do + opts <- O.execParser (O.info (O.helper <*> options) mempty) -pipeClose :: RunningProcess -> IO () -pipeClose (hStdIn, _, _, _) = hClose hStdIn + when (not $ quiet opts) $ putStrLn "press return to stop" -pipeSend :: String -> RunningProcess -> IO RunningProcess -pipeSend param rc@(hStdIn, _hStdOut, _stderr, _process) = do - hPutStrLn hStdIn param - hFlush hStdIn - return rc + commando opts >>= mapM_ putStrLn diff --git a/System/Commando.hs b/System/Commando.hs new file mode 100644 --- /dev/null +++ b/System/Commando.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | A library providing an interface to generate a lazy stream of command +-- results from events occurring in a directory. + +module System.Commando (Options(..), options, commando) where + +import Prelude hiding (FilePath) +import Control.Monad (void) +import System.Process (rawSystem, runCommand, runInteractiveCommand) +import System.FSNotify (startManager, watchTree, stopManager, Event(..)) +import Filesystem.Path.CurrentOS (FilePath, fromText, toText) +import Data.Text (pack, unpack) +import System.IO (hPutStrLn, hGetContents, hSetBuffering, BufferMode(..)) +import GHC.IO.Handle (hClose, hFlush) +import GHC.IO.Handle.Types (Handle) +import System.Process.Internals (ProcessHandle) +import Control.Applicative ((<$>), (<*>)) +import Data.Monoid ((<>)) +import Control.Concurrent (forkIO) +import Data.Maybe (fromMaybe, isJust, catMaybes) +import Control.Concurrent.Chan (newChan, writeChan, getChanContents, Chan) + +import qualified Options.Applicative.Builder.Internal as X +import qualified Options.Applicative as O + +type RunningProcess = (Handle, Handle, Handle, ProcessHandle) + +-- | Options used to configure the behavior of Commando + +data Options = Options { -- | The commando to run + command :: String + -- | Silence any help + , quiet :: Bool + -- | Command accepts input as an argument + , consumer :: Bool + -- | Command accepts input on STDIN + , stdin :: Bool + -- | Command remains running and new events are sent to its STDIN + , persist :: Bool + -- | Display show function used to translate events to strings + , display :: Event -> String + -- | The directory listened to - Default is the current directory. + , directory :: FilePath + } + +-- | The main listening loop. +commando :: Options -> IO [String] +commando o = do + c <- newChan + start c o + catMaybes . takeWhile isJust <$> getChanContents c + +-- | An optparse-applicative parser for command-line options. +options :: O.Parser Options +options = Options + <$> defStr "echo event" ( O.metavar "COMMAND" <> O.help "Command run on events") + <*> O.switch ( O.short 'q' <> O.long "quiet" <> O.help "Hide non-essential output") + <*> O.switch ( O.short 'c' <> O.long "consumer" <> O.help "Pass events as argument to command") + <*> O.switch ( O.short 'i' <> O.long "stdin" <> O.help "Pipe events to command") + <*> O.switch ( O.short 'p' <> O.long "persist" <> O.help "Pipe events to persistent command") + <*> ((show toFP)<$> ( O.switch ( O.short 'j' <> O.long "path-only" <> O.help "Only show the File-Path, not metadata"))) + <*> (dir <$> defStr "." ( O.metavar "DIRECTORY" <> O.help "Directory to monitor" )) + +defStr :: String -> X.Mod X.ArgumentFields String -> O.Parser String +defStr a = def a . O.argument O.str + +def :: a -> O.Parser a -> O.Parser a +def a = fmap (fromMaybe a) . O.optional + +dir :: String -> FilePath +dir = fromText . pack + +start :: CH -> Options -> IO () +start c o = do + man <- startManager + rc <- if persist o then Just <$> startPipe (command o) + else return Nothing + + void $ forkIO $ whenM rc $ \(_,so,_,_) -> hGetContents so >>= putChan c + + let cmd = command o + dsp = display o + + void $ watchTree man (directory o) (const True) + $ case (consumer o, stdin o || persist o ) + of (True , _ ) -> void . rawSystem cmd . return . dsp + (_ , True ) -> void . pipe c rc cmd . dsp + (_ , _ ) -> const $ void $ runCommand cmd + + void $ getLine + + void $ stopManager man + + whenM rc pipeClose + + closeChan c + +whenM :: Monad m => Maybe a -> (a -> m ()) -> m () +whenM m f = maybe (return ()) f m + +startPipe :: String -> IO RunningProcess +startPipe cmd = do + rc@(hStdIn,_,_,_) <- runInteractiveCommand cmd + hSetBuffering hStdIn NoBuffering + return rc + +pipe :: CH -> Maybe RunningProcess -> String -> String -> IO () +pipe c Nothing cmd arg = startPipe cmd >>= pipeSend arg >>= pipeOutput c >>= pipeClose +pipe _ (Just rp) _ arg = void $ pipeSend arg rp + +pipeOutput :: CH -> RunningProcess -> IO RunningProcess +pipeOutput c r@(_,so,_,_) = hGetContents so >>= putChan c >> return r + +pipeClose :: RunningProcess -> IO () +pipeClose (hStdIn, _, _, _) = hClose hStdIn + +pipeSend :: String -> RunningProcess -> IO RunningProcess +pipeSend param rc@(hStdIn, _hStdOut, _stderr, _process) = do + hPutStrLn hStdIn param + hFlush hStdIn + return rc + +() :: a -> a -> Bool -> a +x y = \b -> if b then y else x + +toFP :: Event -> String +toFP (Added fp _) = unpack (either id id (toText fp)) +toFP (Modified fp _) = unpack (either id id (toText fp)) +toFP (Removed fp _) = unpack (either id id (toText fp)) + +-- Chans +type CH = Chan (Maybe String) + +putChan :: Chan (Maybe a) -> a -> IO () +putChan c = writeChan c . Just + +closeChan :: Chan (Maybe a) -> IO () +closeChan c = writeChan c Nothing