packages feed

trackit 0.6.3 → 0.7

raw patch · 5 files changed

+370/−239 lines, 5 filesdep +microlens-platformdep ~brickdep ~optparse-genericdep ~time

Dependencies added: microlens-platform

Dependency ranges changed: brick, optparse-generic, time, vty

Files

src/Main.hs view
@@ -1,16 +1,22 @@+-- TODO QuickCheck:+--+-- * `takeSegs`, etc.+-- * `stepState`++-- TODO changelog++-- TODO check dependency versions+ module Main (main) where  import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVar, writeTVar)-import Control.Monad (fail, forever, guard, void, when)+import Control.Monad (forever, forM_, 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 Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)+import Data.Time.Clock (diffUTCTime, getCurrentTime) import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import GHC.Generics (Generic)@@ -26,28 +32,26 @@        (ParseRecord (..), type (<?>) (..), getWithHelp, lispCaseModifiers,         parseRecordWithModifiers, shortNameModifier) -import Brick-import Brick.BChan-import Graphics.Vty+import Brick.BChan (BChan, newBChan, writeBChan)  import qualified Paths_trackit as Trackit-import ParseANSI+import Options+import TUI  type LText = LText.Text  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)"-  , _followTail    :: Bool           <?> "Follow the tail of the generated output."-  , _showRunning   :: Bool           <?> "Display a message while the command is running."-  , _incremental   :: Bool           <?> "Allow output to be updated incrementally. Redraws the buffer for every output line, so should only be used for \-                                         \slow outputs. Implies '--show-running'."-  , _stabilization :: Maybe Int      <?> "Minimal time (milliseconds) between any file event and the next command update (default: 200)"-  , _version       :: Bool           <?> "Print the version number"+  { _watchDir      :: [FilePath]   <?> "Directory to watch for changes in (not sub-directories). Cannot be used together with '--watch-tree'."+  , _watchTree     :: [FilePath]   <?> "Directory tree to watch for changes in (including sub-directories). Cannot be used together with '--watch-dir'."+  , _command       :: Maybe String <?> "Command to run"+  , _followTail    :: Bool         <?> "Follow the tail of the generated output."+  , _showRunning   :: Bool         <?> "Display a message while the command is running."+  , _incremental   :: Bool         <?> "Allow output to be updated incrementally. Redraws the buffer for every output line, so should only be used for \+                                       \slow outputs. Implies '--show-running'."+  , _stabilization :: Maybe Int    <?> "Minimal time (milliseconds) between any file event and the next command update (default: 200)"+  , _version       :: Bool         <?> "Print the version number"   , _help          :: Bool-  , _debug         :: Bool           <?> "Show debug information in the lower right corner"+  , _debug         :: Bool         <?> "Show debug information in the lower right corner"   } deriving (Show, Generic)  -- `--show-running` is not on by default because it causes a quick flickering@@ -66,25 +70,6 @@     parseRecordWithModifiers       lispCaseModifiers {shortNameModifier = shortName} -data WatchDepth-  = Single-  | Recursive-  deriving (Eq, Show)--data Options = Options-  { watchDir      :: Maybe (FilePath, WatchDepth)-  , command       :: Maybe String-  , maxLines      :: Int-  , followTail    :: Bool-  , showRunning   :: Bool-  , incremental   :: Bool-  , stabilization :: NominalDiffTime-  , debug         :: Bool-  } deriving (Show, Generic)--watchDirError =-  "The flags '--watch-dir' and '--watch-tree' cannot be used together."- getOptions :: IO Options getOptions = do   (CmdOptions {..}, showHelp) <- getWithHelp "trackit"@@ -92,63 +77,17 @@      | 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-              followTail    = unHelpful _followTail-              showRunning   = unHelpful _showRunning-              incremental   = unHelpful _incremental-              stabPerMs     = fromMaybe 200 $ unHelpful _stabilization-              stabilization = fromIntegral stabPerMs / 1000-              debug         = unHelpful _debug-          return $ Options {..}--ansiImage :: Text -> Image-ansiImage = foldMap mkLine . map parseANSI . Text.lines-  where-    mkLine ss =-      foldr (<|>) mempty [text' a s | Segment a s <- ss]---- | Make a 'Context'-aware 'Widget' with 'Fixed' size-withContext :: (Context -> Widget n) -> Widget n-withContext k = Widget Fixed Fixed $ do-  cxt <- getContext-  render (k cxt)---- | Create a bold line looking like this:------ > ---------------- <info> -----------------infoLine :: Text -> Text-infoLine info = Text.concat-  [ "\ESC[1m"-  , line1-  , " "-  , info-  , " "-  , line2-  , "\ESC[m"-  ]-  where-    l = 38 - Text.length info-    line1 = Text.replicate (l     `div` 2) "-"-    line2 = Text.replicate ((l+1) `div` 2) "-"----- | Limit the text to @n@ lines (because large buffers make the app slow)-limit :: Int -> [Text] -> [Text]-limit n ls = ls' ++ case rest of-  [] -> [eof]-  _ -> [pruningNotification]-  where-    (ls', rest) = splitAt n ls-    eof = infoLine "End of output"-    pruningNotification =-      infoLine $ Text.unwords ["Lines beyond", Text.pack (show n), "pruned"]+     | otherwise -> return $+         let watchDirs     = map (, Single)    (unHelpful _watchDir)+                          ++ map (, Recursive) (unHelpful _watchTree)+             command       = unHelpful _command+             followTail    = unHelpful _followTail+             showRunning   = unHelpful _showRunning+             incremental   = unHelpful _incremental+             stabPerMs     = fromMaybe 200 $ unHelpful _stabilization+             stabilization = fromIntegral stabPerMs / 1000+             debug         = unHelpful _debug+          in Options {..}  helpText :: [Text] helpText =@@ -173,7 +112,7 @@   Nothing -> return helpText   Just cmd -> do     (_, o, _) <- Text.readCreateProcessWithExitCode (Process.shell cmd) ""-    return $ limit maxLines $ Text.lines o+    return $ Text.lines o  -- | Run the command provided by the user, or print a helpful text if no command -- was given@@ -183,139 +122,15 @@ runLazyCMD Options {..} = case command of   Nothing -> return helpText   Just cmd ->-    limit maxLines . map LText.toStrict . LText.lines . concatChunks <$>+    map LText.toStrict . LText.lines . concatChunks <$>     Process.readCreateProcessLazy       (Process.shell cmd, LineBuffering, LineBuffering)       "" --- | 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-  { commandOutput :: [Text] -- ^ Lines in reverse-  , commandRunning :: Bool-  , updateCount :: Integer-  } deriving (Eq, Show)- -- | Explicit request to run the command and update output data UpdateRequest = UpdateRequest   deriving (Eq, Show) -data TrackitEvent-  = Running             -- ^ An incremental command started running-  | Done                -- ^ An incremental command is done-  | AddLine Text        -- ^ An incremental command produced a line-  | UpdateBuffer [Text] -- ^ A non-incremental command finished with the given output-  deriving (Eq, Show)--initState :: AppState-initState = AppState-  { commandOutput = []-  , commandRunning = False-  , updateCount = 0-  }--data View = TheView-  deriving (Eq, Ord, Show)--theView :: ViewportScroll View-theView = viewportScroll TheView--drawApp :: Options -> AppState -> [Widget View]-drawApp Options {..} AppState {..} = concat-  [ guard debug >> pure debugWidget-  , pure $-    viewport TheView Both $-    raw $ ansiImage $ Text.unlines $ reverse (runningInfo ++ commandOutput)-  ]-  where-    attr = defAttr `withForeColor` black `withBackColor` white--    runningInfo = if commandRunning then [infoLine "Command is running"] else []--    debugText = "Update count: " <> Text.pack (show updateCount)-    debugWidget =-      withContext $ \cxt ->-        translateBy-          (Location-             (availWidth cxt - Text.length debugText, availHeight cxt - 1)) $-        raw $ text' attr debugText--withSize :: ((Int, Int) -> EventM View ()) -> EventM View ()-withSize k = mapM_ k . fmap extentSize =<< lookupExtent TheView--stepApp ::-     Options-  -> TVar (Maybe UpdateRequest)-  -> AppState-  -> BrickEvent View TrackitEvent-  -> EventM View (Next AppState)-stepApp _ _ s (keyPressed 'q' -> True)          = halt s-stepApp _ updReq s (VtyEvent (EvKey (KChar ' ') _)) = do-  liftIO $ atomically $ writeTVar updReq (Just UpdateRequest)-  continue s-stepApp _ _ s (VtyEvent (EvKey kc []))-  | kc `elem` [KDown,  KChar 'j'] = theView `vScrollBy` 1 >> continue s-  | kc `elem` [KUp,    KChar 'k'] = theView `vScrollBy` (-1) >> continue s-  | kc `elem` [KLeft,  KChar 'h'] = withSize (\(w, _) -> theView `hScrollBy` (negate $ div w 2)) >> continue s-  | kc `elem` [KRight, KChar 'l'] = withSize (\(w, _) -> theView `hScrollBy` (div w 2)) >> continue s-  | kc `elem` [KHome,  KChar 'g'] = vScrollToBeginning theView >> continue s-  | kc `elem` [KEnd,   KChar 'G'] = vScrollToEnd theView >> continue s-  | kc == KPageUp                 = withSize (\(_, h) -> theView `vScrollBy` (negate h)) >> continue s-  | kc == KPageDown               = withSize (\(_, h) -> theView `vScrollBy` h) >> continue s-  | otherwise                     = continue s-stepApp _ _ s (VtyEvent (EvKey kc [MCtrl]))-  | kc == KChar 'u'               = theView `vScrollBy` (-25) >> continue s-  | kc == KChar 'd'               = theView `vScrollBy` (25) >> continue s-  | otherwise                     = continue s-stepApp _ _ s (AppEvent Running) =-  continue s-    { commandOutput = []-    , commandRunning = True-    }-stepApp opts _ s (AppEvent Done) = do-  when (followTail opts) $ vScrollToEnd theView-  continue s-    { commandRunning = False-    , updateCount = updateCount s + 1-    }-stepApp opts _ s (AppEvent (AddLine line)) = do-  when (followTail opts) $ vScrollToEnd theView-  continue s-    { commandOutput = line : commandOutput s-    }-stepApp opts _ s (AppEvent (UpdateBuffer buf)) = do-  when (followTail opts) $ vScrollToEnd theView-  continue s-    { commandOutput = buf-    , commandRunning = False-    , updateCount = updateCount s + 1-    }-stepApp _ _ s _ = continue s--myApp :: Options -> TVar (Maybe UpdateRequest) -> App AppState TrackitEvent View-myApp opts updReq =-  App-  { appDraw = drawApp opts-  , appHandleEvent = stepApp opts updReq-  , appStartEvent = return-  , appAttrMap = const $ attrMap defAttr []-  , appChooseCursor = neverShowCursor-  }--appMain ::-     Options -> TVar (Maybe UpdateRequest) -> BChan TrackitEvent -> IO AppState-appMain opts updReq updEv = do-  vty <- mkVty defaultConfig-  customMain-    vty-    (mkVty defaultConfig)-    (Just updEv)-    (myApp opts updReq)-    initState- -- | A loop that continuously looks for events in the two variables and runs the -- given action in response. The variables are emptied whenever the action runs. --@@ -379,16 +194,17 @@   updReq   <- newTVarIO (Just UpdateRequest)   -- Channel for GUI update events   updEv    <- newBChan 1-  let setFsEvent ev = atomically $ writeTVar lastFSEv $ Just ev+  let mkUpdReq      = atomically $ writeTVar updReq (Just UpdateRequest)+      setFsEvent ev = atomically $ writeTVar lastFSEv $ Just ev   tid <- forkIO $ worker opts lastFSEv updReq (updater opts updEv)-  void $ case watchDir of-    Nothing -> appMain opts updReq updEv-    Just (path, depth) ->-      withManager $ \m -> do-        void $ case depth of-          Single -> FSNotify.watchDir m path (const True) setFsEvent-          Recursive -> FSNotify.watchTree m path (const True) setFsEvent-        appMain opts updReq updEv++  void $ withManager $ \m -> do+    forM_ watchDirs $ \(path, depth) ->+      void $ case depth of+        Single    -> FSNotify.watchDir  m path (const True) setFsEvent+        Recursive -> FSNotify.watchTree m path (const True) setFsEvent+    appMain opts mkUpdReq updEv+   killThread tid  -- Note: The "debouncing" option of fsnotify makes it so that only the *first*
+ src/Options.hs view
@@ -0,0 +1,19 @@+module Options where++import Data.Time.Clock (NominalDiffTime)+import GHC.Generics (Generic)++data WatchDepth+  = Single+  | Recursive+  deriving (Eq, Show)++data Options = Options+  { watchDirs     :: [(FilePath, WatchDepth)]+  , command       :: Maybe String+  , followTail    :: Bool+  , showRunning   :: Bool+  , incremental   :: Bool+  , stabilization :: NominalDiffTime+  , debug         :: Bool+  } deriving (Show, Generic)
src/ParseANSI.hs view
@@ -1,10 +1,17 @@ -- | Parse text containing ANSI escape codes -- -- The parser only handles colors and the \"bold\" property at the moment.-module ParseANSI where+module ParseANSI+  ( Segment (..)+  , lengthSegs+  , takeSegs+  , dropSegs+  , parseANSI+  ) where  -- Reference: <http://ascii-table.com/ansi-escape-sequences.php> +import Data.Foldable (fold) import Data.Monoid (Endo (..)) import Data.Text (Text) import qualified Data.Text as Text@@ -63,15 +70,38 @@   , (37, Endo (`withForeColor` white))   ] --- | Lookup a code in 'codeMap' and return @`Endo` `id`@ if it's not present+-- | Lookup a code in 'codeMap' and return @mempty@ if it's not present lookCode :: Int -> Endo Attr-lookCode c = maybe (Endo id) id $ lookup c codeMap+lookCode c = fold $ lookup c codeMap  -- | A text segment paired with some attribute data Segment = Segment   { attribute :: Attr   , content :: Text   } deriving (Eq, Show)++lengthSegs :: [Segment] -> Int+lengthSegs = sum . map (Text.length . content)++takeSegs :: Int -> [Segment] -> [Segment]+takeSegs _ [] = []+takeSegs n _+  | n <= 0 = []+takeSegs n (s@Segment {..} : ss)+  | len >= n  = [s {content = Text.take n content}]+  | otherwise = s : takeSegs (n-len) ss+  where+    len = Text.length content++dropSegs :: Int -> [Segment] -> [Segment]+dropSegs _ [] = []+dropSegs n ss+  | n <= 0 = ss+dropSegs n (s@Segment {..} : ss)+  | len <= n  = dropSegs (n-len) ss+  | otherwise = s {content = Text.drop n content} : ss+  where+    len = Text.length content  -- | Parse a segment that has been preceded by an 'esc' sequence and does not -- have any other occurrences of 'esc' inside
+ src/TUI.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE TemplateHaskell #-}++module TUI+  ( TrackitEvent (..)+  , appMain+  ) where++import Control.Monad (guard)+import Control.Monad.Trans (liftIO)+import Data.Char (toLower)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as Text++import Lens.Micro.Platform ((&), (.~), (%~), makeLenses)++import Brick+  ( App(..)+  , BrickEvent(..)+  , EventM+  , Location (..)+  , Next+  , Size (..)+  , Widget (..)+  , attrMap+  , availHeight+  , availWidth+  , continue+  , customMain+  , getContext+  , getVtyHandle+  , halt+  , neverShowCursor+  , raw+  , translateBy+  )+import Brick.BChan (BChan)+import Graphics.Vty+  ( Event(..)+  , Image+  , Key(..)+  , Modifier(..)+  , (<|>)+  , black+  , defAttr+  , defaultConfig+  , displayBounds+  , imageWidth+  , mkVty+  , outputIface+  , text'+  , white+  , withBackColor+  , withForeColor+  )++import Options+import ParseANSI++-- | Create an 'Image' from a list of lines (ANSI codes supported)+--+-- Given the first two arguments `x` and `w`, `x` characters are be dropped at+-- the beginning of each line. After offsetting, each line is cropped to `w`+-- characters.+ansiImage ::+     Int -- ^ X offset+  -> Int -- ^ Available width+  -> [Text] -- ^ Lines+  -> Image+ansiImage w x = foldMap (mkLine . takeSegs w . dropSegs x . parseANSI)+  where+    mkLine ss+      | imageWidth line == 0 = text' defAttr " "+          -- Apparently, each line must have at least one character, otherwise+          -- it doesn't take up any vertical space.+      | otherwise = line+      where+        line = foldr (<|>) mempty [text' a s | Segment a s <- ss]+  -- Note that horizontal panning of lines cannot be done outside of this+  -- function. If the lines contain ANSI codes, plain dropping and taking of+  -- characters in the 'Text' representation may lead to strange results. So+  -- panning can only be done after ANSI parsing. (See comment on `AppState` on+  -- why the buffer isn't parsed immediately.)++-- | 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+  { commandOutput  :: [Text] -- ^ Lines in reverse+  , commandRunning :: !Bool+  , bufferWidth    :: !Int -- ^ Width of the widest line in the buffer+  , bufferHeight   :: !Int -- ^ Height of buffer+  , _xOffset       :: !Int+  , _yOffset       :: !Int+  , updateCount    :: !Integer+  } deriving (Eq, Show)+  -- Note: One option would be to have `commandOutput :: [[Segments]]`; i.e.+  -- parse ANSI codes immediately when the buffer is read. This would add some+  -- type safety and would avoid having to parse the same line multiple times.+  -- However, tests show that this approach requires around 3 times more memory+  -- for large buffers.++makeLenses ''AppState++-- | Ensure that the offsets are within the available area+clampState ::+     (Int, Int) -- ^ Available width, height+  -> AppState+  -> AppState+clampState (w, h) s@AppState {..}+  | validOffset = s -- avoid allocation when nothing needs to change+  | otherwise = s+      & xOffset %~ (max 0 . min (bufferWidth - w))+      & yOffset %~ (max 0 . min (bufferHeight - h))+  where+    validOffset = and+      [ _xOffset >= 0+      , _xOffset <= bufferWidth - w+      , _yOffset >= 0+      , _yOffset <= bufferHeight - h+      ]++data TrackitEvent+  = Running             -- ^ An incremental command started running+  | Done                -- ^ An incremental command is done+  | AddLine Text        -- ^ An incremental command produced a line+  | UpdateBuffer [Text] -- ^ A non-incremental command finished with the given output+  deriving (Eq, Show)++initState :: AppState+initState = AppState+  { commandOutput = []+  , commandRunning = False+  , bufferWidth = 0+  , bufferHeight = 0+  , _xOffset = 0+  , _yOffset = 0+  , updateCount = 0+  }++bufferWidget ::+     AppState+  -> [Text] -- ^ Lines in reverse order+  -> Widget m+bufferWidget AppState {..} ls =+  Widget Greedy Greedy $ do+    cxt <- getContext+    let (w, h)        = (availWidth cxt, availHeight cxt)+        offsetFromEnd = bufferHeight - _yOffset - h+        visibleLines  = reverse $ take h $ drop offsetFromEnd ls+    render $ raw $ ansiImage w _xOffset visibleLines++drawApp :: Options -> AppState -> [Widget n]+drawApp Options {..} s@AppState {..} = concat+  [ guard debug          >> pure debugWidget+  , guard commandRunning >> pure runningWidget+  , pure $ bufferWidget s commandOutput+  ]+  where+    attr = defAttr `withForeColor` black `withBackColor` white++    runningText = "running.."+    runningWidget = Widget Fixed Fixed $ do+      cxt <- getContext+      let x = availWidth cxt - Text.length runningText+      render $ translateBy (Location (x, 0)) $ raw $ text' attr runningText+      -- I tried using `padLeft` instead, but it doesn't work because the+      -- padding overwrites any content below it. See this issue/question:+      -- <https://github.com/jtdaugherty/brick/issues/74>++    debugText = "Update count: " <> Text.pack (show updateCount)+    debugWidget = Widget Fixed Fixed $ do+      cxt <- getContext+      let x = availWidth cxt - Text.length debugText+          y = availHeight cxt - 1+      render $ translateBy (Location (x, y)) $ raw $ text' attr debugText++stepApp ::+     Options+  -> IO () -- ^ Update request+  -> AppState+  -> BrickEvent n TrackitEvent+  -> EventM n (Next AppState)+stepApp _ _ s (keyPressed 'q' -> True) = halt s+stepApp _ updReq s (keyPressed ' ' -> True) = liftIO updReq >> continue s+stepApp opts _ s ev = do+  vty <- getVtyHandle+  size <- liftIO $ displayBounds $ outputIface vty+  let s' = clampState size $ stepState opts ev size s+  continue s'++stepState ::+     Options+  -> BrickEvent n TrackitEvent+  -> (Int, Int) -- ^ Available width, height+  -> AppState+  -> AppState+stepState _ (AppEvent Running) _ s = s+  { commandOutput  = []+  , commandRunning = True+  , bufferWidth    = 0+  , bufferHeight   = 0+  }+stepState _ (AppEvent Done) _ s@AppState {..} = s+  { commandRunning = False+  , updateCount    = updateCount + 1+  }+stepState opts (AppEvent (AddLine line)) (_, h) s@AppState {..} = s+  { commandOutput  = line : commandOutput+  , bufferWidth    = bufferWidth `max` lengthSegs (parseANSI line)+  , bufferHeight   = bufferHeight + 1+  , _yOffset       = if followTail opts then bufferHeight + 1 - h else _yOffset+  }+stepState opts (AppEvent (UpdateBuffer buf)) (_, h) s@AppState {..} = s+  { commandOutput  = buf+  , bufferWidth    = maximum $ 0 : map (lengthSegs . parseANSI) buf+  , bufferHeight   = len+  , _yOffset       = if followTail opts then len - h else _yOffset+  , updateCount    = updateCount + 1+  }+  where+    len = length buf+stepState _ (VtyEvent (EvKey kc [])) (w, h) s@AppState {bufferHeight}+  | kc `elem` [KDown,  KChar 'j'] = s & yOffset %~ (+1)+  | kc `elem` [KUp,    KChar 'k'] = s & yOffset %~ subtract 1+  | kc `elem` [KLeft,  KChar 'h'] = s & xOffset %~ subtract (div w 2)+  | kc `elem` [KRight, KChar 'l'] = s & xOffset %~ (+ div w 2)+  | kc `elem` [KHome,  KChar 'g'] = s & yOffset .~ 0+  | kc `elem` [KEnd,   KChar 'G'] = s & yOffset .~ (bufferHeight - h)+  | kc == KPageUp                 = s & yOffset %~ subtract h+  | kc == KPageDown               = s & yOffset %~ (+h)+stepState _ (VtyEvent (EvKey kc [MCtrl])) _ s+  | kc == KChar 'u'               = s & yOffset %~ subtract 25+  | kc == KChar 'd'               = s & yOffset %~ (+25)+stepState _ _ _ s = s++myApp :: Options+  -> IO () -- ^ Update request+  -> App AppState TrackitEvent ()+myApp opts updReq = App+  { appDraw         = drawApp opts+  , appHandleEvent  = stepApp opts updReq+  , appStartEvent   = return+  , appAttrMap      = const $ attrMap defAttr []+  , appChooseCursor = neverShowCursor+  }++appMain ::+     Options+  -> IO () -- ^ Update request+  -> BChan TrackitEvent+  -> IO AppState+appMain opts updReq updEv = do+  vty <- mkVty defaultConfig+  customMain+    vty+    (mkVty defaultConfig)+    (Just updEv)+    (myApp opts updReq)+    initState
trackit.cabal view
@@ -1,5 +1,5 @@ name:                trackit-version:             0.6.3+version:             0.7 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,@@ -39,19 +39,22 @@ executable trackit   main-is:              Main.hs   other-modules:        Paths_trackit+                        Options                         ParseANSI+                        TUI   build-depends:        base <5-                      , brick >= 0.47 && <0.51+                      , brick >= 0.47 && < 0.61                           -- 0.47 adds an argument to customMain                       , fsnotify <0.4+                      , microlens-platform <0.5                       , mtl <2.3-                      , optparse-generic >=1.2 && < 1.4+                      , optparse-generic >=1.2 && < 1.5                       , process <1.7                       , process-extras >=0.4 && <0.8                       , stm <2.6                       , text <1.3-                      , time <1.10-                      , vty <5.27+                      , time < 1.12+                      , vty < 5.33   hs-source-dirs:       src   default-language:     Haskell2010   default-extensions:   BangPatterns@@ -60,6 +63,7 @@                         ExplicitNamespaces                         FlexibleInstances                         MultiWayIf+                        NamedFieldPuns                         NoMonomorphismRestriction                         OverloadedStrings                         RecordWildCards