dr-cabal 0.1.0.0 → 0.2.0.0

raw patch · 11 files changed

+548/−224 lines, 11 filesdep +terminal-sizePVP ok

version bump matches the API change (PVP)

Dependencies added: terminal-size

API changes (from Hackage documentation)

Files

• CHANGELOG.md +68/−10
• README.md +44/−41
• dr-cabal.cabal +4/−1
• src/DrCabal.hs +0/−2
• src/DrCabal/Cli.hs +45/−38
• src/DrCabal/Json.hs +39/−0
• src/DrCabal/Model.hs +21/−0
• src/DrCabal/Profile.hs +71/−28
• src/DrCabal/Profile/Stacked.hs +61/−13
• src/DrCabal/Terminal.hs +71/−0
• src/DrCabal/Watch.hs +124/−91

@@ -1,22 +1,80 @@ # Changelog -`dr-cabal` uses [PVP Versioning][1].-The changelog is available [on GitHub][2].+All notable changes to this project will be documented in this file. -## 0.1.0.0 — August 6, 2022 📚+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to [PVP Versioning][1]. The changelog is also+available [on GitHub][2]. +[1]: https://pvp.haskell.org+[2]: https://github.com/chshersh/dr-cabal/releases++## [Unreleased]++## [0.2.0.0] — 2022-11-20 ✨++### Added++* [#28](https://github.com/chshersh/dr-cabal/issues/28):+  Implement interactive mode+  (by [@Bodigrim][Bodigrim])+* [#24](https://github.com/chshersh/dr-cabal/issues/24):+  Compute the critical path+  (by [@Bodigrim][Bodigrim])+* [#26](https://github.com/chshersh/dr-cabal/issues/26),+  [#30](https://github.com/chshersh/dr-cabal/issues/30):+  Multiple documentation improvements: suggest `--store-dir`,+  `--dependencies-only`, `mktemp`, interactive mode by default+  (by [@Bodigrim][Bodigrim], [@chshersh][chshersh])++### Removed++* Remove `watch` command. Now `dr-cabal profile` can watch and build+  the profiling output at the same time.++### Changed++* [#31](https://github.com/chshersh/dr-cabal/issues/31):+  Refactor CLI significantly:++    + Remove `watch` command+    + Use interactive mode by default (via alternate terminal screen)++  (by [@chshersh][chshersh])++## [0.1.0.0] — 2022-08-06 📚++### Added+ * [#10](https://github.com/chshersh/dr-cabal/issues/10):   Support `Haddock` phase in `cabal build` output-  (by [@diasbruno](https://github.com/diasbruno))+  (by [@diasbruno][diasbruno]) * [#14](https://github.com/chshersh/dr-cabal/issues/14):   Enrich _Summary_ with more info: parallelism level, total dependencies summary-  (by [@bradrn](https://github.com/bradrn))+  (by [@bradrn][bradrn]) * Module structure refactoring to add new profiling modes easier-  (by [@diasbruno](https://github.com/diasbruno))+  (by [@diasbruno][diasbruno]) -## 0.0.0.0 — July 31, 2022 🌇+### Fixed -* Initially created.+* Fixed type in the profile example+  (by [@tonyday567][tonyday567]) -[1]: https://pvp.haskell.org-[2]: https://github.com/chshersh/dr-cabal/releases+## [0.0.0.0] — 2022-07-31 🌇++Initial release prepared by [@chshersh][chshersh].++<!-- Contributors -->++[Bodigrim]: https://github.com/Bodigrim+[bradrn]: https://github.com/bradrn+[chshersh]: https://github.com/chshersh+[diasbruno]: https://github.com/diasbruno+[tonyday567]: https://github.com/tonyday567++<!-- Versions -->++[Unreleased]: https://github.com/chshersh/dr-cabal/compare/v0.2.0.0...HEAD+[0.2.0.0]: https://github.com/chshersh/dr-cabal/compare/v0.1.0.0...v0.2.0.0+[0.1.0.0]: https://github.com/chshersh/dr-cabal/compare/v0.0.0.0...v0.1.0.0+[0.0.0.0]: https://github.com/chshersh/dr-cabal/releases/tag/v0.0.0.0

@@ -6,7 +6,7 @@  `dr-cabal` is a CLI tool for profiling Haskell dependencies build times. -![dr-cabal example](https://raw.githubusercontent.com/chshersh/dr-cabal/main/images/dr-cabal-example.png)+![dr-cabal demo](https://raw.githubusercontent.com/chshersh/dr-cabal/main/images/dr-cabal-demo.gif)  > ℹ️ **DISCLAIMER:** This project is developed and maintained in > free time by volunteers. The development may continue for decades or@@ -16,8 +16,8 @@  ## Install -`dr-cabal` is a Haskell CLI tool and can be installed either from-Hackage or from this repository.+`dr-cabal` is a CLI tool written in Haskell and can be installed+either from Hackage or from this repository.  ### Prerequisites @@ -41,13 +41,12 @@ 	```  2. Build `dr-cabal` from Hackage and copy the resulting executable-   into the desired location:+   into the desired location (e.g. `$HOME/.local/bin`):      ```shell     cabal install dr-cabal \         --install-method=copy \         --overwrite-policy=always \-        --with-compiler=ghc-9.0.2 \         --installdir=$HOME/.local/bin 	``` @@ -81,55 +80,59 @@ > ℹ️ **NOTE:** Make sure the `~/.local/bin` directory or the > directory of your choice is listed in `$PATH`. -## How to use?+## Quick start guide -`dr-cabal` usages comprises two steps:+Run the following command to view interactive profiling report: -1. 👀 Watching `cabal build` output and recording data into a JSON file.-2. 🌈 Producing pretty profiling results.+```shell+cabal --store-dir=$(mktemp -d) build --dependencies-only all | dr-cabal profile+``` -### Watch+### Explanation -> ⚠️ **WARNING:** To get meaningful results, the `dr-cabal watch`-> command needs to be run when none of the dependencies are build. If-> you've already build you project, including dependencies, you can-> purge global Cabal cache using the following command:+This section explains the above command:++1. `dr-cabal` watches the output of the `cabal build` command to+   produce the profiling report. Step into the directory of the+   Haskell project you want to profile and pipe the output of+   `cabal build` to `dr-cabal profile`.+2. Currently, `dr-cabal` can profile only dependencies. So you can+   pass the `--dependencies-only` to avoid extra wait.+3. `cabal` caches built dependencies. You can specify a custom+   directory for storing build artifacts using the `--store-dir` flag+   to build the dependencies anew.+4. The `$(mktemp -d)` command generates a temporary directory so you+   can run the build time profiler in an isolated location.++> ⚠️ **WARNING:** To get meaningful results, including downloading+> of packages, the `dr-cabal watch` command needs to be run when+> none of the dependencies are build (i.e. with cold cabal+> cache). If you've already build you project, including+> dependencies, you can purge global Cabal cache using the+> following command: > > ```shell > rm -rf ~/.cabal > ```->-> You may prefer a less invasive approach if you have custom global-> Cabal configurations:->-> ```shell-> rm -rf ~/.cabal/store-> ```->-> However, with the latter solution you won't see the `Downloading`-> phase in the profiling output. -Run the following command inside the project directory, for which you-want to build the profile chart:--```shell-cabal build all | dr-cabal watch --output=dr-cabal-debug.json-```+## Usage -This command watches the `cabal build` output and records all the-relevant steps in the `dr-cabal-debug.json` file.+> ℹ️ In this section, a more verbose `cabal-install` command from+> "Quick start guide" is replaced with shorter `cabal build`. -If everything is good, you should see output similar to the below one:+`dr-cabal` supports profiling of documentation as well, you only need+to pass relevant flags to `cabal build`: -![dr-cabal watch example](https://raw.githubusercontent.com/chshersh/dr-cabal/main/images/dr-cabal-watch.gif)+```shell+cabal build --enable-documentation --haddock-all | dr-cabal profile+``` -> It's also possible to see the time spent on Haddock. You can run with:->-> ```shell-> cabal build all --enable-documentation --haddock-all | dr-cabal watch --output=dr-cabal-debug.json-> ```+To cache the profiling results in JSON (and avoid building the project+again), use the `--output` flag: -### Profile+```shell+cabal build | dr-cabal profile --output=my_file.json+```  Once you successfully produced a JSON file with all the recorded steps, run the following command to pretty-print the profiling output:@@ -137,7 +140,7 @@ > ⚠️ **WARNING:** For better results, make your terminal full-screen.  ```shell-dr-cabal profile --input=dr-cabal-debug.json+dr-cabal profile --input=my_file.json ```  You'll see the output like on the image below:

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                dr-cabal-version:             0.1.0.0+version:             0.2.0.0 synopsis:            See README for more info description:     CLI tool for profiling Haskell dependencies build times.@@ -81,10 +81,12 @@   exposed-modules:     DrCabal       DrCabal.Cli+      DrCabal.Json       DrCabal.Model       DrCabal.Profile         DrCabal.Profile.Format         DrCabal.Profile.Stacked+      DrCabal.Terminal       DrCabal.Watch    build-depends:@@ -95,6 +97,7 @@     , bytestring           ^>= 0.11     , colourista           ^>= 0.1     , optparse-applicative ^>= 0.17+    , terminal-size        ^>= 0.3.3  executable dr-cabal   import:              common-options

@@ -15,7 +15,6 @@  import DrCabal.Cli (Command (..), readCommand) import DrCabal.Profile (runProfile)-import DrCabal.Watch (runWatch)   main :: IO ()@@ -23,5 +22,4 @@  runDrCabal :: Command -> IO () runDrCabal = \case-    Watch args   -> runWatch args     Profile args -> runProfile args

@@ -15,8 +15,8 @@     ( Command (..)     , readCommand -    , WatchArgs (..)     , ProfileArgs (..)+    , FileMode (..)     ) where  import DrCabal.Model (Style (..))@@ -24,18 +24,23 @@ import qualified Options.Applicative as Opt  data Command-    = Watch WatchArgs-    | Profile ProfileArgs--newtype WatchArgs = WatchArgs-    { watchArgsOutput :: FilePath-    }+    = Profile ProfileArgs  data ProfileArgs = ProfileArgs-    { profileArgsInput :: FilePath-    , profileArgsStyle :: Style+    { profileArgsStyle    :: Style+    , profileArgsFileMode :: FileMode     } +data FileMode+    -- | Don't read from the file and don't store the results in the file+    = None++    -- | Store current results in the file+    | Output FilePath++    -- | Read previously saved results from the file+    | Input FilePath+ readCommand :: IO Command readCommand = Opt.execParser opts   where@@ -48,41 +53,43 @@ -- | All possible commands. commandP :: Opt.Parser Command commandP = Opt.subparser $ mconcat-    [ Opt.command "watch"-          $ Opt.info (Opt.helper <*> watchP)-          $ Opt.progDesc "Watch cabal output and save it"-    , Opt.command "profile"-          $ Opt.info (Opt.helper <*> profileP)-          $ Opt.progDesc "Output pretty cabal profile results"+    [ Opt.command "profile"+        $ Opt.info (Opt.helper <*> profileP)+        $ Opt.progDesc "Build profiling report"     ] -watchP :: Opt.Parser Command-watchP = do-    watchArgsOutput <- Opt.strOption $ mconcat-        [ Opt.long "output"-        , Opt.short 'o'-        , Opt.metavar "FILE_PATH"-        , Opt.help "Save cabal output to a file in a JSON format"-        ]--    pure $ Watch WatchArgs{..}- profileP :: Opt.Parser Command profileP = do-    profileArgsInput <-  Opt.strOption $ mconcat+    profileArgsStyle <- styleP+    profileArgsFileMode <- fileModeP++    pure $ Profile ProfileArgs{..}++styleP :: Opt.Parser Style+styleP = stackedP <|> pure Stacked+  where+    stackedP :: Opt.Parser Style+    stackedP = Opt.flag' Stacked $ mconcat+        [ Opt.long "stacked"+        , Opt.short 's'+        , Opt.help "Format as stacked"+        ]++fileModeP :: Opt.Parser FileMode+fileModeP = inputP <|> outputP <|> pure None+  where+    inputP :: Opt.Parser FileMode+    inputP = fmap Input $ Opt.strOption $ mconcat         [ Opt.long "input"         , Opt.short 'i'         , Opt.metavar "FILE_PATH"-        , Opt.help "Read profile input from a JSON file, created by 'dr-cabal watch'"+        , Opt.help "Read profile input from a JSON file, created by 'dr-cabal profile --output=<some-file>'"         ] -    profileArgsStyle <- stackedP <|> pure Stacked--    pure $ Profile ProfileArgs{..}--stackedP :: Opt.Parser Style-stackedP = Opt.flag' Stacked $ mconcat-    [ Opt.long "stacked"-    , Opt.short 's'-    , Opt.help "Format as stacked"-    ]+    outputP :: Opt.Parser FileMode+    outputP = fmap Output $ Opt.strOption $ mconcat+        [ Opt.long "output"+        , Opt.short 'o'+        , Opt.metavar "FILE_PATH"+        , Opt.help "Save cabal output to a file in a JSON format"+        ]

@@ -0,0 +1,39 @@+{- |+Module                  : DrCabal.Json+Copyright               : (c) 2022 Dmitrii Kovanikov+SPDX-License-Identifier : MPL-2.0+Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>+Stability               : Experimental+Portability             : Portable++This module contains functions to process JSON entries recognised by @dr-cabal@.+-}++module DrCabal.Json+    ( readEntries+    , writeEntries+    ) where++import Data.Aeson (eitherDecodeFileStrict')+import Data.Aeson.Encode.Pretty (encodePretty)++import DrCabal.Model (Entry)++import qualified Colourista+++{- | Read a list of entries from a JSON file.++Exits process with an error message on decoding failure.+-}+readEntries :: FilePath -> IO [Entry]+readEntries file = eitherDecodeFileStrict' file >>= \case+    Right entries -> pure entries+    Left err -> do+        Colourista.errorMessage $ "Error parsing file: " <> toText file+        Colourista.redMessage   $ "      " <> toText err+        exitFailure++-- | Write entries as a pretty JSON to the output file.+writeEntries :: FilePath -> [Entry] -> IO ()+writeEntries outputPath = writeFileLBS outputPath . encodePretty

@@ -14,10 +14,14 @@     , Line (..)     , Status (..)     , Entry (..)+    , parseLine     ) where  import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=)) +import qualified Data.Text as Text++ data Style = Stacked  data Line = Line@@ -62,3 +66,20 @@         entryStart   <- o .: "startTime"         entryLibrary <- o .: "library"         pure Entry{..}++parseLine :: Line -> Maybe Entry+parseLine Line{..} = do+    let txtLine = decodeUtf8 lineLine+    txtStatus : library : _ <- Just $ words txtLine++    -- parse status string to the 'Status' type+    status <- readMaybe $ toString txtStatus++    -- check if this line is a library: '-' separates library name and its version+    guard $ Text.elem '-' library++    pure $ Entry+        { entryStatus  = status+        , entryStart   = lineTime+        , entryLibrary = library+        }

@@ -13,40 +13,83 @@     ( runProfile     ) where -import Colourista.Short (u)-import Data.Aeson (eitherDecodeFileStrict')-import System.Console.ANSI (getTerminalSize)--import DrCabal.Cli (ProfileArgs (..))-import DrCabal.Model (Entry (..), Style (Stacked))+import DrCabal.Cli (FileMode (..), ProfileArgs (..))+import DrCabal.Json (readEntries, writeEntries)+import DrCabal.Model (Entry (..), Style (..)) import DrCabal.Profile.Stacked (createStackedChart)+import DrCabal.Terminal (getTerminalWidth, withAlternateBuffer)+import DrCabal.Watch (watchBuild) -import qualified Colourista  runProfile :: ProfileArgs -> IO ()-runProfile ProfileArgs{..} = do-    terminalWidth <- getTerminalSize >>= \case-        Just (_height, width) -> pure width-        Nothing -> do-            putText $ unlines-                [ "Error getting the terminal width. If you see this error, open an issue"-                , "in the 'dr-cabal' issue tracker and provide as many details as possible"-                , ""-                , "  * " <> u "https://github.com/chshersh/dr-cabal/issues/new"-                ]-            exitFailure+runProfile ProfileArgs{..} = case profileArgsFileMode of+     None ->+         profileInteractive profileArgsStyle+     Output outputFile ->+         profileWithOutput profileArgsStyle outputFile+     Input inputFile ->+         profileFromInput profileArgsStyle inputFile -    entries <- readFromFile profileArgsInput+profileInteractive :: Style -> IO ()+profileInteractive chartStyle = do+    -- draw profiling chart interactively and get all the entries after that+    entries <- withInteractiveProfiling chartStyle -    let chart = case profileArgsStyle of-          Stacked -> createStackedChart terminalWidth entries+    -- draw the chart in the normal terminal screen buffer now+    drawChart <- getChartDrawer chartStyle+    putTextLn $ drawChart entries +    putText $ unlines+        [ "✨  Done!"+        , "🆙  Scroll up to view full profiling chart."+        , "💾  To save the results in a file (to view later without recompilation), run:"+        , ""+        , "    cabal build ... | dr-cabal profile --output=my_file.json"+        ]++profileWithOutput :: Style -> FilePath -> IO ()+profileWithOutput chartStyle outputFile = do+    -- draw profiling chart interactively and get all the entries after that+    entries <- withInteractiveProfiling chartStyle+    writeEntries outputFile entries++    putText $ unlines+        [ "✨  Done!"+        , "💾  Profiling entries are saved in the file: " <> toText outputFile+        , "👀  To view the results from the saved file, run:"+        , ""+        , "    dr-cabal profile --input=" <> toText outputFile+        ]++profileFromInput :: Style -> FilePath -> IO ()+profileFromInput chartStyle inputFile = do+    terminalWidth <- getTerminalWidth+    entries <- readEntries inputFile+    let chart = createChart chartStyle terminalWidth entries     putTextLn chart -readFromFile :: FilePath -> IO [Entry]-readFromFile file = eitherDecodeFileStrict' file >>= \case-    Left err -> do-        Colourista.errorMessage $ "Error parsing file: " <> toText file-        Colourista.redMessage   $ "      " <> toText err-        exitFailure-    Right entries -> pure entries+-------------+-- HELPERS --+-------------++withInteractiveProfiling :: Style -> IO [Entry]+withInteractiveProfiling chartStyle = withAlternateBuffer $ do+    hSetBuffering stdout (BlockBuffering Nothing)+    drawChart <- getChartDrawer chartStyle+    watchBuild drawChart++getChartDrawer :: Style -> IO ([Entry] -> Text)+getChartDrawer chartStyle = do+    terminalWidth <- getTerminalWidth+    pure $ createChart chartStyle terminalWidth++createChart+    :: Style+    -- ^ Chart type+    -> Int+    -- ^ Terminal width+    -> [Entry]+    -- ^ Time entries+    -> Text+createChart = \case+    Stacked -> createStackedChart

@@ -6,7 +6,7 @@ Stability               : Experimental Portability             : Portable -Stacked profiling output mode.+Stacked profiling output mode for the @dr-cabal profile --stacked@ command. -}  module DrCabal.Profile.Stacked@@ -104,8 +104,43 @@             Nothing -> ct `minusw` start             Just it -> ct `minusw` it -formatChart :: Word64 -> Word64 -> Int -> Map Text Phase -> Text-formatChart start end width libs = unlines $ concat+{- | Take a log of Cabal events and derive a critical path, which is the longest+stretch of dependent packages such that the sum of their build times determines+the total wall clock time.++The algorithm works this way:+1. Find the very last event in the log and a corresponding library L.+2. Find when L first emerges in the log (which is when its build started).+3. If this is the very first entry of the log, exit.+4. Find which build just finished before L's build started and a corresponding library L'.+5. Set L := L' and return to Step 2.+-}+computeCriticalPath :: Map Text [(Status, Word64)] -> [Text]+computeCriticalPath libs = case Map.maxView finishTimeToLibs of+    Nothing           -> []  -- oh well, seems the log was empty+    Just (lastLib, _) -> lastLib : unfoldr go lastLib+  where+    -- Inner lists are generated by 'groupEntries', so must be nonempty.+    libsList :: [(Text, [Word64])]+    libsList = map (fmap (map snd)) $ Map.assocs libs++    libsByStartTime :: Map Text Word64+    libsByStartTime = Map.fromList $ map (fmap List.minimum) libsList++    -- Given that timestamps are in nanoseconds, we do not really+    -- expect any entries to have the same finish time.+    finishTimeToLibs :: Map Word64 Text+    finishTimeToLibs = Map.fromList $ map (swap . fmap List.maximum) libsList++    go :: Text -> Maybe (Text, Text)+    go lib = do+        phase <- Map.lookup lib libsByStartTime+        let (finishedBefore, _) = Map.split phase finishTimeToLibs+        prevLib <- fst <$> Map.maxView finishedBefore+        pure (prevLib, prevLib)++formatChart :: Word64 -> Word64 -> Int -> [Text] -> Map Text Phase -> Text+formatChart start end width critPath libs = unlines $ concat     [ legend     , summary     , profile@@ -122,17 +157,18 @@         , "  " <> fmt [red]     block <> "  Building"         , "  " <> fmt [magenta] block <> "  Haddock"         , "  " <> fmt [yellow]  block <> "  Installing"+        , "  " <> b "*"               <> "  Critical path"         , ""         ]      summary :: [Text]     summary =         [ b "Summary"-        , i "  Wall time              " <> " : " <> fmtNanos (end - start)-        , i "  Dependency sum time    " <> " : " <> fmtNanos totalAllPhases-        , i "  Total dependencies     " <> " : " <> show (Map.size libs)-        , i "  Parallelism level      " <> " : " <> fmtDecimalPlaces 2 parallelism-        , i "  Single block resolution" <> " : " <> fmtNanos blockMeasure+        , i "  Wall time (sum along critpath)" <> " : " <> fmtNanos (end - start)+        , i "  Dependency sum time           " <> " : " <> fmtNanos totalAllPhases+        , i "  Total dependencies            " <> " : " <> show (Map.size libs)+        , i "  Parallelism level             " <> " : " <> fmtDecimalPlaces 2 parallelism+        , i "  Single block resolution       " <> " : " <> fmtNanos blockMeasure         , ""         ] @@ -176,14 +212,24 @@      fmtPrefix :: Text -> Phase -> Text     fmtPrefix libName phase = mconcat-        [ Text.justifyRight libSize ' ' libName+        [ fmtCritPath         , " ["         , Text.justifyLeft phaseSize ' ' $ fmtPhase phase         , "] "         , "│"         , " "         ]+      where+        isOnCritPath :: Bool+        isOnCritPath = libName `elem` critPath +        fmtCritPath :: Text+        fmtCritPath+            | isOnCritPath = b $ paddedLibName <> "*"+            | otherwise = paddedLibName <> " "+          where+            paddedLibName = Text.justifyRight libSize ' ' libName+     -- How many nanoseconds each block represents?     -- blocks take:     -- width minus prefix size@@ -206,9 +252,11 @@ createStackedChart width l = case l of     [] -> unlines         [ "No cabal build entries found. Have you already built dependency?"-        , "Try removing global cabal store cache and rerunning 'dr-cabal watch' again."+        , "Try removing global cabal store cache and rerunning 'dr-cabal watch' again."  -- TODO: update message         ]     entries ->-        let start = List.minimum $ map entryStart entries in-        let end   = List.maximum $ map entryStart entries in-        formatChart start end width $ calculatePhases start $ groupEntries entries+        let start    = List.minimum $ map entryStart entries in+        let end      = List.maximum $ map entryStart entries in+        let grouped  = groupEntries entries in+        let critPath = computeCriticalPath grouped in+        formatChart start end width critPath $ calculatePhases start grouped

@@ -0,0 +1,71 @@+{- |+Module                  : DrCabal.Terminal+Copyright               : (c) 2022 Dmitrii Kovanikov+SPDX-License-Identifier : MPL-2.0+Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>+Stability               : Experimental+Portability             : Portable++Utility functions to work with the terminal output.+-}++module DrCabal.Terminal+    ( getTerminalWidth+    , clearScreen+    , withAlternateBuffer+    ) where++import Colourista.Short (u)+import Control.Exception (bracket)+import System.Console.ANSI (clearFromCursorToScreenEnd, cursorUpLine)++import qualified System.Console.Terminal.Size as Terminal+++{- | Get the width of the current terminal.++This function exits the process with the message if it can't get the+width of the current terminal.+-}+getTerminalWidth :: IO Int+getTerminalWidth = Terminal.size >>= \case+    Just (Terminal.Window _height width) -> pure width+    Nothing -> do+        putText $ unlines+            [ "Error getting the terminal width. If you see this error, open an issue"+            , "in the 'dr-cabal' issue tracker and provide as many details as possible"+            , ""+            , "  * " <> u "https://github.com/chshersh/dr-cabal/issues/new"+            ]+        exitFailure++{- | Clears the the @screenHeight@ number of lines in the screen. Pass+the number of lines in the output to clear the entire screen.+-}+clearScreen :: Int -> IO ()+clearScreen screenHeight = do+    -- https://github.com/UnkindPartition/ansi-terminal/issues/141+    when (screenHeight > 0) $+        cursorUpLine screenHeight+    clearFromCursorToScreenEnd++{- | Run action in the alternate buffer and return to the normal+screen after exception or SIGINT.++__NOTE:__ This function always returns to the normal screen after the+action. If you want to print something to the normal screen use the+result of the given action afterwards.+-}+withAlternateBuffer :: IO a -> IO a+withAlternateBuffer action = bracket+    useAlternateScreenBuffer+    (\_ -> useNormalScreenBuffer)+    (\_ -> action)++-- TODO: use functions from 'ansi-terminal'+useAlternateScreenBuffer :: IO ()+useAlternateScreenBuffer = putStrLn "\ESC[?1049h\ESC[H"++-- TODO: use functions from 'ansi-terminal'+useNormalScreenBuffer :: IO ()+useNormalScreenBuffer = putStrLn "\ESC[?1049l"

@@ -9,94 +9,120 @@ Stability               : Experimental Portability             : Portable -Implementation of the @dr-cabal watch@ command.+Watch the output of the @cabal build@ command and update the profile+chart interactively. -}  module DrCabal.Watch-    ( runWatch+    ( watchBuild     ) where  import Colourista.Short (b) import Control.Concurrent (threadDelay)-import Control.Concurrent.Async (concurrently_)-import Data.Aeson.Encode.Pretty (encodePretty)+import Control.Concurrent.Async (concurrently) import GHC.Clock (getMonotonicTimeNSec)-import System.Console.ANSI (clearLine, setCursorColumn) import System.IO (isEOF) -import DrCabal.Cli (WatchArgs (..))-import DrCabal.Model (Entry (..), Line (..))+import DrCabal.Model (Entry (..), Line (..), parseLine)+import DrCabal.Terminal (clearScreen)  import qualified Colourista import qualified Data.ByteString as ByteString-import qualified Data.Text as Text  -runWatch :: WatchArgs -> IO ()-runWatch WatchArgs{..} = do-    watchRef <- newIORef [Start]+{- | Watch build entries from @stdin@ and interactively update the+chart and current status.+-}+watchBuild+    :: ([Entry] -> Text)+    -- ^ A function to draw chart+    -> IO [Entry]+    -- ^ Returns the final list of entries+watchBuild drawChart = do+    inputActionRef <- newIORef [Start] -    concurrently_-        (watchWorker watchRef)-        (readFromStdin watchRef watchArgsOutput)+    (entries, _) <- concurrently+        (interactiveWorker inputActionRef drawChart)+        (stdinReaderWorker inputActionRef) -readFromStdin :: IORef [WatchAction] -> FilePath -> IO ()-readFromStdin watchRef outputPath = go []+    pure entries++stdinReaderWorker :: IORef [InputAction] -> IO ()+stdinReaderWorker inputActionRef = go   where-    go :: [Line] -> IO ()-    go cabalOutput = do+    go :: IO ()+    go = do         isEndOfInput <- isEOF         if isEndOfInput         then do-            pushAction watchRef $ End outputPath cabalOutput+            pushAction inputActionRef End         else do             time <- getMonotonicTimeNSec             line <- ByteString.getLine+            let ln = Line time line              -- output line to the watch worker for output redirection-            pushAction watchRef $ Consume line--            go $ Line time line : cabalOutput+            pushAction inputActionRef $ Consume ln -linesToEntries :: [Line] -> [Entry]-linesToEntries = mapMaybe parseLine . reverse+            go -parseLine :: Line -> Maybe Entry-parseLine Line{..} = do-    let txtLine = decodeUtf8 lineLine-    txtStatus : library : _ <- Just $ words txtLine+-- | Action returned by the @stdinReaderWorker@.+data InputAction+    -- | Produce the initial message+    = Start -    -- parse status string to the 'Status' type-    status <- readMaybe $ toString txtStatus+    -- | Line content read from @stdin@ with timestamp+    | Consume Line -    -- check if this line is a library: '-' separates library name and its version-    guard $ Text.elem '-' library+    -- | EOF reached for @stdin@+    | End -    pure $ Entry-        { entryStatus  = status-        , entryStart   = lineTime-        , entryLibrary = library-        }+-- | Add 'InputAction' to end of the queue in the given 'IORef'.+pushAction :: IORef [InputAction] -> InputAction -> IO ()+pushAction inputActionRef action =+    atomicModifyIORef' inputActionRef $ \actions -> (actions ++ [action], ()) -data WatchAction-    = Start-    | Consume ByteString-    | End FilePath [Line]+data InteractiveCommand+    -- | Initial message+    = Greeting --- | Add 'WatchAction' to end of the list-pushAction :: IORef [WatchAction] -> WatchAction -> IO ()-pushAction watchRef action =-    atomicModifyIORef' watchRef $ \actions -> (actions ++ [action], ())+    -- | New line received from the @stdinReaderWorker@. Update the chart.+    | UpdateChart Line -data WorkerCommand-    = Greeting-    | WriteLine ByteString+    -- | No new lines from @stdin@. Simply wait and update the spinner.     | Wait-    | Finish FilePath [Line] -watchWorker :: IORef [WatchAction] -> IO ()-watchWorker watchRef = go "Watching build output" (cycle spinnerFrames)+    -- | Finished reading lines from @stdin@+    | Finish++{- | Produce the next 'InteractiveCommand' by reading the current+'InputAction' and removing it from the queue.+-}+nextCommand :: IORef [InputAction] -> IO InteractiveCommand+nextCommand inputActionRef = atomicModifyIORef' inputActionRef popAction   where+    popAction :: [InputAction] -> ([InputAction], InteractiveCommand)+    popAction [] = ([], Wait)+    popAction (x : xs) = case x of+        Start     -> (xs, Greeting)+        Consume l -> (xs, UpdateChart l)+        End       -> ([], Finish)++-- | A data type+data Output = Output+    { outputCabalLog :: Text+    , outputEntries  :: [Entry]+    }++interactiveWorker+    :: IORef [InputAction]+    -- ^ Mutable reference to the queue of input actions+    -> ([Entry] -> Text)+    -- ^ A function to draw the chart+    -> IO [Entry]+interactiveWorker inputActionRef drawChart =+    go (Output "Profiling 'cabal build' interactively..." []) (cycle spinnerFrames)+  where     spinnerFrames :: [Text]     spinnerFrames =         [ "⠋"@@ -111,52 +137,59 @@         , "⠏"         ] -    go :: Text -> [Text] -> IO ()+    go :: Output -> [Text] -> IO [Entry]     go _ [] = do         Colourista.errorMessage $             "Panic! At the 'dr-cabal'! Impossible happened: list of frames is empty"         exitFailure-    go prevLine (frame : frames) = do-        command <- atomicModifyIORef' watchRef popAction+    go prevOutput (frame : frames) = do+        command <- nextCommand inputActionRef+         case command of             Greeting -> do-                Colourista.formattedMessage-                    [Colourista.blue, Colourista.bold]-                    "Watching cabal output..."--                go prevLine (frame : frames)-            WriteLine line -> do-                resetLine-                let l = decodeUtf8 line-                putText $ frame <> " " <> l-                hFlush stdout-                threadDelay 80_000  -- wait 80 ms to update spinner-                go l frames+                printOutput frame prevOutput prevOutput+                go prevOutput (frame : frames)+            UpdateChart line@Line{..} -> case parseLine line of+                Nothing -> do+                    let newOutput = prevOutput { outputCabalLog = decodeUtf8 lineLine }+                    printOutput frame prevOutput newOutput+                    go newOutput frames+                Just entry -> do+                    let newOutput = Output+                            { outputCabalLog = decodeUtf8 lineLine+                            , outputEntries  = outputEntries prevOutput ++ [entry]+                            }+                    printOutput frame prevOutput newOutput+                    go newOutput frames             Wait -> do-                resetLine-                putText $ frame <> " " <> prevLine-                hFlush stdout-                threadDelay 80_000  -- wait 80 ms to update spinner-                go prevLine frames-            Finish outputPath lns -> do-                writeFileLBS outputPath $ encodePretty $ linesToEntries lns-                resetLine-                putTextLn $ unlines-                    [ b "Build finished successfully!"-                    , ""-                    , "To see the profiling output, run the following command:"-                    , ""-                    , "    dr-cabal profile --input=" <> toText outputPath-                    ]+                printOutput frame prevOutput prevOutput+                go prevOutput frames -    popAction :: [WatchAction] -> ([WatchAction], WorkerCommand)-    popAction [] = ([], Wait)-    popAction (x : xs) = case x of-        Start        -> (xs, Greeting)-        Consume l    -> (xs, WriteLine l)-        End path lns -> ([], Finish path lns)+            Finish -> do+                putTextLn $ b "Build finished successfully!"+                pure $ outputEntries prevOutput -    resetLine :: IO ()-    resetLine = do-        clearLine-        setCursorColumn 0+    printOutput :: Text -> Output -> Output -> IO ()+    printOutput frame oldOutput newOutput = do+        clearPreviousOutput oldOutput+        putText $ fmtOutput frame newOutput+        hFlush stdout+        threadDelay 80_000  -- wait 80 ms to update spinner++    clearPreviousOutput :: Output -> IO ()+    clearPreviousOutput output = do+        let fakeFrame = ""+        let screenHeight = length $ lines $ fmtOutput fakeFrame output+        clearScreen screenHeight++    fmtOutput :: Text -> Output -> Text+    fmtOutput frame Output{..} =+        chart <> log+      where+        chart :: Text+        chart = case outputEntries of+            [] -> ""+            _  -> drawChart outputEntries++        log :: Text+        log = frame <> " " <> outputCabalLog