diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Emil Axelsson + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Emil Axelsson nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,46 @@ +# trackit + +`trackit` is a command-line tool that listens for changes in a user-supplied directory. Whenever there is a change, a custom command is executed and its standard output is shown live in the terminal. + +## Examples + +Show a live listing of the files in the current directory: + + > trackit --watch-dir=. --command="ls --color" + +Show a live revision graph of a Git repository: + + > GIT_DIR=`git rev-parse --git-dir` + > trackit --watch-tree=$GIT_DIR --command="git log --graph --all --oneline --decorate --color" + +## Installation + +`trackit` can be installed from [Hackage](https://hackage.haskell.org/package/trackit) using Cabal: + + > cabal install trackit + +## Usage + +Run `trackit -h` to get more information about available flags. + +`trackit` starts a new buffer in the terminal and uses it to display the output of the command given as the `--command` flag. The display reacts to the following keyboard events: + + * **q** - Quit `trackit`. + * **arrow keys** - Scroll the output buffer (also with PgUp/PgDown/Home/End). + * **space key** - Re-run the command and update the buffer. This is useful if no watch directory is provided, or if the output is affected by events outside of the watch directory. + +When multiple changes occur in a short time in the watched directory (e.g. when switching branches in a repository), it may not be desired to have `trackit` react to every single change. This is especially the case if the monitored command is expensive (e.g. `git log` in a large repository). For this reason, `trackit` requires a *stabilization period* before running an update. If an event occurs during that period, the period clock is restarted and the update is delayed further. + +The stabilization period can be set in milliseconds using the `--stabilization` flag. A lower value gives quicker response times, but increases the risk of getting spurious updates when a tight sequence changes occurs in the watched directory. The default stabilization period is 200 ms. + +## Comparison to `watch` + +`trackit` offers two main advantages over the similar tool [watch](https://linux.die.net/man/1/watch): + + 1. `trackit` only reacts to file system changes. This avoids having to run a potentially costly command periodically. For example, the following command can easily consume a substantial part of your processor's cycles when run in a large repository: + + ``` + > watch -c -t -n 0,5 -- git log --graph --all --oneline --decorate --color + ``` + + 2. `trackit` supports scrolling, and keeps the scrolled view even if the output is updated. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,248 @@ +module Main where + +import Control.Concurrent (forkIO, killThread, threadDelay) +import Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVar, writeTVar) +import Control.Monad (fail, forever, void, when) +import Control.Monad.STM (atomically) +import Control.Monad.Trans (liftIO) +import Data.Char (toLower) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Version (showVersion) +import qualified Data.Text.Lazy as LText +import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime) +import qualified Data.Text as Text +import GHC.Generics (Generic) +import System.Exit (exitSuccess) +import System.Process.ListLike (shell) +import qualified System.Process.Text as Text + +import System.FSNotify (eventTime, watchTree, withManager) +import qualified System.FSNotify as FSNotify + +import Options.Generic + (ParseRecord (..), type () (..), getWithHelp, lispCaseModifiers, + parseRecordWithModifiers, shortNameModifier) + +import Brick +import Brick.BChan +import Graphics.Vty + +import qualified Paths_trackit as Trackit +import ParseANSI + +data CmdOptions = CmdOptions + { _watchDir :: Maybe FilePath "Directory to watch for changes in (not sub-directories). Cannot be used together with '--watch-tree'." + , _watchTree :: Maybe FilePath "Directory tree to watch for changes in (including sub-directories). Cannot be used together with '--watch-dir'." + , _command :: Maybe String "Command to run" + , _maxLines :: Maybe Int "Maximum number of lines to show (default: 400)" + , _stabilization :: Maybe Int "Minimal time (milliseconds) between the any file event and command update (default: 200)" + , _version :: Bool "Print the version number" + , _help :: Bool + } deriving (Show, Generic) + +shortName :: String -> Maybe Char +shortName "_watchDir" = Just 'd' +shortName "_watchTree" = Just 't' +shortName (_:c:_) = Just c +shortName _ = Nothing + +instance ParseRecord CmdOptions where + parseRecord = + parseRecordWithModifiers + lispCaseModifiers {shortNameModifier = shortName} + +data WatchDepth + = Single + | Recursive + deriving (Eq, Show) + +data Options = Options + { watchDir :: Maybe (FilePath, WatchDepth) + , command :: Maybe String + , maxLines :: Int + , stabilization :: NominalDiffTime + } deriving (Show, Generic) + +watchDirError = + "The flags '--watch-dir' and '--watch-tree' cannot be used together." + +getOptions :: IO Options +getOptions = do + (CmdOptions {..}, showHelp) <- getWithHelp "trackit" + if | _help -> showHelp >> exitSuccess + | unHelpful _version -> + do putStrLn $ showVersion Trackit.version + exitSuccess + | otherwise -> + do watchDir <- case (unHelpful _watchDir, unHelpful _watchTree) of + (Nothing, Nothing) -> return Nothing + (Just d, Nothing) -> return $ Just (d, Single) + (Nothing, Just t) -> return $ Just (t, Recursive) + _ -> fail watchDirError + let command = unHelpful _command + maxLines = fromMaybe 400 $ unHelpful _maxLines + stabPerMs = fromMaybe 200 $ unHelpful _stabilization + stabilization = fromIntegral stabPerMs / 1000 + return $ Options {..} + +ansiImage :: Text -> Image +ansiImage = foldMap mkLine . map parseANSI . Text.lines + where + mkLine ss = + foldr (<|>) mempty [text a $ LText.fromStrict s | Segment a s <- ss] + +-- | Limit the text to @n@ lines (because large buffers make the app slow) +limit :: Int -> Text -> Text +limit n t + | length ls > n = Text.unlines (take n ls ++ [pruningNotification]) + | otherwise = t <> eof + where + ls = Text.lines t + eof = "\ESC[1m---------- End of output ----------\ESC[m" + pruningNotification = Text.unwords + [ "\ESC[1m---------- Lines beyond" + , Text.pack (show n) + , "pruned ----------\ESC[m" + ] + +getStdOut :: (a, stdout, b) -> stdout +getStdOut (_, o, _) = o + +helpText :: Text +helpText = Text.concat + [ "No command provided. Run 'trackit --help' for help.\n\n" + , "Press 'q' to exit this window." + ] + +-- | Run the command provided by the user, or print a helpful text if no command +-- was given +runCMD :: Options -> IO Text +runCMD Options {..} = + case command of + Nothing -> return helpText + Just cmd -> + limit maxLines . getStdOut <$> + Text.readCreateProcessWithExitCode (shell cmd) "" + +-- | Case-insensitive key-press recognizer +keyPressed :: Char -> BrickEvent n e -> Bool +keyPressed c (VtyEvent (EvKey (KChar c') [])) = toLower c == toLower c' +keyPressed _ _ = False + +data AppState = AppState + { theText :: Text + } + +initState :: AppState +initState = AppState + { theText = "" + } + +data View = TheView + deriving (Eq, Ord, Show) + +theView :: ViewportScroll View +theView = viewportScroll TheView + +drawApp :: AppState -> [Widget View] +drawApp AppState {..} = pure $ viewport TheView Both $ raw $ ansiImage theText + +withSize :: ((Int, Int) -> EventM View ()) -> EventM View () +withSize k = mapM_ k . fmap extentSize =<< lookupExtent TheView + +updateApp :: Options -> AppState -> EventM View (Next AppState) +updateApp opts s = do + newText <- liftIO $ runCMD opts + continue $ s {theText = newText} + +stepApp :: Options -> AppState -> BrickEvent View () -> EventM View (Next AppState) +stepApp _ s (keyPressed 'q' -> True) = halt s +stepApp _ s (VtyEvent (EvKey KDown [])) = theView `vScrollBy` 1 >> continue s +stepApp _ s (VtyEvent (EvKey KUp [])) = theView `vScrollBy` (-1) >> continue s +stepApp _ s (VtyEvent (EvKey KLeft [])) = withSize (\(w, _) -> theView `hScrollBy` (negate $ div w 2)) >> continue s +stepApp _ s (VtyEvent (EvKey KRight [])) = withSize (\(w, _) -> theView `hScrollBy` (div w 2)) >> continue s +stepApp _ s (VtyEvent (EvKey KHome _)) = vScrollToBeginning theView >> continue s +stepApp _ s (VtyEvent (EvKey KEnd _)) = vScrollToEnd theView >> continue s +stepApp _ s (VtyEvent (EvKey KPageUp [])) = withSize (\(_, h) -> theView `vScrollBy` (negate h)) >> continue s +stepApp _ s (VtyEvent (EvKey KPageDown [])) = withSize (\(_, h) -> theView `vScrollBy` h) >> continue s +stepApp opts s (VtyEvent (EvKey (KChar ' ') _)) = updateApp opts s +stepApp opts s (AppEvent ()) = updateApp opts s +stepApp _ s _ = continue s + +myApp :: Options -> App AppState () View +myApp opts = + App + { appDraw = drawApp + , appHandleEvent = stepApp opts + , appStartEvent = return + , appAttrMap = const $ attrMap defAttr [] + , appChooseCursor = neverShowCursor + } + +appMain :: Options -> BChan () -> IO AppState +appMain opts updEv = + customMain (mkVty defaultConfig) (Just updEv) (myApp opts) initState + +-- | A loop that continuously looks for events in the 'TVar' and runs the given +-- action whenever there's an event that occurred more than +-- 'stabilization' seconds ago. Then the 'TVar' is emptied. If the event +-- occurred less time ago, it will remain in the 'TVar' and processed in a later +-- iteration (unless overwritten by another event meanwhile). +delayedUpdate :: + Options + -> TVar (Maybe FSNotify.Event) + -- ^ Variable holding the last file event that has not yet been processed + -> IO () -- ^ Action to perform when the file event has stabilized + -> IO () +delayedUpdate Options {..} lastFSEv action = + forever $ do + threadDelay loopPeriod + t <- getCurrentTime + act <- + atomically $ do + mfsEv <- readTVar lastFSEv + case mfsEv of + Nothing -> return False + Just fsEv -> do + let stable = diffUTCTime t (eventTime fsEv) >= stabilization + when stable $ writeTVar lastFSEv Nothing + return stable + when act action + where + loopPeriod = max 10000 $ round (stabilization * 1e6 / 5) + -- Cap at 10 ms to avoid making the loop too busy when the stabilization + -- period is small. + +main = do + opts@Options {..} <- getOptions + lastFSEv <- newTVarIO Nothing -- Channel holding the last file event + updEv <- newBChan 1 -- Channel for GUI update events + let setEvent ev = atomically $ writeTVar lastFSEv $ Just ev + update = writeBChan updEv () + update -- Force initial GUI update + case watchDir of + Nothing -> void $ appMain opts updEv + Just (path, depth) -> do + tid <- forkIO $ delayedUpdate opts lastFSEv update + withManager $ \m -> do + void $ case depth of + Single -> FSNotify.watchDir m path (const True) setEvent + Recursive -> watchTree m path (const True) setEvent + void $ appMain opts updEv + killThread tid + +-- Note: The "debouncing" option of fsnotify makes it so that only the *first* +-- in a tight series of events is reported. However, this is problematic since +-- it means that the GUI may miss file events. This can happen if a Git command +-- performs multiple file system operations (which is usually the case) and the +-- command take more time than updating the GUI (e.g. due to the repository +-- being large). It can of course also happen if a Git command is issued just +-- after another one. +-- +-- In contrast, the approach taken here is to react to the *last* in a tight +-- sequence of events. A tight sequence is defined as a sequence in which each +-- consecutive pair of events have a time distance of less than +-- `stabilization` seconds. And since `delayedUpdate` runs continuously, there's +-- never a risk that an event will be missed. diff --git a/src/ParseANSI.hs b/src/ParseANSI.hs new file mode 100644 --- /dev/null +++ b/src/ParseANSI.hs @@ -0,0 +1,84 @@ +-- | Parse text containing ANSI escape codes +-- +-- The parser only handles colors and the \"bold\" property at the moment. +module ParseANSI where + +-- Reference: + +import Data.Monoid ((<>), Endo (..)) +import Data.Text (Text) +import qualified Data.Text as Text + +import Graphics.Vty.Attributes + +readMay :: Read a => Text -> Maybe a +readMay t = case reads $ Text.unpack t of + [(a, "")] -> Just a + _ -> Nothing + +onHead :: (a -> a) -> [a] -> [a] +onHead _ [] = [] +onHead f (a:as) = f a : as + +esc = "\ESC[" +escm = "\ESC[m" + +-- | Parse a text that has been preceded by an 'esc' sequence +-- +-- The result contains the control codes and the rest of the text. +parseEsc :: Text -> Maybe ([Int], Text) +parseEsc t = case Text.uncons rest of + Just ('m', rest') -> (, rest') <$> parseCodes codes + _ -> Nothing + where + codes = Text.takeWhile (/= 'm') t + rest = Text.dropWhile (/= 'm') t + + parseCodes :: Text -> Maybe [Int] + parseCodes = mapM readMay . filter (not . Text.null) . Text.splitOn ";" + +-- | Mapping from control code to 'Attr' +-- (reference: ) +codeMap :: [(Int, Endo Attr)] +codeMap = + [ (1, Endo (`withStyle` bold)) + , (30, Endo (`withForeColor` black)) + , (31, Endo (`withForeColor` red)) + , (32, Endo (`withForeColor` green)) + , (33, Endo (`withForeColor` yellow)) + , (34, Endo (`withForeColor` blue)) + , (35, Endo (`withForeColor` magenta)) + , (36, Endo (`withForeColor` cyan)) + , (37, Endo (`withForeColor` white)) + ] + +-- | Lookup a code in 'codeMap' and return @`Endo` `id`@ if it's not present +lookCode :: Int -> Endo Attr +lookCode c = maybe (Endo id) id $ lookup c codeMap + +-- | A text segment paired with some attribute +data Segment = Segment + { attribute :: Attr + , content :: Text + } deriving (Eq, Show) + +-- | Parse a segment that has been preceded by an 'esc' sequence and does not +-- have any other occurrences of 'esc' inside +parseSegment :: Text -> Segment +parseSegment s + | Just (cs, rest) <- parseEsc s = Segment (mkAttr cs) rest + | otherwise = Segment defAttr s + where + mkAttr cs = foldMap lookCode cs `appEndo` defAttr + +-- | Parse a text containing ANSI control codes +parseANSI :: Text -> [Segment] +parseANSI = map parseSegment . onHead fixHead . Text.splitOn esc + where + -- Ensure that the text starts with an escape code + fixHead :: Text -> Text + fixHead h = case Text.breakOn esc h of + ("", _) -> h -- Already starts with `esc` + (h1, _empty) -> escm <> h1 + -- No `esc` in the string (because `splitOn` makes sure that the + -- separator is either first in the segment or absent) diff --git a/trackit.cabal b/trackit.cabal new file mode 100644 --- /dev/null +++ b/trackit.cabal @@ -0,0 +1,66 @@ +name: trackit +version: 0.1 +synopsis: A command-line tool for live monitoring +description: @trackit@ is a command-line tool that listens for changes + in a user-supplied directory. Whenever there is a change, + a custom command is executed and its standard output is + shown live in the terminal. + . + = Examples + . + Show a live listing of the files in the current directory: + . + >> trackit --watch-dir=. --command="ls --color" + . + Show a live revision graph of a Git repository: + . + >> GIT_DIR=`git rev-parse --git-dir` + >> trackit --watch-tree=$GIT_DIR --command="git log --graph --all --oneline --decorate --color" + . + For more information, see the + . +license: BSD3 +license-file: LICENSE +author: Emil Axelsson +maintainer: 78emil@gmail.com +copyright: 2018 Emil Axelsson +category: Development +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: README.md + +source-repository head + type: git + location: https://github.com/emilaxelsson/trackit.git + +executable trackit + main-is: Main.hs + other-modules: Paths_trackit + ParseANSI + build-depends: base >=4.10 && <4.11, + brick, + fsnotify, + mtl, + optparse-generic, + process, + process-extras, + stm, + text, + time, + vty + hs-source-dirs: src + default-language: Haskell2010 + default-extensions: BangPatterns + DataKinds + DeriveGeneric + ExplicitNamespaces + FlexibleInstances + MultiWayIf + NoMonomorphismRestriction + OverloadedStrings + RecordWildCards + TupleSections + TypeOperators + ViewPatterns + ghc-options: -Wall -Wno-missing-signatures -threaded