Commando 0.1.0.0 → 1.0.0.0
raw patch · 3 files changed
+181/−94 lines, 3 files
Files
- Commando.cabal +33/−2
- Commando.hs +9/−92
- System/Commando.hs +139/−0
Commando.cabal view
@@ -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,
Commando.hs view
@@ -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
+ System/Commando.hs view
@@ -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