├── .envrc ├── .forgejo └── workflows │ ├── pull-from-github.yaml │ └── test.yaml ├── .github └── workflows │ ├── pull-from-forgejo.yaml │ └── test.yaml ├── .gitignore ├── .hlint.yaml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── RELEASE-CHECKLIST.md ├── bench ├── bench.sh ├── nom-shell-452e7d5.nix-log.zst ├── populate-store-for-benchmark.sh ├── profile.sh ├── scream.nix └── slow-bench.sh ├── cabal.project.local ├── completions ├── nom-build.zsh ├── nom-shell.zsh ├── nom.bash └── nom.zsh ├── default.nix ├── example-screenshot.png ├── exe └── Main.hs ├── flake.lock ├── flake.nix ├── fourmolu.yaml ├── hie.yaml ├── lib ├── Data │ └── Sequence │ │ └── Strict.hs └── NOM │ ├── Builds.hs │ ├── Error.hs │ ├── IO.hs │ ├── IO │ ├── Input.hs │ └── Input │ │ ├── JSON.hs │ │ └── OldStyle.hs │ ├── NixMessage │ ├── JSON.hs │ └── OldStyle.hs │ ├── Parser.hs │ ├── Parser │ └── JSON.hs │ ├── Print.hs │ ├── Print │ ├── Table.hs │ └── Tree.hs │ ├── State.hs │ ├── State │ ├── CacheId.hs │ ├── CacheId │ │ ├── Map.hs │ │ └── Set.hs │ ├── Sorting.hs │ └── Tree.hs │ ├── StreamParser.hs │ ├── Update.hs │ ├── Update │ ├── Monad.hs │ └── Monad │ │ └── CacheBuildReports.hs │ └── Util.hs ├── nix-output-monitor.cabal ├── renovate.json ├── test ├── Golden.hs ├── Property.hs └── golden │ ├── all.nix │ ├── default.nix │ ├── fail │ ├── default.nix │ ├── stderr │ ├── stderr.json │ ├── stdout │ └── stdout.json │ └── standard │ ├── default.nix │ ├── stderr │ ├── stderr.json │ ├── stdout │ └── stdout.json └── weeder.dhall /.envrc: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | use_flake 3 | -------------------------------------------------------------------------------- /.forgejo/workflows/pull-from-github.yaml: -------------------------------------------------------------------------------- 1 | name: Pull from GitHub 2 | on: 3 | schedule: 4 | - cron: '0 * * * *' 5 | workflow_dispatch: 6 | 7 | jobs: 8 | update: 9 | runs-on: nix 10 | 11 | steps: 12 | - uses: actions/checkout@v4 13 | - name: Pull main if fast-forward 14 | run: | 15 | git pull --ff-only https://github.com/maralorn/nix-output-monitor.git main:main 16 | git push origin main:main 17 | -------------------------------------------------------------------------------- /.forgejo/workflows/test.yaml: -------------------------------------------------------------------------------- 1 | name: Nix build 2 | on: [push] 3 | run-name: Test and build flake 4 | jobs: 5 | nix-build: 6 | runs-on: nix 7 | strategy: 8 | matrix: 9 | attribute: 10 | - default 11 | env: 12 | HOME: . 13 | steps: 14 | - uses: actions/checkout@v4 15 | - name: Configuring remote builders 16 | run: | 17 | mkdir -p ~/.config/nix 18 | cp $(builders-configurator) ~/.config/nix/machines 19 | echo "builders = @$(pwd)/.config/nix/machines" >> ~/.config/nix/nix.conf 20 | - run: nix build --log-format bar-with-logs .#${{ matrix.attribute }} -v 21 | - run: archive-nix-path 22 | nix-flake-check: 23 | runs-on: nix 24 | env: 25 | HOME: . 26 | steps: 27 | - uses: actions/checkout@v4 28 | - name: Configuring remote builders 29 | run: | 30 | mkdir -p ~/.config/nix 31 | cp $(builders-configurator) ~/.config/nix/machines 32 | echo "builders = @$(pwd)/.config/nix/machines" >> ~/.config/nix/nix.conf 33 | - run: nix flake check --log-format bar-with-logs -v 34 | -------------------------------------------------------------------------------- /.github/workflows/pull-from-forgejo.yaml: -------------------------------------------------------------------------------- 1 | name: Pull from code.maralorn.de 2 | on: 3 | schedule: 4 | - cron: '0 * * * *' 5 | workflow_dispatch: 6 | 7 | jobs: 8 | update: 9 | runs-on: ubuntu-latest 10 | 11 | steps: 12 | - uses: actions/checkout@v4 13 | - name: Pull main if fast-forward 14 | run: | 15 | git pull --ff-only https://code.maralorn.de/maralorn/nix-output-monitor.git main:main 16 | git push origin main:main 17 | -------------------------------------------------------------------------------- /.github/workflows/test.yaml: -------------------------------------------------------------------------------- 1 | name: Nix build 2 | on: [push] 3 | run-name: Test and build flake 4 | jobs: 5 | nix-build: 6 | runs-on: ubuntu-latest 7 | steps: 8 | - uses: actions/checkout@v4 9 | - uses: cachix/install-nix-action@v31 10 | - run: nix flake check 11 | - run: nix build 12 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle 2 | .direnv 3 | .pre-commit-config.yaml 4 | result* 5 | bench/profile-run-* 6 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | - ignore: {name: Avoid lambda} 2 | - ignore: {name: Avoid lambda using `infix`} 3 | - ignore: {name: Redundant irrefutable pattern} 4 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for nix-output-monitor 2 | 3 | ## 2.1.6 -- 2025-04-07 4 | 5 | * Improve finished message coloring by @Aehmlo 6 | * Switch from lock-file to filelock library 7 | * Compatibility with GHC 9.8 8 | 9 | ## 2.1.5 -- 2025-02-28 10 | 11 | * Support new activity type used in nix 12 | * Use synchronized rendering to better prevent flickering. See for more details. 13 | Note: For a list of supported Terminals see 14 | 15 | ## 2.1.4 -- 2024-10-17 16 | 17 | * bash: Add shell completion for `nom` command (thanks to @tomberek and @pdietl). 18 | * zsh: Add shell completion for `nom` and `nom-shell` command (additionally to the existing completion for `nom-build`). 19 | * Fix typo in README (thanks to @techie2000) 20 | 21 | ## 2.1.3 -- 2024-07-28 22 | 23 | * Remove non ascii characters from help message (thanks to @SandaruKasa) 24 | * Display trace/warning messages (thanks to @daniel-sampliner) 25 | * Internal: Flake updates (thanks to @SuperSandro2000) 26 | 27 | ## 2.1.2 -- 2024-01-26 28 | 29 | * Compatibility with mtl 2.3 30 | 31 | ## 2.1.1 -- 2023-11-27 32 | 33 | * Maintenance: Only use `-Werror` in CI, not in release 34 | 35 | ## 2.1.0 -- 2023-11-26 36 | 37 | * More consistent table alignment calculation (thanks to @9999years) 38 | * Alignment issues on WSL, macOS or kitty should be gone now, please report any issues you encounter 39 | * This changes the icon for waiting builds and downloads to use the pause symbol 40 | * Correct SIGINT/SIGTERM handling (thanks to @picnoir) 41 | * Use bold font in status line 42 | * Significant performance fixes 43 | 44 | ## 2.0.0.7 -- 2023-09-17 45 | 46 | * Bump hermes-json dependency to 0.6.0.0 47 | 48 | ## 2.0.0.6 -- 2023-05-14 49 | 50 | * Small improvements in error reporting. 51 | * Significant performance improvements. 52 | 53 | ## 2.0.0.5 -- 2022-11-28 54 | 55 | * Fix a bug, where nom failed to parse build errors in json mode. 56 | * Improve test suite, including regressions for this bug. 57 | 58 | ## 2.0.0.4 -- 2022-11-21 59 | 60 | * nom will now not show json parsing errors when something was not a json message from nix. #69 61 | * `nom develop` and `nom shell` will now work when the user specifies a `--command` #69 62 | * nom will now pass through lines without newline ending, when in old style piping mode. This way it can e.g. show sudo prompts. #68 63 | 64 | ## 2.0.0.3 -- 2022-10-25 65 | 66 | * Fix crash on terminal misreporting it’s size 67 | * Fix crash, when nix-command experimental feature is not enabled. 68 | * Performance improvements 69 | 70 | ## 2.0.0.2 -- 2022-10-19 71 | 72 | * Fix crash on too small windows 73 | 74 | ## 2.0.0.1 -- 2022-10-18 75 | 76 | * Fix formatting for transfer host labels. 77 | * Declutter tree: Only show timers over 1s. Reduce host label colors. 78 | 79 | ## 2.0.0.0 -- 2022-10-15 80 | 81 | ### Highlights: 82 | 83 | * **New ways to use nom**, via different aliases and options. Have a look at the README for new usage or just try `nom build`, `nom develop` or `nom-build` … 84 | * **Full support for new-style nix commands like `nix build`** and therefor also flakes. 85 | * Support for parsing the nix "internal-json" log format. This gives us much more information. 86 | * The output has been massively reworked to accommodate the new information available from json output. This includes: 87 | * Running downloads/uploads 88 | * Show current build phase (only possible for local builds). 89 | * Remote builders are displayed more economically 90 | * Build summaries have been reworked to be less overwhelming 91 | * Log output is prefixed with build job names. 92 | * Massive internal refactoring with significant performance improvements and less flickering. 93 | 94 | ### Further changes: 95 | 96 | * The algorithm to layout the rendering tree has been improved. 97 | * Improved build name display and show build platform if different from our platform. 98 | * Better error reporting. 99 | * Pause build time counter while system is suspended. 100 | * Fixed a color flickering issue in the dependency graph (thx @alyssais). 101 | * Removed some weird operators. (thx @blachheaven) 102 | * The old nom-build wrapper is obsolete and has been removed. 103 | * Updated to use ghc 9.2 with corresponding features like GHC2021 and RecordDotSyntax. 104 | * Added benchmarking and profiling scripts, to monitor performance. 105 | * Most performance improvements came from replacing aeson with json-hermes. 106 | 107 | ## 1.1.3.0 -- 2022-03-21 108 | * Update parser to correctly detect failed builds on nix 2.7 109 | 110 | ## 1.1.2.1 -- 2022-03-16 111 | * Move nom-build and zsh completion files from nixpkgs into this repo 112 | * Internal refactoring for streamly >= 0.8 and ghc 9.0 compat 113 | 114 | ## 1.1.2.0 -- 2022-03-12 115 | * Fix the bug that the colored errors of newer nix version didn‘t get parsed as errors. 116 | 117 | ## 1.1.1.0 -- 2022-03-08 118 | * Only show dependency graph when necessary 119 | * Only show build counts for host, when not zero 120 | 121 | ## 1.1.0.0 -- 2022-03-07 122 | * Replace list of running and failed builds with a continually updated dependency graph 123 | * A lot of small convenience improvements e.g. nicer timestamps 124 | * Make input parsing more robust via using streamly. This hopefully fixes #23. 125 | * Symbols: Change a few used symbols and force text representation 126 | 127 | ## 1.0.5.0 -- 2022-03-05 128 | * Make the parser for storepath accept more storepaths which actually occur in the wild. 129 | 130 | ## 1.0.4.2 -- 2022-02-25 131 | * Other fixes for relude 1.0 compat 132 | 133 | ## 1.0.4.1 -- 2022-02-25 134 | * Rename an internal variable for relude 1.0 compat 135 | 136 | ## 1.0.4.0 -- 2021-12-03 137 | * Make parsing a bit more flexible for better nix 2.4 compatibility. 138 | 139 | ## 1.0.3.3 -- 2021-09-24 140 | * Reduce flickering for some terminal emulators. Thanks @pennae 141 | 142 | ## 1.0.3.2 -- 2021-09-17 143 | * Improve warning when nom received no input, again. 144 | 145 | ## 1.0.3.1 -- 2021-04-30 146 | * Improve warning when nom received no input 147 | 148 | ## 1.0.3.0 -- 2021-03-04 149 | 150 | * Internal refactoring 151 | * State of last planned build is now displayed in bottom bar 152 | 153 | ## 1.0.2.0 -- 2021-03-04 154 | 155 | ### Bug fixes 156 | 157 | * Introduce proper file locking for build times DB. Multiple running nom instances should work now with every single build time being recorded. 158 | * Improved the parser for failed build messages. Should now correctly work with `nix-build -k`. 159 | 160 | ## 1.0.1.1 -- 2021-02-21 161 | 162 | * Use a different symbol for the total 163 | 164 | ## 1.0.1.0 -- 2021-02-21 165 | 166 | * Catch IO errors and try to restart 167 | 168 | ## 1.0.0.0 -- 2021-02-21 169 | 170 | * Added recognition of `--check` builds 171 | * Added recognition of failed builds 172 | * Display final derivation in status line 173 | * Exit with failure code when a failed build was recognized 174 | * Truncate output so that it works in too small terminal windows 175 | * Save past build times in cache and display the moving average to the user 176 | 177 | ## 0.1.0.3 -- 2021-02-20 178 | 179 | * Reworked the printing code to make it more robust 180 | 181 | ## 0.1.0.2 -- 2020-10-18 182 | 183 | * Fixed a layout bug when no builds are going on. 184 | 185 | ## 0.1.0.1 -- 2020-10-16 186 | 187 | * Changed emojis for completed to checkmark and waiting to hourglass. 188 | 189 | ## 0.1.0.0 -- 2020-10-03 190 | 191 | * First version. Released on an unsuspecting world. 192 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # nix-output-monitor 2 | 3 | Pipe your nix-build output through the nix-output-monitor (aka nom) to get additional information while building. 4 | 5 | While your build runs, nom will draw something like this at the bottom of your build log: 6 | 7 | ![](example-screenshot.png) 8 | 9 | *(note that to reduce clutter nom only shows timers over 1s build or download time.)* 10 | 11 | [![Packaging status](https://repology.org/badge/vertical-allrepos/nix-output-monitor.svg)](https://repology.org/project/nix-output-monitor/versions) 12 | 13 | ## Status 14 | 15 | This was an experiment to write something fun and useful in Haskell, which proved to be useful to quite a lot of people. 16 | By now, nom is quite fully featured with support for nix v1 commands (e.g. `nix-build`) and nix v2 command (e.g. `nix build`). 17 | At this point it seems like I will maintain nom until better UX options for nix arrive. 18 | 19 | You are free and **very welcome to contribute feedback, issues or PRs**. 20 | Issues and pull requests can be opened at **[GitHub](https://github.com/maralorn/nix-output-monitor)**. 21 | 22 | **Source and releases** are available from **[code.maralorn.de](https://code.maralorn.de/maralorn/nix-output-monitor/releases)**. 23 | Starting from version 2.1.0, nom follows the [SemVer](https://semver) versioning scheme. 24 | The versioning applies to the behavior of the executable. 25 | There are no stability guarantees for the library component in the cabal project. 26 | 27 | ## Support 28 | 29 | If your question is not answered in this README you can ask it in [#nix-output-monitor:maralorn.de](https://matrix.to/#/#nix-output-monitor:maralorn.de) on matrix or open an issue on github. 30 | 31 | ## Installing 32 | 33 | * nixpkgs: nom is in nixpkgs. Just install `pkgs.nix-output-monitor` in the usual way. You might want to install it from nixos-unstable to get the newest version. 34 | * cabal: Install `cabal-install` and run `cabal install` in the checked out repo. 35 | * nix: or use `nix build` or `nix-env` or include the flake output of this repo in your nixos config. 36 | 37 | ## Running 38 | 39 | ### The Easy Way 40 | 41 | **Warning:** The displayed build tree might be incomplete with new-style commands like `nix build` for nix versions <2.10. 42 | 43 | The `nom` binary (starting from version 2.0) behaves as a `nix` drop in, with much more colorful output, but **only** for the following commands: 44 | 45 | `nom build `: Behaves like `nix build `. 46 | `nom shell `: Behaves like `nix shell `. 47 | `nom develop `: Behaves like `nix develop `. 48 | 49 | The latter two commands work by calling `nix shell` or `nix develop` twice, the first time with overridden `--run exit` and monitoring the output, the second time passing output through to the user. This will incur a performance cost by doubling eval time. 50 | 51 | Furthermore when called via the corresponding provided symlinks, nom is also a drop-in for the following commands: 52 | `nom-build `: Behaves like `nix-build `. 53 | `nom-shell `: Behaves like `nix-shell `. 54 | 55 | All aliases internally use the json-based approach (see next section) and propagate error codes. 56 | If you want nom support for other nix commands please open an issue. 57 | 58 | ### The Flexible Way 59 | 60 | #### JSON based 61 | ```shell 62 | nix-build --log-format internal-json -v |& nom --json 63 | ``` 64 | **Warning:** Don‘t forget to redirect stderr. That's what the `&`, does. 65 | 66 | #### Human readable log parsing 67 | 68 | It his highly recommended to always append `--log-format internal-json -v` (or use the above mentioned aliases.) and call `nom` with `--json`. That will give you much more informative output. 69 | 70 | If you are in a situation, where you can‘t use the json based nix output you can still use 71 | ```shell 72 | nix-build |& nom 73 | ``` 74 | 75 | **Warning:** Don‘t forget to redirect stderr. That's what the `&`, does. 76 | 77 | This has the advantage to also work with other commands like `nixos-rebuild` or `home-manager`, where it is not trivial to pass in the `--log-format internal-json -v` flag. nom will pass everything it reads through, if it does not understand it. This makes it ideal to attach it to scripts which output more then just `nix` output. 78 | 79 | ### Preserving Colored Text 80 | 81 | Colored text will work as expected in json-mode. 82 | 83 | In human-readable log mode you can preserve the color of the redirected text by using the `unbuffer` command from the `expect` package. 84 | 85 | ```shell 86 | unbuffer nix-build |& nom 87 | ``` 88 | 89 | ## Explanation 90 | 91 | ### Legend 92 | 93 | Nom tries to convey information via symbols and colors 94 | 95 | * `⏵`, yellow: running builds 96 | * `✔`, green: completed builds 97 | * `⏸`, blue: planned builds 98 | * `⚠`, red: failed builds 99 | * `↓ ⏵`, yellow: running downloads 100 | * `↑ ⏵`, yellow: running uploads 101 | * `↓ ✔`, green: completed downloads 102 | * `↑ ✔`, green: completed uploads 103 | * `↓ ⏸`, blue: waiting downloads 104 | * `∅`: a moving average over past builds of this derivation 105 | * `⏱︎`: running time 106 | * `∑`: a summary over all packages and hosts 107 | 108 | If you can‘t see all icons you maybe need another terminal font. 109 | I recommend any font from `pkgs.nerdfonts` e.g. `"JetBrainsMono Nerd Font"`. 110 | Also different terminals might work differently well. I recommend: `pkgs.foot`. 111 | 112 | ### How to Read the Dependency Graph 113 | 114 | * Every entry in the nom tree stands for one derivation. 115 | * Children of a node are direct dependencies. 116 | * nom will try to show you the most relevant part of the dependency tree, roughly aiming to fill a third of your terminal 117 | * No build will be printed twice in the tree, it will only be shown for the lower most dependency. 118 | * nom will do it’s best to print all running or failed builds, downloads and uploads, but it does not print every direct child of a node. 119 | * Use the colors from above to read the summary 120 | 121 | ## Example Runs 122 | 123 | An example remote build: 124 | [![asciicast](https://asciinema.org/a/KwCh38ujQ9wusHw8kyW4KCMZo.svg)](https://asciinema.org/a/KwCh38ujQ9wusHw8kyW4KCMZo) 125 | 126 | An example with a lot of downloads: 127 | [![asciicast](https://asciinema.org/a/7hJXH2iFLEkKxG1lL25lspqNn.svg)](https://asciinema.org/a/7hJXH2iFLEkKxG1lL25lspqNn) 128 | 129 | ## Implementation 130 | 131 | Right now nom uses four sources of information: 132 | 133 | 1. The parsed nix-build output (json or human-readable) 134 | 2. it checks if build results exist in the nix-store (only in human-readable mode) 135 | 3. it queries `.drv` files for information about the `out` output path. 136 | 4. It caches build times in `$XDG_CACHE_HOME/nix-output-monitor/build-reports.csv`. 137 | 138 | ## Limitations 139 | 140 | * This will fail in unexpected and expected ways. 141 | * Luckily I don‘t think this program screws up anything more than your terminal. 142 | * remote builds will sometimes be shown as running even when they are actually still waiting for uploads or downloads. This is how nix reports it. 143 | * Terminal clearing and reprinting is brittle. It might fail with your terminal or terminal width. But at this point I‘ve invested some effort to make it usable. 144 | * This program also makes assumptions like your nix-store is at "/nix/store". 145 | 146 | ### For human-readable log parsing mode: 147 | * nix-output-monitor receives most it's information from parsing nix-build output. The parser might be too strict or too loose for use cases I didn‘t think of. Then **the numbers displayed will be off**! 148 | * nix-build does not show info when a download or upload is finished, so we currently cannot differentiate between started and completed downloads. 149 | * For completed build detection we assume that every derivation has an output called "out". 150 | -------------------------------------------------------------------------------- /RELEASE-CHECKLIST.md: -------------------------------------------------------------------------------- 1 | - [ ] Prepare commit with: 2 | * Bump version in nix-output-monitor.cabal 3 | * Add CHANGELOG.md entry 4 | * LOOK AT THE GIT HISTORY FOR THIS 5 | * Run pre-commit to account for updated default.nix 6 | - [ ] Create release on code.maralorn.de 7 | * tag: v 8 | * title: 9 | * Description: Copy CHANGELOG.md entry 10 | - [ ] Bump in nixpkgs 11 | -------------------------------------------------------------------------------- /bench/bench.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | bench/populate-store-for-benchmark.sh 3 | zstd -d < bench/nom-shell-452e7d5.nix-log.zst | cabal run -- nom --json +RTS -s 4 | -------------------------------------------------------------------------------- /bench/nom-shell-452e7d5.nix-log.zst: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maralorn/nix-output-monitor/2d82c7c6011bb08ce2de6817f00b3f1b6aee09f6/bench/nom-shell-452e7d5.nix-log.zst -------------------------------------------------------------------------------- /bench/populate-store-for-benchmark.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | nom build '.?rev=452e7d5330b94afbe93b0910fc6afac0170551ad#devShells.x86_64-linux.default' 3 | -------------------------------------------------------------------------------- /bench/profile.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -eu 4 | FOLDER="bench/profile-run-$(date +'%Y-%m-%d-%H:%M:%S')" 5 | mkdir -p "$FOLDER" 6 | git show --oneline -q > "$FOLDER/git-status" 7 | git status >> "$FOLDER/git-status" 8 | git diff >> "$FOLDER/git-status" 9 | zstd -d < bench/nom-shell-452e7d5.nix-log.zst | cabal run --enable-profiling --ghc-option "-rtsopts" -- nom --json +RTS -i0.01 -l -pj -hd "-s$FOLDER/allocations" 10 | mv nom.eventlog "$FOLDER/eventlog" 11 | mv nom.prof "$FOLDER/prof.json" 12 | eventlog2html "$FOLDER/eventlog" 13 | #hs-speedscope "$FOLDER/eventlog" 14 | echo See results in "$FOLDER/prof.json" 15 | -------------------------------------------------------------------------------- /bench/scream.nix: -------------------------------------------------------------------------------- 1 | { 2 | pkgs ? (import { }), 3 | }: 4 | pkgs.stdenv.mkDerivation { 5 | name = "robot-that-screams"; 6 | buildCommand = '' 7 | for _ in {0..1000000}; do 8 | echo AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 9 | done 10 | ''; 11 | } 12 | -------------------------------------------------------------------------------- /bench/slow-bench.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | zstd -d < bench/nom-shell-452e7d5.nix-log.zst | pv --quiet --line-mode --rate-limit 20000 | cabal run -- nom --json +RTS -s 3 | -------------------------------------------------------------------------------- /cabal.project.local: -------------------------------------------------------------------------------- 1 | package * 2 | ghc-options: -fwrite-ide-info 3 | constraints: relude >=1.0.0.0 4 | allow-newer: *:base, *:ghc-prim 5 | ignore-project: False 6 | -------------------------------------------------------------------------------- /completions/nom-build.zsh: -------------------------------------------------------------------------------- 1 | #compdef nom-build 2 | compdef nom-build=nix-build 3 | -------------------------------------------------------------------------------- /completions/nom-shell.zsh: -------------------------------------------------------------------------------- 1 | #compdef nom-shell 2 | compdef nom-shell=nix-shell 3 | -------------------------------------------------------------------------------- /completions/nom.bash: -------------------------------------------------------------------------------- 1 | __load_completion nix 2 | complete -F _complete_nix nom 3 | -------------------------------------------------------------------------------- /completions/nom.zsh: -------------------------------------------------------------------------------- 1 | #compdef nom 2 | 3 | # File copied from github.com/nixos/nix/misc/zsh/completion.zsh and adapted for nom 4 | 5 | function _nom() { 6 | local ifs_bk="$IFS" 7 | local input=("${(Q)words[@]}") 8 | IFS=$'\n' 9 | local res=($(NIX_GET_COMPLETIONS=$((CURRENT - 1)) "$input[@]" 2>/dev/null)) 10 | IFS="$ifs_bk" 11 | local tpe="${${res[1]}%%> *}" 12 | local -a suggestions 13 | declare -a suggestions 14 | for suggestion in ${res:1}; do 15 | suggestions+=("${suggestion%% *}") 16 | done 17 | local -a args 18 | if [[ "$tpe" == filenames ]]; then 19 | args+=('-f') 20 | elif [[ "$tpe" == attrs ]]; then 21 | args+=('-S' '') 22 | fi 23 | compadd -J nom "${args[@]}" -a suggestions 24 | } 25 | 26 | _nom "$@" 27 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, ansi-terminal, async, attoparsec, base, bytestring 2 | , cassava, containers, directory, extra, filelock, filepath 3 | , hermes-json, HUnit, lib, MemoTrie, nix-derivation, optics, random 4 | , relude, safe, safe-exceptions, stm, streamly-core, strict 5 | , strict-types, terminal-size, text, time, transformers 6 | , typed-process, unix, word8 7 | }: 8 | mkDerivation { 9 | pname = "nix-output-monitor"; 10 | version = "2.1.6"; 11 | src = ./.; 12 | isLibrary = true; 13 | isExecutable = true; 14 | libraryHaskellDepends = [ 15 | ansi-terminal async attoparsec base bytestring cassava containers 16 | directory extra filelock filepath hermes-json MemoTrie 17 | nix-derivation optics relude safe safe-exceptions stm streamly-core 18 | strict strict-types terminal-size text time transformers word8 19 | ]; 20 | executableHaskellDepends = [ 21 | ansi-terminal async attoparsec base bytestring cassava containers 22 | directory extra filelock filepath hermes-json MemoTrie 23 | nix-derivation optics relude safe safe-exceptions stm streamly-core 24 | strict strict-types terminal-size text time transformers 25 | typed-process unix word8 26 | ]; 27 | testHaskellDepends = [ 28 | ansi-terminal async attoparsec base bytestring cassava containers 29 | directory extra filelock filepath hermes-json HUnit MemoTrie 30 | nix-derivation optics random relude safe safe-exceptions stm 31 | streamly-core strict strict-types terminal-size text time 32 | transformers typed-process word8 33 | ]; 34 | homepage = "https://code.maralorn.de/maralorn/nix-output-monitor"; 35 | description = "Processes output of Nix commands to show helpful and pretty information"; 36 | license = lib.licenses.agpl3Plus; 37 | mainProgram = "nom"; 38 | } 39 | -------------------------------------------------------------------------------- /example-screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maralorn/nix-output-monitor/2d82c7c6011bb08ce2de6817f00b3f1b6aee09f6/example-screenshot.png -------------------------------------------------------------------------------- /exe/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Control.Concurrent (ThreadId, myThreadId, throwTo) 4 | import Control.Exception qualified as Exception 5 | import Control.Monad.Trans.Writer.CPS (runWriterT) 6 | import Data.ByteString qualified as ByteString 7 | import Data.IORef qualified as IORef 8 | import Data.Text.IO (hPutStrLn) 9 | import Data.Time (ZonedTime) 10 | import Data.Version (showVersion) 11 | import GHC.IO.Exception (ExitCode (ExitFailure)) 12 | import NOM.Error (NOMError) 13 | import NOM.IO (interact) 14 | import NOM.IO.Input (NOMInput (..), UpdateResult (..)) 15 | import NOM.IO.Input.JSON () 16 | import NOM.IO.Input.OldStyle (OldStyleInput) 17 | import NOM.NixMessage.JSON (NixJSONMessage) 18 | import NOM.Print (Config (..), stateToText) 19 | import NOM.Print.Table (markup, red) 20 | import NOM.State (DependencySummary (..), NOMV1State (..), ProgressState (..), initalStateFromBuildPlatform) 21 | import NOM.State.CacheId.Map qualified as CMap 22 | import NOM.Update (detectLocalFinishedBuilds, maintainState) 23 | import NOM.Update.Monad (UpdateMonad) 24 | import Optics (gfield, (%), (%~), (.~), (^.)) 25 | import Paths_nix_output_monitor (version) 26 | import Relude 27 | import System.Console.ANSI qualified as Terminal 28 | import System.Console.Terminal.Size (Window) 29 | import System.Environment qualified as Environment 30 | import System.IO.Error qualified as IOError 31 | import System.Posix.Signals qualified as Signals 32 | import System.Process.Typed (proc, runProcess) 33 | import System.Process.Typed qualified as Process 34 | import Type.Strict qualified as StrictType 35 | 36 | type MainThreadId = ThreadId 37 | 38 | outputHandle :: Handle 39 | outputHandle = stderr 40 | 41 | defaultConfig :: Config 42 | defaultConfig = 43 | MkConfig 44 | { piping = False 45 | , silent = False 46 | } 47 | 48 | replaceCommandWithExit :: [String] -> [String] 49 | replaceCommandWithExit = (<> ["--command", "sh", "-c", "exit"]) . takeWhile (\x -> x /= "--command" && x /= "-c") 50 | 51 | knownSubCommands :: [String] 52 | knownSubCommands = ["build", "shell", "develop"] 53 | 54 | knownFlags :: [String] 55 | knownFlags = ["--version", "-h", "--help", "--json"] 56 | 57 | withJSON :: [String] -> [String] 58 | withJSON x = "-v" : "--log-format" : "internal-json" : x 59 | 60 | main :: IO Void 61 | main = do 62 | installSignalHandlers 63 | 64 | prog_name <- Environment.getProgName 65 | args <- Environment.getArgs 66 | 67 | lookupEnv "NIX_GET_COMPLETIONS" >>= \case 68 | Just _ -> printNixCompletion prog_name args 69 | Nothing -> runApp prog_name args 70 | 71 | runApp :: String -> [String] -> IO Void 72 | runApp = \cases 73 | _ ["--version"] -> do 74 | hPutStrLn stderr ("nix-output-monitor " <> fromString (showVersion version)) 75 | exitWith =<< runProcess (proc "nix" ["--version"]) 76 | "nom-build" args -> exitWith =<< runMonitoredCommand defaultConfig (proc "nix-build" (withJSON args)) 77 | "nom-shell" args -> do 78 | exitOnFailure =<< runMonitoredCommand defaultConfig{silent = True} (proc "nix-shell" (withJSON args <> ["--run", "exit"])) 79 | exitWith =<< runProcess (proc "nix-shell" args) 80 | "nom" ("build" : args) -> exitWith =<< runMonitoredCommand defaultConfig (proc "nix" ("build" : withJSON args)) 81 | "nom" ("shell" : args) -> do 82 | exitOnFailure =<< runMonitoredCommand defaultConfig{silent = True} (proc "nix" ("shell" : withJSON (replaceCommandWithExit args))) 83 | exitWith =<< runProcess (proc "nix" ("shell" : args)) 84 | "nom" ("develop" : args) -> do 85 | exitOnFailure =<< runMonitoredCommand defaultConfig{silent = True} (proc "nix" ("develop" : withJSON (replaceCommandWithExit args))) 86 | exitWith =<< runProcess (proc "nix" ("develop" : args)) 87 | "nom" [] -> do 88 | finalState <- monitorHandle @OldStyleInput defaultConfig{piping = True} stdin 89 | if CMap.size finalState.fullSummary.failedBuilds + length finalState.nixErrors == 0 90 | then exitSuccess 91 | else exitFailure 92 | "nom" ["--json"] -> do 93 | finalState <- monitorHandle @NixJSONMessage defaultConfig{piping = True} stdin 94 | if CMap.size finalState.fullSummary.failedBuilds + length finalState.nixErrors == 0 95 | then exitSuccess 96 | else exitFailure 97 | _ xs -> do 98 | hPutStrLn stderr helpText 99 | -- It's not a mistake if the user requests the help text, otherwise tell 100 | -- them off with a non-zero exit code. 101 | if any (liftA2 (||) (== "-h") (== "--help")) xs then exitSuccess else exitFailure 102 | 103 | printNixCompletion :: String -> [String] -> IO Void 104 | printNixCompletion = \cases 105 | "nom" [input] -> do 106 | putStrLn "normal" 107 | mapM_ putStrLn $ findMatches input (knownSubCommands <> knownFlags) 108 | exitSuccess 109 | "nom" args@(sub_cmd : _) 110 | | sub_cmd `elem` knownSubCommands -> 111 | exitWith =<< Process.runProcess (Process.proc "nix" args) 112 | prog args -> do 113 | putTextLn $ "No completion support for " <> unwords (toText <$> prog : args) 114 | exitFailure 115 | 116 | findMatches :: String -> [String] -> [String] 117 | findMatches input = filter (input `isPrefixOf`) 118 | 119 | installSignalHandlers :: IO () 120 | installSignalHandlers = do 121 | mainThreadId <- myThreadId >>= IORef.newIORef 122 | _ <- Signals.installHandler Signals.sigTERM (Signals.CatchInfo $ quitSignalHandler mainThreadId) Nothing 123 | _ <- Signals.installHandler Signals.sigINT (Signals.CatchInfo $ quitSignalHandler mainThreadId) Nothing 124 | pass 125 | 126 | quitSignalHandler :: IORef MainThreadId -> Signals.SignalInfo -> IO () 127 | quitSignalHandler iomtid _ = do 128 | mtid <- IORef.readIORef iomtid 129 | Terminal.hShowCursor outputHandle 130 | -- The RTS runtime kills for us the sub-threads when the main thread 131 | -- is terminated. 132 | throwTo mtid $ ExitFailure 1 133 | 134 | exitOnFailure :: Process.ExitCode -> IO () 135 | exitOnFailure = \case 136 | code@Process.ExitFailure{} -> exitWith code 137 | _ -> pass 138 | 139 | printIOException :: IOError.IOError -> IO () 140 | printIOException io_exception = do 141 | let error_msg = case (IOError.isDoesNotExistError io_exception, IOError.ioeGetFileName io_exception) of 142 | (True, Just cmd) -> "Command '" <> toText cmd <> "' not available from $PATH." 143 | _ -> show io_exception 144 | hPutStrLn stderr $ markup red ("nix-output-monitor: " <> error_msg) 145 | 146 | runMonitoredCommand :: Config -> Process.ProcessConfig () () () -> IO Process.ExitCode 147 | runMonitoredCommand config process_config = do 148 | let process_config_with_handles = 149 | Process.setStdout Process.createPipe 150 | . Process.setStderr Process.createPipe 151 | $ process_config 152 | Exception.handle ((ExitFailure 1 <$) . printIOException) 153 | $ Process.withProcessWait process_config_with_handles \process -> do 154 | void $ monitorHandle @NixJSONMessage config (Process.getStderr process) 155 | exitCode <- Process.waitExitCode process 156 | output <- ByteString.hGetContents (Process.getStdout process) 157 | unless (ByteString.null output) $ ByteString.hPut stdout output 158 | pure exitCode 159 | 160 | data ProcessState a = MkProcessState 161 | { updaterState :: UpdaterState a 162 | , printFunction :: Maybe (Window Int) -> (ZonedTime, Double) -> Text 163 | } 164 | deriving stock (Generic) 165 | 166 | monitorHandle :: forall a. (StrictType.Strict (UpdaterState a), NOMInput a) => Config -> Handle -> IO NOMV1State 167 | monitorHandle config input_handle = withParser @a \streamParser -> do 168 | finalState <- 169 | do 170 | Terminal.hHideCursor outputHandle 171 | hSetBuffering stdout (BlockBuffering (Just 1_000_000)) 172 | 173 | current_system <- Exception.handle ((Nothing <$) . printIOException) $ Just . decodeUtf8 <$> Process.readProcessStdout_ (Process.proc "nix" ["eval", "--extra-experimental-features", "nix-command", "--impure", "--raw", "--expr", "builtins.currentSystem"]) 174 | first_state <- initalStateFromBuildPlatform current_system 175 | -- We enforce here, that the state type is completely strict so that we don‘t accumulate thunks while running the program. 176 | let first_process_state = MkProcessState (StrictType.Strict $ firstState @a first_state) (stateToText config first_state) 177 | interact config streamParser (processStateUpdater @a config) (\now -> gfield @"updaterState" % nomState @a %~ maintainState now) (.printFunction) (finalizer config) (inputStream @a input_handle) outputHandle first_process_state 178 | `Exception.finally` do 179 | Terminal.hShowCursor outputHandle 180 | ByteString.hPut outputHandle "\n" -- We print a new line after finish, because in normal nom state the last line is not empty. 181 | pure (finalState.updaterState ^. nomState @a) 182 | 183 | {-# INLINE processStateUpdater #-} 184 | processStateUpdater :: 185 | forall a m. 186 | (NOMInput a, UpdateMonad m) => 187 | Config -> 188 | a -> 189 | StateT (ProcessState a) m ([NOMError], ByteString, Bool) 190 | processStateUpdater config input = do 191 | old_state <- get 192 | updater_result <- updateState input old_state.updaterState 193 | put 194 | MkProcessState 195 | { updaterState = updater_result.newState 196 | , printFunction = maybe old_state.printFunction (stateToText config) updater_result.newStateToPrint 197 | } 198 | pure 199 | ( updater_result.errors 200 | , updater_result.output 201 | , not (null updater_result.errors) 202 | || not (ByteString.null updater_result.output) 203 | || isJust updater_result.newStateToPrint 204 | ) 205 | 206 | finalizer :: 207 | forall a m. 208 | (NOMInput a, UpdateMonad m) => 209 | Config -> 210 | StateT (ProcessState a) m () 211 | finalizer config = do 212 | old_state <- get 213 | newState <- (gfield @"progressState" .~ Finished) <$> execStateT (runWriterT detectLocalFinishedBuilds) (old_state.updaterState ^. nomState @a) 214 | put 215 | MkProcessState 216 | { updaterState = nomState @a .~ newState $ old_state.updaterState 217 | , printFunction = stateToText config newState 218 | } 219 | 220 | helpText :: Text 221 | helpText = 222 | unlines 223 | [ "nix-output-monitor usages:" 224 | , " Wrappers:" 225 | , " nom build " 226 | , " nom shell " 227 | , " nom develop " 228 | , "" 229 | , " nom-build " 230 | , " nom-shell " 231 | , "" 232 | , " Direct piping:" 233 | , " via json parsing:" 234 | , " nix build --log-format internal-json -v |& nom --json" 235 | , " nix-build --log-format internal-json -v |& nom --json" 236 | , "" 237 | , " via human-readable log parsing:" 238 | , " nix-build |& nom" 239 | , "" 240 | , " Don't forget to redirect stderr, too. That's what the & does." 241 | , "" 242 | , "Flags:" 243 | , " --version Show version." 244 | , " -h, --help Show this help." 245 | , " --json Parse input as nix internal-json" 246 | , "" 247 | , "Please see the readme for more details:" 248 | , "https://code.maralorn.de/maralorn/nix-output-monitor#readme" 249 | ] 250 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-compat": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1696426674, 7 | "narHash": "sha256-kvjfFW7WAETZlt09AgDn1MrtKzP7t90Vf7vypd3OL1U=", 8 | "owner": "edolstra", 9 | "repo": "flake-compat", 10 | "rev": "0f9255e01c2351cc7d116c072cb317785dd33b33", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "edolstra", 15 | "repo": "flake-compat", 16 | "type": "github" 17 | } 18 | }, 19 | "flake-utils": { 20 | "inputs": { 21 | "systems": "systems" 22 | }, 23 | "locked": { 24 | "lastModified": 1731533236, 25 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 26 | "owner": "numtide", 27 | "repo": "flake-utils", 28 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 29 | "type": "github" 30 | }, 31 | "original": { 32 | "id": "flake-utils", 33 | "type": "indirect" 34 | } 35 | }, 36 | "git-hooks": { 37 | "inputs": { 38 | "flake-compat": "flake-compat", 39 | "gitignore": "gitignore", 40 | "nixpkgs": [ 41 | "nixpkgs" 42 | ] 43 | }, 44 | "locked": { 45 | "lastModified": 1747372754, 46 | "narHash": "sha256-2Y53NGIX2vxfie1rOW0Qb86vjRZ7ngizoo+bnXU9D9k=", 47 | "owner": "cachix", 48 | "repo": "git-hooks.nix", 49 | "rev": "80479b6ec16fefd9c1db3ea13aeb038c60530f46", 50 | "type": "github" 51 | }, 52 | "original": { 53 | "owner": "cachix", 54 | "repo": "git-hooks.nix", 55 | "type": "github" 56 | } 57 | }, 58 | "gitignore": { 59 | "inputs": { 60 | "nixpkgs": [ 61 | "git-hooks", 62 | "nixpkgs" 63 | ] 64 | }, 65 | "locked": { 66 | "lastModified": 1709087332, 67 | "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=", 68 | "owner": "hercules-ci", 69 | "repo": "gitignore.nix", 70 | "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", 71 | "type": "github" 72 | }, 73 | "original": { 74 | "owner": "hercules-ci", 75 | "repo": "gitignore.nix", 76 | "type": "github" 77 | } 78 | }, 79 | "nixpkgs": { 80 | "locked": { 81 | "lastModified": 1748693115, 82 | "narHash": "sha256-StSrWhklmDuXT93yc3GrTlb0cKSS0agTAxMGjLKAsY8=", 83 | "owner": "NixOS", 84 | "repo": "nixpkgs", 85 | "rev": "910796cabe436259a29a72e8d3f5e180fc6dfacc", 86 | "type": "github" 87 | }, 88 | "original": { 89 | "id": "nixpkgs", 90 | "ref": "nixos-unstable", 91 | "type": "indirect" 92 | } 93 | }, 94 | "root": { 95 | "inputs": { 96 | "flake-utils": "flake-utils", 97 | "git-hooks": "git-hooks", 98 | "nixpkgs": "nixpkgs" 99 | } 100 | }, 101 | "systems": { 102 | "locked": { 103 | "lastModified": 1681028828, 104 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 105 | "owner": "nix-systems", 106 | "repo": "default", 107 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 108 | "type": "github" 109 | }, 110 | "original": { 111 | "owner": "nix-systems", 112 | "repo": "default", 113 | "type": "github" 114 | } 115 | } 116 | }, 117 | "root": "root", 118 | "version": 7 119 | } 120 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "nix-output-monitor"; 3 | inputs = { 4 | nixpkgs.url = "nixpkgs/nixos-unstable"; 5 | git-hooks = { 6 | url = "github:cachix/git-hooks.nix"; 7 | inputs.nixpkgs.follows = "nixpkgs"; 8 | }; 9 | }; 10 | outputs = 11 | { 12 | self, 13 | nixpkgs, 14 | flake-utils, 15 | git-hooks, 16 | ... 17 | }: 18 | flake-utils.lib.eachDefaultSystem ( 19 | system: 20 | let 21 | inherit (nixpkgs.legacyPackages.${system}) 22 | lib 23 | haskell 24 | pkgs 25 | haskellPackages 26 | ; 27 | hlib = (_: haskell.lib.compose) system; 28 | golden-tests = import ./test/golden/all.nix; 29 | cleanSelf = lib.sourceFilesBySuffices self [ 30 | ".hs" 31 | ".cabal" 32 | "stderr" 33 | "stdout" 34 | "stderr.json" 35 | "stdout.json" 36 | ".zsh" 37 | ".bash" 38 | "LICENSE" 39 | "CHANGELOG.md" 40 | "default.nix" 41 | ]; 42 | in 43 | rec { 44 | packages = { 45 | default = lib.pipe { } [ 46 | (haskellPackages.callPackage self) 47 | haskellPackages.buildFromCabalSdist 48 | hlib.justStaticExecutables 49 | (hlib.appendConfigureFlag "--ghc-option=-Werror --ghc-option=-Wno-error=unrecognised-warning-flags") 50 | 51 | (hlib.overrideCabal { 52 | src = cleanSelf; 53 | doCheck = system == "x86_64-linux"; 54 | preCheck = '' 55 | # ${lib.concatStringsSep ", " (golden-tests ++ map (x: x.drvPath) golden-tests)} 56 | export TESTS_FROM_FILE=true; 57 | ''; 58 | buildTools = [ pkgs.installShellFiles ]; 59 | postInstall = '' 60 | ln -s nom "$out/bin/nom-build" 61 | ln -s nom "$out/bin/nom-shell" 62 | chmod a+x $out/bin/nom-shell 63 | installShellCompletion completions/* 64 | ''; 65 | }) 66 | ]; 67 | }; 68 | checks = { 69 | git-hooks-check = git-hooks.lib.${system}.run { 70 | src = ./.; 71 | tools = { 72 | fourmolu = lib.mkForce (lib.getBin pkgs.haskellPackages.fourmolu); 73 | cabal-gild = lib.mkForce (lib.getBin pkgs.haskellPackages.cabal-gild); 74 | }; 75 | hooks = { 76 | hlint.enable = true; 77 | nixfmt-rfc-style = { 78 | excludes = [ "default.nix" ]; 79 | enable = true; 80 | }; 81 | cabal2nix.enable = true; 82 | nil.enable = true; 83 | editorconfig-checker = { 84 | excludes = [ ".*\\.md" ]; 85 | enable = true; 86 | }; 87 | deadnix.enable = true; 88 | statix.enable = true; 89 | fourmolu.enable = true; 90 | ormolu.settings.defaultExtensions = [ 91 | "TypeApplications" 92 | "BangPatterns" 93 | "ImportQualifiedPost" 94 | "BlockArguments" 95 | ]; 96 | shellcheck = { 97 | enable = true; 98 | excludes = [ "\\.zsh" ]; 99 | }; 100 | cabal-gild.enable = true; 101 | }; 102 | }; 103 | }; 104 | devShells.default = haskellPackages.shellFor { 105 | packages = _: [ packages.default ]; 106 | buildInputs = [ 107 | git-hooks.packages.${system}.default 108 | pkgs.haskell-language-server 109 | (lib.getBin pkgs.haskellPackages.weeder) 110 | pkgs.cabal-install 111 | pkgs.pv 112 | ]; 113 | withHoogle = true; 114 | inherit (self.checks.${system}.git-hooks-check) shellHook; 115 | }; 116 | } 117 | ); 118 | } 119 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | indentation: 2 2 | unicode: never 3 | respectful: false 4 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | -------------------------------------------------------------------------------- /lib/Data/Sequence/Strict.hs: -------------------------------------------------------------------------------- 1 | module Data.Sequence.Strict ( 2 | Seq.sortOn, 3 | Seq.filter, 4 | (<|), 5 | Data.Sequence.Strict.fromList, 6 | Seq.null, 7 | Seq.length, 8 | Seq ((Seq.:<|)), 9 | ) where 10 | 11 | import Data.Sequence qualified as Seq 12 | import Relude 13 | 14 | (<|) :: a -> Seq a -> Seq a 15 | !item <| rest = item Seq.<| rest 16 | 17 | fromList :: [a] -> Seq.Seq a 18 | fromList = foldr (<|) mempty 19 | -------------------------------------------------------------------------------- /lib/NOM/Builds.hs: -------------------------------------------------------------------------------- 1 | module NOM.Builds (parseHost, Derivation (..), StorePath (..), Host (..), FailType (..), parseStorePath, parseDerivation, storePathByteStringParser, derivationByteStringParser, parseIndentedStoreObject) where 2 | 3 | import Data.Attoparsec.ByteString qualified as Parser 4 | import Data.Attoparsec.ByteString.Char8 qualified as Parser.Char 5 | import Data.Attoparsec.Text qualified as TextParser 6 | import Data.Text qualified as Text 7 | import Relude 8 | 9 | data StorePath = StorePath 10 | { hash :: Text 11 | , name :: Text 12 | } 13 | deriving stock (Show, Ord, Eq, Generic) 14 | 15 | storePathByteStringParser :: Parser.Parser StorePath 16 | storePathByteStringParser = 17 | StorePath 18 | . decodeUtf8 19 | <$> (Parser.string storePrefixBS *> Parser.take 32) 20 | <*> (decodeUtf8 <$> (Parser.Char.char '-' *> Parser.takeWhile (Parser.inClass "a-zA-Z0-9?=_.+-"))) 21 | 22 | derivationByteStringParser :: Parser.Parser Derivation 23 | derivationByteStringParser = 24 | storePathByteStringParser >>= storePathToDerivation 25 | 26 | storePathTextParser :: TextParser.Parser StorePath 27 | storePathTextParser = 28 | StorePath 29 | <$> (TextParser.string storePrefix *> TextParser.take 32) 30 | <*> (TextParser.char '-' *> TextParser.takeWhile (TextParser.inClass "a-zA-Z0-9?=_.+-")) 31 | 32 | derivationTextParser :: TextParser.Parser Derivation 33 | derivationTextParser = 34 | storePathTextParser >>= storePathToDerivation 35 | 36 | storePathToDerivation :: (MonadFail m) => StorePath -> m Derivation 37 | storePathToDerivation path = case Text.stripSuffix ".drv" path.name of 38 | Just realName -> pure $ Derivation $ path{name = realName} 39 | Nothing -> fail "StorePath is not a derivation." 40 | 41 | indentedStoreObjectTextParser :: TextParser.Parser (Either Derivation StorePath) 42 | indentedStoreObjectTextParser = 43 | ( StorePath 44 | <$> (TextParser.string (" " <> storePrefix) *> TextParser.take 32) 45 | <*> (TextParser.char '-' *> TextParser.takeText) 46 | ) 47 | <&> \path -> case storePathToDerivation path of 48 | Just drv -> Left drv 49 | Nothing -> Right path 50 | 51 | parseDerivation :: (MonadFail m) => Text -> m Derivation 52 | parseDerivation = either fail pure . TextParser.parseOnly (derivationTextParser <* TextParser.endOfInput) 53 | 54 | parseStorePath :: (MonadFail m) => Text -> m StorePath 55 | parseStorePath = either fail pure . TextParser.parseOnly (storePathTextParser <* TextParser.endOfInput) 56 | 57 | parseIndentedStoreObject :: (MonadFail m) => Text -> m (Either Derivation StorePath) 58 | parseIndentedStoreObject = either fail pure . TextParser.parseOnly indentedStoreObjectTextParser 59 | 60 | parseHost :: Text -> Host 61 | parseHost = \case 62 | "" -> Localhost 63 | "local" -> Localhost 64 | host -> Host host 65 | 66 | newtype Derivation = Derivation {storePath :: StorePath} 67 | deriving stock (Show, Generic) 68 | deriving newtype (Eq, Ord) 69 | 70 | instance ToText Derivation where 71 | toText drv = toText drv.storePath <> ".drv" 72 | 73 | instance ToString Derivation where 74 | toString = toString . toText 75 | 76 | storePrefixBS :: ByteString 77 | storePrefixBS = encodeUtf8 storePrefix 78 | 79 | storePrefix :: Text 80 | storePrefix = "/nix/store/" 81 | 82 | instance ToText StorePath where 83 | toText path = storePrefix <> path.hash <> "-" <> path.name 84 | 85 | instance ToString StorePath where 86 | toString = toString . toText 87 | 88 | data Host = Localhost | Host Text 89 | deriving stock (Ord, Eq, Show, Generic) 90 | 91 | instance ToText Host where 92 | toText (Host name) = name 93 | toText Localhost = "localhost" 94 | 95 | instance ToString Host where 96 | toString = toString . toText 97 | 98 | data FailType = ExitCode Int | HashMismatch 99 | deriving stock (Show, Eq, Ord, Generic) 100 | -------------------------------------------------------------------------------- /lib/NOM/Error.hs: -------------------------------------------------------------------------------- 1 | module NOM.Error (NOMError (..)) where 2 | 3 | import Control.Exception (IOException) 4 | import Relude 5 | 6 | data NOMError 7 | = InputError IOException 8 | | DerivationReadError IOException 9 | | DerivationParseError Text 10 | | ParseNixJSONMessageError Text ByteString 11 | deriving stock (Show, Eq) 12 | -------------------------------------------------------------------------------- /lib/NOM/IO.hs: -------------------------------------------------------------------------------- 1 | module NOM.IO (interact, processTextStream, StreamParser, Stream) where 2 | 3 | import Control.Concurrent (threadDelay) 4 | import Control.Concurrent.Async (concurrently_, race_) 5 | import Control.Concurrent.STM (check, swapTVar) 6 | import Data.ByteString qualified as ByteString 7 | import Data.ByteString.Builder qualified as Builder 8 | import Data.ByteString.Char8 qualified as ByteString 9 | import Data.Text qualified as Text 10 | import Data.Time (ZonedTime, getZonedTime) 11 | import NOM.Error (NOMError) 12 | import NOM.Print (Config (..)) 13 | import NOM.Print.Table as Table (bold, displayWidth, displayWidthBS, markup, red, truncate) 14 | import NOM.Update.Monad (UpdateMonad, getNow) 15 | import Relude 16 | import Streamly.Data.Fold qualified as Fold 17 | import Streamly.Data.Stream qualified as Stream 18 | import System.Console.ANSI (SGR (Reset), setSGRCode) 19 | import System.Console.ANSI qualified as Terminal 20 | import System.Console.Terminal.Size qualified as Terminal.Size 21 | import System.IO qualified 22 | 23 | type Stream = Stream.Stream IO 24 | 25 | type StreamParser update = Stream ByteString -> Stream update 26 | 27 | type Output = Text 28 | 29 | type UpdateFunc update state = forall m. (UpdateMonad m) => update -> StateT state m ([NOMError], ByteString, Bool) 30 | 31 | type OutputFunc state = state -> Maybe Window -> (ZonedTime, Double) -> Output 32 | 33 | type Finalizer state = forall m. (UpdateMonad m) => StateT state m () 34 | 35 | type Window = Terminal.Size.Window Int 36 | 37 | runUpdate :: 38 | forall update state. 39 | TVar [ByteString] -> 40 | TMVar state -> 41 | TVar Bool -> 42 | UpdateFunc update state -> 43 | update -> 44 | IO () 45 | runUpdate output_builder_var state_var refresh_display_var updater input = do 46 | -- Since we are taking the state_var here we prevent any other state update 47 | -- to happen simultaneously. 48 | old_state <- atomically $ takeTMVar state_var 49 | ((errors, log_output, display_changed), !newState) <- runStateT (updater input) old_state 50 | atomically $ do 51 | forM_ errors (writeErrorToBuilder output_builder_var) 52 | putTMVar state_var newState 53 | unless (ByteString.null log_output) do 54 | modifyTVar' output_builder_var (log_output :) 55 | modifyTVar' refresh_display_var (|| display_changed) 56 | 57 | -- https://gitlab.com/gnachman/iterm2/-/wikis/synchronized-updates-spec 58 | startAtomicUpdate, endAtomicUpdate :: Builder.Builder 59 | startAtomicUpdate = "\x1b[?2026h" 60 | endAtomicUpdate = "\x1b[?2026l" 61 | 62 | writeStateToScreen :: 63 | forall state. 64 | Bool -> 65 | TVar Int -> 66 | TMVar state -> 67 | TVar [ByteString] -> 68 | TVar Bool -> 69 | (Double -> state -> state) -> 70 | OutputFunc state -> 71 | Handle -> 72 | IO () 73 | writeStateToScreen pad printed_lines_var nom_state_var nix_output_buffer_var refresh_display_var maintenance printer output_handle = do 74 | nowClock <- getZonedTime 75 | now <- getNow 76 | terminalSize <- 77 | Terminal.Size.hSize output_handle <&> \case 78 | -- We throw away non positive window sizes, which some terminals apparently report 79 | -- to avoid divisions by zero later on. 80 | val@(Just window) | window.width > 0, window.height > 0 -> val 81 | _ -> Nothing 82 | 83 | (nom_state, nix_output_raw) <- atomically do 84 | -- ==== Time Critical Segment - calculating to much in atomically can lead 85 | -- to recalculations. In this section we are racing with the input parsing 86 | -- thread to update the state. 87 | -- we bind those lazily to not calculate them during the STM transaction 88 | nom_state <- maintenance now <$> takeTMVar nom_state_var 89 | putTMVar nom_state_var nom_state 90 | 91 | writeTVar refresh_display_var False 92 | 93 | nix_output_raw <- swapTVar nix_output_buffer_var [] 94 | pure (nom_state, nix_output_raw) 95 | -- ==== 96 | 97 | let nix_output = ByteString.lines $ ByteString.concat $ reverse nix_output_raw 98 | nix_output_length = length nix_output 99 | 100 | nom_output = ByteString.lines $ encodeUtf8 $ truncateOutput terminalSize (printer nom_state terminalSize (nowClock, now)) 101 | nom_output_length = length nom_output 102 | 103 | -- We will try to calculate how many lines we can draw without reaching the end 104 | -- of the screen so that we can avoid flickering redraws triggered by 105 | -- printing a newline. 106 | -- For the output passed through from Nix the lines could be to long leading 107 | -- to reflow by the terminal and therefor messing with our line count. 108 | -- We try to predict the number of introduced linebreaks here. The number 109 | -- might be slightly to high in corner cases but that will only trigger 110 | -- slightly more redraws which is totally acceptable. 111 | reflow_line_count_correction = 112 | terminalSize <&> \size -> 113 | -- This division is fine, because we don‘t accept non positive window sizes. 114 | getSum $ foldMap (\line -> Sum (displayWidthBS line `div` size.width)) nix_output 115 | 116 | (last_printed_line_count, lines_to_pad) <- atomically do 117 | last_printed_line_count <- readTVar printed_lines_var 118 | -- When the nom output suddenly gets smaller, it might jump up from the bottom of the screen. 119 | -- To prevent this we insert a few newlines before it. 120 | -- We only do this if we know the size of the terminal. 121 | let lines_to_pad = case reflow_line_count_correction of 122 | Just reflow_correction | pad -> max 0 (last_printed_line_count - reflow_correction - nix_output_length - nom_output_length) 123 | _ -> 0 124 | line_count_to_print = nom_output_length + lines_to_pad 125 | writeTVar printed_lines_var line_count_to_print 126 | pure (last_printed_line_count, lines_to_pad) 127 | 128 | -- Prepare ByteString to write on terminal 129 | let output_to_print = nix_output <> mtimesDefault lines_to_pad [""] <> nom_output 130 | output_to_print_with_newline_annotations = zip (howToGoToNextLine last_printed_line_count reflow_line_count_correction <$> [0 ..]) output_to_print 131 | output = 132 | toStrict 133 | . Builder.toLazyByteString 134 | $ startAtomicUpdate 135 | <> 136 | -- when we clear the line, but don‘t use cursorUpLine, the cursor needs to be moved to the start for printing. 137 | -- we do that before clearing because we can 138 | memptyIfFalse (last_printed_line_count == 1) (Builder.stringUtf8 $ Terminal.setCursorColumnCode 0) 139 | <> 140 | -- Clear last output from screen. 141 | -- First we clear the current line, if we have written on it. 142 | memptyIfFalse (last_printed_line_count > 0) (Builder.stringUtf8 Terminal.clearLineCode) 143 | <> 144 | -- Then, if necessary we, move up and clear more lines. 145 | stimesMonoid 146 | (max (last_printed_line_count - 1) 0) 147 | ( Builder.stringUtf8 (Terminal.cursorUpLineCode 1) -- Moves cursor one line up and to the beginning of the line. 148 | <> Builder.stringUtf8 Terminal.clearLineCode -- We are avoiding to use clearFromCursorToScreenEnd 149 | -- because it apparently triggers a flush on some terminals. 150 | ) 151 | <> 152 | -- Insert the output to write to the screen. 153 | ( output_to_print_with_newline_annotations & foldMap \(newline, line) -> 154 | ( case newline of 155 | StayInLine -> mempty 156 | MoveToNextLine -> Builder.stringUtf8 (Terminal.cursorDownLineCode 1) 157 | PrintNewLine -> Builder.byteString "\n" 158 | ) 159 | <> Builder.byteString line 160 | ) 161 | -- Corner case: If nom is not outputting anything but we are printing output from nix, then we want to append a newline 162 | <> memptyIfFalse (nom_output_length == 0 && nix_output_length > 0) Builder.byteString "\n" 163 | <> endAtomicUpdate 164 | 165 | -- Actually write to the buffer. We do this all in one step and with a strict 166 | -- ByteString so that everything is precalculated and the actual put is 167 | -- definitely just a simple copy. Any delay while writing could create 168 | -- flickering. 169 | ByteString.hPut output_handle output 170 | System.IO.hFlush output_handle 171 | 172 | data ToNextLine = StayInLine | MoveToNextLine | PrintNewLine 173 | deriving stock (Generic) 174 | 175 | -- Depending on the current line of the output we are printing we need to decide 176 | -- how to move to a new line before printing. 177 | howToGoToNextLine :: Int -> Maybe Int -> Int -> ToNextLine 178 | howToGoToNextLine _ Nothing = \case 179 | -- When we have no info about terminal size, better be careful and always print 180 | -- newlines if necessary. 181 | 0 -> StayInLine 182 | _ -> PrintNewLine 183 | howToGoToNextLine previousPrintedLines (Just correction) = \case 184 | -- When starting to print we are always in an empty line with the cursor at the start. 185 | -- So we don‘t need to go to a new line 186 | 0 -> StayInLine 187 | -- When the current offset is smaller than the number of previously printed lines. 188 | -- e.g. we have printed 1 line, but before we had printed 2 189 | -- then we can probably move the cursor a row down without needing to print a newline. 190 | x 191 | | x + correction < previousPrintedLines -> 192 | MoveToNextLine 193 | -- When we are at the bottom of the terminal we have no choice but need to 194 | -- print a newline and thus (sadly) flush the terminal 195 | _ -> PrintNewLine 196 | 197 | interact :: 198 | forall update state. 199 | Config -> 200 | StreamParser update -> 201 | UpdateFunc update state -> 202 | (Double -> state -> state) -> 203 | OutputFunc state -> 204 | Finalizer state -> 205 | Stream (Either NOMError ByteString) -> 206 | Handle -> 207 | state -> 208 | IO state 209 | interact config parser updater maintenance printer finalize input_stream output_handle initialState = 210 | processTextStream config parser updater maintenance (Just (printer, output_handle)) finalize initialState input_stream 211 | 212 | -- frame durations are passed to threadDelay and thus are given in microseconds 213 | 214 | maxFrameDuration :: Int 215 | maxFrameDuration = 1_000_000 -- once per second to update timestamps 216 | 217 | minFrameDuration :: Int 218 | minFrameDuration = 219 | -- this seems to be a nice compromise to reduce excessive 220 | -- flickering, since the movement is not continuous this low frequency doesn‘t 221 | -- feel to sluggish for the eye, for me. 222 | 60_000 -- ~17 times per second 223 | 224 | processTextStream :: 225 | forall update state. 226 | Config -> 227 | StreamParser update -> 228 | UpdateFunc update state -> 229 | (Double -> state -> state) -> 230 | Maybe (OutputFunc state, Handle) -> 231 | Finalizer state -> 232 | state -> 233 | Stream (Either NOMError ByteString) -> 234 | IO state 235 | processTextStream config parser updater maintenance printerMay finalize initialState inputStream = do 236 | state_var <- newTMVarIO initialState 237 | output_builder_var <- newTVarIO [] 238 | refresh_display_var <- newTVarIO False 239 | let keepProcessing :: IO () 240 | keepProcessing = 241 | inputStream 242 | & Stream.tap (errorsToBuilderFold output_builder_var) 243 | & Stream.mapMaybe rightToMaybe 244 | & parser 245 | & Stream.fold (Fold.drainMapM (runUpdate output_builder_var state_var refresh_display_var updater)) 246 | waitForInput :: IO () 247 | waitForInput = atomically $ check =<< readTVar refresh_display_var 248 | printerMay & maybe keepProcessing \(printer, output_handle) -> do 249 | linesVar <- newTVarIO 0 250 | let writeToScreen :: IO () 251 | writeToScreen = writeStateToScreen (not config.silent) linesVar state_var output_builder_var refresh_display_var maintenance printer output_handle 252 | keepPrinting :: IO () 253 | keepPrinting = forever do 254 | race_ (concurrently_ (threadDelay minFrameDuration) waitForInput) (threadDelay maxFrameDuration) 255 | writeToScreen 256 | race_ keepProcessing keepPrinting 257 | atomically (takeTMVar state_var) >>= execStateT finalize >>= atomically . putTMVar state_var 258 | writeToScreen 259 | (if isNothing printerMay then (>>= execStateT finalize) else id) $ atomically $ takeTMVar state_var 260 | 261 | errorsToBuilderFold :: TVar [ByteString] -> Fold.Fold IO (Either NOMError ByteString) () 262 | errorsToBuilderFold builder_var = Fold.drainMapM saveInput 263 | where 264 | saveInput :: Either NOMError ByteString -> IO () 265 | saveInput = \case 266 | Left nom_error -> atomically $ writeErrorToBuilder builder_var nom_error 267 | _ -> pass 268 | 269 | writeErrorToBuilder :: TVar [ByteString] -> NOMError -> STM () 270 | writeErrorToBuilder output_builder_var nom_error = do 271 | modifyTVar' output_builder_var (appendError nom_error) 272 | 273 | appendError :: NOMError -> [ByteString] -> [ByteString] 274 | appendError err prev = error_line : prev 275 | where 276 | !error_line = optional_linebreak <> nomError <> show err <> "\n" 277 | optional_linebreak 278 | | (last_chunk : _) <- prev 279 | , not (ByteString.isSuffixOf "\n" last_chunk) = 280 | "\n" 281 | | otherwise = "" 282 | 283 | nomError :: ByteString 284 | nomError = encodeUtf8 (markup (red . bold) "nix-output-monitor error: ") 285 | 286 | truncateOutput :: Maybe Window -> Text -> Text 287 | truncateOutput win output = maybe output go win 288 | where 289 | go :: Window -> Text 290 | go window = Text.intercalate "\n" $ truncateColumns window.width <$> truncateRows window.height 291 | 292 | truncateColumns :: Int -> Text -> Text 293 | truncateColumns columns line = if displayWidth line > columns then Table.truncate (columns - 1) line <> "…" <> toText (setSGRCode [Reset]) else line 294 | 295 | truncateRows :: Int -> [Text] 296 | truncateRows rows 297 | | length outputLines >= rows - outputLinesToAlwaysShow = take 1 outputLines <> [" ⋮ "] <> drop (length outputLines + outputLinesToAlwaysShow + 2 - rows) outputLines 298 | | otherwise = outputLines 299 | 300 | outputLines :: [Text] 301 | outputLines = Text.lines output 302 | 303 | outputLinesToAlwaysShow :: Int 304 | outputLinesToAlwaysShow = 5 305 | -------------------------------------------------------------------------------- /lib/NOM/IO/Input.hs: -------------------------------------------------------------------------------- 1 | module NOM.IO.Input ( 2 | NOMInput (..), 3 | UpdateResult (..), 4 | statelessUnfoldM, 5 | ) where 6 | 7 | import NOM.Error (NOMError) 8 | import NOM.IO (Stream, StreamParser) 9 | import NOM.State (NOMV1State) 10 | import NOM.Update.Monad (UpdateMonad) 11 | import Optics (Lens') 12 | import Relude 13 | import Streamly.Data.Stream qualified as Stream 14 | 15 | statelessUnfoldM :: (Monad m) => m (Maybe a) -> Stream.Stream m a 16 | statelessUnfoldM generator = 17 | Stream.repeatM generator 18 | & Stream.takeWhile isJust 19 | & Stream.catMaybes 20 | 21 | data UpdateResult a = MkUpdateResult 22 | { errors :: [NOMError] 23 | , output :: ByteString 24 | , newStateToPrint :: Maybe NOMV1State 25 | , newState :: UpdaterState a 26 | } 27 | deriving stock (Generic) 28 | 29 | class NOMInput a where 30 | type UpdaterState a 31 | firstState :: NOMV1State -> UpdaterState a 32 | updateState :: (UpdateMonad m) => a -> UpdaterState a -> m (UpdateResult a) 33 | nomState :: Lens' (UpdaterState a) NOMV1State 34 | inputStream :: Handle -> Stream (Either NOMError ByteString) 35 | withParser :: (StreamParser a -> IO t) -> IO t 36 | -------------------------------------------------------------------------------- /lib/NOM/IO/Input/JSON.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | 3 | module NOM.IO.Input.JSON () where 4 | 5 | import Control.Exception qualified as Exception 6 | import Data.ByteString.Char8 qualified as ByteString.Char8 7 | import Data.Hermes qualified as JSON 8 | import NOM.Error (NOMError (..)) 9 | import NOM.IO (Stream) 10 | import NOM.IO.Input (NOMInput (..), UpdateResult (..), statelessUnfoldM) 11 | import NOM.NixMessage.JSON (NixJSONMessage) 12 | import NOM.Parser.JSON (parseJSONLine) 13 | import NOM.State (NOMV1State) 14 | import NOM.Update (updateStateNixJSONMessage) 15 | import Optics qualified 16 | import Relude 17 | import System.IO.Error qualified as IOError 18 | 19 | readLines :: Handle -> Stream (Either NOMError ByteString) 20 | readLines handle = 21 | statelessUnfoldM 22 | $ Exception.try (ByteString.Char8.hGetLine handle) 23 | <&> \case 24 | Left err | IOError.isEOFError err -> Nothing 25 | Left err -> Just (Left (InputError err)) -- Forward Exceptions, when we encounter them 26 | Right input -> Just (Right input) 27 | 28 | instance NOMInput NixJSONMessage where 29 | withParser body = JSON.withHermesEnv_ (body . fmap . parseJSONLine) 30 | type UpdaterState NixJSONMessage = NOMV1State 31 | inputStream = readLines 32 | nomState = Optics.equality' 33 | firstState = id 34 | {-# INLINE updateState #-} 35 | updateState input old_state = mkUpdateResult <$> updateStateNixJSONMessage input old_state 36 | where 37 | mkUpdateResult ((errors, output), new_state) = 38 | MkUpdateResult 39 | { errors 40 | , output 41 | , newStateToPrint = new_state 42 | , newState = fromMaybe old_state new_state 43 | } 44 | -------------------------------------------------------------------------------- /lib/NOM/IO/Input/OldStyle.hs: -------------------------------------------------------------------------------- 1 | module NOM.IO.Input.OldStyle (OldStyleInput) where 2 | 3 | import Control.Exception qualified as Exception 4 | import Data.ByteString qualified as ByteString 5 | import Data.Strict qualified as Strict 6 | import NOM.Error (NOMError (..)) 7 | import NOM.IO (Stream) 8 | import NOM.IO.Input (NOMInput (..), UpdateResult (..), statelessUnfoldM) 9 | import NOM.NixMessage.OldStyle (NixOldStyleMessage) 10 | import NOM.Parser (parser) 11 | import NOM.State (NOMV1State) 12 | import NOM.StreamParser (parseStreamAttoparsec) 13 | import NOM.Update (updateStateNixOldStyleMessage) 14 | import Optics (gfield) 15 | import Relude 16 | 17 | readTextChunks :: Handle -> Stream (Either NOMError ByteString) 18 | readTextChunks handle = 19 | statelessUnfoldM 20 | $ Exception.try (ByteString.hGetSome handle bufferSize) 21 | <&> \case 22 | Left err -> Just (Left (InputError err)) -- Forward Exceptions, when we encounter them 23 | Right "" -> Nothing -- EOF 24 | Right input -> Just (Right input) 25 | where 26 | bufferSize :: Int 27 | bufferSize = 4096 * 16 28 | 29 | data OldStyleState = MkOldStyleState 30 | { state :: NOMV1State 31 | , -- Because old style human nix logs don’t include information for when a 32 | -- build finishes we monitor the existence of the output paths. 33 | -- This variable saves when we last polled the disc for 34 | -- output paths of currently running builds. 35 | lastRead :: Strict.Maybe Double 36 | } 37 | deriving stock (Generic) 38 | 39 | data OldStyleInput = MkOldStyleInput 40 | { parseResult :: Maybe NixOldStyleMessage 41 | , parsedInput :: ByteString 42 | } 43 | 44 | instance NOMInput OldStyleInput where 45 | withParser body = body (fmap (uncurry MkOldStyleInput . first join) <$> parseStreamAttoparsec parser) 46 | type UpdaterState OldStyleInput = OldStyleState 47 | inputStream = readTextChunks 48 | nomState = gfield @"state" 49 | firstState state' = MkOldStyleState{state = state', lastRead = Strict.Nothing} 50 | {-# INLINE updateState #-} 51 | updateState input old_state = mkUpdateResult <$> updateStateNixOldStyleMessage (input.parseResult, input.parsedInput) (Strict.toLazy old_state.lastRead, old_state.state) 52 | where 53 | mkUpdateResult ((errors, output), (new_timestamp, new_state)) = 54 | MkUpdateResult 55 | { errors 56 | , output 57 | , newStateToPrint = new_state 58 | , newState = MkOldStyleState (fromMaybe (old_state.state) new_state) (Strict.toStrict new_timestamp) 59 | } 60 | -------------------------------------------------------------------------------- /lib/NOM/NixMessage/JSON.hs: -------------------------------------------------------------------------------- 1 | module NOM.NixMessage.JSON (NixJSONMessage (..), StartAction (..), StopAction (..), MessageAction (..), ResultAction (..), ActivityResult (..), Activity (..), ActivityId (..), Verbosity (..), ActivityProgress (..), ActivityType (..)) where 2 | 3 | import NOM.Builds (Derivation (..), Host (..), StorePath (..)) 4 | import NOM.Error (NOMError) 5 | import Relude 6 | 7 | newtype ActivityId = MkId {value :: Int} 8 | deriving newtype (Show, Eq, Ord) 9 | deriving stock (Generic) 10 | 11 | newtype StopAction = MkStopAction {id :: ActivityId} 12 | deriving newtype (Eq) 13 | deriving stock (Show) 14 | 15 | data Verbosity where 16 | Error :: Verbosity 17 | Warn :: Verbosity 18 | Notice :: Verbosity 19 | Info :: Verbosity 20 | Talkative :: Verbosity 21 | Chatty :: Verbosity 22 | Debug :: Verbosity 23 | Vomit :: Verbosity 24 | deriving stock (Show, Eq, Ord) 25 | 26 | data ActivityType where 27 | UnknownType :: ActivityType 28 | CopyPathType :: ActivityType 29 | FileTransferType :: ActivityType 30 | RealiseType :: ActivityType 31 | CopyPathsType :: ActivityType 32 | BuildsType :: ActivityType 33 | BuildType :: ActivityType 34 | OptimiseStoreType :: ActivityType 35 | VerifyPathsType :: ActivityType 36 | SubstituteType :: ActivityType 37 | QueryPathInfoType :: ActivityType 38 | PostBuildHookType :: ActivityType 39 | BuildWaitingType :: ActivityType 40 | FetchTreeType :: ActivityType 41 | deriving stock (Show, Eq) 42 | 43 | data Activity where 44 | Unknown :: Activity 45 | CopyPath :: StorePath -> Host -> Host -> Activity 46 | FileTransfer :: Text -> Activity 47 | Realise :: Activity 48 | CopyPaths :: Activity 49 | Builds :: Activity 50 | Build :: Derivation -> Host -> Activity 51 | OptimiseStore :: Activity 52 | VerifyPaths :: Activity 53 | Substitute :: StorePath -> Host -> Activity 54 | QueryPathInfo :: StorePath -> Host -> Activity 55 | PostBuildHook :: Derivation -> Activity 56 | BuildWaiting :: Activity 57 | FetchTree :: Activity 58 | deriving stock (Show, Eq, Ord, Generic) 59 | 60 | data ActivityResult where 61 | FileLinked :: Int -> Int -> ActivityResult 62 | BuildLogLine :: Text -> ActivityResult 63 | UntrustedPath :: StorePath -> ActivityResult 64 | CorruptedPath :: StorePath -> ActivityResult 65 | SetPhase :: Text -> ActivityResult 66 | Progress :: ActivityProgress -> ActivityResult 67 | SetExpected :: ActivityType -> Int -> ActivityResult 68 | PostBuildLogLine :: Text -> ActivityResult 69 | deriving stock (Show, Eq) 70 | 71 | data ActivityProgress = MkActivityProgress 72 | { done :: Int 73 | , expected :: Int 74 | , running :: Int 75 | , failed :: Int 76 | } 77 | deriving stock (Show, Eq, Ord, Generic) 78 | 79 | data StartAction = MkStartAction 80 | { id :: ActivityId 81 | , level :: Verbosity 82 | , text :: Text 83 | , activity :: Activity 84 | } 85 | deriving stock (Show, Eq) 86 | 87 | data ResultAction = MkResultAction 88 | { id :: ActivityId 89 | , result :: ActivityResult 90 | } 91 | deriving stock (Show, Eq) 92 | 93 | data MessageAction = MkMessageAction 94 | { level :: Verbosity 95 | , message :: Text 96 | -- currently unused, but theoretically present in the protocol 97 | -- , line :: Maybe Int 98 | -- , column :: Maybe Int 99 | -- , file :: Maybe Text 100 | } 101 | deriving stock (Show, Eq) 102 | 103 | data NixJSONMessage where 104 | Stop :: StopAction -> NixJSONMessage 105 | Start :: StartAction -> NixJSONMessage 106 | Result :: ResultAction -> NixJSONMessage 107 | Message :: MessageAction -> NixJSONMessage 108 | Plain :: ByteString -> NixJSONMessage 109 | ParseError :: NOMError -> NixJSONMessage 110 | deriving stock (Show, Eq) 111 | -------------------------------------------------------------------------------- /lib/NOM/NixMessage/OldStyle.hs: -------------------------------------------------------------------------------- 1 | module NOM.NixMessage.OldStyle (NixOldStyleMessage (..)) where 2 | 3 | import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..)) 4 | import Relude 5 | 6 | data NixOldStyleMessage where 7 | Uploading :: StorePath -> Host -> NixOldStyleMessage 8 | Downloading :: StorePath -> Host -> NixOldStyleMessage 9 | PlanCopies :: Int -> NixOldStyleMessage 10 | Build :: Derivation -> Host -> NixOldStyleMessage 11 | PlanBuilds :: Set Derivation -> Derivation -> NixOldStyleMessage 12 | PlanDownloads :: Double -> Double -> Set StorePath -> NixOldStyleMessage 13 | Checking :: Derivation -> NixOldStyleMessage 14 | Failed :: Derivation -> FailType -> NixOldStyleMessage 15 | deriving stock (Show, Eq) 16 | -------------------------------------------------------------------------------- /lib/NOM/Parser.hs: -------------------------------------------------------------------------------- 1 | module NOM.Parser (parser, oldStyleParser, planBuildLine, planDownloadLine, inTicks) where 2 | 3 | import Data.Attoparsec.ByteString ( 4 | Parser, 5 | choice, 6 | manyTill', 7 | string, 8 | ) 9 | import Data.Attoparsec.ByteString qualified as ParseW8 10 | import Data.Attoparsec.ByteString.Char8 ( 11 | anyChar, 12 | char, 13 | decimal, 14 | double, 15 | endOfLine, 16 | isEndOfLine, 17 | takeTill, 18 | ) 19 | import NOM.Builds ( 20 | Derivation (..), 21 | FailType (ExitCode, HashMismatch), 22 | Host (..), 23 | StorePath (..), 24 | derivationByteStringParser, 25 | storePathByteStringParser, 26 | ) 27 | import NOM.NixMessage.OldStyle (NixOldStyleMessage (..)) 28 | import Relude hiding (take, takeWhile) 29 | 30 | parser :: Parser (Maybe NixOldStyleMessage) 31 | parser = Just <$> oldStyleParser <|> Nothing <$ noMatch 32 | 33 | oldStyleParser :: Parser NixOldStyleMessage 34 | oldStyleParser = planBuilds <|> planDownloads <|> copying <|> building <|> failed <|> checking 35 | 36 | noMatch :: Parser ByteString 37 | noMatch = ParseW8.takeTill isEndOfLine <* endOfLine 38 | 39 | inTicks :: Parser a -> Parser a 40 | inTicks x = tick *> x <* tick 41 | 42 | tick :: Parser () 43 | tick = void $ char '\'' 44 | 45 | noTicks :: Parser ByteString 46 | noTicks = takeTill (== '\'') 47 | 48 | host :: Parser Host 49 | host = Host . decodeUtf8 <$> inTicks noTicks 50 | 51 | ellipsisEnd :: Parser () 52 | ellipsisEnd = string "..." >> endOfLine 53 | 54 | indent :: Parser () 55 | indent = void $ string " " 56 | 57 | -- these ( )?derivations will be built: 58 | -- /nix/store/4lj96sc0pyf76p4w6irh52wmgikx8qw2-nix-output-monitor-0.1.0.3.drv 59 | planBuilds :: Parser NixOldStyleMessage 60 | planBuilds = 61 | maybe mzero (\x -> pure (PlanBuilds (fromList (toList x)) (last x))) 62 | . nonEmpty 63 | =<< choice 64 | [ string "these derivations will be built:" 65 | , string "this derivation will be built:" 66 | , string "these " *> (decimal :: Parser Int) *> string " derivations will be built:" 67 | ] 68 | *> endOfLine 69 | *> many planBuildLine 70 | 71 | planBuildLine :: Parser Derivation 72 | planBuildLine = indent *> derivationByteStringParser <* endOfLine 73 | 74 | planDownloads :: Parser NixOldStyleMessage 75 | planDownloads = 76 | PlanDownloads 77 | <$> ( choice 78 | [ string "these paths" 79 | , string "this path" 80 | , string "these " *> (decimal :: Parser Int) *> string " paths" 81 | ] 82 | *> string " will be fetched (" 83 | *> double 84 | ) 85 | <*> (string " MiB download, " *> double) 86 | <*> (string " MiB unpacked):" *> endOfLine *> (fromList <$> many planDownloadLine)) 87 | 88 | planDownloadLine :: Parser StorePath 89 | planDownloadLine = indent *> storePathByteStringParser <* endOfLine 90 | 91 | failed :: Parser NixOldStyleMessage 92 | -- builder for '/nix/store/fbpdwqrfwr18nn504kb5jqx7s06l1mar-regex-base-0.94.0.1.drv' failed with exit code 1 93 | failed = 94 | Failed 95 | <$> ( choice 96 | [ string "error: build of " <* inTicks derivationByteStringParser <* manyTill' anyChar (string "failed: error: ") 97 | , string "error: " 98 | , pure "" 99 | ] 100 | *> string "builder for " 101 | *> inTicks derivationByteStringParser 102 | <* string " failed with exit code " 103 | ) 104 | <*> (ExitCode <$> decimal <* choice [endOfLine, char ';' *> endOfLine]) 105 | <|> 106 | -- error: hash mismatch in fixed-output derivation '/nix/store/nrx4swgzs3iy049fqfx51vhnbb9kzkyv-source.drv': 107 | Failed 108 | <$> (choice [string "error: ", pure ""] *> string "hash mismatch in fixed-output derivation " *> inTicks derivationByteStringParser <* string ":") 109 | <*> pure HashMismatch 110 | <* endOfLine 111 | 112 | -- checking outputs of '/nix/store/xxqgv6kwf6yz35jslsar0kx4f03qzyis-nix-output-monitor-0.1.0.3.drv'... 113 | checking :: Parser NixOldStyleMessage 114 | checking = Checking <$> (string "checking outputs of " *> inTicks derivationByteStringParser <* ellipsisEnd) 115 | 116 | -- copying 1 paths... 117 | -- copying path '/nix/store/fzyahnw94msbl4ic5vwlnyakslq4x1qm-source' to 'ssh://maralorn@example.org'... 118 | copying :: Parser NixOldStyleMessage 119 | copying = 120 | string "copying " 121 | *> (transmission <|> PlanCopies <$> decimal <* string " paths" <* ellipsisEnd) 122 | 123 | transmission :: Parser NixOldStyleMessage 124 | transmission = do 125 | p <- string "path " *> inTicks storePathByteStringParser 126 | (Uploading p <$> toHost <|> Downloading p <$> fromHost) <* ellipsisEnd 127 | 128 | fromHost :: Parser Host 129 | fromHost = string " from " *> host 130 | 131 | toHost :: Parser Host 132 | toHost = string " to " *> host 133 | 134 | onHost :: Parser Host 135 | onHost = string " on " *> host 136 | 137 | -- building '/nix/store/4lj96sc0pyf76p4w6irh52wmgikx8qw2-nix-output-monitor-0.1.0.3.drv' on 'ssh://maralorn@example.org'... 138 | building :: Parser NixOldStyleMessage 139 | building = do 140 | p <- string "building " *> inTicks derivationByteStringParser 141 | Build p Localhost <$ ellipsisEnd <|> Build p <$> onHost <* ellipsisEnd 142 | -------------------------------------------------------------------------------- /lib/NOM/Parser/JSON.hs: -------------------------------------------------------------------------------- 1 | module NOM.Parser.JSON (parseJSONLine) where 2 | 3 | import Data.ByteString qualified as ByteString 4 | import Data.Hermes qualified as JSON 5 | import Data.Hermes.Decoder (listOfInt) 6 | import NOM.Builds (parseDerivation, parseHost, parseStorePath) 7 | import NOM.Error (NOMError (..)) 8 | import NOM.NixMessage.JSON (Activity (..), ActivityId (..), ActivityProgress (..), ActivityResult (..), ActivityType (..), MessageAction (..), NixJSONMessage (..), ResultAction (..), StartAction (..), StopAction (..), Verbosity (..)) 9 | import Relude hiding (one) 10 | 11 | parseJSONLine :: JSON.HermesEnv -> ByteString -> NixJSONMessage 12 | parseJSONLine env input = maybe (Plain input) on_json (ByteString.stripPrefix "@nix " input) 13 | where 14 | on_json raw_json = either translate_hermes_error_to_nom_error id $ JSON.parseByteString env parseAction raw_json 15 | where 16 | translate_hermes_error_to_nom_error :: JSON.HermesException -> NixJSONMessage 17 | translate_hermes_error_to_nom_error json_error = 18 | ParseError $ ParseNixJSONMessageError (show json_error) raw_json 19 | 20 | parseVerbosity :: JSON.Decoder Verbosity 21 | parseVerbosity = JSON.withInt \case 22 | 0 -> pure Error 23 | 1 -> pure Warn 24 | 2 -> pure Notice 25 | 3 -> pure Info 26 | 4 -> pure Talkative 27 | 5 -> pure Chatty 28 | 6 -> pure Debug 29 | 7 -> pure Vomit 30 | other -> fail ("invalid verbosity level:" <> show other) 31 | 32 | parseActivityType :: (MonadFail m) => Int -> m ActivityType 33 | parseActivityType = \case 34 | 0 -> pure UnknownType 35 | 100 -> pure CopyPathType 36 | 101 -> pure FileTransferType 37 | 102 -> pure RealiseType 38 | 103 -> pure CopyPathsType 39 | 104 -> pure BuildsType 40 | 105 -> pure BuildType 41 | 106 -> pure OptimiseStoreType 42 | 107 -> pure VerifyPathsType 43 | 108 -> pure SubstituteType 44 | 109 -> pure QueryPathInfoType 45 | 110 -> pure PostBuildHookType 46 | 111 -> pure BuildWaitingType 47 | 112 -> pure FetchTreeType 48 | other -> fail ("invalid activity result type: " <> show other) 49 | 50 | parseAction :: JSON.Decoder NixJSONMessage 51 | parseAction = JSON.object $ do 52 | action <- JSON.atKey "action" JSON.text 53 | ( \case 54 | "start" -> Start <$> parseStartAction 55 | "stop" -> Stop <$> parseStopAction 56 | "result" -> Result <$> parseResultAction 57 | "msg" -> Message <$> parseMessageAction 58 | other -> fail ("unknown action type: " <> toString other) 59 | ) 60 | action 61 | 62 | parseMessageAction :: JSON.FieldsDecoder MessageAction 63 | parseMessageAction = do 64 | level <- JSON.atKey "level" parseVerbosity 65 | message <- JSON.atKey "msg" JSON.text 66 | pure MkMessageAction{..} 67 | 68 | textFields :: JSON.FieldsDecoder [Text] 69 | textFields = JSON.atKey "fields" (JSON.list JSON.text) 70 | 71 | textOrNumFields :: JSON.FieldsDecoder [Either Text Int] 72 | textOrNumFields = JSON.atKey "fields" $ JSON.list (Left <$> JSON.text <|> Right <$> JSON.int) 73 | 74 | intFields :: JSON.FieldsDecoder [Int] 75 | intFields = JSON.atKey "fields" listOfInt 76 | 77 | one :: (MonadFail m) => m [b] -> m b 78 | one listdec = do 79 | fields <- listdec 80 | case fields of 81 | [field] -> pure field 82 | _ -> fail "expected one field" 83 | 84 | two :: (MonadFail m) => m [b] -> m (b, b) 85 | two listdec = do 86 | fields <- listdec 87 | case fields of 88 | [field1, field2] -> pure (field1, field2) 89 | _ -> fail "expected one field" 90 | 91 | three :: (MonadFail m) => m [b] -> m (b, b, b) 92 | three listdec = do 93 | fields <- listdec 94 | case fields of 95 | [field1, field2, field3] -> pure (field1, field2, field3) 96 | _ -> fail "expected one field" 97 | 98 | four :: (MonadFail m) => m [b] -> m (b, b, b, b) 99 | four listdec = do 100 | fields <- listdec 101 | case fields of 102 | [field1, field2, field3, field4] -> pure (field1, field2, field3, field4) 103 | _ -> fail "expected one field" 104 | 105 | parseResultAction :: JSON.FieldsDecoder ResultAction 106 | parseResultAction = do 107 | idField <- MkId <$> JSON.atKey "id" JSON.int 108 | type' <- JSON.atKey "type" JSON.int 109 | let txt = textFields 110 | let num = intFields 111 | result <- case type' of 112 | 100 -> uncurry FileLinked <$> two num 113 | 101 -> BuildLogLine <$> one txt 114 | 102 -> UntrustedPath <$> (one txt >>= parseStorePath) 115 | 103 -> CorruptedPath <$> (one txt >>= parseStorePath) 116 | 104 -> SetPhase <$> one txt 117 | 105 -> (\(done, expected, running, failed) -> Progress (MkActivityProgress{..})) <$> four num 118 | 106 -> do 119 | (typeNum, number) <- two num 120 | activityType <- parseActivityType typeNum 121 | pure $ SetExpected activityType number 122 | 107 -> PostBuildLogLine <$> one txt 123 | other -> fail ("invalid activity result type: " <> show other) 124 | pure MkResultAction{id = idField, result} 125 | 126 | parseStopAction :: JSON.FieldsDecoder StopAction 127 | parseStopAction = MkStopAction . MkId <$> JSON.atKey "id" JSON.int 128 | 129 | parseStartAction :: JSON.FieldsDecoder StartAction 130 | parseStartAction = do 131 | idField <- JSON.atKey "id" JSON.int 132 | text <- JSON.atKey "text" JSON.text 133 | level <- JSON.atKey "level" parseVerbosity 134 | activityType <- JSON.atKey "type" (JSON.withInt parseActivityType) 135 | let txt = textFields 136 | activity <- case activityType of 137 | UnknownType -> pure Unknown 138 | CopyPathType -> 139 | three txt >>= \(path, from, to) -> do 140 | path' <- parseStorePath path 141 | pure $ CopyPath path' (parseHost from) (parseHost to) 142 | FileTransferType -> FileTransfer <$> one txt 143 | RealiseType -> pure Realise 144 | CopyPathsType -> pure CopyPaths 145 | BuildsType -> pure Builds 146 | BuildType -> 147 | four textOrNumFields >>= \(path, host, _, _) -> do 148 | path' <- either pure (const $ fail "Got Int expected Text") path 149 | path'' <- parseDerivation path' 150 | host' <- either pure (const $ fail "Got Int expected Text") host 151 | pure $ Build path'' (parseHost host') 152 | OptimiseStoreType -> pure OptimiseStore 153 | VerifyPathsType -> pure VerifyPaths 154 | SubstituteType -> 155 | two txt >>= \(path, host) -> do 156 | path' <- parseStorePath path 157 | pure $ Substitute path' (parseHost host) 158 | QueryPathInfoType -> 159 | two txt >>= \(path, host) -> do 160 | path' <- parseStorePath path 161 | pure $ QueryPathInfo path' (parseHost host) 162 | PostBuildHookType -> PostBuildHook <$> (one txt >>= parseDerivation) 163 | BuildWaitingType -> pure BuildWaiting 164 | FetchTreeType -> pure FetchTree 165 | pure MkStartAction{id = MkId idField, text, activity, level} 166 | -------------------------------------------------------------------------------- /lib/NOM/Print.hs: -------------------------------------------------------------------------------- 1 | module NOM.Print (stateToText, showCode, Config (..)) where 2 | 3 | import Data.Foldable qualified as Unsafe 4 | import Data.IntMap.Strict qualified as IntMap 5 | import Data.List qualified as List 6 | import Data.List.NonEmpty.Extra (appendr) 7 | import Data.Map.Strict qualified as Map 8 | import Data.MemoTrie (memo) 9 | import Data.Sequence.Strict qualified as Seq 10 | import Data.Set qualified as Set 11 | import Data.Strict qualified as Strict 12 | import Data.Text qualified as Text 13 | import Data.Time (NominalDiffTime, ZonedTime, defaultTimeLocale, formatTime) 14 | import Data.Tree (Forest, Tree (Node)) 15 | import GHC.Records (HasField) 16 | import NOM.Builds (Derivation (..), FailType (..), Host (..), StorePath (..)) 17 | import NOM.NixMessage.JSON (ActivityId (..)) 18 | import NOM.Print.Table (Entry, blue, bold, cells, dummy, green, grey, header, label, magenta, markup, markups, prependLines, printAlignedSep, red, text, yellow) 19 | import NOM.Print.Tree (showForest) 20 | import NOM.State ( 21 | ActivityStatus (..), 22 | BuildFail (..), 23 | BuildInfo (..), 24 | BuildStatus (..), 25 | DependencySummary (..), 26 | DerivationId, 27 | DerivationInfo (..), 28 | DerivationSet, 29 | InputDerivation (..), 30 | NOMState, 31 | NOMV1State (..), 32 | ProgressState (..), 33 | StorePathId, 34 | StorePathInfo (..), 35 | StorePathMap, 36 | StorePathSet, 37 | TransferInfo (..), 38 | getDerivationInfos, 39 | getStorePathInfos, 40 | inputStorePaths, 41 | ) 42 | import NOM.State.CacheId.Map qualified as CMap 43 | import NOM.State.CacheId.Set qualified as CSet 44 | import NOM.State.Sorting (SortKey, sortKey, summaryIncludingRoot) 45 | import NOM.State.Tree (mapRootsTwigsAndLeafs) 46 | import NOM.Update (appendDifferingPlatform) 47 | import Optics (itoList, view, _2) 48 | import Relude 49 | import System.Console.ANSI (SGR (Reset), setSGRCode) 50 | import System.Console.Terminal.Size (Window) 51 | import System.Console.Terminal.Size qualified as Window 52 | import Text.Printf (printf) 53 | 54 | showCode :: Text -> [String] 55 | showCode = map (printf "%02X" . fromEnum) . toString 56 | 57 | vertical, lowerleft, upperleft, horizontal, down, up, clock, running, done, bigsum, warning, todo, leftT, average :: Text 58 | 59 | -- | U+2503 BOX DRAWINGS HEAVY VERTICAL 60 | vertical = "┃" 61 | 62 | -- | U+2517 BOX DRAWINGS HEAVY UP AND RIGHT 63 | lowerleft = "┗" 64 | 65 | -- | U+250F BOX DRAWINGS HEAVY DOWN AND RIGHT 66 | upperleft = "┏" 67 | 68 | -- | U+2523 BOX DRAWINGS HEAVY VERTICAL AND RIGHT 69 | leftT = "┣" 70 | 71 | -- | U+2501 BOX DRAWINGS HEAVY HORIZONTAL 72 | horizontal = "━" 73 | 74 | -- | U+2193 DOWNWARDS ARROW 75 | down = "↓" 76 | 77 | -- | U+2191 UPWARDS ARROW 78 | up = "↑" 79 | 80 | -- | U+23F1 STOPWATCH 81 | clock = "⏱" 82 | 83 | -- | U+23F5 BLACK MEDIUM RIGHT-POINTING TRIANGLE 84 | running = "⏵" 85 | 86 | -- | U+2714 HEAVY CHECK MARK 87 | done = "✔" 88 | 89 | -- | U+23F8 DOUBLE VERTICAL BAR 90 | todo = "⏸" 91 | 92 | -- | U+26A0 WARNING SIGN 93 | warning = "⚠" 94 | 95 | -- | U+2205 EMPTY SET 96 | average = "∅" 97 | 98 | -- | U+2211 N-ARY SUMMATION 99 | bigsum = "∑" 100 | 101 | showCond :: (Monoid m) => Bool -> m -> m 102 | showCond = memptyIfFalse 103 | 104 | targetRatio, defaultTreeMax :: Int 105 | targetRatio = 3 -- We divide by this, don‘t set this to zero. 106 | defaultTreeMax = 20 107 | 108 | data Config = MkConfig 109 | { silent :: Bool 110 | , piping :: Bool 111 | } 112 | 113 | printSections :: NonEmpty Text -> Text 114 | printSections = (upperleft <>) . Text.intercalate (toText (setSGRCode [Reset]) <> "\n" <> leftT) . toList 115 | 116 | -- printInterestingActivities :: Maybe Text -> IntMap InterestingActivity -> (ZonedTime, Double) -> Text 117 | -- printInterestingActivities message activities (_, now) = 118 | -- prependLines 119 | -- "" 120 | -- (vertical <> " ") 121 | -- (vertical <> " ") 122 | -- (horizontal <> markup bold " Build Planning:" :| maybeToList message <> (IntMap.elems activities <&> \activity -> unwords (activity.text : ifTimeDiffRelevant now activity.start id))) 123 | 124 | printTraces :: Seq Text -> Int -> Text 125 | printTraces traces maxHeight = 126 | prependLines 127 | "" 128 | (vertical <> " ") 129 | (vertical <> " ") 130 | (horizontal <> markup (bold . yellow) (" " <> show (length interesting_traces) <> " Traces: ") :| (lines =<< filtered_traces)) 131 | where 132 | interesting_traces = toList traces 133 | compact_traces = sum (length . lines <$> interesting_traces) > maxHeight 134 | filtered_traces = (if compact_traces then map compactError else id) interesting_traces 135 | 136 | printErrors :: Seq Text -> Int -> Text 137 | printErrors errors maxHeight = 138 | prependLines 139 | "" 140 | (vertical <> " ") 141 | (vertical <> " ") 142 | (horizontal <> markup (bold . red) (" " <> show (length interesting_errors) <> " Errors: ") :| (lines =<< filtered_errors)) 143 | where 144 | interesting_errors = 145 | reverse 146 | . filter (not . Text.isInfixOf "dependencies of derivation") 147 | $ toList errors 148 | compact_errors = sum (length . lines <$> interesting_errors) > maxHeight 149 | filtered_errors = (if compact_errors then map compactError else id) interesting_errors 150 | 151 | compactError :: Text -> Text 152 | compactError = fst . Text.breakOn "\n last 10 log lines:" 153 | 154 | stateToText :: Config -> NOMV1State -> Maybe (Window Int) -> (ZonedTime, Double) -> Text 155 | stateToText config buildState@MkNOMV1State{..} = memo printWithSize . fmap Window.height 156 | where 157 | printWithSize :: Maybe Int -> (ZonedTime, Double) -> Text 158 | printWithSize maybeWindow = printWithTime 159 | where 160 | printWithTime :: (ZonedTime, Double) -> Text 161 | printWithTime 162 | | progressState == JustStarted && config.piping = \nows@(_, now) -> markup bold (time nows <> showCond (now - startTime > 15) (markup grey " nom hasn‘t detected any input. Have you redirected nix-build stderr into nom? (See -h and the README for details.)")) 163 | | progressState == Finished && config.silent = const "" 164 | | Just sections' <- nonEmpty sections = \now -> printSections . fmap ($ now) $ sections' <> one (table . time) 165 | | fullSummary /= mempty = printSections . one . table . time 166 | | config.silent = const "" 167 | | otherwise = markup bold . time 168 | sections = 169 | fmap snd 170 | . filter fst 171 | $ [ 172 | -- (not (IntMap.null interestingActivities) || isJust evalMessage, printInterestingActivities evalMessage interestingActivities) 173 | (not (Seq.null nixErrors), const errorDisplay) 174 | , (not (Seq.null nixTraces), const traceDisplay) 175 | , (not (Seq.null forestRoots), buildsDisplay . snd) 176 | ] 177 | maxHeight = case maybeWindow of 178 | Just limit -> limit `div` targetRatio -- targetRatio is hardcoded to be bigger than zero. 179 | Nothing -> defaultTreeMax 180 | buildsDisplay now = 181 | prependLines 182 | horizontal 183 | (vertical <> " ") 184 | (vertical <> " ") 185 | (printBuilds buildState hostNums maxHeight now) 186 | errorDisplay = printErrors nixErrors maxHeight 187 | traceDisplay = printTraces nixTraces maxHeight 188 | -- evalMessage = case evaluationState.lastFileName of 189 | -- Strict.Just file_name -> Just ("Evaluated " <> show (evaluationState.count) <> " files, last one was '" <> file_name <> "'") 190 | -- Strict.Nothing -> Nothing 191 | runTime now = timeDiff now startTime 192 | time 193 | | progressState == Finished = \(nowClock, now) -> finishMarkup (" at " <> toText (formatTime defaultTimeLocale "%H:%M:%S" nowClock) <> " after " <> runTime now) 194 | | otherwise = \(_, now) -> clock <> " " <> runTime now 195 | MkDependencySummary{..} = fullSummary 196 | runningBuilds' = (.host) <$> runningBuilds 197 | completedBuilds' = (.host) <$> completedBuilds 198 | failedBuilds' = (.host) <$> failedBuilds 199 | numFailedBuilds = CMap.size failedBuilds 200 | table time' = 201 | prependLines 202 | (stimes (3 :: Int) horizontal <> " ") 203 | (vertical <> " ") 204 | (lowerleft <> horizontal <> " " <> bigsum <> " ") 205 | $ printAlignedSep (innerTable `appendr` one (lastRow time')) 206 | innerTable :: [NonEmpty Entry] 207 | innerTable = fromMaybe (one (text "")) (nonEmpty headers) : showCond showHosts printHosts 208 | headers = 209 | (cells 3 <$> optHeader showBuilds "Builds") 210 | <> (cells 3 <$> optHeader showDownloads "Downloads") 211 | <> (cells 2 <$> optHeader showUploads "Uploads") 212 | <> optHeader showHosts "Host" 213 | optHeader cond = showCond cond . one . bold . header :: Text -> [Entry] 214 | partial_last_row = 215 | showCond 216 | showBuilds 217 | [ yellow $ nonZeroBold running numRunningBuilds 218 | , green $ nonZeroBold done numCompletedBuilds 219 | , blue $ nonZeroBold todo numPlannedBuilds 220 | ] 221 | <> showCond 222 | showDownloads 223 | [ yellow $ nonZeroBold down downloadsRunning 224 | , green $ nonZeroBold down downloadsDone 225 | , blue $ nonZeroBold todo numPlannedDownloads 226 | ] 227 | <> showCond 228 | showUploads 229 | [ yellow $ nonZeroBold up uploadsRunning 230 | , green $ nonZeroBold up uploadsDone 231 | ] 232 | lastRow time' = partial_last_row `appendr` one (bold (header time')) 233 | 234 | showHosts = Set.size hosts > 1 235 | manyHosts = Set.size buildHosts > 1 || Set.size hosts > 2 -- We only need number labels on hosts if we are using remote builders or more then one transfer peer (normally a substitution cache). 236 | hostNums = zip (toList hosts) [0 ..] 237 | showBuilds = totalBuilds > 0 238 | showDownloads = downloadsDone + downloadsRunning + numPlannedDownloads > 0 239 | showUploads = uploadsDone + uploadsRunning > 0 240 | numPlannedDownloads = CSet.size plannedDownloads 241 | buildHosts = one Localhost <> foldMap (foldMap one) [runningBuilds', completedBuilds', failedBuilds'] 242 | hosts = buildHosts <> foldMap (foldMap (one . (.host))) [completedUploads, completedDownloads] 243 | numRunningBuilds = CMap.size runningBuilds 244 | numCompletedBuilds = CMap.size completedBuilds 245 | numPlannedBuilds = CSet.size plannedBuilds 246 | totalBuilds = numPlannedBuilds + numRunningBuilds + numCompletedBuilds 247 | downloadsDone = CMap.size completedDownloads 248 | downloadsRunning = CMap.size runningDownloads 249 | uploadsRunning = CMap.size runningUploads 250 | uploadsDone = CMap.size completedUploads 251 | finishedWithTraces = 252 | mconcat 253 | [ markup yellow warning 254 | , markup green " Finished " 255 | , markup yellow ("with " <> show (length nixTraces) <> " traces reported by nix") 256 | ] 257 | finishMarkup 258 | | numFailedBuilds > 0 = markup red . ((warning <> " Exited after " <> show numFailedBuilds <> " build failures") <>) 259 | | not (null nixErrors) = markup red . ((warning <> " Exited with " <> show (length nixErrors) <> " errors reported by nix") <>) 260 | | not (null nixTraces) = (finishedWithTraces <>) . markup green 261 | | otherwise = markup green . ("Finished" <>) 262 | printHosts :: [NonEmpty Entry] 263 | printHosts = 264 | mapMaybe (nonEmpty . labelForHost) hostNums 265 | where 266 | labelForHost :: (Host, Int) -> [Entry] 267 | labelForHost (host, index) = 268 | showCond 269 | showBuilds 270 | [ yellow $ nonZeroShowBold running numRunningBuildsOnHost 271 | , green $ nonZeroShowBold done doneBuilds 272 | , dummy 273 | ] 274 | <> showCond 275 | showDownloads 276 | [ yellow $ nonZeroShowBold down downloadsRunning' 277 | , green $ nonZeroShowBold down downloads 278 | , dummy 279 | ] 280 | <> showCond 281 | showUploads 282 | [ yellow $ nonZeroShowBold up uploadsRunning' 283 | , green $ nonZeroShowBold up uploads 284 | ] 285 | <> one (magenta . header $ (if index > 0 && manyHosts then "[" <> show index <> "]: " else "") <> toText host) 286 | where 287 | uploads = action_count_for_host host completedUploads 288 | uploadsRunning' = action_count_for_host host runningUploads 289 | downloads = action_count_for_host host completedDownloads 290 | downloadsRunning' = action_count_for_host host runningDownloads 291 | numRunningBuildsOnHost = action_count_for_host host runningBuilds 292 | doneBuilds = action_count_for_host host completedBuilds 293 | action_count_for_host :: (HasField "host" a Host) => Host -> CMap.CacheIdMap b a -> Int 294 | action_count_for_host host = CMap.size . CMap.filter (\x -> host == x.host) 295 | 296 | nonZeroShowBold :: Text -> Int -> Entry 297 | nonZeroShowBold label' num = if num > 0 then label label' $ text (markup bold (show num)) else dummy 298 | 299 | nonZeroBold :: Text -> Int -> Entry 300 | nonZeroBold label' num = label label' $ text (markup (if num > 0 then bold else id) (show num)) 301 | 302 | data TreeLocation = Root | Twig | Leaf deriving stock (Eq) 303 | 304 | ifTimeDiffRelevant :: Double -> Double -> ([Text] -> [Text]) -> [Text] 305 | ifTimeDiffRelevant to from = ifTimeDurRelevant $ realToFrac (to - from) 306 | 307 | ifTimeDurRelevant :: NominalDiffTime -> ([Text] -> [Text]) -> [Text] 308 | ifTimeDurRelevant dur mod' = memptyIfFalse (dur > 1) (mod' [clock, printDuration dur]) 309 | 310 | printBuilds :: 311 | NOMV1State -> 312 | [(Host, Int)] -> 313 | Int -> 314 | Double -> 315 | NonEmpty Text 316 | printBuilds nomState@MkNOMV1State{..} hostNums maxHeight = printBuildsWithTime 317 | where 318 | hostLabel :: Bool -> Host -> Text 319 | hostLabel color host = (if color then markup magenta else id) $ maybe (toText host) (("[" <>) . (<> "]") . show) (List.lookup host hostNums) 320 | printBuildsWithTime :: Double -> NonEmpty Text 321 | printBuildsWithTime now = (graphHeader :|) $ showForest $ fmap (fmap ($ now)) preparedPrintForest 322 | num_raw_roots = length forestRoots 323 | num_roots = length preparedPrintForest 324 | graphTitle = markup bold "Dependency Graph" 325 | graphHeader = " " <> graphHeaderInner <> ":" 326 | graphHeaderInner 327 | | num_raw_roots <= 1 = graphTitle 328 | | num_raw_roots == num_roots = unwords [graphTitle, "with", show num_roots, "roots"] 329 | | otherwise = unwords [graphTitle, "showing", show num_roots, "of", show num_raw_roots, "roots"] 330 | preparedPrintForest :: Forest (Double -> Text) 331 | preparedPrintForest = mapRootsTwigsAndLeafs (printTreeNode Root) (printTreeNode Twig) (printTreeNode Leaf) <$> buildForest 332 | printTreeNode :: TreeLocation -> DerivationInfo -> Double -> Text 333 | printTreeNode location drvInfo = 334 | let summary = showSummary drvInfo.dependencySummary 335 | (planned, display_drv) = printDerivation drvInfo (get' (inputStorePaths drvInfo)) 336 | displayed_summary = showCond (location == Leaf && planned && not (Text.null summary)) (markup grey " waiting for " <> summary) 337 | in \now -> display_drv now <> displayed_summary 338 | 339 | buildForest :: Forest DerivationInfo 340 | buildForest = evalState (goBuildForest forestRoots) mempty 341 | 342 | goBuildForest :: Seq DerivationId -> State DerivationSet (Forest DerivationInfo) 343 | goBuildForest = \case 344 | (thisDrv Seq.:<| restDrvs) -> do 345 | seen_ids <- get 346 | let mkNode 347 | | not (CSet.member thisDrv seen_ids) && CSet.member thisDrv derivationsToShow = do 348 | let drvInfo = get' (getDerivationInfos thisDrv) 349 | childs = children thisDrv 350 | modify (CSet.insert thisDrv) 351 | subforest <- goBuildForest childs 352 | pure (Node drvInfo subforest :) 353 | | otherwise = pure id 354 | prepend_node <- mkNode 355 | prepend_node <$> goBuildForest restDrvs 356 | _ -> pure [] 357 | derivationsToShow :: DerivationSet 358 | derivationsToShow = 359 | let should_be_shown (index, (can_be_hidden, _, _)) = not can_be_hidden || index < maxHeight 360 | (_, sorted_set) = execState (goDerivationsToShow forestRoots) mempty 361 | in CSet.fromFoldable 362 | $ fmap (\(_, (_, _, drvId)) -> drvId) 363 | $ takeWhile should_be_shown 364 | $ itoList 365 | $ Set.toAscList sorted_set 366 | 367 | children :: DerivationId -> Seq DerivationId 368 | children drv_id = fmap (.derivation) $ (.inputDerivations) $ get' $ getDerivationInfos drv_id 369 | 370 | goDerivationsToShow :: 371 | Seq DerivationId -> 372 | State 373 | ( DerivationSet -- seenIds 374 | , Set 375 | ( Bool -- is allowed to be hidden, 376 | , SortKey 377 | , DerivationId 378 | ) 379 | ) 380 | () 381 | goDerivationsToShow = \case 382 | (thisDrv Seq.:<| restDrvs) -> do 383 | (seen_ids, sorted_set) <- get 384 | let sort_key = sortKey nomState thisDrv 385 | summary@MkDependencySummary{..} = get' (summaryIncludingRoot thisDrv) 386 | runningTransfers = CMap.keysSet runningDownloads <> CMap.keysSet runningUploads 387 | nodesOfRunningTransfers = flip foldMap (CSet.toList runningTransfers) \path -> 388 | let infos = get' (getStorePathInfos path) 389 | in infos.inputFor <> CSet.fromFoldable infos.producer 390 | may_hide = CSet.isSubsetOf (nodesOfRunningTransfers <> CMap.keysSet failedBuilds <> CMap.keysSet runningBuilds) seen_ids 391 | show_this_node = 392 | maxHeight 393 | > 0 394 | && summary 395 | /= mempty 396 | && not (CSet.member thisDrv seen_ids) 397 | && ( not may_hide 398 | || Set.size sorted_set 399 | < maxHeight 400 | || sort_key 401 | < view _2 (Set.elemAt (maxHeight - 1) sorted_set) 402 | ) 403 | new_seen_ids = CSet.insert thisDrv seen_ids 404 | new_sorted_set = Set.insert (may_hide, sort_key, thisDrv) sorted_set 405 | when show_this_node $ put (new_seen_ids, new_sorted_set) >> goDerivationsToShow (children thisDrv) 406 | goDerivationsToShow restDrvs 407 | _ -> pass 408 | 409 | get' :: NOMState b -> b 410 | get' procedure = evalState procedure nomState 411 | 412 | showSummary :: DependencySummary -> Text 413 | showSummary MkDependencySummary{..} = 414 | unwords 415 | $ join 416 | [ memptyIfTrue 417 | (CMap.null failedBuilds) 418 | [markup red $ show (CMap.size failedBuilds) <> " " <> warning] 419 | , memptyIfTrue 420 | (CMap.null runningBuilds) 421 | [markup yellow $ show (CMap.size runningBuilds) <> " " <> running] 422 | , memptyIfTrue 423 | (CSet.null plannedBuilds) 424 | [markup blue $ show (CSet.size plannedBuilds) <> " " <> todo] 425 | , memptyIfTrue 426 | (CMap.null runningUploads) 427 | [markup yellow $ show (CMap.size runningUploads) <> " " <> up] 428 | , memptyIfTrue 429 | (CMap.null runningDownloads) 430 | [markup yellow $ show (CMap.size runningDownloads) <> " " <> down] 431 | , memptyIfTrue 432 | (CSet.null plannedDownloads) 433 | [markup blue $ show (CSet.size plannedDownloads) <> " " <> down <> " " <> todo] 434 | ] 435 | 436 | hostMarkup :: Bool -> Host -> [Text] 437 | hostMarkup _ Localhost = mempty 438 | hostMarkup color host = ["on", hostLabel color host] 439 | 440 | print_hosts :: Bool -> Text -> [Host] -> [Text] 441 | print_hosts color direction_label hosts 442 | | null hosts || length hostNums <= 2 = [] 443 | | otherwise = direction_label : (hostLabel color <$> hosts) 444 | print_hosts_down color = print_hosts color "from" 445 | print_hosts_up color = print_hosts color "to" 446 | 447 | printDerivation :: DerivationInfo -> Map Text StorePathId -> (Bool, Double -> Text) 448 | printDerivation drvInfo _input_store_paths = do 449 | let store_paths_in :: StorePathSet -> Bool 450 | store_paths_in some_set = not $ Map.null $ Map.filter (`CSet.member` some_set) drvInfo.outputs 451 | store_paths_in_map :: StorePathMap (TransferInfo a) -> [TransferInfo a] 452 | store_paths_in_map info_map = toList $ Map.mapMaybe (`CMap.lookup` info_map) drvInfo.outputs 453 | hosts :: [TransferInfo a] -> [Host] 454 | hosts = toList . Set.fromList . fmap (.host) 455 | earliest_start :: [TransferInfo a] -> Double 456 | earliest_start = Unsafe.minimum . fmap (.start) 457 | build_sum :: [TransferInfo (Strict.Maybe Double)] -> NominalDiffTime 458 | build_sum = sum . fmap (\transfer_info -> realToFrac $ Strict.maybe 0 (transfer_info.start -) transfer_info.end) 459 | phaseMay activityId' = do 460 | activityId <- Strict.toLazy activityId' 461 | activity_status <- IntMap.lookup activityId.value nomState.activities 462 | Strict.toLazy $ activity_status.phase 463 | drvName = appendDifferingPlatform nomState drvInfo drvInfo.name.storePath.name 464 | downloadingOutputs = store_paths_in_map drvInfo.dependencySummary.runningDownloads 465 | uploadingOutputs = store_paths_in_map drvInfo.dependencySummary.runningUploads 466 | plannedDownloads = store_paths_in drvInfo.dependencySummary.plannedDownloads 467 | downloadedOutputs = store_paths_in_map drvInfo.dependencySummary.completedDownloads 468 | uploadedOutputs = store_paths_in_map drvInfo.dependencySummary.completedUploads 469 | in -- This code for printing info about every output proved to be to verbose. Keeping it in case we want something like that later on, maybe as an option. 470 | -- store_path_info_list = 471 | -- ((\(name, infos) now -> markups [bold, yellow] (running <> " " <> name <> " " <> down) <> " " <> markup magenta (disambiguate_transfer_host infos.host) <> clock <> " " <> timeDiff now infos.start) <$> store_paths_in_map drvInfo.dependencySummary.runningDownloads) 472 | -- <> ((\(name, infos) now -> markups [bold, yellow] (running <> " " <> name <> " " <> up) <> " " <> markup magenta (disambiguate_transfer_host infos.host) <> clock <> " " <> timeDiff now infos.start) <$> store_paths_in_map drvInfo.dependencySummary.runningUploads) 473 | -- <> ((\name -> const $ markup blue (todo <> name <> " " <> down)) <$> store_paths_in drvInfo.dependencySummary.plannedDownloads) 474 | -- <> ((\(name, infos) -> const $ markups [bold, green] (done <> " ") <> markup green (name <> " " <> down <> " ") <> markup magenta (disambiguate_transfer_host infos.host) <> markup grey (maybe "" (\end -> clock <> " " <> timeDiff end infos.start) infos.end)) <$> store_paths_in_map drvInfo.dependencySummary.completedDownloads) 475 | -- <> ((\(name, infos) -> const $ markups [bold, green] (done <> " ") <> markup green (name <> " " <> up <> " ") <> markup magenta (disambiguate_transfer_host infos.host) <> markup grey (maybe "" (\end -> clock <> " " <> timeDiff end infos.start) infos.end)) <$> store_paths_in_map drvInfo.dependencySummary.completedUploads) 476 | -- store_path_infos = if null store_path_info_list then const "" else \now -> " (" <> Text.intercalate ", " (($ now) <$> store_path_info_list) <> ")" 477 | 478 | case drvInfo.buildStatus of 479 | _ 480 | | not $ null downloadingOutputs -> 481 | ( False 482 | , \now -> 483 | unwords 484 | $ markups [bold, yellow] (down <> " " <> running <> " " <> drvName) 485 | : ( print_hosts_down True (hosts downloadingOutputs) 486 | <> ifTimeDiffRelevant now (earliest_start downloadingOutputs) id 487 | ) 488 | ) 489 | | not $ null uploadingOutputs -> 490 | ( False 491 | , \now -> 492 | unwords 493 | $ markups [bold, yellow] (up <> " " <> running <> " " <> drvName) 494 | : ( print_hosts_up True (hosts uploadingOutputs) 495 | <> ifTimeDiffRelevant now (earliest_start uploadingOutputs) id 496 | ) 497 | ) 498 | Unknown 499 | | plannedDownloads -> (True, const $ markup blue (down <> " " <> todo <> " " <> drvName)) 500 | | not $ null downloadedOutputs -> 501 | ( False 502 | , const 503 | $ unwords 504 | $ markup green (down <> " " <> done <> " " <> drvName) 505 | : fmap 506 | (markup grey) 507 | ( print_hosts_down False (hosts downloadedOutputs) 508 | <> ifTimeDurRelevant (build_sum downloadedOutputs) id 509 | ) 510 | ) 511 | | not $ null uploadedOutputs -> 512 | ( False 513 | , const 514 | $ unwords 515 | $ markup green (up <> " " <> done <> " " <> drvName) 516 | : fmap 517 | (markup grey) 518 | ( print_hosts_up False (hosts uploadedOutputs) 519 | <> ifTimeDurRelevant (build_sum uploadedOutputs) id 520 | ) 521 | ) 522 | | otherwise -> (False, const drvName) 523 | Planned -> (True, const $ markup blue (todo <> " " <> drvName)) 524 | Building buildInfo -> 525 | let phaseList = case phaseMay buildInfo.activityId of 526 | Nothing -> [] 527 | Just phase -> [markup bold ("(" <> phase <> ")")] 528 | before_time = 529 | [markups [yellow, bold] (running <> " " <> drvName)] 530 | <> hostMarkup True buildInfo.host 531 | <> phaseList 532 | after_time = Strict.maybe [] (\x -> ["(" <> average <> " " <> timeDiffSeconds x <> ")"]) buildInfo.estimate 533 | in (False, \now -> unwords $ before_time <> ifTimeDiffRelevant now buildInfo.start (<> after_time)) 534 | Failed buildInfo -> 535 | let MkBuildFail endTime failType = buildInfo.end 536 | phaseInfo = case phaseMay buildInfo.activityId of 537 | Nothing -> [] 538 | Just phase -> ["in", phase] 539 | in ( False 540 | , const 541 | . markups [red, bold] 542 | . unwords 543 | $ [warning, drvName] 544 | <> hostMarkup False buildInfo.host 545 | <> ["failed with", printFailType failType, "after", clock, timeDiff endTime buildInfo.start] 546 | <> phaseInfo 547 | ) 548 | Built buildInfo -> 549 | ( False 550 | , const 551 | $ markup green (done <> " " <> drvName) 552 | <> " " 553 | <> ( markup grey 554 | . unwords 555 | $ ( hostMarkup False buildInfo.host 556 | <> ifTimeDiffRelevant buildInfo.end buildInfo.start id 557 | ) 558 | ) 559 | ) 560 | 561 | printFailType :: FailType -> Text 562 | printFailType = \case 563 | ExitCode i -> "exit code " <> show i 564 | HashMismatch -> "hash mismatch" 565 | 566 | timeDiff :: Double -> Double -> Text 567 | timeDiff x = 568 | printDuration . realToFrac . (x -) 569 | 570 | minute :: NominalDiffTime 571 | minute = 60 572 | 573 | hour :: NominalDiffTime 574 | hour = 60 * minute 575 | 576 | day :: NominalDiffTime 577 | day = 24 * hour 578 | 579 | printDuration :: NominalDiffTime -> Text 580 | printDuration diff 581 | | diff < minute = p "%Ss" 582 | | diff < hour = p "%Mm%Ss" 583 | | diff < day = p "%Hh%Mm%Ss" 584 | | otherwise = p "%dd%Hh%Mm%Ss" 585 | where 586 | p x = toText $ formatTime defaultTimeLocale x diff 587 | 588 | timeDiffSeconds :: Int -> Text 589 | timeDiffSeconds = printDuration . fromIntegral 590 | -------------------------------------------------------------------------------- /lib/NOM/Print/Table.hs: -------------------------------------------------------------------------------- 1 | module NOM.Print.Table ( 2 | Entry, 3 | cells, 4 | printAlignedSep, 5 | prependLines, 6 | text, 7 | label, 8 | bold, 9 | green, 10 | yellow, 11 | blue, 12 | magenta, 13 | red, 14 | dummy, 15 | header, 16 | displayWidth, 17 | truncate, 18 | markup, 19 | markups, 20 | grey, 21 | displayWidthBS, 22 | ) where 23 | 24 | import Control.Exception (assert) 25 | -- ansi-terminal 26 | 27 | import Data.ByteString.Char8 qualified as ByteString 28 | import Data.Text qualified as Text 29 | import Relude hiding (truncate) 30 | import System.Console.ANSI ( 31 | Color (Black, Blue, Green, Magenta, Red, Yellow), 32 | ColorIntensity (Dull, Vivid), 33 | ConsoleIntensity (BoldIntensity), 34 | ConsoleLayer (Foreground), 35 | SGR (Reset, SetColor, SetConsoleIntensity), 36 | setSGRCode, 37 | ) 38 | 39 | data Entry = Entry 40 | { codes :: [SGR] 41 | , lcontent :: Text 42 | , rcontent :: Text 43 | , width :: Int 44 | } 45 | 46 | -- >>> displayWidth "∑" 47 | -- 1 48 | 49 | {- | Gives display width of a string, correctly ignoring ANSI codes and trying to 50 | guess correct with for unicode symbols like emojis. 51 | -} 52 | displayWidth :: Text -> Int 53 | displayWidth = fst . Text.foldl' widthFold (0, False) 54 | 55 | -- | Like displayWidth but for ByteString 56 | displayWidthBS :: ByteString -> Int 57 | displayWidthBS = fst . ByteString.foldl' widthFold (0, False) 58 | 59 | truncate :: Int -> Text -> Text 60 | truncate cut = either id (\(x, _, _) -> x) . Text.foldl' (truncateFold cut) (Right ("", 0, False)) 61 | 62 | truncateFold :: Int -> Either Text (Text, Int, Bool) -> Char -> Either Text (Text, Int, Bool) 63 | truncateFold _ (Left x) _ = Left x 64 | truncateFold cut (Right (l, x, e)) c = 65 | let (newX, newE) = widthFold (x, e) c 66 | in if newX > cut then Left l else Right (l <> Text.singleton c, newX, newE) 67 | 68 | -- See: https://github.com/maralorn/nix-output-monitor/issues/78 69 | widthFold :: 70 | -- | (Width so far, in an ANSI escape sequence) 71 | (Int, Bool) -> 72 | Char -> 73 | (Int, Bool) 74 | widthFold (x, True) 'm' = (x, False) 75 | widthFold (x, True) _ = (x, True) 76 | widthFold (x, False) (fromEnum -> 0x1b) = (x, True) -- Escape sequence 77 | widthFold (x, False) _ = (x + 1, False) 78 | 79 | dummy :: Entry 80 | dummy = text "" 81 | 82 | text :: Text -> Entry 83 | text t = Entry [] "" t 1 84 | 85 | header :: Text -> Entry 86 | header t = Entry [] t "" 1 87 | 88 | cells :: Int -> Entry -> Entry 89 | cells width e = e{width} 90 | 91 | label :: Text -> Entry -> Entry 92 | label t e = e{lcontent = t} 93 | 94 | addCode :: SGR -> Entry -> Entry 95 | addCode code e = e{codes = code : e.codes} 96 | 97 | addColor :: Color -> Entry -> Entry 98 | addColor = addCode . SetColor Foreground Dull 99 | 100 | bold, red, green, yellow, blue, magenta, grey :: Entry -> Entry 101 | bold = addCode (SetConsoleIntensity BoldIntensity) 102 | green = addColor Green 103 | red = addColor Red 104 | yellow = addColor Yellow 105 | blue = addColor Blue 106 | magenta = addColor Magenta 107 | grey = addCode $ SetColor Foreground Vivid Black 108 | 109 | prependLines :: Text -> Text -> Text -> NonEmpty Text -> Text 110 | prependLines top mid bot rows = 111 | assert 112 | matching 113 | ( top 114 | <> Text.intercalate ("\n" <> mid) allButLast 115 | <> memptyIfTrue (null allButLast) ("\n" <> bot) 116 | <> last rows 117 | ) 118 | where 119 | allButLast = init rows 120 | matching = Text.length top == Text.length mid && Text.length mid == Text.length bot 121 | 122 | verticalSlim, hsep :: Text 123 | verticalSlim = "│" 124 | hsep = " " <> verticalSlim <> " " 125 | 126 | printAlignedSep :: NonEmpty (NonEmpty Entry) -> NonEmpty Text 127 | printAlignedSep rows = printRow hsep (toList $ widths hsep rows) <$> rows 128 | 129 | widths :: Text -> NonEmpty (NonEmpty Entry) -> NonEmpty Int 130 | widths sep rows = nonEmpty restList & maybe (one width) (\rest -> width :| toList (widths sep rest)) 131 | where 132 | (width, restList) = nextWidth sep rows 133 | 134 | nextWidth :: Text -> NonEmpty (NonEmpty Entry) -> (Int, [NonEmpty Entry]) 135 | nextWidth sep rows = (width, chopWidthFromRows sep width rows) 136 | where 137 | width = getWidthForNextColumn rows 138 | 139 | getWidthForNextColumn :: NonEmpty (NonEmpty Entry) -> Int 140 | getWidthForNextColumn = getWidthForColumn . fmap head 141 | 142 | getWidthForColumn :: NonEmpty Entry -> Int 143 | getWidthForColumn = foldl' max 0 . fmap getRelevantWidthForEntry 144 | 145 | getRelevantWidthForEntry :: Entry -> Int 146 | getRelevantWidthForEntry entry 147 | | entry.width == 1 = entryWidth entry 148 | getRelevantWidthForEntry _ = 0 149 | 150 | entryWidth :: Entry -> Int 151 | entryWidth Entry{lcontent, rcontent} = displayWidth lcontent + displayWidth rcontent + if Text.null lcontent || Text.null rcontent then 0 else 1 152 | 153 | chopWidthFromRows :: Text -> Int -> NonEmpty (NonEmpty Entry) -> [NonEmpty Entry] 154 | chopWidthFromRows sep width = mapMaybe (nonEmpty . chopWidthFromRow sep width) . toList 155 | 156 | chopWidthFromRow :: Text -> Int -> NonEmpty Entry -> [Entry] 157 | chopWidthFromRow sep targetWidth (entry@Entry{width} :| rest) 158 | | width > 1 = entry{width = width - 1, lcontent = "", rcontent = mtimesDefault (max 0 (entryWidth entry - targetWidth - displayWidth sep)) " "} : rest 159 | chopWidthFromRow _ _ (_ :| rest) = rest 160 | 161 | printRow :: Text -> [Int] -> NonEmpty Entry -> Text 162 | printRow sep colWidths entries = Text.intercalate sep $ snd (foldl' foldFun (colWidths, id) entries) [] 163 | where 164 | foldFun (colsLeft, line) entry@Entry{width} = 165 | (drop width colsLeft, line . (printEntry sep entry (take width colsLeft) :)) 166 | 167 | -- >>> printEntry "" (cells 2 (label ">" (text "<"))) [] 168 | -- "><" 169 | 170 | markups :: [Entry -> Entry] -> Text -> Text 171 | markups fs = foldl' (.) id (markup <$> fs) 172 | 173 | markup :: (Entry -> Entry) -> Text -> Text 174 | markup f = showEntry . f . text 175 | 176 | showEntry :: Entry -> Text 177 | showEntry = flip (printEntry "") [] 178 | 179 | printEntry :: Text -> Entry -> [Int] -> Text 180 | printEntry sep Entry{codes, lcontent, rcontent} entryWidths = whenCodes codes <> lcontent <> spacing <> rcontent <> whenCodes [Reset] 181 | where 182 | spaces = max 0 (width - displayWidth rcontent - displayWidth lcontent) 183 | spacing = mtimesDefault spaces " " 184 | whenCodes = memptyIfFalse (not . null $ codes) . toText . setSGRCode 185 | width = sum entryWidths + (Text.length sep * (length entryWidths - 1)) 186 | -------------------------------------------------------------------------------- /lib/NOM/Print/Tree.hs: -------------------------------------------------------------------------------- 1 | module NOM.Print.Tree (showForest) where 2 | 3 | import Data.Tree (Forest, Tree (..)) 4 | import NOM.Print.Table (blue, markup) 5 | import Relude 6 | 7 | showForest :: Forest Text -> [Text] 8 | showForest = reverse . go False 9 | where 10 | go :: Bool -> Forest Text -> [Text] 11 | go indent = join . (if indent then onLastAndRest (onFirstAndRest (markup blue "┌─ " <>) (" " <>)) (onFirstAndRest (markup blue "├─ " <>) (markup blue "│ " <>)) else id) . fmap showTree 12 | showTree :: Tree Text -> [Text] 13 | showTree (Node label' content) = label' : go True content 14 | onFirstAndRest :: (a -> b) -> (a -> b) -> [a] -> [b] 15 | onFirstAndRest _ _ [] = [] 16 | onFirstAndRest f g (x : xs) = f x : (g <$> xs) 17 | onLastAndRest :: (a -> b) -> (a -> b) -> [a] -> [b] 18 | onLastAndRest _ _ [] = [] 19 | onLastAndRest f _ [x] = [f x] 20 | onLastAndRest f g (x : xs) = g x : onLastAndRest f g xs 21 | -------------------------------------------------------------------------------- /lib/NOM/State.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-orphans #-} 2 | {-# OPTIONS_GHC -Wno-redundant-constraints #-} 3 | 4 | module NOM.State ( 5 | ProgressState (..), 6 | RunningBuildInfo, 7 | StorePathId, 8 | StorePathState (..), 9 | StorePathInfo (..), 10 | StorePathSet, 11 | StorePathMap, 12 | BuildInfo (..), 13 | BuildStatus (..), 14 | DependencySummary (..), 15 | DerivationId, 16 | DerivationInfo (..), 17 | DerivationSet, 18 | DerivationMap, 19 | TransferInfo (..), 20 | BuildFail (..), 21 | NOMState, 22 | NOMV1State (..), 23 | ActivityStatus (..), 24 | InterestingActivity (..), 25 | InputDerivation (..), 26 | EvalInfo (..), 27 | getDerivationInfos, 28 | initalStateFromBuildPlatform, 29 | updateSummaryForStorePath, 30 | clearDerivationIdFromSummary, 31 | clearStorePathsFromSummary, 32 | getStorePathInfos, 33 | NOMStateT, 34 | getRunningBuilds, 35 | getRunningBuildsByHost, 36 | lookupStorePathId, 37 | getStorePathId, 38 | getDerivationId, 39 | outPathToDerivation, 40 | derivationToAnyOutPath, 41 | updateSummaryForDerivation, 42 | inputStorePaths, 43 | parseOutputName, 44 | OutputName (..), 45 | ) where 46 | 47 | import Data.Map.Strict qualified as Map 48 | import Data.Set qualified as Set 49 | import Data.Strict qualified as Strict 50 | import Data.Text qualified as Text 51 | import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..)) 52 | import NOM.NixMessage.JSON (Activity, ActivityId, ActivityProgress) 53 | import NOM.State.CacheId (CacheId) 54 | import NOM.State.CacheId.Map (CacheIdMap) 55 | import NOM.State.CacheId.Map qualified as CMap 56 | import NOM.State.CacheId.Set (CacheIdSet) 57 | import NOM.State.CacheId.Set qualified as CSet 58 | import NOM.Update.Monad ( 59 | BuildReportMap, 60 | MonadCacheBuildReports (getCachedBuildReports), 61 | MonadNow, 62 | getNow, 63 | ) 64 | import NOM.Util (foldMapEndo) 65 | import Optics (gfield, (%~)) 66 | import Relude 67 | import Type.Strict qualified as StrictType 68 | 69 | instance (StrictType.StrictType seen v) => StrictType.StrictType seen (IntMap v) 70 | 71 | instance (StrictType.StrictType seen v) => StrictType.StrictType seen (Map k v) 72 | 73 | instance StrictType.StrictType seen IntSet 74 | 75 | instance (StrictType.StrictType seen v) => StrictType.StrictType seen (Seq v) 76 | 77 | data StorePathState 78 | = DownloadPlanned 79 | | Downloading RunningTransferInfo 80 | | Uploading RunningTransferInfo 81 | | Downloaded CompletedTransferInfo 82 | | Uploaded CompletedTransferInfo 83 | deriving stock (Show, Eq, Ord, Generic) 84 | 85 | data OutputName 86 | = Out 87 | | Doc 88 | | Dev 89 | | Bin 90 | | Info 91 | | Lib 92 | | Man 93 | | Dist 94 | | Other Text 95 | deriving stock (Show, Eq, Ord, Generic) 96 | 97 | outputNames :: Map Text OutputName 98 | outputNames = 99 | Map.fromList 100 | . fmap (\x -> (Text.toLower (show x), x)) 101 | $ [ Out 102 | , Doc 103 | , Dev 104 | , Bin 105 | , Info 106 | , Lib 107 | , Man 108 | , Dist 109 | ] 110 | 111 | parseOutputName :: Text -> OutputName 112 | parseOutputName name = fromMaybe (Other name) $ Map.lookup name outputNames 113 | 114 | data InputDerivation = MkInputDerivation 115 | { derivation :: DerivationId 116 | , outputs :: Set OutputName 117 | } 118 | deriving stock (Show, Eq, Ord, Generic) 119 | 120 | data DerivationInfo = MkDerivationInfo 121 | { name :: Derivation 122 | , outputs :: Map OutputName StorePathId 123 | , inputDerivations :: Seq InputDerivation 124 | , inputSources :: StorePathSet 125 | , buildStatus :: BuildStatus 126 | , dependencySummary :: DependencySummary 127 | , cached :: Bool 128 | , derivationParents :: DerivationSet 129 | , pname :: Strict.Maybe Text 130 | , platform :: Strict.Maybe Text 131 | } 132 | deriving stock (Show, Eq, Ord, Generic) 133 | 134 | type StorePathId = CacheId StorePath 135 | 136 | type DerivationId = CacheId Derivation 137 | 138 | type StorePathMap = CacheIdMap StorePath 139 | 140 | type DerivationMap = CacheIdMap Derivation 141 | 142 | type StorePathSet = CacheIdSet StorePath 143 | 144 | type DerivationSet = CacheIdSet Derivation 145 | 146 | data StorePathInfo = MkStorePathInfo 147 | { name :: StorePath 148 | , states :: Set StorePathState 149 | , producer :: Strict.Maybe DerivationId 150 | , inputFor :: DerivationSet 151 | } 152 | deriving stock (Show, Eq, Ord, Generic) 153 | 154 | type RunningBuildInfo = BuildInfo () 155 | 156 | type CompletedBuildInfo = BuildInfo Double 157 | 158 | type RunningTransferInfo = TransferInfo () 159 | 160 | type CompletedTransferInfo = TransferInfo (Strict.Maybe Double) 161 | 162 | type FailedBuildInfo = BuildInfo BuildFail 163 | 164 | data DependencySummary = MkDependencySummary 165 | { plannedBuilds :: DerivationSet 166 | , runningBuilds :: DerivationMap RunningBuildInfo 167 | , completedBuilds :: DerivationMap CompletedBuildInfo 168 | , failedBuilds :: DerivationMap FailedBuildInfo 169 | , plannedDownloads :: StorePathSet 170 | , completedDownloads :: StorePathMap CompletedTransferInfo 171 | , completedUploads :: StorePathMap CompletedTransferInfo 172 | , runningDownloads :: StorePathMap RunningTransferInfo 173 | , runningUploads :: StorePathMap RunningTransferInfo 174 | } 175 | deriving stock (Show, Eq, Ord, Generic) 176 | 177 | data ActivityStatus = MkActivityStatus 178 | { activity :: Activity 179 | , phase :: Strict.Maybe Text 180 | , progress :: Strict.Maybe ActivityProgress 181 | } 182 | deriving stock (Show, Eq, Ord, Generic) 183 | 184 | data InterestingActivity = MkInterestingUnknownActivity 185 | { text :: Text 186 | , start :: Double 187 | } 188 | deriving stock (Show, Eq, Ord, Generic) 189 | 190 | data EvalInfo = MkEvalInfo 191 | { lastFileName :: Strict.Maybe Text 192 | , count :: Int 193 | , at :: Double 194 | } 195 | deriving stock (Show, Eq, Ord, Generic) 196 | 197 | data NOMV1State = MkNOMV1State 198 | { derivationInfos :: DerivationMap DerivationInfo 199 | , storePathInfos :: StorePathMap StorePathInfo 200 | , fullSummary :: DependencySummary 201 | , forestRoots :: Seq DerivationId 202 | , buildReports :: BuildReportMap 203 | , startTime :: Double 204 | , progressState :: ProgressState 205 | , storePathIds :: Map StorePath StorePathId 206 | , derivationIds :: Map Derivation DerivationId 207 | , touchedIds :: DerivationSet 208 | , activities :: IntMap ActivityStatus 209 | , nixErrors :: Seq Text 210 | , nixTraces :: Seq Text 211 | , buildPlatform :: Strict.Maybe Text 212 | , interestingActivities :: IntMap InterestingActivity 213 | , evaluationState :: EvalInfo 214 | } 215 | deriving stock (Show, Eq, Ord, Generic) 216 | 217 | data ProgressState = JustStarted | InputReceived | Finished 218 | deriving stock (Show, Eq, Ord, Generic) 219 | 220 | data BuildFail = MkBuildFail 221 | { at :: Double 222 | , failType :: FailType 223 | } 224 | deriving stock (Show, Eq, Ord, Generic) 225 | 226 | data BuildStatus 227 | = Unknown 228 | | Planned 229 | | Building (BuildInfo ()) 230 | | Failed (BuildInfo BuildFail) -- End 231 | | Built (BuildInfo Double) -- End 232 | deriving stock (Show, Eq, Ord, Generic) 233 | 234 | data BuildInfo a = MkBuildInfo 235 | { start :: Double 236 | , host :: Host 237 | , estimate :: Strict.Maybe Int 238 | , activityId :: Strict.Maybe ActivityId 239 | , end :: a 240 | } 241 | deriving stock (Show, Eq, Ord, Generic, Functor) 242 | 243 | data TransferInfo a = MkTransferInfo 244 | { host :: Host 245 | , start :: Double 246 | , end :: a 247 | } 248 | deriving stock (Show, Eq, Ord, Generic, Functor) 249 | 250 | initalStateFromBuildPlatform :: (MonadCacheBuildReports m, MonadNow m) => Maybe Text -> m NOMV1State 251 | initalStateFromBuildPlatform platform = do 252 | now <- getNow 253 | buildReports <- getCachedBuildReports 254 | pure 255 | $ MkNOMV1State 256 | mempty 257 | mempty 258 | mempty 259 | mempty 260 | buildReports 261 | now 262 | JustStarted 263 | mempty 264 | mempty 265 | mempty 266 | mempty 267 | mempty 268 | mempty 269 | (Strict.toStrict platform) 270 | mempty 271 | MkEvalInfo{count = 0, at = 0, lastFileName = Strict.Nothing} 272 | 273 | instance Semigroup DependencySummary where 274 | (MkDependencySummary ls1 lm2 lm3 lm4 ls5 lm6 lm7 lm8 lm9) <> (MkDependencySummary rs1 rm2 rm3 rm4 rs5 rm6 rm7 rm8 rm9) = MkDependencySummary (ls1 <> rs1) (lm2 <> rm2) (lm3 <> rm3) (lm4 <> rm4) (ls5 <> rs5) (lm6 <> rm6) (lm7 <> rm7) (lm8 <> rm8) (lm9 <> rm9) 275 | 276 | instance Monoid DependencySummary where 277 | mempty = MkDependencySummary mempty mempty mempty mempty mempty mempty mempty mempty mempty 278 | 279 | getRunningBuilds :: NOMState (DerivationMap RunningBuildInfo) 280 | getRunningBuilds = gets (.fullSummary.runningBuilds) 281 | 282 | getRunningBuildsByHost :: Host -> NOMState (DerivationMap RunningBuildInfo) 283 | getRunningBuildsByHost host = CMap.filter (\x -> x.host == host) <$> getRunningBuilds 284 | 285 | lookupStorePathId :: StorePathId -> NOMState StorePath 286 | lookupStorePathId pathId = (.name) <$> getStorePathInfos pathId 287 | 288 | type NOMState a = forall m. (MonadState NOMV1State m) => m a 289 | 290 | type NOMStateT m a = (MonadState NOMV1State m) => m a 291 | 292 | emptyStorePathInfo :: StorePath -> StorePathInfo 293 | emptyStorePathInfo path = MkStorePathInfo path mempty Strict.Nothing mempty 294 | 295 | emptyDerivationInfo :: Derivation -> DerivationInfo 296 | emptyDerivationInfo drv = MkDerivationInfo drv mempty mempty mempty Unknown mempty False mempty Strict.Nothing Strict.Nothing 297 | 298 | getStorePathId :: StorePath -> NOMState StorePathId 299 | getStorePathId path = do 300 | let newId = do 301 | key <- gets (CMap.nextKey . (.storePathInfos)) 302 | modify' (gfield @"storePathInfos" %~ CMap.insert key (emptyStorePathInfo path)) 303 | modify' (gfield @"storePathIds" %~ Map.insert path key) 304 | pure key 305 | gets (Map.lookup path . (.storePathIds)) >>= maybe newId pure 306 | 307 | getDerivationId :: Derivation -> NOMState DerivationId 308 | getDerivationId drv = do 309 | let newId = do 310 | key <- gets (CMap.nextKey . (.derivationInfos)) 311 | modify' (gfield @"derivationInfos" %~ CMap.insert key (emptyDerivationInfo drv)) 312 | modify' (gfield @"derivationIds" %~ Map.insert drv key) 313 | pure key 314 | gets (Map.lookup drv . (.derivationIds)) >>= maybe newId pure 315 | 316 | inputStorePaths :: DerivationInfo -> NOMState (Map Text StorePathId) 317 | inputStorePaths drv_info = do 318 | inputs <- forM (CSet.toList drv_info.inputSources) \source -> do 319 | store_path_infos <- getStorePathInfos source 320 | pure (store_path_infos.name.name, source) 321 | pure $ Map.fromList inputs 322 | 323 | derivationToAnyOutPath :: DerivationId -> NOMState (Maybe StorePath) 324 | derivationToAnyOutPath drv = 325 | gets (CMap.lookup drv . (.derivationInfos) >=> listToMaybe . Map.elems . (.outputs)) 326 | >>= mapM (\pathId -> lookupStorePathId pathId) 327 | 328 | outPathToDerivation :: StorePathId -> NOMState (Maybe DerivationId) 329 | outPathToDerivation path = gets (CMap.lookup path . (.storePathInfos) >=> Strict.toLazy . (.producer)) 330 | 331 | -- Only do this with derivationIds that you got via lookupDerivation 332 | getDerivationInfos :: DerivationId -> NOMState DerivationInfo 333 | getDerivationInfos drvId = 334 | fromMaybe (error "BUG: drvId is no key in derivationInfos") 335 | . CMap.lookup drvId 336 | . (.derivationInfos) 337 | <$> get 338 | 339 | -- Only do this with derivationIds that you got via lookupDerivation 340 | getStorePathInfos :: StorePathId -> NOMState StorePathInfo 341 | getStorePathInfos storePathId = 342 | fromMaybe (error "BUG: storePathId is no key in storePathInfos") 343 | . CMap.lookup storePathId 344 | . (.storePathInfos) 345 | <$> get 346 | 347 | clearDerivationIdFromSummary :: BuildStatus -> DerivationId -> DependencySummary -> DependencySummary 348 | clearDerivationIdFromSummary oldStatus drvId = case oldStatus of 349 | Unknown -> id 350 | Planned -> gfield @"plannedBuilds" %~ CSet.delete drvId 351 | Building _ -> gfield @"runningBuilds" %~ CMap.delete drvId 352 | Failed _ -> gfield @"failedBuilds" %~ CMap.delete drvId 353 | Built _ -> gfield @"completedBuilds" %~ CMap.delete drvId 354 | 355 | updateSummaryForDerivation :: BuildStatus -> BuildStatus -> DerivationId -> DependencySummary -> DependencySummary 356 | updateSummaryForDerivation oldStatus newStatus drvId = 357 | clearDerivationIdFromSummary oldStatus drvId . case newStatus of 358 | Unknown -> id 359 | Planned -> gfield @"plannedBuilds" %~ CSet.insert drvId 360 | Building bi -> gfield @"runningBuilds" %~ CMap.insert drvId (void bi) 361 | Failed bi -> gfield @"failedBuilds" %~ CMap.insert drvId bi 362 | Built bi -> gfield @"completedBuilds" %~ CMap.insert drvId bi 363 | 364 | clearStorePathsFromSummary :: Set StorePathState -> StorePathId -> DependencySummary -> DependencySummary 365 | clearStorePathsFromSummary deleted_states path_id = 366 | foldMapEndo remove_deleted deleted_states 367 | where 368 | remove_deleted :: StorePathState -> DependencySummary -> DependencySummary 369 | remove_deleted = \case 370 | DownloadPlanned -> gfield @"plannedDownloads" %~ CSet.delete path_id 371 | Downloading _ -> gfield @"runningDownloads" %~ CMap.delete path_id 372 | Uploading _ -> gfield @"runningUploads" %~ CMap.delete path_id 373 | Downloaded _ -> gfield @"completedDownloads" %~ CMap.delete path_id 374 | Uploaded _ -> gfield @"completedUploads" %~ CMap.delete path_id 375 | 376 | updateSummaryForStorePath :: Set StorePathState -> Set StorePathState -> StorePathId -> DependencySummary -> DependencySummary 377 | updateSummaryForStorePath old_states new_states path_id = 378 | foldMapEndo insert_added added_states . clearStorePathsFromSummary deleted_states path_id 379 | where 380 | insert_added :: StorePathState -> DependencySummary -> DependencySummary 381 | insert_added = \case 382 | DownloadPlanned -> gfield @"plannedDownloads" %~ CSet.insert path_id 383 | Downloading ho -> gfield @"runningDownloads" %~ CMap.insert path_id ho 384 | Uploading ho -> gfield @"runningUploads" %~ CMap.insert path_id ho 385 | Downloaded ho -> gfield @"completedDownloads" %~ CMap.insert path_id ho 386 | Uploaded ho -> gfield @"completedUploads" %~ CMap.insert path_id ho 387 | deleted_states = Set.difference old_states new_states 388 | added_states = Set.difference new_states old_states 389 | -------------------------------------------------------------------------------- /lib/NOM/State/CacheId.hs: -------------------------------------------------------------------------------- 1 | module NOM.State.CacheId (CacheId (..)) where 2 | 3 | import Data.MemoTrie (HasTrie (..)) 4 | import Relude 5 | 6 | type CacheId :: Type -> Type 7 | newtype CacheId b = MkCacheId {unCacheId :: Int} 8 | deriving stock (Show, Eq, Ord, Read, Generic) 9 | 10 | instance HasTrie (CacheId b) where 11 | newtype CacheId b :->: c = CacheIdTrie (Int :->: c) 12 | trie = coerce (trie @Int) 13 | untrie = coerce (untrie @Int) 14 | enumerate = coerce (enumerate @Int) 15 | -------------------------------------------------------------------------------- /lib/NOM/State/CacheId/Map.hs: -------------------------------------------------------------------------------- 1 | module NOM.State.CacheId.Map ( 2 | NOM.State.CacheId.Map.filter, 3 | NOM.State.CacheId.Map.toList, 4 | lookup, 5 | insert, 6 | keysSet, 7 | nextKey, 8 | adjust, 9 | delete, 10 | size, 11 | NOM.State.CacheId.Map.null, 12 | CacheIdMap, 13 | ) where 14 | 15 | import Data.IntMap.Strict qualified as IntMap 16 | import NOM.State.CacheId (CacheId (MkCacheId)) 17 | import NOM.State.CacheId.Set qualified as CSet 18 | import Relude 19 | 20 | type CacheIdMap :: Type -> Type -> Type 21 | newtype CacheIdMap b a = MkCacheIdMap {intMap :: IntMap a} 22 | deriving stock (Show, Eq, Ord, Read, Generic) 23 | deriving newtype (Semigroup, Monoid, Foldable, Functor) 24 | 25 | filter :: (a -> Bool) -> CacheIdMap b a -> CacheIdMap b a 26 | filter p = MkCacheIdMap . IntMap.filter p . (.intMap) 27 | 28 | lookup :: CacheId b -> CacheIdMap b a -> Maybe a 29 | lookup (MkCacheId index) cmap = IntMap.lookup index cmap.intMap 30 | 31 | toList :: CacheIdMap b a -> [(CacheId b, a)] 32 | toList = fmap (first MkCacheId) . IntMap.toList . (.intMap) 33 | 34 | insert :: CacheId b -> a -> CacheIdMap b a -> CacheIdMap b a 35 | insert (MkCacheId index) value cmap = MkCacheIdMap $ IntMap.insert index value cmap.intMap 36 | 37 | keysSet :: CacheIdMap b a -> CSet.CacheIdSet b 38 | keysSet = coerce . IntMap.keysSet . (.intMap) 39 | 40 | nextKey :: CacheIdMap b a -> CacheId b 41 | nextKey = MkCacheId . maybe 0 ((+ 1) . fst) . IntMap.lookupMax . (.intMap) 42 | 43 | adjust :: (a -> a) -> CacheId b -> CacheIdMap b a -> CacheIdMap b a 44 | adjust f (MkCacheId key) = MkCacheIdMap . IntMap.adjust f key . (.intMap) 45 | 46 | delete :: CacheId b -> CacheIdMap b a -> CacheIdMap b a 47 | delete (MkCacheId key) = coerce . IntMap.delete key . (.intMap) 48 | 49 | size :: CacheIdMap b a -> Int 50 | size = IntMap.size . (.intMap) 51 | 52 | null :: CacheIdMap b a -> Bool 53 | null = IntMap.null . (.intMap) 54 | -------------------------------------------------------------------------------- /lib/NOM/State/CacheId/Set.hs: -------------------------------------------------------------------------------- 1 | module NOM.State.CacheId.Set ( 2 | insert, 3 | CacheIdSet (MkCacheIdSet), 4 | NOM.State.CacheId.Set.toList, 5 | NOM.State.CacheId.Set.null, 6 | fromFoldable, 7 | maxView, 8 | union, 9 | difference, 10 | delete, 11 | size, 12 | isSubsetOf, 13 | member, 14 | ) where 15 | 16 | import Data.IntSet qualified as IntSet 17 | import NOM.State.CacheId (CacheId (MkCacheId)) 18 | import Relude hiding (head) 19 | 20 | type CacheIdSet :: Type -> Type 21 | newtype CacheIdSet b = MkCacheIdSet {ints :: IntSet} 22 | deriving stock (Show, Eq, Ord, Read, Generic) 23 | deriving newtype (Semigroup, Monoid) 24 | 25 | insert :: CacheId b -> CacheIdSet b -> CacheIdSet b 26 | insert (MkCacheId x) = MkCacheIdSet . IntSet.insert x . (.ints) 27 | 28 | toList :: CacheIdSet b -> [CacheId b] 29 | toList = fmap MkCacheId . IntSet.toList . (.ints) 30 | 31 | fromFoldable :: (Foldable f) => f (CacheId b) -> CacheIdSet b 32 | fromFoldable = foldl' (flip insert) mempty 33 | 34 | null :: CacheIdSet b -> Bool 35 | null = IntSet.null . (.ints) 36 | 37 | maxView :: CacheIdSet b -> Maybe (CacheId b, CacheIdSet b) 38 | maxView = coerce . IntSet.maxView . (.ints) 39 | 40 | union :: CacheIdSet b -> CacheIdSet b -> CacheIdSet b 41 | union = coerce IntSet.union 42 | 43 | difference :: CacheIdSet b -> CacheIdSet b -> CacheIdSet b 44 | difference = coerce IntSet.difference 45 | 46 | delete :: CacheId b -> CacheIdSet b -> CacheIdSet b 47 | delete = coerce IntSet.delete 48 | 49 | size :: CacheIdSet b -> Int 50 | size = coerce IntSet.size 51 | 52 | isSubsetOf :: CacheIdSet b -> CacheIdSet b -> Bool 53 | isSubsetOf = coerce IntSet.isSubsetOf 54 | 55 | member :: CacheId b -> CacheIdSet b -> Bool 56 | member = coerce IntSet.member 57 | -------------------------------------------------------------------------------- /lib/NOM/State/Sorting.hs: -------------------------------------------------------------------------------- 1 | module NOM.State.Sorting ( 2 | sortDepsOfSet, 3 | summaryIncludingRoot, 4 | sortKey, 5 | SortKey, 6 | ) where 7 | 8 | import Control.Monad.Extra (pureIf) 9 | import Data.List.Extra (firstJust) 10 | import Data.MemoTrie (memo) 11 | import Data.Sequence.Strict qualified as Seq 12 | import NOM.State ( 13 | BuildFail (..), 14 | BuildInfo (..), 15 | BuildStatus (Unknown), 16 | DependencySummary (..), 17 | DerivationId, 18 | DerivationInfo (..), 19 | DerivationSet, 20 | InputDerivation (..), 21 | NOMState, 22 | NOMV1State (..), 23 | StorePathInfo (..), 24 | TransferInfo (..), 25 | getDerivationInfos, 26 | getStorePathInfos, 27 | updateSummaryForDerivation, 28 | updateSummaryForStorePath, 29 | ) 30 | import NOM.State.CacheId.Map qualified as CMap 31 | import NOM.State.CacheId.Set qualified as CSet 32 | import NOM.Util (foldMapEndo) 33 | import Optics (gfield, (%~)) 34 | import Relude 35 | import Safe.Foldable (minimumMay) 36 | 37 | sortDepsOfSet :: DerivationSet -> NOMState () 38 | sortDepsOfSet parents = do 39 | currentState <- get 40 | let sort_parent :: DerivationId -> NOMState () 41 | sort_parent drvId = do 42 | drvInfo <- getDerivationInfos drvId 43 | let newDrvInfo = (gfield @"inputDerivations" %~ sort_derivations) drvInfo 44 | modify' (gfield @"derivationInfos" %~ CMap.insert drvId newDrvInfo) 45 | sort_derivations :: Seq InputDerivation -> Seq InputDerivation 46 | sort_derivations = Seq.sortOn (sort_key . (.derivation)) 47 | 48 | sort_key :: DerivationId -> SortKey 49 | sort_key = memo (sortKey currentState) 50 | mapM_ (\drvId -> sort_parent drvId) $ CSet.toList parents 51 | 52 | type SortKey = 53 | ( SortOrder -- First sort by the state of this build 54 | , SortOrder -- Sort by the most important kind of build for all children 55 | , -- We always want to show all running builds and transfers so we try to display them low in the tree. 56 | Down Int -- Running Builds, prefer more 57 | , Down Int -- Running Downloads, prefer more 58 | -- But we want to show the smallest tree showing all builds and downloads to save screen estate. 59 | , Int -- Waiting Builds and Downloads, prefer less 60 | ) 61 | 62 | data SortOrder 63 | = -- First the failed builds starting with the earliest failures 64 | SFailed Double 65 | | -- Second the running builds starting with longest running 66 | SBuilding Double 67 | | -- The longer a download is running, the more it matters. 68 | SDownloading Double 69 | | -- The longer an upload is running, the more it matters. 70 | SUploading Double 71 | | SWaiting 72 | | SDownloadWaiting 73 | | -- The longer a build is completed the less it matters 74 | SDone (Down Double) 75 | | -- The longer a download is completed the less it matters 76 | SDownloaded (Down Double) 77 | | -- The longer an upload is completed the less it matters 78 | SUploaded (Down Double) 79 | | SUnknown 80 | deriving stock (Eq, Show, Ord) 81 | 82 | summaryIncludingRoot :: DerivationId -> NOMState DependencySummary 83 | summaryIncludingRoot drvId = do 84 | MkDerivationInfo{dependencySummary, buildStatus} <- getDerivationInfos drvId 85 | pure (updateSummaryForDerivation Unknown buildStatus drvId dependencySummary) 86 | 87 | summaryOnlyThisNode :: DerivationId -> NOMState DependencySummary 88 | summaryOnlyThisNode drvId = do 89 | MkDerivationInfo{outputs, buildStatus} <- getDerivationInfos drvId 90 | output_infos <- mapM (\x -> (x,) <$> getStorePathInfos x) (toList outputs) 91 | pure 92 | $ foldMapEndo 93 | ( \(output_id, output_info) -> 94 | updateSummaryForStorePath mempty output_info.states output_id 95 | ) 96 | output_infos 97 | . updateSummaryForDerivation Unknown buildStatus drvId 98 | $ mempty 99 | 100 | sortOrder :: DependencySummary -> SortOrder 101 | sortOrder MkDependencySummary{..} = fromMaybe SUnknown (firstJust id sort_entries) 102 | where 103 | sort_entries = 104 | [ SFailed <$> minimumMay ((.at) . (.end) <$> failedBuilds) 105 | , SBuilding <$> minimumMay ((.start) <$> runningBuilds) 106 | , SDownloading <$> minimumMay ((.start) <$> runningDownloads) 107 | , SUploading <$> minimumMay ((.start) <$> runningUploads) 108 | , pureIf (not (CSet.null plannedBuilds)) SWaiting 109 | , pureIf (not (CSet.null plannedDownloads)) SDownloadWaiting 110 | , SDone <$> minimumMay (Down . (.end) <$> completedBuilds) 111 | , SDownloaded <$> minimumMay (Down . (.start) <$> completedDownloads) 112 | , SUploaded <$> minimumMay (Down . (.start) <$> completedUploads) 113 | ] 114 | 115 | sortKey :: NOMV1State -> DerivationId -> SortKey 116 | sortKey nom_state drvId = 117 | let (only_this_summary, summary@MkDependencySummary{..}) = evalState ((,) <$> summaryOnlyThisNode drvId <*> summaryIncludingRoot drvId) nom_state 118 | in (sortOrder only_this_summary, sortOrder summary, Down (CMap.size runningBuilds), Down (CMap.size runningDownloads), CSet.size plannedBuilds + CSet.size plannedDownloads) 119 | -------------------------------------------------------------------------------- /lib/NOM/State/Tree.hs: -------------------------------------------------------------------------------- 1 | module NOM.State.Tree ( 2 | mapRootsTwigsAndLeafs, 3 | ) where 4 | 5 | import Data.Tree (Tree (Node)) 6 | import Relude 7 | 8 | mapRootsTwigsAndLeafs :: (a -> b) -> (a -> b) -> (a -> b) -> Tree a -> Tree b 9 | mapRootsTwigsAndLeafs mapRoot mapTwig mapLeaf = go True 10 | where 11 | go top = \case 12 | Node l [] -> Node (mapLeaf l) [] 13 | Node l rest | top -> Node (mapRoot l) (go False <$> rest) 14 | Node l rest -> Node (mapTwig l) (go False <$> rest) 15 | -------------------------------------------------------------------------------- /lib/NOM/StreamParser.hs: -------------------------------------------------------------------------------- 1 | module NOM.StreamParser (parseStreamAttoparsec, stripANSICodes) where 2 | 3 | import Data.Attoparsec.ByteString (IResult (..), Parser, Result, parse) 4 | import Data.ByteString qualified as ByteString 5 | import Data.Word8 qualified as Word8 6 | import Relude 7 | import Streamly.Data.Stream qualified as Stream 8 | import Streamly.Data.Unfold qualified as Unfold 9 | 10 | type ContParser update = ByteString -> Result update 11 | 12 | parseChunk :: 13 | (Monad m) => 14 | ContParser update -> 15 | Unfold.Unfold (StateT (ContParser update) m) (ByteString, ByteString) (Maybe update, ByteString) 16 | parseChunk fresh_parse_function = unfoldNext generate 17 | where 18 | generate input = state (transition_function input) 19 | transition_function (strippedInput, rawInput) current_parse_function = 20 | ( 21 | ( (parsed_update, raw_parsed) 22 | , yet_to_parse 23 | ) 24 | , next_parse_function 25 | ) 26 | where 27 | parse_result = current_parse_function strippedInput 28 | parsed_update = case parse_result of 29 | Done _ result -> Just result 30 | _ -> Nothing 31 | split_raw_by_rest rest = ByteString.splitAt (ByteString.length strippedInput - ByteString.length rest) rawInput 32 | (raw_parsed, yet_to_parse) = case parse_result of 33 | Done rest _ 34 | | not (ByteString.null rest) 35 | , (consumedNow, rawLeft) <- split_raw_by_rest rest -> 36 | (consumedNow, Just (rest, rawLeft)) 37 | _ -> (rawInput, Nothing) 38 | next_parse_function = case parse_result of 39 | Partial cont -> cont 40 | _ -> fresh_parse_function 41 | 42 | csi :: ByteString 43 | csi = "\27[" 44 | 45 | breakOnANSIStartCode :: ByteString -> (ByteString, ByteString) 46 | breakOnANSIStartCode = ByteString.breakSubstring csi 47 | 48 | streamANSIChunks :: (Monad m) => Unfold.Unfold m ByteString (ByteString, ByteString) 49 | streamANSIChunks = unfoldNext generate 50 | where 51 | generate :: (Monad m) => ByteString -> m ((ByteString, ByteString), Maybe ByteString) 52 | generate input = pure ((filtered, filtered <> code), restOfStream) 53 | where 54 | (filtered, unfiltered) = breakOnANSIStartCode input 55 | (codeParts, rest) = ByteString.break Word8.isLetter unfiltered 56 | (code, restOfStream) = case ByteString.uncons rest of 57 | Just (headOfRest, tailOfRest) -> (ByteString.snoc codeParts headOfRest, Just tailOfRest) 58 | Nothing -> (codeParts, Nothing) 59 | 60 | {- | unfoldNext is like a normal unfold, but takes an (a, Maybe s) instead of Maybe (a, s) 61 | this means that the generator function will definitely generate the next 62 | stream item, but the stream can finish after that item. 63 | -} 64 | unfoldNext :: (Monad m) => (s -> m (a, Maybe s)) -> Unfold.Unfold m s a 65 | unfoldNext = 66 | Unfold.lmap Just 67 | . Unfold.unfoldrM 68 | . mapM 69 | 70 | parseStreamAttoparsec :: 71 | (Monad m) => 72 | Parser update -> 73 | Stream.Stream m ByteString -> 74 | Stream.Stream m (Maybe update, ByteString) 75 | parseStreamAttoparsec parser = 76 | fmap snd 77 | . Stream.runStateT (pure fresh_parse_func) 78 | . Stream.unfoldMany (Unfold.many (parseChunk fresh_parse_func) streamANSIChunks) 79 | . Stream.liftInner 80 | where 81 | fresh_parse_func = parse parser 82 | 83 | stripANSICodes :: Text -> Text 84 | stripANSICodes = 85 | decodeUtf8 86 | . ByteString.concat 87 | . toList @(Stream.Stream Identity) 88 | . Stream.unfold 89 | ( fmap fst 90 | . Unfold.lmap encodeUtf8 91 | $ streamANSIChunks 92 | ) 93 | -------------------------------------------------------------------------------- /lib/NOM/Update.hs: -------------------------------------------------------------------------------- 1 | module NOM.Update (updateStateNixJSONMessage, updateStateNixOldStyleMessage, maintainState, detectLocalFinishedBuilds, appendDifferingPlatform) where 2 | 3 | import Control.Monad.Trans.Writer.CPS (WriterT, runWriterT, tell) 4 | import Data.ByteString.Char8 qualified as ByteString 5 | import Data.IntMap.Strict qualified as IntMap 6 | import Data.Map.Strict qualified as Map 7 | import Data.Sequence.Strict qualified as Seq 8 | import Data.Set qualified as Set 9 | import Data.Strict qualified as Strict 10 | import Data.Text qualified as Text 11 | import Data.Time (NominalDiffTime) 12 | import NOM.Builds (Derivation (..), FailType, Host (..), StorePath (..), parseDerivation, parseIndentedStoreObject, parseStorePath) 13 | import NOM.Error (NOMError) 14 | import NOM.NixMessage.JSON (Activity, ActivityId, ActivityResult (..), MessageAction (..), NixJSONMessage (..), ResultAction (..), StartAction (..), StopAction (..), Verbosity (..)) 15 | import NOM.NixMessage.JSON qualified as JSON 16 | import NOM.NixMessage.OldStyle (NixOldStyleMessage) 17 | import NOM.NixMessage.OldStyle qualified as OldStyleMessage 18 | import NOM.Parser qualified as Parser 19 | import NOM.Print.Table (blue, markup) 20 | import NOM.State ( 21 | ActivityStatus (..), 22 | BuildFail (..), 23 | BuildInfo (..), 24 | BuildStatus (..), 25 | DependencySummary, 26 | DerivationId, 27 | DerivationInfo (..), 28 | DerivationMap, 29 | DerivationSet, 30 | EvalInfo (..), 31 | InputDerivation (..), 32 | InterestingActivity (..), 33 | NOMState, 34 | NOMStateT, 35 | NOMV1State (..), 36 | OutputName (Out), 37 | ProgressState (..), 38 | RunningBuildInfo, 39 | StorePathId, 40 | StorePathState (..), 41 | TransferInfo (..), 42 | clearDerivationIdFromSummary, 43 | clearStorePathsFromSummary, 44 | derivationToAnyOutPath, 45 | getDerivationId, 46 | getDerivationInfos, 47 | getRunningBuildsByHost, 48 | getStorePathId, 49 | getStorePathInfos, 50 | outPathToDerivation, 51 | parseOutputName, 52 | updateSummaryForDerivation, 53 | updateSummaryForStorePath, 54 | ) 55 | import NOM.State qualified as State 56 | import NOM.State.CacheId.Map qualified as CMap 57 | import NOM.State.CacheId.Set qualified as CSet 58 | import NOM.State.Sorting (sortDepsOfSet, sortKey) 59 | import NOM.StreamParser (stripANSICodes) 60 | import NOM.Update.Monad ( 61 | BuildReportMap, 62 | MonadCacheBuildReports (..), 63 | MonadCheckStorePath (..), 64 | MonadNow (..), 65 | MonadReadDerivation (..), 66 | UpdateMonad, 67 | ) 68 | import NOM.Util (foldMapEndo, parseOneText) 69 | import Nix.Derivation qualified as Nix 70 | import Optics (gconstructor, gfield, has, preview, (%), (%~), (.~)) 71 | import Relude 72 | import System.Console.ANSI (SGR (Reset), setSGRCode) 73 | 74 | type ProcessingT m a = (UpdateMonad m) => NOMStateT (WriterT [Either NOMError ByteString] m) a 75 | 76 | getReportName :: DerivationInfo -> Text 77 | getReportName drv = case drv.pname of 78 | Strict.Just pname -> pname 79 | Strict.Nothing -> Text.dropWhileEnd (`Set.member` fromList ".1234567890-") drv.name.storePath.name 80 | 81 | setInputReceived :: NOMState Bool 82 | setInputReceived = do 83 | s <- get 84 | let change = s.progressState == JustStarted 85 | when change (put s{progressState = InputReceived}) 86 | pure change 87 | 88 | maintainState :: Double -> NOMV1State -> NOMV1State 89 | maintainState now = execState $ do 90 | currentState <- get 91 | unless (CSet.null currentState.touchedIds) $ do 92 | sortDepsOfSet currentState.touchedIds 93 | modify' (gfield @"forestRoots" %~ Seq.sortOn (sortKey currentState)) 94 | modify' (gfield @"touchedIds" .~ mempty) 95 | when (Strict.isJust currentState.evaluationState.lastFileName && currentState.evaluationState.at <= now - 5 && currentState.fullSummary /= mempty) do 96 | modify' (gfield @"evaluationState" %~ \old_state -> old_state{lastFileName = Strict.Nothing}) 97 | 98 | minTimeBetweenPollingNixStore :: NominalDiffTime 99 | minTimeBetweenPollingNixStore = 0.2 -- in seconds 100 | 101 | {-# INLINE updateStateNixJSONMessage #-} 102 | updateStateNixJSONMessage :: forall m. (UpdateMonad m) => NixJSONMessage -> NOMV1State -> m (([NOMError], ByteString), Maybe NOMV1State) 103 | updateStateNixJSONMessage input inputState = 104 | {-# SCC "updateStateNixJSONMessage" #-} 105 | do 106 | ((hasChanged, msgs), outputState) <- 107 | {-# SCC "run_state" #-} 108 | runStateT 109 | ( runWriterT 110 | ( sequence 111 | [ {-# SCC "input_received" #-} setInputReceived 112 | , {-# SCC "processing" #-} processJsonMessage input 113 | ] 114 | ) 115 | ) 116 | inputState 117 | let retval = if or hasChanged then Just outputState else Nothing 118 | errors = lefts msgs 119 | {-# SCC "emitting_new_state" #-} pure ((errors, ByteString.unlines (rights msgs)), retval) 120 | 121 | updateStateNixOldStyleMessage :: forall m. (UpdateMonad m) => (Maybe NixOldStyleMessage, ByteString) -> (Maybe Double, NOMV1State) -> m (([NOMError], ByteString), (Maybe Double, Maybe NOMV1State)) 122 | updateStateNixOldStyleMessage (result, input) (inputAccessTime, inputState) = do 123 | now <- getNow 124 | 125 | let processing = case result of 126 | Just result' -> processResult result' 127 | Nothing -> pure False 128 | (outputAccessTime, check) 129 | | maybe True ((>= minTimeBetweenPollingNixStore) . realToFrac . (now -)) inputAccessTime = (Just now, detectLocalFinishedBuilds) 130 | | otherwise = (inputAccessTime, pure False) 131 | ((hasChanged, msgs), outputState) <- 132 | runStateT 133 | ( runWriterT 134 | ( or 135 | <$> sequence 136 | [ -- First check if this is the first time that we receive input (for error messages). 137 | setInputReceived 138 | , -- Update the state if any changes where parsed. 139 | processing 140 | , -- Check if any local builds have finished, because nix-build would not tell us. 141 | -- If we haven‘t done so in the last minTimeBetweenPollingNixStore seconds. 142 | check 143 | ] 144 | ) 145 | ) 146 | inputState 147 | -- If any of the update steps returned true, return the new state, otherwise return Nothing. 148 | let retval = (outputAccessTime, if hasChanged then Just outputState else Nothing) 149 | errors = lefts msgs 150 | pure ((errors, input <> ByteString.unlines (rights msgs)), retval) 151 | 152 | derivationIsCompleted :: (UpdateMonad m) => DerivationId -> NOMStateT m Bool 153 | derivationIsCompleted drvId = 154 | derivationToAnyOutPath drvId >>= \case 155 | Nothing -> pure False -- Derivation has no "out" output. 156 | Just path -> storePathExists path 157 | 158 | detectLocalFinishedBuilds :: ProcessingT m Bool 159 | detectLocalFinishedBuilds = do 160 | runningLocalBuilds <- CMap.toList <$> getRunningBuildsByHost Localhost -- .> traceShowId 161 | newCompletedOutputs <- filterM (\(x, _) -> derivationIsCompleted x) runningLocalBuilds 162 | let anyBuildsFinished = not (null newCompletedOutputs) 163 | when anyBuildsFinished (finishBuilds Localhost newCompletedOutputs) 164 | pure anyBuildsFinished 165 | 166 | withChange :: (Functor f) => f b -> f Bool 167 | withChange = (True <$) 168 | 169 | noChange :: (Applicative f) => f Bool 170 | noChange = pure False 171 | 172 | processResult :: (UpdateMonad m) => NixOldStyleMessage -> ProcessingT m Bool 173 | processResult result = do 174 | now <- getNow 175 | case result of 176 | OldStyleMessage.Uploading path host -> withChange do 177 | pathId <- getStorePathId path 178 | uploaded host pathId now 179 | OldStyleMessage.Downloading path host -> withChange do 180 | pathId <- getStorePathId path 181 | downloaded host pathId now 182 | finishBuildByPathId host pathId 183 | OldStyleMessage.PlanCopies _ -> noChange 184 | OldStyleMessage.Build drvName host -> withChange do 185 | building host drvName now Nothing 186 | OldStyleMessage.PlanBuilds plannedBuilds _lastBuild -> withChange do 187 | plannedDrvIds <- forM (toList plannedBuilds) (\x -> lookupDerivation x) 188 | planBuilds (fromList plannedDrvIds) 189 | OldStyleMessage.PlanDownloads _download _unpacked plannedDownloads -> withChange do 190 | plannedDownloadIds <- forM (toList plannedDownloads) (\x -> getStorePathId x) 191 | planDownloads (fromList plannedDownloadIds) 192 | OldStyleMessage.Checking drvName -> withChange do 193 | building Localhost drvName now Nothing 194 | OldStyleMessage.Failed drv code -> withChange do 195 | drvId <- lookupDerivation drv 196 | failedBuild now drvId code 197 | 198 | processJsonMessage :: (UpdateMonad m) => NixJSONMessage -> ProcessingT m Bool 199 | processJsonMessage = \case 200 | Message MkMessageAction{message, level} | level <= Info && level > Error -> do 201 | let message' = encodeUtf8 message 202 | tell [Right message'] 203 | case parseIndentedStoreObject message of 204 | Just (Right download) -> 205 | {-# SCC "plan_download" #-} 206 | withChange do 207 | plannedDownloadId <- getStorePathId download 208 | planDownloads $ one plannedDownloadId 209 | Just (Left build) -> 210 | {-# SCC "plan_build" #-} 211 | withChange do 212 | plannedDrvId <- lookupDerivation build 213 | planBuilds (one plannedDrvId) 214 | _ -> noChange 215 | Message MkMessageAction{message, level = Error} 216 | | stripped <- stripANSICodes message 217 | , Text.isPrefixOf "error:" stripped -> 218 | {-# SCC "pass_through_error" #-} 219 | withChange do 220 | errors <- gets (.nixErrors) 221 | unless (any (Text.isInfixOf (Text.drop 7 stripped) . stripANSICodes) errors) do 222 | modify' (gfield @"nixErrors" %~ (<> (message Seq.<| mempty))) 223 | tell [Right (encodeUtf8 message)] 224 | whenJust 225 | (snd <$> parseOneText Parser.oldStyleParser (stripped <> "\n")) 226 | (\old_style_parse_result -> void $ processResult old_style_parse_result) 227 | Message MkMessageAction{message, level = Error} 228 | | stripped <- stripANSICodes message 229 | , Text.isPrefixOf "trace:" stripped -> 230 | {-# SCC "pass_through_error" #-} 231 | withChange do 232 | traces <- gets (.nixTraces) 233 | unless (any (Text.isInfixOf (Text.drop 7 stripped) . stripANSICodes) traces) do 234 | modify' (gfield @"nixTraces" %~ (<> (message Seq.<| mempty))) 235 | tell [Right (encodeUtf8 message)] 236 | whenJust 237 | (snd <$> parseOneText Parser.oldStyleParser (stripped <> "\n")) 238 | (\old_style_parse_result -> void $ processResult old_style_parse_result) 239 | Message MkMessageAction{message} | Just suffix <- Text.stripPrefix "evaluating file '" message -> withChange do 240 | let file_name = Text.dropEnd 1 suffix 241 | now <- getNow 242 | modify' (gfield @"evaluationState" %~ \old -> old{count = old.count + 1, lastFileName = Strict.Just file_name, at = now}) 243 | Result MkResultAction{result = BuildLogLine line, id = id'} -> 244 | {-# SCC "pass_through_build_line" #-} 245 | do 246 | nomState <- get 247 | prefix <- activityPrefix ((.activity) <$> IntMap.lookup id'.value nomState.activities) 248 | tell [Right (encodeUtf8 (prefix <> line))] 249 | noChange 250 | Result MkResultAction{result = SetPhase phase, id = id'} -> 251 | {-# SCC "updating_phase" #-} withChange $ modify' (gfield @"activities" %~ IntMap.adjust (gfield @"phase" .~ Strict.Just phase) id'.value) 252 | Result MkResultAction{result = Progress progress, id = id'} -> 253 | {-# SCC "updating_progress" #-} withChange $ modify' (gfield @"activities" %~ IntMap.adjust (gfield @"progress" .~ Strict.Just progress) id'.value) 254 | Start startAction@MkStartAction{id = id'} -> 255 | {-# SCC "starting_action" #-} 256 | do 257 | prefix <- activityPrefix $ Just startAction.activity 258 | when (not (Text.null startAction.text) && startAction.level <= Info) $ tell [Right . encodeUtf8 $ prefix <> startAction.text] 259 | let set_interesting = withChange do 260 | now <- getNow 261 | modify' (gfield @"interestingActivities" %~ IntMap.insert id'.value (MkInterestingUnknownActivity startAction.text now)) 262 | changed <- case startAction.activity of 263 | JSON.Build drvName host -> withChange do 264 | now <- getNow 265 | building host drvName now (Just id') 266 | JSON.CopyPath path from Localhost -> withChange do 267 | now <- getNow 268 | pathId <- getStorePathId path 269 | downloading from pathId now 270 | JSON.CopyPath path Localhost to -> withChange do 271 | now <- getNow 272 | pathId <- getStorePathId path 273 | uploading to pathId now 274 | JSON.Unknown | Text.isPrefixOf "querying info" startAction.text -> set_interesting 275 | JSON.QueryPathInfo{} -> set_interesting 276 | _ -> noChange -- tell [Right (encodeUtf8 (markup yellow "unused activity: " <> show startAction.id <> " " <> show startAction.activity))] 277 | when changed $ modify' (gfield @"activities" %~ IntMap.insert id'.value (MkActivityStatus startAction.activity Strict.Nothing Strict.Nothing)) 278 | pure changed 279 | Stop MkStopAction{id = id'} -> 280 | {-# SCC "stoping_action" #-} 281 | do 282 | activity <- gets (\s -> IntMap.lookup id'.value s.activities) 283 | interesting_activity <- gets (\s -> IntMap.lookup id'.value s.interestingActivities) 284 | modify' (gfield @"interestingActivities" %~ IntMap.delete id'.value) 285 | case activity of 286 | Just (MkActivityStatus{activity = JSON.CopyPath path from Localhost}) -> withChange do 287 | now <- getNow 288 | pathId <- getStorePathId path 289 | downloaded from pathId now 290 | Just (MkActivityStatus{activity = JSON.CopyPath path Localhost to}) -> withChange do 291 | now <- getNow 292 | pathId <- getStorePathId path 293 | uploaded to pathId now 294 | Just (MkActivityStatus{activity = JSON.Build drv host}) -> do 295 | drvId <- lookupDerivation drv 296 | isCompleted <- derivationIsCompleted drvId 297 | if isCompleted then withChange $ finishBuildByDrvId host drvId else noChange 298 | _ -> pure (isJust interesting_activity) 299 | Plain msg -> tell [Right msg] >> noChange 300 | ParseError err -> tell [Left err] >> noChange 301 | Result _other_result -> noChange 302 | Message _other_message -> noChange 303 | 304 | -- tell [Right (encodeUtf8 (markup yellow "unused message: " <> show _other))] 305 | 306 | appendDifferingPlatform :: NOMV1State -> DerivationInfo -> Text -> Text 307 | appendDifferingPlatform nomState drvInfo = case (nomState.buildPlatform, drvInfo.platform) of 308 | (Strict.Just p1, Strict.Just p2) | p1 /= p2 -> (<> "-" <> p2) 309 | _ -> id 310 | 311 | activityPrefix :: Maybe Activity -> ProcessingT m Text 312 | activityPrefix activities = case activities of 313 | Just (JSON.Build derivation _) -> do 314 | drvInfo <- lookupDerivationInfos derivation 315 | nomState <- get 316 | pure $ toText (setSGRCode [Reset]) <> markup blue (appendDifferingPlatform nomState drvInfo (getReportName drvInfo) <> "> ") 317 | _ -> pure "" 318 | 319 | movingAverage :: Double 320 | movingAverage = 0.5 321 | 322 | reportFinishingBuilds :: (MonadCacheBuildReports m, MonadNow m) => Host -> NonEmpty (DerivationInfo, Double) -> m BuildReportMap 323 | reportFinishingBuilds host builds = do 324 | now <- getNow 325 | updateBuildReports (modifyBuildReports host (timeDiffInt now <<$>> builds)) 326 | 327 | -- | time difference in seconds rounded down 328 | timeDiffInt :: Double -> Double -> Int 329 | timeDiffInt = fmap floor . (-) 330 | 331 | finishBuilds :: Host -> [(DerivationId, BuildInfo ())] -> ProcessingT m () 332 | finishBuilds host builds = do 333 | derivationsWithNames <- forM builds \(drvId, buildInfo) -> 334 | (,buildInfo.start) <$> getDerivationInfos drvId 335 | ( \case 336 | Nothing -> pass 337 | Just finishedBuilds -> do 338 | newBuildReports <- reportFinishingBuilds host finishedBuilds 339 | modify' (gfield @"buildReports" .~ newBuildReports) 340 | ) 341 | $ nonEmpty derivationsWithNames 342 | now <- getNow 343 | forM_ builds \(drv, info) -> updateDerivationState drv (const (Built (info $> now))) 344 | 345 | modifyBuildReports :: Host -> NonEmpty (DerivationInfo, Int) -> BuildReportMap -> BuildReportMap 346 | modifyBuildReports host = foldMapEndo (uncurry insertBuildReport) 347 | where 348 | insertBuildReport name = 349 | Map.insertWith 350 | (\new old -> floor (movingAverage * fromIntegral new + (1 - movingAverage) * fromIntegral old)) 351 | (host, getReportName name) 352 | 353 | failedBuild :: Double -> DerivationId -> FailType -> NOMState () 354 | failedBuild now drv code = updateDerivationState drv update 355 | where 356 | update = \case 357 | Built a -> State.Failed (a $> MkBuildFail now code) 358 | Building a -> State.Failed (a $> MkBuildFail now code) 359 | x -> x 360 | 361 | lookupDerivation :: Derivation -> ProcessingT m DerivationId 362 | lookupDerivation drv = do 363 | drvId <- getDerivationId drv 364 | isCached <- gets (maybe False (.cached) . CMap.lookup drvId . (.derivationInfos)) 365 | unless isCached 366 | $ getDerivation drv 367 | >>= \case 368 | Left err -> tell [Left err] 369 | Right parsedDrv -> insertDerivation parsedDrv drvId 370 | pure drvId 371 | 372 | lookupDerivationInfos :: Derivation -> ProcessingT m DerivationInfo 373 | lookupDerivationInfos drvName = do 374 | drvId <- lookupDerivation drvName 375 | getDerivationInfos drvId 376 | 377 | insertDerivation :: Nix.Derivation FilePath Text -> DerivationId -> ProcessingT m () 378 | insertDerivation derivation drvId = do 379 | -- We need to be really careful in this function. The Nix.Derivation keeps the 380 | -- read-in derivation file in memory. When using Texts from it we must make 381 | -- sure we destroy sharing with the original file, so that it can be garbage 382 | -- collected. 383 | 384 | outputs <- 385 | derivation.outputs & Map.mapKeys (parseOutputName . Text.copy) & Map.traverseMaybeWithKey \_ path -> 386 | parseStorePath (toText (Nix.path path)) & mapM \pathName -> do 387 | pathId <- getStorePathId pathName 388 | modify' (gfield @"storePathInfos" %~ CMap.adjust (gfield @"producer" .~ Strict.Just drvId) pathId) 389 | pure pathId 390 | inputSources <- 391 | derivation.inputSrcs & flip foldlM mempty \acc path -> do 392 | pathIdMay <- 393 | parseStorePath (toText path) & mapM \pathName -> do 394 | pathId <- getStorePathId pathName 395 | modify' (gfield @"storePathInfos" %~ CMap.adjust (gfield @"inputFor" %~ CSet.insert drvId) pathId) 396 | pure pathId 397 | pure $ maybe id CSet.insert pathIdMay acc 398 | inputDerivationsList <- 399 | derivation.inputDrvs & Map.toList & mapMaybeM \(drvPath, outputs_of_input) -> do 400 | depIdMay <- 401 | parseDerivation (toText drvPath) & mapM \depName -> do 402 | depId <- lookupDerivation depName 403 | modify' (gfield @"derivationInfos" %~ CMap.adjust (gfield @"derivationParents" %~ CSet.insert drvId) depId) 404 | modify' (gfield @"forestRoots" %~ Seq.filter (/= depId)) 405 | pure depId 406 | pure $ (\derivation_id -> MkInputDerivation{derivation = derivation_id, outputs = Set.map (parseOutputName . Text.copy) outputs_of_input}) <$> depIdMay 407 | let inputDerivations = Seq.fromList inputDerivationsList 408 | modify 409 | ( gfield @"derivationInfos" 410 | %~ CMap.adjust 411 | ( \derivation_info -> 412 | derivation_info 413 | { outputs 414 | , inputSources 415 | , inputDerivations 416 | , cached = True 417 | , platform = Strict.Just (Text.copy derivation.platform) 418 | , pname = Strict.toStrict (Text.copy <$> Map.lookup "pname" derivation.env) 419 | } 420 | ) 421 | drvId 422 | ) 423 | noParents <- CSet.null . (.derivationParents) <$> getDerivationInfos drvId 424 | when noParents $ modify' (gfield @"forestRoots" %~ (drvId Seq.<|)) 425 | 426 | planBuilds :: Set DerivationId -> NOMState () 427 | planBuilds drvIds = forM_ drvIds \drvId -> 428 | updateDerivationState drvId (const Planned) 429 | 430 | planDownloads :: Set StorePathId -> NOMState () 431 | planDownloads pathIds = forM_ pathIds \pathId -> 432 | insertStorePathState pathId DownloadPlanned Nothing 433 | 434 | finishBuildByDrvId :: Host -> DerivationId -> ProcessingT m () 435 | finishBuildByDrvId host drvId = do 436 | buildInfoMay <- getBuildInfoIfRunning drvId 437 | whenJust buildInfoMay \buildInfo -> finishBuilds host [(drvId, buildInfo)] 438 | 439 | finishBuildByPathId :: Host -> StorePathId -> ProcessingT m () 440 | finishBuildByPathId host pathId = do 441 | drvIdMay <- outPathToDerivation pathId 442 | whenJust drvIdMay (\x -> finishBuildByDrvId host x) 443 | 444 | downloading :: Host -> StorePathId -> Double -> NOMState () 445 | downloading host pathId start = insertStorePathState pathId (State.Downloading MkTransferInfo{host, start, end = ()}) Nothing 446 | 447 | getBuildInfoIfRunning :: DerivationId -> NOMState (Maybe RunningBuildInfo) 448 | getBuildInfoIfRunning drvId = 449 | runMaybeT $ do 450 | drvInfos <- MaybeT (gets (CMap.lookup drvId . (.derivationInfos))) 451 | MaybeT (pure ((() <$) <$> preview (gfield @"buildStatus" % gconstructor @"Building") drvInfos)) 452 | 453 | downloaded :: Host -> StorePathId -> Double -> NOMState () 454 | downloaded host pathId end = insertStorePathState pathId (Downloaded MkTransferInfo{host, start = end, end = Strict.Nothing}) $ Just \case 455 | State.Downloading transfer_info | transfer_info.host == host -> Downloaded (transfer_info $> Strict.Just end) 456 | other -> other 457 | 458 | uploading :: Host -> StorePathId -> Double -> NOMState () 459 | uploading host pathId start = 460 | insertStorePathState pathId (State.Uploading MkTransferInfo{host, start, end = ()}) Nothing 461 | 462 | uploaded :: Host -> StorePathId -> Double -> NOMState () 463 | uploaded host pathId end = 464 | insertStorePathState pathId (Uploaded MkTransferInfo{host, start = end, end = Strict.Nothing}) $ Just \case 465 | State.Uploading transfer_info | transfer_info.host == host -> Uploaded (transfer_info $> Strict.Just end) 466 | other -> other 467 | 468 | building :: Host -> Derivation -> Double -> Maybe ActivityId -> ProcessingT m () 469 | building host drvName now activityId = do 470 | reportName <- getReportName <$> lookupDerivationInfos drvName 471 | lastNeeded <- Map.lookup (host, reportName) . (.buildReports) <$> get 472 | drvId <- lookupDerivation drvName 473 | updateDerivationState drvId (const (Building (MkBuildInfo now host (Strict.toStrict lastNeeded) (Strict.toStrict activityId) ()))) 474 | 475 | updateDerivationState :: DerivationId -> (BuildStatus -> BuildStatus) -> NOMState () 476 | updateDerivationState drvId updateStatus = do 477 | -- Update derivationInfo for this Derivation 478 | derivation_infos <- getDerivationInfos drvId 479 | let oldStatus = derivation_infos.buildStatus 480 | newStatus = updateStatus oldStatus 481 | when (oldStatus /= newStatus) do 482 | modify' (gfield @"derivationInfos" %~ CMap.adjust (gfield @"buildStatus" .~ newStatus) drvId) 483 | let update_summary = updateSummaryForDerivation oldStatus newStatus drvId 484 | clear_summary = clearDerivationIdFromSummary oldStatus drvId 485 | 486 | -- Update summaries of all parents and sort them 487 | updateParents False update_summary clear_summary (derivation_infos.derivationParents) 488 | 489 | -- Update fullSummary 490 | modify' (gfield @"fullSummary" %~ update_summary) 491 | 492 | updateParents :: Bool -> (DependencySummary -> DependencySummary) -> (DependencySummary -> DependencySummary) -> DerivationSet -> NOMState () 493 | updateParents force_direct update_func clear_func direct_parents = do 494 | relevant_parents <- (if force_direct then CSet.union direct_parents else id) <$> collect_parents True mempty direct_parents 495 | parents <- collect_parents False mempty direct_parents 496 | modify 497 | ( gfield @"derivationInfos" 498 | %~ apply_to_all_summaries update_func relevant_parents 499 | . apply_to_all_summaries clear_func (CSet.difference parents relevant_parents) 500 | ) 501 | modify' (gfield @"touchedIds" %~ CSet.union parents) 502 | where 503 | apply_to_all_summaries :: 504 | (DependencySummary -> DependencySummary) -> 505 | DerivationSet -> 506 | DerivationMap DerivationInfo -> 507 | DerivationMap DerivationInfo 508 | apply_to_all_summaries func = foldMapEndo (CMap.adjust (gfield @"dependencySummary" %~ func)) . CSet.toList 509 | collect_parents :: Bool -> DerivationSet -> DerivationSet -> NOMState DerivationSet 510 | collect_parents no_irrelevant collected_parents parents_to_scan = case CSet.maxView parents_to_scan of 511 | Nothing -> pure collected_parents 512 | Just (current_parent, rest_to_scan) -> do 513 | drv_infos <- getDerivationInfos current_parent 514 | transfer_states <- fold <$> forM (Map.lookup Out drv_infos.outputs) (fmap (.states) . \x -> getStorePathInfos x) 515 | let all_transfers_completed = all (\x -> has (gconstructor @"Downloaded") x || has (gconstructor @"Uploaded") x) transfer_states 516 | is_irrelevant = all_transfers_completed && has (gconstructor @"Unknown") drv_infos.buildStatus || has (gconstructor @"Built") drv_infos.buildStatus 517 | proceed = collect_parents no_irrelevant 518 | if is_irrelevant && no_irrelevant 519 | then proceed collected_parents rest_to_scan 520 | else proceed (CSet.insert current_parent collected_parents) (CSet.union (CSet.difference drv_infos.derivationParents collected_parents) rest_to_scan) 521 | 522 | updateStorePathStates :: StorePathState -> Maybe (StorePathState -> StorePathState) -> Set StorePathState -> Set StorePathState 523 | updateStorePathStates new_state update_state = 524 | Set.insert new_state 525 | . localFilter 526 | . ( case update_state of 527 | Just update_func -> Set.fromList . fmap update_func . Set.toList 528 | Nothing -> id 529 | ) 530 | where 531 | localFilter = case new_state of 532 | DownloadPlanned -> id 533 | State.Downloading _ -> Set.filter (DownloadPlanned /=) 534 | Downloaded _ -> Set.filter (DownloadPlanned /=) -- We don‘t need to filter downloading state because that has already been handled by the update_state function 535 | State.Uploading _ -> id 536 | Uploaded _ -> id -- Analogous to downloaded 537 | 538 | insertStorePathState :: StorePathId -> StorePathState -> Maybe (StorePathState -> StorePathState) -> NOMState () 539 | insertStorePathState storePathId new_store_path_state update_store_path_state = do 540 | -- Update storePathInfos for this Storepath 541 | store_path_info <- getStorePathInfos storePathId 542 | let oldStatus = store_path_info.states 543 | newStatus = updateStorePathStates new_store_path_state update_store_path_state oldStatus 544 | modify' (gfield @"storePathInfos" %~ CMap.adjust (gfield @"states" .~ newStatus) storePathId) 545 | 546 | let update_summary = updateSummaryForStorePath oldStatus newStatus storePathId 547 | clear_summary = clearStorePathsFromSummary oldStatus storePathId 548 | 549 | -- Update summaries of all parents 550 | updateParents True update_summary clear_summary (Strict.maybe id CSet.insert store_path_info.producer store_path_info.inputFor) 551 | 552 | -- Update fullSummary 553 | modify' (gfield @"fullSummary" %~ update_summary) 554 | -------------------------------------------------------------------------------- /lib/NOM/Update/Monad.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE UndecidableInstances #-} 2 | 3 | module NOM.Update.Monad ( 4 | UpdateMonad, 5 | MonadNow (..), 6 | MonadReadDerivation (..), 7 | MonadCheckStorePath (..), 8 | module NOM.Update.Monad.CacheBuildReports, 9 | ) where 10 | 11 | import Control.Exception (try) 12 | import Control.Monad.Trans.Writer.CPS (WriterT) 13 | -- attoparsec 14 | import Data.Attoparsec.Text (eitherResult, parse) 15 | import Data.Text.IO qualified as TextIO 16 | import GHC.Clock qualified 17 | import NOM.Builds (Derivation, StorePath) 18 | import NOM.Error (NOMError (..)) 19 | import NOM.Update.Monad.CacheBuildReports 20 | -- nix-derivation 21 | import Nix.Derivation qualified as Nix 22 | import Relude 23 | import System.Directory (doesPathExist) 24 | 25 | type UpdateMonad m = (Monad m, MonadNow m, MonadReadDerivation m, MonadCacheBuildReports m, MonadCheckStorePath m) 26 | 27 | class (Monad m) => MonadNow m where 28 | getNow :: m Double 29 | 30 | instance MonadNow IO where 31 | getNow = GHC.Clock.getMonotonicTime 32 | 33 | instance (MonadNow m) => MonadNow (StateT a m) where 34 | getNow = lift getNow 35 | 36 | instance (MonadNow m) => MonadNow (WriterT a m) where 37 | getNow = lift getNow 38 | 39 | class (Monad m) => MonadReadDerivation m where 40 | getDerivation :: Derivation -> m (Either NOMError (Nix.Derivation FilePath Text)) 41 | 42 | instance MonadReadDerivation IO where 43 | getDerivation = 44 | fmap 45 | ( first DerivationReadError 46 | >=> first (DerivationParseError . toText) 47 | . eitherResult 48 | . parse Nix.parseDerivation 49 | ) 50 | . try 51 | . TextIO.readFile 52 | . toString 53 | 54 | instance (MonadReadDerivation m) => MonadReadDerivation (StateT a m) where 55 | getDerivation = lift . getDerivation 56 | 57 | instance (MonadReadDerivation m) => MonadReadDerivation (ExceptT a m) where 58 | getDerivation = lift . getDerivation 59 | 60 | instance (MonadReadDerivation m) => MonadReadDerivation (WriterT a m) where 61 | getDerivation = lift . getDerivation 62 | 63 | class (Monad m) => MonadCheckStorePath m where 64 | storePathExists :: StorePath -> m Bool 65 | 66 | instance MonadCheckStorePath IO where 67 | storePathExists = doesPathExist . toString 68 | 69 | instance (MonadCheckStorePath m) => MonadCheckStorePath (StateT a m) where 70 | storePathExists = lift . storePathExists 71 | 72 | instance (MonadCheckStorePath m) => MonadCheckStorePath (WriterT a m) where 73 | storePathExists = lift . storePathExists 74 | -------------------------------------------------------------------------------- /lib/NOM/Update/Monad/CacheBuildReports.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-missed-specialisations #-} 2 | 3 | module NOM.Update.Monad.CacheBuildReports ( 4 | MonadCacheBuildReports (..), 5 | BuildReport (..), 6 | BuildReportMap, 7 | ) where 8 | 9 | import Control.Exception.Safe (catchAny, catchIO) 10 | import Control.Monad.Trans.Writer.CPS (WriterT) 11 | import Data.Csv (FromRecord, HasHeader (NoHeader), ToRecord, decode, encode) 12 | import Data.Map.Strict qualified as Map 13 | import NOM.Builds (Host (..)) 14 | import Relude 15 | import System.Directory (XdgDirectory (XdgCache), createDirectoryIfMissing, getXdgDirectory) 16 | import System.FileLock (SharedExclusive (Exclusive), withFileLock) 17 | import System.FilePath ((<.>), ()) 18 | 19 | -- Exposed functions 20 | 21 | class (Monad m) => MonadCacheBuildReports m where 22 | getCachedBuildReports :: m BuildReportMap 23 | updateBuildReports :: (BuildReportMap -> BuildReportMap) -> m BuildReportMap 24 | 25 | data BuildReport = BuildReport 26 | { host :: Text 27 | , name :: Text 28 | , seconds :: Int 29 | } 30 | deriving stock (Generic, Show, Eq) 31 | deriving anyclass (FromRecord, ToRecord) 32 | 33 | type BuildReportMap = Map (Host, Text) Int 34 | 35 | instance MonadCacheBuildReports IO where 36 | getCachedBuildReports = do 37 | dir <- buildReportsDir 38 | loadBuildReports dir 39 | updateBuildReports updateFunc = catchAny (tryUpdateBuildReports updateFunc) mempty 40 | 41 | instance (MonadCacheBuildReports m) => MonadCacheBuildReports (StateT a m) where 42 | getCachedBuildReports = lift getCachedBuildReports 43 | updateBuildReports = lift . updateBuildReports 44 | 45 | instance (MonadCacheBuildReports m) => MonadCacheBuildReports (WriterT a m) where 46 | getCachedBuildReports = lift getCachedBuildReports 47 | updateBuildReports = lift . updateBuildReports 48 | 49 | -- Implementation 50 | 51 | tryUpdateBuildReports :: (BuildReportMap -> BuildReportMap) -> IO BuildReportMap 52 | tryUpdateBuildReports updateFunc = do 53 | dir <- buildReportsDir 54 | catchIO (createDirectoryIfMissing True dir) (const pass) 55 | withFileLock 56 | (dir buildReportsFilename <.> "lock") 57 | Exclusive 58 | (const $ updateBuildReportsUnlocked updateFunc dir) 59 | 60 | updateBuildReportsUnlocked :: (BuildReportMap -> BuildReportMap) -> FilePath -> IO BuildReportMap 61 | updateBuildReportsUnlocked updateFunc dir = do 62 | reports <- updateFunc <$> loadBuildReports dir 63 | reports <$ saveBuildReports dir reports 64 | 65 | buildReportsDir :: IO FilePath 66 | buildReportsDir = getXdgDirectory XdgCache "nix-output-monitor" 67 | 68 | buildReportsFilename :: FilePath 69 | buildReportsFilename = "build-reports.csv" 70 | 71 | saveBuildReports :: FilePath -> BuildReportMap -> IO () 72 | saveBuildReports dir reports = catchIO trySave mempty 73 | where 74 | trySave = do 75 | createDirectoryIfMissing True dir 76 | writeFileLBS (dir buildReportsFilename) (encode . toCSV $ reports) 77 | 78 | loadBuildReports :: FilePath -> IO BuildReportMap 79 | loadBuildReports dir = catchIO tryLoad mempty 80 | where 81 | tryLoad = 82 | readFileLBS (dir buildReportsFilename) 83 | <&> ( decode NoHeader 84 | >>> either mempty (fromCSV . toList) 85 | ) 86 | 87 | toCSV :: BuildReportMap -> [BuildReport] 88 | toCSV = fmap (\((fromHost -> host, name), seconds) -> BuildReport{..}) . Map.assocs 89 | 90 | fromHost :: Host -> Text 91 | fromHost = \case 92 | Localhost -> "" 93 | Host x -> x 94 | 95 | fromCSV :: [BuildReport] -> BuildReportMap 96 | fromCSV = fromList . fmap (\BuildReport{..} -> ((toHost host, name), seconds)) 97 | 98 | toHost :: Text -> Host 99 | toHost = \case 100 | "" -> Localhost 101 | x -> Host x 102 | -------------------------------------------------------------------------------- /lib/NOM/Util.hs: -------------------------------------------------------------------------------- 1 | module NOM.Util (foldMapEndo, forMaybeM, parseOne, parseOneText) where 2 | 3 | import Data.Attoparsec.ByteString qualified as Parser 4 | import Relude 5 | 6 | foldMapEndo :: (Foldable f) => (b -> a -> a) -> f b -> a -> a 7 | foldMapEndo f = appEndo . foldMap (Endo . f) 8 | 9 | forMaybeM :: (Monad m) => [a] -> (a -> m (Maybe b)) -> m [b] 10 | forMaybeM = flip mapMaybeM 11 | 12 | parseOneText :: (ConvertUtf8 a ByteString) => Parser.Parser b -> a -> Maybe (ByteString, b) 13 | parseOneText parser = parseOne parser . encodeUtf8 14 | 15 | parseOne :: Parser.Parser b -> ByteString -> Maybe (ByteString, b) 16 | parseOne parser input = case Parser.parse parser input of 17 | Parser.Done x a -> Just (x, a) 18 | _ -> Nothing 19 | -------------------------------------------------------------------------------- /nix-output-monitor.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: nix-output-monitor 3 | version: 2.1.6 4 | synopsis: 5 | Processes output of Nix commands to show helpful and pretty information 6 | 7 | description: 8 | A tool which consumes Nix’s output to enrich your terminal output with useful information. 9 | 10 | homepage: https://code.maralorn.de/maralorn/nix-output-monitor 11 | bug-reports: https://github.com/maralorn/nix-output-monitor/issues 12 | license: AGPL-3.0-or-later 13 | license-file: LICENSE 14 | author: maralorn 15 | maintainer: maralorn 16 | build-type: Simple 17 | extra-source-files: 18 | completions/completion.bash 19 | completions/completion.zsh 20 | test/golden/fail/stderr 21 | test/golden/fail/stderr.json 22 | test/golden/fail/stdout 23 | test/golden/fail/stdout.json 24 | test/golden/standard/stderr 25 | test/golden/standard/stderr.json 26 | test/golden/standard/stdout 27 | test/golden/standard/stdout.json 28 | 29 | extra-doc-files: CHANGELOG.md 30 | category: 31 | console 32 | nix 33 | 34 | source-repository head 35 | type: git 36 | location: https://code.maralorn.de/maralorn/nix-output-monitor 37 | 38 | common common-config 39 | default-extensions: 40 | AllowAmbiguousTypes 41 | BlockArguments 42 | DataKinds 43 | DeriveAnyClass 44 | DerivingStrategies 45 | DuplicateRecordFields 46 | ImportQualifiedPost 47 | LambdaCase 48 | NoFieldSelectors 49 | NoImplicitPrelude 50 | OverloadedRecordDot 51 | OverloadedStrings 52 | RecordWildCards 53 | StrictData 54 | TypeFamilies 55 | TypeOperators 56 | UnicodeSyntax 57 | ViewPatterns 58 | 59 | build-depends: 60 | MemoTrie, 61 | ansi-terminal, 62 | async, 63 | attoparsec, 64 | base >=4.10 && <5.0, 65 | bytestring, 66 | cassava, 67 | containers, 68 | directory, 69 | extra, 70 | filelock, 71 | filepath, 72 | hermes-json >=0.6.0.0, 73 | nix-derivation, 74 | optics, 75 | relude, 76 | safe, 77 | safe-exceptions, 78 | stm, 79 | streamly-core, 80 | strict, 81 | strict-types, 82 | terminal-size, 83 | text, 84 | time, 85 | transformers, 86 | word8, 87 | 88 | default-language: GHC2021 89 | ghc-options: 90 | -Weverything 91 | -Wno-missing-import-lists 92 | -Wno-missing-local-signatures 93 | -Wno-implicit-prelude 94 | -Wno-monomorphism-restriction 95 | -Wno-missed-specialisations 96 | -Wno-all-missed-specialisations 97 | -Wno-missing-kind-signatures 98 | -Wno-missing-role-annotations 99 | -Wno-missing-safe-haskell-mode 100 | -Wno-safe 101 | -Wno-unsafe 102 | -fno-show-valid-hole-fits 103 | -fexpose-all-unfoldings 104 | -fshow-warning-groups 105 | 106 | library 107 | import: common-config 108 | hs-source-dirs: lib 109 | -- cabal-gild: discover lib 110 | exposed-modules: 111 | Data.Sequence.Strict 112 | NOM.Builds 113 | NOM.Error 114 | NOM.IO 115 | NOM.IO.Input 116 | NOM.IO.Input.JSON 117 | NOM.IO.Input.OldStyle 118 | NOM.NixMessage.JSON 119 | NOM.NixMessage.OldStyle 120 | NOM.Parser 121 | NOM.Parser.JSON 122 | NOM.Print 123 | NOM.Print.Table 124 | NOM.Print.Tree 125 | NOM.State 126 | NOM.State.CacheId 127 | NOM.State.CacheId.Map 128 | NOM.State.CacheId.Set 129 | NOM.State.Sorting 130 | NOM.State.Tree 131 | NOM.StreamParser 132 | NOM.Update 133 | NOM.Update.Monad 134 | NOM.Update.Monad.CacheBuildReports 135 | NOM.Util 136 | 137 | common exes 138 | import: common-config 139 | ghc-options: 140 | -threaded 141 | -Wno-unused-packages 142 | -with-rtsopts=-maxN2 143 | 144 | executable nom 145 | import: exes 146 | hs-source-dirs: exe 147 | main-is: Main.hs 148 | other-modules: Paths_nix_output_monitor 149 | build-depends: 150 | nix-output-monitor, 151 | typed-process, 152 | unix, 153 | 154 | autogen-modules: Paths_nix_output_monitor 155 | 156 | common tests 157 | import: exes 158 | build-depends: 159 | HUnit, 160 | nix-output-monitor, 161 | typed-process, 162 | 163 | test-suite unit-tests 164 | import: tests 165 | hs-source-dirs: test 166 | type: exitcode-stdio-1.0 167 | main-is: Property.hs 168 | 169 | test-suite golden-tests 170 | import: tests 171 | hs-source-dirs: test 172 | build-depends: random 173 | type: exitcode-stdio-1.0 174 | main-is: Golden.hs 175 | -------------------------------------------------------------------------------- /renovate.json: -------------------------------------------------------------------------------- 1 | { 2 | "$schema": "https://docs.renovatebot.com/renovate-schema.json", 3 | "extends": [ 4 | "local>maralorn/renovate-presets" 5 | ] 6 | } 7 | -------------------------------------------------------------------------------- /test/Golden.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Control.Monad.Trans.Writer.CPS (runWriterT) 4 | import Data.ByteString.Char8 qualified as ByteString 5 | import Data.Text qualified as Text 6 | import NOM.Builds (parseStorePath) 7 | import NOM.Error (NOMError) 8 | import NOM.IO (processTextStream) 9 | import NOM.IO.Input (NOMInput (..), UpdateResult (..)) 10 | import NOM.IO.Input.JSON () 11 | import NOM.IO.Input.OldStyle (OldStyleInput) 12 | import NOM.NixMessage.JSON (NixJSONMessage) 13 | import NOM.Print (Config (..)) 14 | import NOM.State ( 15 | DependencySummary (..), 16 | DerivationId, 17 | NOMV1State (..), 18 | getStorePathId, 19 | initalStateFromBuildPlatform, 20 | outPathToDerivation, 21 | ) 22 | import NOM.State.CacheId.Map qualified as CMap 23 | import NOM.State.CacheId.Set qualified as CSet 24 | import NOM.Update ( 25 | detectLocalFinishedBuilds, 26 | maintainState, 27 | ) 28 | import NOM.Update.Monad (UpdateMonad) 29 | import NOM.Util (forMaybeM) 30 | import Optics ((%~), (.~), (^.)) 31 | import Relude 32 | import Streamly.Data.Stream qualified as Stream 33 | import System.Environment qualified 34 | import System.Process.Typed qualified as Process 35 | import System.Random (randomIO) 36 | import Test.HUnit ( 37 | Counts (errors, failures), 38 | Test, 39 | Testable (test), 40 | assertBool, 41 | assertEqual, 42 | runTestTT, 43 | (~:), 44 | ) 45 | 46 | tests :: [TestConfig -> Test] 47 | tests = [goldenStandard, goldenFail] 48 | 49 | label :: (Semigroup a, IsString a) => TestConfig -> a -> a 50 | label config name = "golden test " <> name <> " for " <> (if config.oldStyle then "old-style messages" else "json messages") <> if config.withNix then " with nix" else " with log from file" 51 | 52 | allBools :: [Bool] 53 | allBools = [True, False] 54 | 55 | main :: IO () 56 | main = do 57 | with_nix <- isNothing <$> System.Environment.lookupEnv "TESTS_FROM_FILE" 58 | when with_nix 59 | $ Process.runProcess_ 60 | $ Process.setStderr Process.nullStream 61 | $ Process.setStdout Process.nullStream 62 | $ Process.proc 63 | "nix-store" 64 | ["-r", "/nix/store/y7ji7mwys7g60j2w8bl93cmfbvd3xi3r-busybox-static-x86_64-unknown-linux-musl-1.35.0/bin/"] 65 | counts <- runTestTT 66 | $ test 67 | $ do 68 | test' <- tests 69 | if with_nix 70 | then do 71 | test' <$> [MkTestConfig{..} | withNix <- allBools, oldStyle <- allBools] 72 | else test' <$> [MkTestConfig{withNix = with_nix, ..} | oldStyle <- allBools] 73 | if Test.HUnit.errors counts + failures counts == 0 then exitSuccess else exitFailure 74 | 75 | data TestConfig = MkTestConfig {withNix :: Bool, oldStyle :: Bool} 76 | 77 | testBuild :: String -> TestConfig -> (Text -> NOMV1State -> IO ()) -> Test 78 | testBuild name config asserts = 79 | label config name ~: do 80 | let suffix = if config.oldStyle then "" else ".json" 81 | callNix = do 82 | seed <- randomIO @Int 83 | let command = 84 | if config.oldStyle 85 | then 86 | Process.proc 87 | "nix-build" 88 | ["test/golden/" <> name <> "/default.nix", "--no-out-link", "--argstr", "seed", show seed] 89 | else 90 | Process.proc 91 | "nix" 92 | ["build", "-f", "test/golden/" <> name <> "/default.nix", "--no-link", "--argstr", "seed", show seed, "-v", "--log-format", "internal-json"] 93 | Process.readProcess command 94 | <&> (\(_, stdout', stderr') -> (decodeUtf8 stdout', toStrict stderr')) 95 | readFiles = (,) . decodeUtf8 <$> readFileBS ("test/golden/" <> name <> "/stdout" <> suffix) <*> readFileBS ("test/golden/" <> name <> "/stderr" <> suffix) 96 | (output, errors) <- if config.withNix then callNix else readFiles 97 | end_state <- if config.oldStyle then testProcess @OldStyleInput (Stream.fromPure errors) else testProcess @NixJSONMessage (Stream.fromList (ByteString.lines errors)) 98 | asserts output end_state 99 | 100 | testProcess :: forall input. (NOMInput input) => Stream.Stream IO ByteString -> IO NOMV1State 101 | testProcess input = withParser @input \streamParser -> do 102 | first_state <- firstState @input <$> initalStateFromBuildPlatform (Just "x86_64-linux") 103 | end_state <- processTextStream @input @(UpdaterState input) (MkConfig False False) streamParser stateUpdater (\now -> nomState @input %~ maintainState now) Nothing (finalizer @input) first_state (Right <$> input) 104 | pure (end_state ^. nomState @input) 105 | 106 | stateUpdater :: forall input m. (NOMInput input, UpdateMonad m) => input -> StateT (UpdaterState input) m ([NOMError], ByteString, Bool) 107 | stateUpdater input = do 108 | old_state <- get 109 | new_state <- (.newState) <$> updateState @input input old_state 110 | put new_state 111 | pure (mempty, mempty, False) 112 | 113 | finalizer :: forall input m. (NOMInput input, UpdateMonad m) => StateT (UpdaterState input) m () 114 | finalizer = do 115 | old_state <- get 116 | new_state <- execStateT (runWriterT detectLocalFinishedBuilds) (old_state ^. nomState @input) 117 | put (nomState @input .~ new_state $ old_state) 118 | 119 | goldenStandard :: TestConfig -> Test 120 | goldenStandard config = testBuild "standard" config \nix_output endState@MkNOMV1State{fullSummary = MkDependencySummary{..}} -> do 121 | let noOfBuilds :: Int 122 | noOfBuilds = 4 123 | assertBool "Everything built" (CSet.null plannedBuilds) 124 | assertBool "No running builds" (CMap.null runningBuilds) 125 | assertEqual "Builds completed" noOfBuilds (CMap.size completedBuilds) 126 | when config.oldStyle $ do 127 | let outputStorePaths = mapMaybe parseStorePath (Text.lines nix_output) 128 | assertEqual "All output paths parsed" noOfBuilds (length outputStorePaths) 129 | let outputDerivations :: [DerivationId] 130 | outputDerivations = flip evalState endState $ forMaybeM outputStorePaths \path -> do 131 | pathId <- getStorePathId path 132 | outPathToDerivation pathId 133 | assertEqual "Derivations for all outputs have been found" noOfBuilds (length outputDerivations) 134 | assertBool "All found derivations have successfully been built" (CSet.isSubsetOf (CSet.fromFoldable outputDerivations) (CMap.keysSet completedBuilds)) 135 | 136 | goldenFail :: TestConfig -> Test 137 | goldenFail config = testBuild "fail" config \_ MkNOMV1State{fullSummary = d@MkDependencySummary{..}} -> do 138 | assertEqual ("There should be one waiting build in " <> show d) 1 (CSet.size plannedBuilds) 139 | assertEqual ("There should be one failed build in " <> show d) 1 (CMap.size failedBuilds) 140 | assertEqual ("There should be no completed builds in " <> show d) 0 (CMap.size completedBuilds) 141 | assertEqual ("There should be one unfinished build " <> show d) 1 (CMap.size runningBuilds) 142 | -------------------------------------------------------------------------------- /test/Property.hs: -------------------------------------------------------------------------------- 1 | import Data.Set (singleton) 2 | import NOM.Builds 3 | import NOM.NixMessage.OldStyle (NixOldStyleMessage (..)) 4 | import NOM.Parser 5 | import NOM.Util (parseOne) 6 | import Relude 7 | import Relude.Unsafe qualified as Unsafe 8 | import Test.HUnit 9 | 10 | assertOldStyleParse :: ByteString -> IO (ByteString, NixOldStyleMessage) 11 | assertOldStyleParse input = do 12 | let res = parseOne parser input 13 | assertBool "parsing succeeds" (isJust res) 14 | let (t, res') = Unsafe.fromJust res 15 | assertBool "parsing succeeds with an actual match" (isJust res') 16 | pure (t, Unsafe.fromJust res') 17 | 18 | main :: IO () 19 | main = do 20 | counts <- 21 | runTestTT 22 | $ test 23 | [ "Parse Plan" ~: do 24 | (rest, result) <- 25 | assertOldStyleParse 26 | "these derivations will be built:\n /nix/store/7n05q79qhrgvnfmvv2v3cnj3yqf4d1hf-haskell-language-server-0.4.0.0.drv\nthese paths will be fetched (134.19 MiB download, 1863.82 MiB unpacked):\n /nix/store/60zb5dndaw1fzir3s69sy3xhy19gll1p-ghc-8.8.2\ngarbage" 27 | assertEqual 28 | "result matches" 29 | ( PlanBuilds 30 | ( singleton 31 | ( Derivation 32 | $ StorePath 33 | "7n05q79qhrgvnfmvv2v3cnj3yqf4d1hf" 34 | "haskell-language-server-0.4.0.0" 35 | ) 36 | ) 37 | ( Derivation 38 | $ StorePath 39 | "7n05q79qhrgvnfmvv2v3cnj3yqf4d1hf" 40 | "haskell-language-server-0.4.0.0" 41 | ) 42 | ) 43 | result 44 | (rest2, result2) <- assertOldStyleParse rest 45 | assertEqual 46 | "result matches" 47 | ( PlanDownloads 48 | 134.19 49 | 1863.82 50 | (singleton (StorePath "60zb5dndaw1fzir3s69sy3xhy19gll1p" "ghc-8.8.2")) 51 | ) 52 | result2 53 | assertEqual "rest is okay" "garbage" rest2 54 | , "Parse Downloading" ~: do 55 | (rest, result) <- 56 | assertOldStyleParse 57 | "copying path '/nix/store/yk1164s4bkj6p3s4mzxm5fc4qn38cnmf-ghc-8.8.2-doc' from 'https://cache.nixos.org'...\n" 58 | assertEqual 59 | "result matches" 60 | ( Downloading 61 | (StorePath "yk1164s4bkj6p3s4mzxm5fc4qn38cnmf" "ghc-8.8.2-doc") 62 | (Host "https://cache.nixos.org") 63 | ) 64 | result 65 | assertEqual "no rest" "" rest 66 | , "Parse local building" ~: do 67 | (rest, result) <- 68 | assertOldStyleParse 69 | "building '/nix/store/dpqlnrbvzhjxp06d1mc3ksf2w8m2ldms-aeson-1.5.2.0.drv'...\n" 70 | assertEqual 71 | "result matches" 72 | ( Build 73 | (Derivation $ StorePath "dpqlnrbvzhjxp06d1mc3ksf2w8m2ldms" "aeson-1.5.2.0") 74 | Localhost 75 | ) 76 | result 77 | assertEqual "no rest" "" rest 78 | , "Parse remote building" ~: do 79 | (rest, result) <- 80 | assertOldStyleParse 81 | "building '/nix/store/63jjdifv1x1nymjxdwla603xy1sggakk-hoogle-local-0.1.drv' on 'ssh://maralorn@example.com'...\n" 82 | assertEqual 83 | "result matches" 84 | ( Build 85 | (Derivation $ StorePath "63jjdifv1x1nymjxdwla603xy1sggakk" "hoogle-local-0.1") 86 | (Host "ssh://maralorn@example.com") 87 | ) 88 | result 89 | assertEqual "no rest" "" rest 90 | , "Parse failed build" ~: do 91 | (rest, result) <- 92 | assertOldStyleParse 93 | "builder for '/nix/store/fbpdwqrfwr18nn504kb5jqx7s06l1mar-regex-base-0.94.0.1.drv' failed with exit code 1\n" 94 | assertEqual 95 | "result matches" 96 | (Failed (Derivation $ StorePath "fbpdwqrfwr18nn504kb5jqx7s06l1mar" "regex-base-0.94.0.1") (ExitCode 1)) 97 | result 98 | assertEqual "no rest" "" rest 99 | , "Parse faild build for nix 2.4" ~: do 100 | (rest, result) <- 101 | assertOldStyleParse 102 | "error: builder for '/nix/store/dylih0mw8yisn6nrjc3qlf51knmdkrq1-local-build-3.drv' failed with exit code 1;\n" 103 | assertEqual 104 | "result matches" 105 | (Failed (Derivation $ StorePath "dylih0mw8yisn6nrjc3qlf51knmdkrq1" "local-build-3") (ExitCode 1)) 106 | result 107 | assertEqual "no rest" "" rest 108 | ] 109 | if errors counts + failures counts == 0 then exitSuccess else exitFailure 110 | -------------------------------------------------------------------------------- /test/golden/all.nix: -------------------------------------------------------------------------------- 1 | let 2 | packages = seed: (import ./standard { inherit seed; }); 3 | in 4 | builtins.attrValues (packages "old-style") ++ builtins.attrValues (packages "json") 5 | -------------------------------------------------------------------------------- /test/golden/default.nix: -------------------------------------------------------------------------------- 1 | args@{ busybox ? false, ... }: 2 | let 3 | busyboxPath = 4 | "/nix/store/y7ji7mwys7g60j2w8bl93cmfbvd3xi3r-busybox-static-x86_64-unknown-linux-musl-1.35.0/bin/"; 5 | busyboxBin = builtins.storePath busyboxPath; 6 | in if busybox then 7 | derivation (args // { 8 | system = builtins.currentSystem; 9 | builder = busyboxBin + "/sh"; 10 | sleep = busyboxBin + "/sleep"; 11 | args = [ "-c" args.script ]; 12 | }) 13 | else 14 | derivation (args // { 15 | system = "x86_64-linux"; 16 | builder = "/bin/sh"; 17 | args = [ "-c" args.script ]; 18 | }) 19 | -------------------------------------------------------------------------------- /test/golden/fail/default.nix: -------------------------------------------------------------------------------- 1 | { seed }: 2 | let 3 | mkBuild = name: deps: script: 4 | import ./.. { 5 | inherit name deps seed script; 6 | busybox = true; 7 | }; 8 | in rec { 9 | build_long = mkBuild "build-long" [ ] "$sleep 10s"; 10 | build_waiting = mkBuild "build-waiting" [ build_long build_fail ] ""; 11 | build_fail = mkBuild "build-fail" [ ] "$sleep 1s; exit 1;"; 12 | } 13 | -------------------------------------------------------------------------------- /test/golden/fail/stderr: -------------------------------------------------------------------------------- 1 | these 3 derivations will be built: 2 | /nix/store/ngp61r4mb986d14cmnlz4ln9yyyk76sr-build-long.drv 3 | /nix/store/ppv7ng39r8bxfdh9m3xsw3qf8s58pkfg-build-fail.drv 4 | /nix/store/nynf9h9crljsyh1z98bmq6m0vz65x82q-build-waiting.drv 5 | building '/nix/store/ppv7ng39r8bxfdh9m3xsw3qf8s58pkfg-build-fail.drv'... 6 | building '/nix/store/ngp61r4mb986d14cmnlz4ln9yyyk76sr-build-long.drv'... 7 | error: builder for '/nix/store/ppv7ng39r8bxfdh9m3xsw3qf8s58pkfg-build-fail.drv' failed with exit code 1 8 | error: build of '/nix/store/ngp61r4mb986d14cmnlz4ln9yyyk76sr-build-long.drv', '/nix/store/nynf9h9crljsyh1z98bmq6m0vz65x82q-build-waiting.drv', '/nix/store/ppv7ng39r8bxfdh9m3xsw3qf8s58pkfg-build-fail.drv' failed 9 | -------------------------------------------------------------------------------- /test/golden/fail/stdout: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maralorn/nix-output-monitor/2d82c7c6011bb08ce2de6817f00b3f1b6aee09f6/test/golden/fail/stdout -------------------------------------------------------------------------------- /test/golden/fail/stdout.json: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maralorn/nix-output-monitor/2d82c7c6011bb08ce2de6817f00b3f1b6aee09f6/test/golden/fail/stdout.json -------------------------------------------------------------------------------- /test/golden/standard/default.nix: -------------------------------------------------------------------------------- 1 | { seed }: 2 | let 3 | mkBuild = name: deps: 4 | import ./.. { 5 | inherit name deps seed; 6 | script = "echo output for $out; echo foo > $out"; 7 | }; 8 | in rec { 9 | build1 = mkBuild "build1" [ ]; 10 | build2 = mkBuild "build2" [ build1 ]; 11 | build3 = mkBuild "build3" [ build1 build2 ]; 12 | build4 = mkBuild "build4" [ build2 build3 ]; 13 | } 14 | -------------------------------------------------------------------------------- /test/golden/standard/stderr: -------------------------------------------------------------------------------- 1 | these 4 derivations will be built: 2 | /nix/store/xv3g9i3081rqx4wilyi304c17axrajnq-build1.drv 3 | /nix/store/787q931q04dbgjzrqys28j5vyszz86ls-build2.drv 4 | /nix/store/3p8ih1xqwcs9kjcw2gni9lv0hsmn2vwl-build3.drv 5 | /nix/store/724mhypf8g8ahffn4c9x32j53yigj486-build4.drv 6 | building '/nix/store/xv3g9i3081rqx4wilyi304c17axrajnq-build1.drv'... 7 | output for /nix/store/22d93x5fqmrwfxp18fyb4labbs1q2slw-build1 8 | building '/nix/store/787q931q04dbgjzrqys28j5vyszz86ls-build2.drv'... 9 | output for /nix/store/xvw4mzwrpg0n2pcw5i30cjanc74ysp2z-build2 10 | building '/nix/store/3p8ih1xqwcs9kjcw2gni9lv0hsmn2vwl-build3.drv'... 11 | output for /nix/store/226w8ydbdhjnah61b418434ygw2m0ald-build3 12 | building '/nix/store/724mhypf8g8ahffn4c9x32j53yigj486-build4.drv'... 13 | output for /nix/store/dgln3wcjj1yd89wp61qn0037yyblf5l8-build4 14 | -------------------------------------------------------------------------------- /test/golden/standard/stdout: -------------------------------------------------------------------------------- 1 | /nix/store/22d93x5fqmrwfxp18fyb4labbs1q2slw-build1 2 | /nix/store/xvw4mzwrpg0n2pcw5i30cjanc74ysp2z-build2 3 | /nix/store/226w8ydbdhjnah61b418434ygw2m0ald-build3 4 | /nix/store/dgln3wcjj1yd89wp61qn0037yyblf5l8-build4 5 | -------------------------------------------------------------------------------- /test/golden/standard/stdout.json: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/maralorn/nix-output-monitor/2d82c7c6011bb08ce2de6817f00b3f1b6aee09f6/test/golden/standard/stdout.json -------------------------------------------------------------------------------- /weeder.dhall: -------------------------------------------------------------------------------- 1 | { roots = [ "^Paths_.", "^Main.main$", "showCode$" ], type-class-roots = True } 2 | --------------------------------------------------------------------------------