├── .github └── workflows │ └── nix.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── Main_example.hs ├── README.md ├── Setup.hs ├── app ├── Config.hs ├── Config │ ├── Common.hs │ ├── PackageFetcher.hs │ └── VersionSource.hs └── Main.hs ├── cabal.project ├── default.nix ├── flake.lock ├── flake.nix ├── nix └── default.nix ├── nvfetcher.cabal ├── nvfetcher_example.toml ├── src ├── NvFetcher.hs └── NvFetcher │ ├── Config.hs │ ├── Core.hs │ ├── ExtractSrc.hs │ ├── FetchRustGitDeps.hs │ ├── GetGitCommitDate.hs │ ├── NixExpr.hs │ ├── NixFetcher.hs │ ├── Nvchecker.hs │ ├── Options.hs │ ├── PackageSet.hs │ ├── Types.hs │ ├── Types │ ├── Lens.hs │ └── ShakeExtras.hs │ └── Utils.hs └── test ├── CheckVersionSpec.hs ├── FetchRustGitDepsSpec.hs ├── GetGitCommitDateSpec.hs ├── NixExprSpec.hs ├── PrefetchSpec.hs ├── Spec.hs └── Utils.hs /.github/workflows/nix.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | pull_request: 4 | push: 5 | branches: [master] 6 | jobs: 7 | nix-tests: 8 | runs-on: ubuntu-latest 9 | steps: 10 | - uses: actions/checkout@v4 11 | - uses: cachix/install-nix-action@v25 12 | with: 13 | github_access_token: ${{ secrets.GITHUB_TOKEN }} 14 | nix_path: nixpkgs=channel:nixos-unstable 15 | 16 | - name: Run Nix Flake Check 17 | run: nix flake check 18 | 19 | - name: Build library and generate haddock 20 | run: | 21 | nix build .\#nvfetcher-lib.out.doc 22 | cp -r ./result-doc/share/doc/nvfetcher-*/html/ docs 23 | 24 | - name: Run spec tests 25 | run: | 26 | nix develop --command cabal update 27 | nix develop --command cabal test 28 | 29 | - name: Run CLI with nvfetcher_example.toml 30 | run : nix shell --command nvfetcher --config nvfetcher_example.toml 31 | 32 | - name: Eval generated.nix 33 | run : nix eval -f _sources/generated.nix 34 | 35 | - name: Cleanup 36 | run: rm -r _sources 37 | 38 | - name: Run Main_example.hs 39 | run: nix develop .\#ghcWithNvfetcher --command runghc Main_example.hs 40 | 41 | - name: Deploy generated haddock to github pages 42 | uses: peaceiris/actions-gh-pages@v3 43 | if: ${{ github.repository_owner == 'berberman' && github.ref == 'refs/heads/master' }} 44 | with: 45 | github_token: ${{ secrets.GITHUB_TOKEN }} 46 | publish_dir: ./docs 47 | cname: nvfetcher.torus.icu 48 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ### Haskell 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | *.prof 12 | *.aux 13 | *.hp 14 | *.eventlog 15 | .virtualenv 16 | .hsenv 17 | .hpc 18 | .cabal-sandbox/ 19 | cabal.sandbox.config 20 | cabal.config 21 | cabal.project.local 22 | .ghc.environment.* 23 | .HTF/ 24 | # Stack 25 | .stack-work/ 26 | stack.yaml.lock 27 | 28 | ### IDE/support 29 | # Vim 30 | [._]*.s[a-v][a-z] 31 | [._]*.sw[a-p] 32 | [._]s[a-v][a-z] 33 | [._]sw[a-p] 34 | *~ 35 | tags 36 | 37 | # IntellijIDEA 38 | .idea/ 39 | .ideaHaskellLib/ 40 | *.iml 41 | 42 | # Atom 43 | .haskell-ghc-mod.json 44 | 45 | # VS 46 | .vscode/ 47 | 48 | # Emacs 49 | *# 50 | .dir-locals.el 51 | TAGS 52 | 53 | # other 54 | .DS_Store 55 | 56 | _sources 57 | sources.nix 58 | 59 | result 60 | result-doc 61 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for nvfetcher 2 | 3 | ## 0.7.0.0 4 | 5 | Now nvfetcher removes all files *except* `generated.json` and `generated.nix` in `_sources` before each run. If you do want to keep those files, you can use the new CLI option `--keep-old`. In addition, a new target `purge` is introduced for resetting the state of nvfetcher by deleting the shake database saved in XDG directory. 6 | 7 | * Quote package name passed to nvchecker 8 | * Add `url.name` option to specify the file name in prefetch 9 | * Clean build dir before build 10 | * Support keep going on fetch failure 11 | * Add `--commit-summary` 12 | * Support sparseCheckout 13 | 14 | ## 0.6.2.0 15 | 16 | * Rework config parsing with toml-reader 17 | 18 | ## 0.6.1.0 19 | 20 | * Replace `nix-prefetch` with `nix-prefetch-git` and `nix-prefetch-url` 21 | 22 | ## 0.6.0.0 23 | 24 | * Parse error output from nvchecker 25 | * Add source and fetcher for Docker containers (Thanks to @amesgen) 26 | * Add option fetch.force to always rerun the prefetch rule 27 | * Add `fetchGitHubRelease'` to `PackageSet` 28 | * Add `GetGitCommitDate` rule 29 | * Add `--keyfile` to pass [nvchecker keyfile](https://nvchecker.readthedocs.io/en/latest/usage.html#configuration-table) 30 | * Remove IFD from extracing sources 31 | 32 | ## 0.5.0.0 33 | 34 | There have been many significant changes since the last release. 35 | **Starting from this version, nvfetcher no longer requires shake database for each project, 36 | in other words, there is no need to commit the database in git or share it between machines.** 37 | Also, a machine-readable `generated.json` will be generated for convenience. 38 | 39 | ### Migration 40 | 41 | The option in TOML configuration `cargo_lock` (string) was changed to `cargo_locks` (list of strings), since now nvfetcher supports handling multi-cargo locks. 42 | 43 | * Use `fetchFromGitHub` as the GitHub fetcher (introduces [`nix-prefetch`](https://github.com/msteen/nix-prefetch)) 44 | * Add [cmd](https://nvchecker.readthedocs.io/en/latest/usage.html#find-with-a-command) version source 45 | * Support pinning a package 46 | * Tweak src name to extract .vsx file properly 47 | * Add option --filter to specify packages to update 48 | * Fix missing `argActionAfterBuild` 49 | * Add one shot nvchecker rule independent of package definition 50 | * Don't cache generated nix exprs in shake database 51 | * Add `fetchTarball` 52 | * Produce parser readable `generated.json` 53 | * Internalize shake database 54 | * Validate config before decoding 55 | * Extract `Config` from `Arg` and save it to shake extra 56 | * Breakdown `Args` to provide a more concise API 57 | * Support multi-cargo lock files 58 | * Pretty print rules in command line 59 | 60 | ## 0.4.0.0 61 | 62 | * Rename `_build` to `_sources` 63 | * Remove the symlink `sources.nix -> _sources/generated.nix` 64 | * Remove CLI option `--output` (was used to set the symlink source name, `sources.nix` by default) 65 | * Add CLI option `build-dir` to specify build directory (`_sources` by default) 66 | * Add CLI option `--commit-changes` to commit changes of build directory 67 | * Support openvsx and vsmarketplace version sources (needs new version of nvchecker) 68 | * Support attributes pass through 69 | * Fix the bug that Core rule was cut off even if the configuration has changed 70 | (no longer needs to use `nvfetcher clean` to keep the build system consistency manually) 71 | * Fix the parser of git source in Cargo.lock 72 | * Fix wrong trailing white spances in generated nix expr 73 | * Fix missing semicolon in generated nix expr that reads Cargo.lock file 74 | * Enhance eDSL experience 75 | * Add some unit tests 76 | 77 | ## 0.3.0.0 78 | 79 | There are massive enhancements since the last release: 80 | 81 | * Add support for nvchecker [list options](https://nvchecker.readthedocs.io/en/latest/usage.html#list-options) 82 | * Refactor TOML config parsing 83 | * Remove version specification in fetcher config (`fetch.url = url:version` -> `fetch.url = url`) 84 | * Add support for calculating [`cargoLock`](https://github.com/NixOS/nixpkgs/blob/master/doc/languages-frameworks/rust.section.md#importing-a-cargolock-file) for `rustPlatform.buildRustPackage` 85 | * Add support for nvchecker [global options](https://nvchecker.readthedocs.io/en/latest/usage.html#global-options) 86 | * Remove ambiguous branch specification (`git.branch`) from git fetcher 87 | * Enable parallelism by default 88 | * Add a global retry option 89 | * Rename `.shake` to `_build` 90 | * Generate nix output file in `_build`, and symlink it to `../sources.nix` (You have to keep `_build` as the `nvfetcher` run result) 91 | * Support extracting arbitrary files from fetched package source 92 | * Add nvchecker upstream sources [`src.webpage`](https://nvchecker.readthedocs.io/en/latest/usage.html#search-in-a-webpage) and [`src.httpheader`](https://nvchecker.readthedocs.io/en/latest/usage.html#search-in-an-http-header) 93 | * Add nvchecker upstream source `src.github_tag` 94 | * Share CLI between `runNvfetcher` (use `nvfetcher` in the DSL way) and `nvfetcher` executable program 95 | * Nix related improvements: 96 | * Add a development shell `ghcWithNvfetcher` for people who want to use `nvfetcher` as a Haskell library 97 | * Generate command line completion for the executable 98 | 99 | 100 | ## 0.2.0.0 101 | 102 | * Generated package sources will be sorted alphabetically. 103 | * CLI program now supports `nix-git-prefetch` configurations in TOML. 104 | * Lenses are added for some data types. 105 | * CLI options are no loger inherited from Shake. Now `nvfetcher` has its own CLI options with completion support. 106 | 107 | ## 0.1.0.0 108 | 109 | * First version. Released on an unsuspecting world. 110 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 berberman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Main_example.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import NvFetcher 6 | 7 | main :: IO () 8 | main = runNvFetcher packageSet 9 | 10 | packageSet :: PackageSet () 11 | packageSet = do 12 | define $ package "fd" `fromGitHub` ("sharkdp", "fd") `extractSource` ["Cargo.lock"] 13 | 14 | define $ package "gcc-10" `fromGitHubTag` ("gcc-mirror", "gcc", includeRegex ?~ "releases/gcc-10.*") 15 | 16 | define $ package "feeluown-core" `fromPypi` "feeluown" 17 | 18 | define $ 19 | package "apple-emoji" 20 | `sourceManual` "0.0.0.20200413" 21 | `fetchUrl` const 22 | "https://github.com/samuelngs/apple-emoji-linux/releases/download/alpha-release-v1.0.0/AppleColorEmoji.ttf" 23 | 24 | define $ 25 | package "nvfetcher-git" 26 | `sourceGit` "https://github.com/berberman/nvfetcher" 27 | `fetchGitHub` ("berberman", "nvfetcher") 28 | 29 | -- define $ 30 | -- package "vim" 31 | -- `sourceWebpage` ("http://ftp.vim.org/pub/vim/patches/7.3/", "7\\.3\\.\\d+", id) 32 | -- `fetchGitHub` ("vim", "vim") 33 | -- `tweakVersion` (\v -> v & fromPattern ?~ "(.+)" & toPattern ?~ "v\\1") 34 | 35 | define $ 36 | package "rust-git-dependency-example" 37 | `sourceManual` "8a5f37a8f80a3b05290707febf57e88661cee442" 38 | `fetchGit` "https://gist.github.com/NickCao/6c4dbc4e15db5da107de6cdb89578375" 39 | `hasCargoLocks` ["Cargo.lock"] 40 | 41 | define $ package "vscode-LiveServer" `fromOpenVsx` ("ritwickdey", "LiveServer") 42 | 43 | define $ 44 | package "revda" 45 | `sourceGit` "https://github.com/THMonster/Revda" 46 | `fetchGitHub'` ("THMonster", "Revda", fetchSubmodules .~ True) 47 | `hasCargoLocks` ["dmlive/Cargo.lock", "dmlive/tars-stream/Cargo.lock"] 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # nvfetcher 2 | 3 | [![Hackage](https://img.shields.io/hackage/v/nvfetcher.svg?logo=haskell)](https://hackage.haskell.org/package/nvfetcher) 4 | [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE) 5 | [![nix](https://github.com/berberman/nvfetcher/actions/workflows/nix.yml/badge.svg)](https://github.com/berberman/nvfetcher/actions/workflows/nix.yml) 6 | 7 | nvfetcher is a tool to automate nix package updates. It's built on top of [shake](https://www.shakebuild.com/), 8 | integrating [nvchecker](https://github.com/lilydjwg/nvchecker). 9 | nvfetcher cli program accepts a TOML file as config, which defines a set of package sources to run. 10 | 11 | ## Overview 12 | 13 | For example, feeding the following configuration to`nvfetcher`: 14 | 15 | ```toml 16 | # nvfetcher.toml 17 | [feeluown] 18 | src.pypi = "feeluown" 19 | fetch.pypi = "feeluown" 20 | ``` 21 | 22 | it will create `_sources/generated.nix`: 23 | 24 | ```nix 25 | { fetchgit, fetchurl, fetchFromGitHub }: 26 | { 27 | feeluown = { 28 | pname = "feeluown"; 29 | version = "3.8.2"; 30 | src = fetchurl { 31 | url = "https://pypi.io/packages/source/f/feeluown/feeluown-3.8.2.tar.gz"; 32 | sha256 = "sha256-V2yzpkmjRkipZOvQGB2mYRhiiEly6QPrTOMJ7BmyWBQ="; 33 | }; 34 | }; 35 | } 36 | ``` 37 | 38 | and `_sources/generated.json`: 39 | 40 | ```json 41 | { 42 | "feeluown": { 43 | "pinned": false, 44 | "cargoLocks": null, 45 | "name": "feeluown-core", 46 | "version": "3.8.2", 47 | "passthru": null, 48 | "src": { 49 | "url": "https://pypi.io/packages/source/f/feeluown/feeluown-3.8.2.tar.gz", 50 | "name": null, 51 | "type": "url", 52 | "sha256": "sha256-V2yzpkmjRkipZOvQGB2mYRhiiEly6QPrTOMJ7BmyWBQ=" 53 | }, 54 | "extract": null, 55 | "rustGitDeps": null 56 | } 57 | } 58 | ``` 59 | 60 | We tell nvfetcher how to get the latest version number of packages and how to fetch their sources given version numbers, 61 | and nvfetcher will help us keep their version and prefetched SHA256 sums up-to-date, producing ready-to-use nix expressions in `_sources/generated.nix`. 62 | Nvfetcher reads `generated.json` to produce version change message, such as `feeluown: 3.8.1 → 3.8.2`. 63 | We always check versions of packages during each run, but only do prefetch and further operations when needed. 64 | 65 | ### Live examples 66 | 67 | How to use the generated sources file? Here are several examples: 68 | 69 | - My [flakes repo](https://github.com/berberman/flakes) 70 | 71 | - Nick Cao's [flakes repo](https://gitlab.com/NickCao/flakes/-/tree/master/pkgs) 72 | 73 | ## Installation 74 | 75 | `nvfetcher` package is available in [nixpkgs](https://github.com/NixOS/nixpkgs), so you can try it with: 76 | 77 | ``` 78 | $ nix-shell -p nvfetcher 79 | ``` 80 | 81 | This repo also has flakes support: 82 | 83 | ``` 84 | $ nix run github:berberman/nvfetcher 85 | ``` 86 | 87 | To use it as a Haskell library, the package is available on [Hackage](https://hackage.haskell.org/package/nvfetcher). 88 | If you want to use the Haskell library from flakes, there is also a shell `ghcWithNvfetcher`: 89 | 90 | ``` 91 | $ nix develop github:berberman/nvfetcher#ghcWithNvfetcher 92 | $ runghc Main.hs 93 | ``` 94 | 95 | where you can define packages in `Main.hs`. See [Haskell library](#Haskell-library) for details. 96 | 97 | ## Usage 98 | 99 | Basically, there are two ways to use nvfetcher, where the difference is how we provide package sources definitions to it. 100 | 101 | ### CLI 102 | 103 | To run nvfetcher as a CLI program, you'll need to provide package sources defined in TOML. 104 | 105 | ``` 106 | Usage: nvfetcher [--version] [--help] [-o|--build-dir DIR] [--commit-changes] 107 | [-l|--changelog FILE] [-j NUM] [-r|--retry NUM] [-t|--timing] 108 | [-v|--verbose] [-f|--filter REGEX] [-k|--keyfile FILE] 109 | [--keep-old] [--keep-going] [TARGET] [-c|--config FILE] 110 | 111 | generate nix sources expr for the latest version of packages 112 | 113 | Available options: 114 | --version Show version 115 | --help Show this help text 116 | -o,--build-dir DIR Directory that nvfetcher puts artifacts to 117 | (default: "_sources") 118 | --commit-changes `git commit` build dir with version changes as commit 119 | message 120 | -l,--changelog FILE Dump version changes to a file 121 | -j NUM Number of threads (0: detected number of processors) 122 | (default: 0) 123 | -r,--retry NUM Times to retry of some rules (nvchecker, prefetch, 124 | nix-build, etc.) (default: 3) 125 | -t,--timing Show build time 126 | -v,--verbose Verbose mode 127 | -f,--filter REGEX Regex to filter packages to be updated 128 | -k,--keyfile FILE Nvchecker keyfile 129 | --keep-old Don't remove old files other than generated json and 130 | nix before build 131 | --keep-going Don't stop if some packages failed to be fetched 132 | TARGET Three targets are available: 1.build 2.clean (remove 133 | all generated files) 3.purge (remove shake db) 134 | (default: build) 135 | -c,--config FILE Path to nvfetcher TOML config 136 | (default: "nvfetcher.toml") 137 | ``` 138 | 139 | Each _package_ corresponds to a TOML table, whose name is encoded as table key, with 140 | two required fields and three optional fields in each table. 141 | You can find an example of the configuration file, see [`nvfetcher_example.toml`](nvfetcher_example.toml). 142 | 143 | ### Keyfile 144 | 145 | You can specify nvchecker keyfile via command line option. 146 | For the format of this file, please refer to [nvchecker documentation](https://nvchecker.readthedocs.io/en/latest/usage.html#configuration-table). 147 | 148 | #### Nvchecker 149 | 150 | Version source -- how do we track upstream version updates? 151 | 152 | - `src.github = owner/repo` - the latest github release 153 | - `src.github_tag = owner/repo` - the max github tag, usually used with list options (see below) 154 | - `src.pypi = pypi_name` - the latest pypi release 155 | - `src.git = git_url` (and an optional `src.branch = git_branch`) - **the latest commit** of a repo 156 | - `src.archpkg = archlinux_pkg_name` -- the latest version of an archlinux package 157 | - `src.aur = aur_pkg_name` -- the latest version of an aur package 158 | - `src.manual = v` -- a fixed version, which never updates 159 | - `src.repology = project:repo` -- the latest version from repology 160 | - `src.webpage = web_url` and `src.regex` -- a string in webpage that matches with regex 161 | - `src.httpheader = request_url` and `src.regex` -- a string in http header that matches with regex 162 | - `src.openvsx = publisher.ext_name` -- the latest version of a vscode extension from open vsx 163 | - `src.vsmarketplace = publisher.ext_name` -- the latest version of a vscode extension from vscode marketplace 164 | - `src.cmd = cmd` -- the version from a shell command (e.g. `echo Meow`) 165 | - `src.container = owner/name` - the latest tag of a container from the Docker registry 166 | 167 | Optional list options for some version sources (`src.github_tag`, `src.webpage`, and `src.httpheader` and `src.container`), 168 | see the corresponding [nvchecker documentation](https://nvchecker.readthedocs.io/en/latest/usage.html#list-options) for details. 169 | 170 | - `src.include_regex` 171 | - `src.exclude_regex` 172 | - `src.sort_version_key` 173 | - `src.ignored` 174 | 175 | Optional global options for all kinds of version sources, 176 | see the corresponding [nvchecker documentation](https://nvchecker.readthedocs.io/en/latest/usage.html#global-options) for details. You can tweak obtained version number using this option, e.g. stripping the prefix `v` or transforming the result by regex. 177 | 178 | - `src.prefix` 179 | - `src.from_pattern` 180 | - `src.to_pattern` 181 | 182 | #### Nix fetcher 183 | 184 | How do we fetch the package source if we have the target version number? 185 | `$ver` is available in string, which will be set to the result of nvchecker. 186 | 187 | - `fetch.github = owner/repo` 188 | - `fetch.pypi = pypi_name` 189 | - `fetch.git = git_url` 190 | - `fetch.url = url` 191 | - `fetch.openvsx = publisher.ext_name` 192 | - `fetch.vsmarketplace = publisher.ext_name` 193 | - `fetch.tarball = tarball_url` 194 | - `fetch.docker = owner/name` 195 | 196 | Optional config for `nix-prefetch-url`, applies when the fetcher equals to `fetch.url`. 197 | `$ver` is available in string, just like for the fetch config. 198 | 199 | - `url.name = file_name` 200 | 201 | Optional config for `nix-prefetch-git`, applies when the fetcher equals to `fetch.github` or `fetch.git`. 202 | 203 | - `git.deepClone` 204 | - `git.fetchSubmodules` 205 | - `git.leaveDotGit` 206 | 207 | Optional config for `fetch.docker`/`dockerTools.pullImage`: 208 | 209 | - `docker.os` 210 | - `docker.arch` 211 | - `docker.finalImageName` 212 | - `docker.finalImageTag` 213 | - `docker.tlsVerify` 214 | 215 | #### Extract src 216 | 217 | Optional _extract src_ config, files are extracted into build directory, and then read by `readFile` in generated nix expr. 218 | 219 | - `extract = [ "file_1", "file_2", ...]` - file paths are relative to the source root 220 | 221 | #### Rust support 222 | 223 | `rustPlatform.buildRustPackage` now accepts an attribute [`cargoLock`](https://github.com/NixOS/nixpkgs/blob/master/doc/languages-frameworks/rust.section.md#importing-a-cargolock-file) to vendor dependencies from `Cargo.lock`, 224 | so we can use this instead of TOFU `cargoSha256` for Rust packaging. `nvfetcher` supports automating this process, 225 | extracting the lock file to build and calculating `cargoLock.outputHashes`, as long as you set the config. 226 | There can be many lock files in one source. 227 | 228 | - `cargo_locks = [ "cargo_lock_path_1", "cargo_lock_path_2", ...]` - relative to the source root 229 | 230 | #### Passthru 231 | 232 | _passthru_ config, an additional set of attrs to be generated. 233 | 234 | - `passthru = { k1 = "v1", k2 = "v2", ... }` 235 | 236 | Note: currently the values can only be strings 237 | 238 | #### Pinned 239 | 240 | If a package is pinned, we call nvchecker to check the new version iff there's no existing version. 241 | 242 | - `pinned = true` 243 | 244 | #### Git commit date 245 | 246 | If the version source of a package is `git`, nvfetcher can finds out the commit date of this revision, 247 | in the format of `%Y-%m-%d` by default. You can provide your own [`strftime`](https://strftime.org/) format: 248 | 249 | - `git.date_format = "strftime_format"` 250 | 251 | #### Force fetching 252 | 253 | Always fetch the package, even if its version (nvchecker output) doesn't change. 254 | This is useful when the file to be downloaded cannot not be determined by the url. 255 | 256 | - `fetch.force = true` 257 | 258 | > Note: In such case, nvfetcher will not produce a version change log, since the version doesn't change at all. 259 | > Only sha256 in generated files will be updated. 260 | 261 | ### Haskell library 262 | 263 | nvfetcher itself is a Haskell library as well, whereas the CLI program is just a trivial wrapper of the library. 264 | You can create a Haskell program depending on it directly, by using the `runNvFetcher` entry point. 265 | In this case, we can define packages in Haskell language, getting rid of TOML constraints. 266 | 267 | You can find an example of using nvfetcher in the library way, see [`Main_example.hs`](Main_example.hs). 268 | 269 | ## Documentation 270 | 271 | For details of the library, documentation of released versions is available on [Hackage](https://hackage.haskell.org/package/nvfetcher), 272 | and of master is on our [github pages](https://nvfetcher.berberman.space). 273 | 274 | ## Contributing 275 | 276 | Issues and PRs are always welcome. **\_(:з」∠)\_** 277 | 278 | Building from source: 279 | 280 | ``` 281 | $ git clone https://github.com/berberman/nvfetcher 282 | $ nix develop 283 | $ cabal update 284 | $ cabal build 285 | ``` 286 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | {-# LANGUAGE ViewPatterns #-} 6 | 7 | module Config (prettyPackageConfigParseError, parseConfig, PackageConfigValidateError (..)) where 8 | 9 | import Config.PackageFetcher 10 | import Config.VersionSource 11 | import Control.Monad.Trans.Except 12 | import qualified Data.HashMap.Strict as HMap 13 | import Data.List (foldl', intersect) 14 | import qualified Data.Map.Strict as Map 15 | import Data.Text (Text) 16 | import qualified Data.Text as T 17 | import NvFetcher.Types 18 | import TOML 19 | import TOML.Decode 20 | 21 | -- should be NE 22 | newtype MyKey = MyKey {unMyKey :: [Text]} 23 | 24 | myKeyToText :: MyKey -> Text 25 | myKeyToText = T.intercalate "." . unMyKey 26 | 27 | data PackageConfigValidateError 28 | = TomlError TOMLError 29 | | KeyConflicts PackageName [[Text]] 30 | | KeyUnexpected PackageName [Text] 31 | 32 | prettyPackageConfigParseError :: PackageConfigValidateError -> Text 33 | prettyPackageConfigParseError (TomlError e) = "Failed to parse config file: " <> renderTOMLError e 34 | prettyPackageConfigParseError (KeyConflicts pkg xs) = T.unlines ["In [" <> pkg <> "], key conflicts occurred: " <> T.intercalate ", " ks | ks <- xs] 35 | prettyPackageConfigParseError (KeyUnexpected pkg xs) = T.unlines ["In [" <> pkg <> "], unexpected keys found: " <> k | k <- xs] 36 | 37 | parseConfig :: Text -> Either [PackageConfigValidateError] [Package] 38 | parseConfig raw = runExcept $ case decodeWith tableDecoder raw of 39 | Right (Map.toList -> x) -> mapM (uncurry eachP) x 40 | Left err -> throwE [TomlError err] 41 | where 42 | tableDecoder = 43 | makeDecoder $ \case 44 | (Table t) -> pure t 45 | v -> typeMismatch v 46 | eachP pkg v@(Table _) = do 47 | let keys = myKeyToText <$> allKeys [] v 48 | checkConflicts pkg keys 49 | checkUnexpected pkg keys 50 | case unDecodeM (runDecoder (packageConfigDecoder pkg) v) [] of 51 | Left e -> throwE [TomlError $ uncurry DecodeError e] 52 | Right x -> pure x 53 | eachP pkg _ = throwE [KeyUnexpected pkg [pkg]] 54 | allKeys prefix (Table t) = 55 | mconcat 56 | [ case x of 57 | (Table _) -> [] 58 | _ -> [MyKey $ prefix <> [k]] 59 | | (k, x) <- Map.toList t 60 | ] 61 | <> Map.foldrWithKey (\k v acc -> allKeys (prefix <> [k]) v <> acc) [] t 62 | allKeys _ _ = [] 63 | checkConflicts pkg keys = 64 | throwN 65 | [ KeyConflicts pkg [intersection] 66 | | k <- 67 | [ ("src." <>) <$> versionSourceKeys, 68 | ("fetch." <>) <$> fetcherKeys 69 | ], 70 | let intersection = keys `intersect` k, 71 | length intersection > 1 72 | ] 73 | checkUnexpected pkg keys = 74 | throwN $ 75 | -- git 76 | [ KeyUnexpected pkg gk 77 | | let gk = filter (T.isPrefixOf "git.") keys, 78 | not $ null gk, 79 | "fetch.git" `notElem` keys && "fetch.github" `notElem` keys 80 | ] 81 | <> 82 | -- url 83 | [KeyUnexpected pkg uk | let uk = filter ("url.name" ==) keys, not $ null uk, "fetch.url" `notElem` keys] 84 | -- docker 85 | <> [ KeyUnexpected pkg dk 86 | | let dk = filter (T.isPrefixOf "docker.") keys, 87 | not $ null dk, 88 | "fetch.docker" `notElem` keys 89 | ] 90 | -- list options 91 | <> [ KeyUnexpected pkg lk 92 | | let lk = listOptionsKeys `intersect` keys, 93 | not $ null lk, 94 | "src.docker" `notElem` keys 95 | && "src.httpheader" `notElem` keys 96 | && "src.container" `notElem` keys 97 | && "src.github_tag" `notElem` keys 98 | ] 99 | throwN [] = pure () 100 | throwN xs = throwE xs 101 | 102 | -------------------------------------------------------------------------------- 103 | 104 | packageConfigDecoder :: PackageName -> Decoder Package 105 | packageConfigDecoder name = 106 | Package name 107 | <$> (CheckVersion <$> versionSourceDecoder <*> nvcheckerOptionsDecoder) 108 | <*> fetcherDecoder 109 | <*> extractFilesDecoder 110 | <*> cargoLockPathDecoder 111 | <*> passthruDecoder 112 | <*> pinnedDecoder 113 | <*> gitDateFormatDecoder 114 | <*> forceFetchDecoder 115 | 116 | -------------------------------------------------------------------------------- 117 | 118 | extractFilesDecoder :: Decoder (Maybe PackageExtractSrc) 119 | extractFilesDecoder = fmap PackageExtractSrc <$> getFieldOpt "extract" 120 | 121 | cargoLockPathDecoder :: Decoder (Maybe PackageCargoLockFiles) 122 | cargoLockPathDecoder = fmap PackageCargoLockFiles <$> getFieldOpt "cargo_locks" 123 | 124 | nvcheckerOptionsDecoder :: Decoder NvcheckerOptions 125 | nvcheckerOptionsDecoder = 126 | NvcheckerOptions 127 | <$> getFieldsOpt ["src", "prefix"] 128 | <*> getFieldsOpt ["src", "from_pattern"] 129 | <*> getFieldsOpt ["src", "to_pattern"] 130 | 131 | passthruDecoder :: Decoder PackagePassthru 132 | passthruDecoder = 133 | getFieldOpt @Value "passthru" >>= \case 134 | Just (Table t) -> go [] t >>= \(mconcat -> fs) -> pure $ PackagePassthru $ foldl' (flip ($)) HMap.empty fs 135 | Just _ -> makeDecoder typeMismatch 136 | Nothing -> pure $ PackagePassthru HMap.empty 137 | where 138 | go prefix x = 139 | sequenceA 140 | [ case v of 141 | (String text) -> pure [HMap.insert (myKeyToText $ MyKey $ prefix <> [k]) text] 142 | Table t -> mconcat <$> go (prefix <> [k]) t 143 | _ -> makeDecoder (\_ -> invalidValue "passthru value must be string for now" v) 144 | | (k, v) <- Map.toList x 145 | ] 146 | 147 | pinnedDecoder :: Decoder UseStaleVersion 148 | pinnedDecoder = 149 | maybe NoStale (\x -> if x then PermanentStale else NoStale) 150 | <$> getFieldOpt "pinned" 151 | 152 | gitDateFormatDecoder :: Decoder DateFormat 153 | gitDateFormatDecoder = DateFormat <$> getFieldsOpt ["git", "date_format"] 154 | 155 | forceFetchDecoder :: Decoder ForceFetch 156 | forceFetchDecoder = 157 | maybe NoForceFetch (\x -> if x then ForceFetch else NoForceFetch) 158 | <$> getFieldsOpt ["fetch", "force"] 159 | -------------------------------------------------------------------------------- /app/Config/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Config.Common where 5 | 6 | import Data.Text (Text) 7 | import qualified Data.Text as T 8 | import TOML 9 | 10 | gitHubNameDecoder :: Decoder (Text, Text) 11 | gitHubNameDecoder = makeDecoder $ \case 12 | v@(String s) -> case T.split (== '/') s of 13 | [owner, repo] -> pure (owner, repo) 14 | _ -> invalidValue "unexpected github format: it should be in the format of [owner]/[repo]" v 15 | v -> typeMismatch v 16 | 17 | vscodeExtensionNameDecoder :: Decoder (Text, Text) 18 | vscodeExtensionNameDecoder = makeDecoder $ \case 19 | -- assume that we can't have '.' in extension's name 20 | v@(String s) -> case T.split (== '.') s of 21 | [publisher, extName] -> pure (publisher, extName) 22 | _ -> invalidValue "unexpected vscode extension format: it should be in the format of [publisher].[extName]" v 23 | v -> typeMismatch v 24 | -------------------------------------------------------------------------------- /app/Config/PackageFetcher.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE ViewPatterns #-} 7 | 8 | module Config.PackageFetcher (fetcherDecoder, fetcherKeys) where 9 | 10 | import Config.Common 11 | import Data.Coerce (coerce) 12 | import Data.Foldable (asum) 13 | import Data.Maybe (fromMaybe) 14 | import Data.Text (Text) 15 | import qualified Data.Text as T 16 | import GHC.Generics (Generic) 17 | import Lens.Micro 18 | import NvFetcher.NixFetcher 19 | import NvFetcher.Types 20 | import NvFetcher.Types.Lens 21 | import TOML 22 | 23 | fetcherDecoder :: Decoder PackageFetcher 24 | fetcherDecoder = 25 | asum 26 | [ gitHubDecoder, 27 | pypiDecoder, 28 | openVsxDecoder, 29 | vscodeMarketplaceDecoder, 30 | gitDecoder, 31 | urlDecoder, 32 | tarballDecoder, 33 | dockerDecoder 34 | ] 35 | 36 | fetcherKeys :: [Text] 37 | fetcherKeys = 38 | [ "github", 39 | "pypi", 40 | "openvsx", 41 | "vsmarketplace", 42 | "git", 43 | "url", 44 | "tarball", 45 | "docker" 46 | ] 47 | 48 | -------------------------------------------------------------------------------- 49 | 50 | data GitOptions = GitOptions 51 | { goDeepClone :: Maybe Bool, 52 | goFetchSubmodules :: Maybe Bool, 53 | goLeaveDotGit :: Maybe Bool, 54 | goSparseCheckout :: Maybe [Text] 55 | } 56 | deriving (Eq, Generic) 57 | 58 | gitOptionsDecoder :: Decoder GitOptions 59 | gitOptionsDecoder = 60 | GitOptions 61 | <$> getFieldsOpt ["git", "deepClone"] 62 | <*> getFieldsOpt ["git", "fetchSubmodules"] 63 | <*> getFieldsOpt ["git", "leaveDotGit"] 64 | <*> getFieldsOpt ["git", "sparseCheckout"] 65 | 66 | _GitOptions :: Traversal' (NixFetcher f) GitOptions 67 | _GitOptions f x@FetchGit {..} = 68 | ( \GitOptions {..} -> 69 | x 70 | & deepClone .~ fromMaybe False goDeepClone 71 | & fetchSubmodules .~ fromMaybe False goFetchSubmodules 72 | & leaveDotGit .~ fromMaybe False goLeaveDotGit 73 | & sparseCheckout .~ fromMaybe [] goSparseCheckout 74 | ) 75 | <$> f (GitOptions (Just _deepClone) (Just _fetchSubmodules) (Just _leaveDotGit) (Just _sparseCheckout)) 76 | _GitOptions f x@FetchGitHub {..} = 77 | ( \GitOptions {..} -> 78 | x 79 | & deepClone .~ fromMaybe False goDeepClone 80 | & fetchSubmodules .~ fromMaybe False goFetchSubmodules 81 | & leaveDotGit .~ fromMaybe False goLeaveDotGit 82 | & sparseCheckout .~ fromMaybe [] goSparseCheckout 83 | ) 84 | <$> f (GitOptions (Just _deepClone) (Just _fetchSubmodules) (Just _leaveDotGit) (Just _sparseCheckout)) 85 | _GitOptions _ x = pure x 86 | 87 | -------------------------------------------------------------------------------- 88 | 89 | gitHubDecoder :: Decoder PackageFetcher 90 | gitHubDecoder = do 91 | (owner, repo) <- getFieldsWith gitHubNameDecoder ["fetch", "github"] 92 | gitOptions <- gitOptionsDecoder 93 | pure $ \v -> gitHubFetcher (owner, repo) v & _GitOptions .~ gitOptions 94 | 95 | -------------------------------------------------------------------------------- 96 | 97 | gitDecoder :: Decoder PackageFetcher 98 | gitDecoder = do 99 | url <- getFields ["fetch", "git"] 100 | gitOptions <- gitOptionsDecoder 101 | pure $ \v -> gitFetcher url v & _GitOptions .~ gitOptions 102 | 103 | -------------------------------------------------------------------------------- 104 | 105 | pypiDecoder :: Decoder PackageFetcher 106 | pypiDecoder = pypiFetcher <$> getFields ["fetch", "pypi"] 107 | 108 | -------------------------------------------------------------------------------- 109 | 110 | openVsxDecoder :: Decoder PackageFetcher 111 | openVsxDecoder = openVsxFetcher <$> getFieldsWith vscodeExtensionNameDecoder ["fetch", "openvsx"] 112 | 113 | -------------------------------------------------------------------------------- 114 | 115 | vscodeMarketplaceDecoder :: Decoder PackageFetcher 116 | vscodeMarketplaceDecoder = vscodeMarketplaceFetcher <$> getFieldsWith vscodeExtensionNameDecoder ["fetch", "vsmarketplace"] 117 | 118 | -------------------------------------------------------------------------------- 119 | 120 | urlDecoder :: Decoder PackageFetcher 121 | urlDecoder = do 122 | url <- getFields ["fetch", "url"] 123 | name <- getFieldsOpt ["url", "name"] 124 | pure $ \(coerce -> v) -> urlFetcher' (T.replace "$ver" v url) (fmap (T.replace "$ver" v) name) 125 | 126 | -------------------------------------------------------------------------------- 127 | 128 | tarballDecoder :: Decoder PackageFetcher 129 | tarballDecoder = do 130 | url <- getFields ["fetch", "tarball"] 131 | pure $ \(coerce -> v) -> tarballFetcher $ T.replace "$ver" v url 132 | 133 | -------------------------------------------------------------------------------- 134 | 135 | dockerDecoder :: Decoder PackageFetcher 136 | dockerDecoder = 137 | (\f (coerce -> v) -> f & imageTag .~ v) 138 | <$> ( FetchDocker 139 | <$> getFields ["fetch", "docker"] 140 | <*> pure "" -- set in fmap 141 | <*> pure () 142 | <*> pure () 143 | <*> getFieldsOpt ["docker", "os"] 144 | <*> getFieldsOpt ["docker", "arch"] 145 | <*> getFieldsOpt ["docker", "finalImageName"] 146 | <*> getFieldsOpt ["docker", "finalImageTag"] 147 | <*> getFieldsOpt ["docker", "tlsVerify"] 148 | ) 149 | -------------------------------------------------------------------------------- /app/Config/VersionSource.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | 6 | module Config.VersionSource (versionSourceDecoder, versionSourceKeys, listOptionsKeys) where 7 | 8 | import Config.Common 9 | import Data.Coerce (coerce) 10 | import Data.Foldable (asum) 11 | import Data.Text (Text) 12 | import qualified Data.Text as T 13 | import NvFetcher.Types 14 | import TOML 15 | 16 | versionSourceDecoder :: Decoder VersionSource 17 | versionSourceDecoder = 18 | -- everything is in src table 19 | flip getFieldWith "src" $ 20 | asum 21 | [ gitHubReleaseDecoder, 22 | gitHubTagDecoder, 23 | gitDecoder, 24 | pypiDecoder, 25 | archLinuxDecoder, 26 | aurDecoder, 27 | manualDecoder, 28 | repologyDecoder, 29 | webpageDecoder, 30 | httpHeaderDecoder, 31 | openVsxDecoder, 32 | vscodeMarketplaceDecoder, 33 | cmdDecoder, 34 | containerDecoder 35 | ] 36 | 37 | versionSourceKeys :: [Text] 38 | versionSourceKeys = 39 | [ "github", 40 | "github_tag", 41 | "git", 42 | "pypi", 43 | "archpkg", 44 | "aur", 45 | "manual", 46 | "webpage", 47 | "httpheader", 48 | "openvsx", 49 | "vsmarketplace", 50 | "cmd", 51 | "container" 52 | ] 53 | 54 | listOptionsKeys :: [Text] 55 | listOptionsKeys = 56 | [ "include_regex", 57 | "exclude_regex", 58 | "sort_version_key", 59 | "ignored" 60 | ] 61 | 62 | -------------------------------------------------------------------------------- 63 | 64 | listOptionsDecoder :: Decoder ListOptions 65 | listOptionsDecoder = 66 | ListOptions 67 | <$> getFieldOpt "include_regex" 68 | <*> getFieldOpt "exclude_regex" 69 | <*> ( getFieldOpt @Text "sort_version_key" >>= \case 70 | Just "parse_version" -> pure $ Just ParseVersion 71 | Just "vercmp" -> pure $ Just Vercmp 72 | Just _ -> makeDecoder $ invalidValue "unexpected sort_version_key: it should be either parse_version or vercmp" 73 | Nothing -> pure Nothing 74 | ) 75 | <*> getFieldOpt "ignored" 76 | 77 | -------------------------------------------------------------------------------- 78 | 79 | gitHubReleaseDecoder :: Decoder VersionSource 80 | gitHubReleaseDecoder = uncurry GitHubRelease <$> getFieldWith gitHubNameDecoder "github" 81 | 82 | -------------------------------------------------------------------------------- 83 | 84 | gitHubTagDecoder :: Decoder VersionSource 85 | gitHubTagDecoder = do 86 | (_owner, _repo) <- getFieldWith gitHubNameDecoder "github_tag" 87 | _listOptions <- listOptionsDecoder 88 | pure GitHubTag {..} 89 | 90 | -------------------------------------------------------------------------------- 91 | 92 | gitDecoder :: Decoder VersionSource 93 | gitDecoder = Git <$> getField "git" <*> (coerce @(Maybe Text) <$> getFieldOpt "branch") 94 | 95 | -------------------------------------------------------------------------------- 96 | 97 | pypiDecoder :: Decoder VersionSource 98 | pypiDecoder = Pypi <$> getField "pypi" 99 | 100 | -------------------------------------------------------------------------------- 101 | 102 | archLinuxDecoder :: Decoder VersionSource 103 | archLinuxDecoder = ArchLinux <$> getField "archpkg" 104 | 105 | -------------------------------------------------------------------------------- 106 | 107 | aurDecoder :: Decoder VersionSource 108 | aurDecoder = Aur <$> getField "aur" 109 | 110 | -------------------------------------------------------------------------------- 111 | 112 | manualDecoder :: Decoder VersionSource 113 | manualDecoder = Manual <$> getField "manual" 114 | 115 | -------------------------------------------------------------------------------- 116 | 117 | repologyDecoder :: Decoder VersionSource 118 | repologyDecoder = makeDecoder $ \case 119 | v@(String s) -> case T.split (== ':') s of 120 | [_repology, _repo] -> pure Repology {..} 121 | _ -> invalidValue "unexpected repology format: it should be in the format of [repology]:[repo]" v 122 | v -> typeMismatch v 123 | 124 | ------------------------------------------------------------ 125 | 126 | webpageDecoder :: Decoder VersionSource 127 | webpageDecoder = do 128 | _vurl <- getField "webpage" 129 | _regex <- getField "regex" 130 | _listOptions <- listOptionsDecoder 131 | pure Webpage {..} 132 | 133 | -------------------------------------------------------------------------------- 134 | 135 | httpHeaderDecoder :: Decoder VersionSource 136 | httpHeaderDecoder = do 137 | _vurl <- getField "httpheader" 138 | _regex <- getField "regex" 139 | _listOptions <- listOptionsDecoder 140 | pure HttpHeader {..} 141 | 142 | -------------------------------------------------------------------------------- 143 | 144 | openVsxDecoder :: Decoder VersionSource 145 | openVsxDecoder = uncurry OpenVsx <$> getFieldWith vscodeExtensionNameDecoder "openvsx" 146 | 147 | -------------------------------------------------------------------------------- 148 | 149 | vscodeMarketplaceDecoder :: Decoder VersionSource 150 | vscodeMarketplaceDecoder = uncurry VscodeMarketplace <$> getFieldWith vscodeExtensionNameDecoder "vsmarketplace" 151 | 152 | -------------------------------------------------------------------------------- 153 | 154 | cmdDecoder :: Decoder VersionSource 155 | cmdDecoder = Cmd <$> getField "cmd" 156 | 157 | -------------------------------------------------------------------------------- 158 | 159 | containerDecoder :: Decoder VersionSource 160 | containerDecoder = Container <$> getField "container" <*> listOptionsDecoder 161 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Config 6 | import Data.Default (def) 7 | import qualified Data.Text as T 8 | import qualified Data.Text.IO as T 9 | import NvFetcher 10 | import NvFetcher.Options 11 | import Options.Applicative.Simple 12 | 13 | getCLIOptionsWithConfig :: IO (CLIOptions, FilePath) 14 | getCLIOptionsWithConfig = 15 | getCLIOptions $ 16 | (,) 17 | <$> cliOptionsParser 18 | <*> strOption 19 | ( long "config" 20 | <> short 'c' 21 | <> metavar "FILE" 22 | <> help "Path to nvfetcher TOML config" 23 | <> value "nvfetcher.toml" 24 | <> showDefault 25 | <> completer (bashCompleter "file") 26 | ) 27 | 28 | main :: IO () 29 | main = do 30 | (opt, configPath) <- getCLIOptionsWithConfig 31 | raw <- T.readFile configPath 32 | case parseConfig raw of 33 | Left e -> error $ T.unpack $ T.unlines $ prettyPackageConfigParseError <$> e 34 | Right pkgs -> applyCliOptions def opt >>= \o -> runNvFetcherNoCLI o (optTarget opt) $ purePackageSet pkgs 35 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | 3 | package nvfetcher 4 | documentation: True 5 | haddock-html: True 6 | haddock-hoogle: True 7 | haddock-internal: True 8 | test-show-details: direct 9 | 10 | tests: true 11 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | (import 2 | ( 3 | let 4 | lock = builtins.fromJSON (builtins.readFile ./flake.lock); 5 | in 6 | fetchTarball { 7 | url = "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz"; 8 | sha256 = lock.nodes.flake-compat.locked.narHash; 9 | } 10 | ) 11 | { 12 | src = ./.; 13 | }).defaultNix 14 | -------------------------------------------------------------------------------- /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 | "owner": "numtide", 33 | "repo": "flake-utils", 34 | "type": "github" 35 | } 36 | }, 37 | "nixpkgs": { 38 | "locked": { 39 | "lastModified": 1732014248, 40 | "narHash": "sha256-y/MEyuJ5oBWrWAic/14LaIr/u5E0wRVzyYsouYY3W6w=", 41 | "owner": "NixOS", 42 | "repo": "nixpkgs", 43 | "rev": "23e89b7da85c3640bbc2173fe04f4bd114342367", 44 | "type": "github" 45 | }, 46 | "original": { 47 | "owner": "NixOS", 48 | "ref": "nixos-unstable", 49 | "repo": "nixpkgs", 50 | "type": "github" 51 | } 52 | }, 53 | "root": { 54 | "inputs": { 55 | "flake-compat": "flake-compat", 56 | "flake-utils": "flake-utils", 57 | "nixpkgs": "nixpkgs" 58 | } 59 | }, 60 | "systems": { 61 | "locked": { 62 | "lastModified": 1681028828, 63 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 64 | "owner": "nix-systems", 65 | "repo": "default", 66 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 67 | "type": "github" 68 | }, 69 | "original": { 70 | "owner": "nix-systems", 71 | "repo": "default", 72 | "type": "github" 73 | } 74 | } 75 | }, 76 | "root": "root", 77 | "version": 7 78 | } 79 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; 3 | inputs.flake-utils.url = "github:numtide/flake-utils"; 4 | inputs.flake-compat = { 5 | url = "github:edolstra/flake-compat"; 6 | flake = false; 7 | }; 8 | outputs = { self, nixpkgs, flake-utils, flake-compat, ... }: 9 | with flake-utils.lib; 10 | eachDefaultSystem (system: 11 | let 12 | pkgs = import nixpkgs { 13 | inherit system; 14 | overlays = [ self.overlays.default ]; 15 | config = { allowBroken = true; }; 16 | }; 17 | in with pkgs; rec { 18 | packages.default = nvfetcher-bin; 19 | devShells.default = with haskell.lib; 20 | (addBuildTools (haskellPackages.nvfetcher) [ 21 | haskell-language-server 22 | cabal-install 23 | nvchecker 24 | nix-prefetch-git 25 | nix-prefetch-docker 26 | cabal2nix # cd nix && cabal2nix ../. > default.nix && .. 27 | ]).envFunc { }; 28 | packages.nvfetcher-lib = with haskell.lib; 29 | overrideCabal (haskellPackages.nvfetcher) (drv: { 30 | haddockFlags = [ 31 | "--html-location='https://hackage.haskell.org/package/$pkg-$version/docs'" 32 | ]; 33 | }); 34 | packages.ghcWithNvfetcher = mkShell { 35 | buildInputs = [ 36 | nix-prefetch-git 37 | nix-prefetch-docker 38 | nvchecker 39 | (haskellPackages.ghcWithPackages (p: [ p.nvfetcher ])) 40 | ]; 41 | }; 42 | hydraJobs = { inherit packages; }; 43 | }) // { 44 | overlays.default = final: prev: { 45 | haskellPackages = prev.haskellPackages.override (old: { 46 | overrides = 47 | final.lib.composeExtensions (old.overrides or (_: _: { })) 48 | (hself: hsuper: { 49 | nvfetcher = with final.haskell.lib; 50 | hself.generateOptparseApplicativeCompletions [ "nvfetcher" ] 51 | (overrideCabal (prev.haskellPackages.callPackage ./nix { }) 52 | (drv: { 53 | # test needs network 54 | # don't use `doCheck = false` here, because we still want to have test dependencies in dev shell 55 | checkPhase = ""; 56 | buildTools = drv.buildTools or [ ] 57 | ++ [ final.makeWrapper ]; 58 | postInstall = with final; 59 | drv.postInstall or "" + '' 60 | wrapProgram $out/bin/nvfetcher \ 61 | --prefix PATH ":" "${ 62 | lib.makeBinPath [ 63 | nvchecker 64 | nix-prefetch-git 65 | nix-prefetch-docker 66 | ] 67 | }" 68 | ''; 69 | })); 70 | }); 71 | }); 72 | nvfetcher-bin = with final; 73 | let 74 | hl = haskell.lib; 75 | nvfetcherStatic = hl.justStaticExecutables haskellPackages.nvfetcher; 76 | scope = nvfetcherStatic.scope; 77 | in 78 | hl.overrideCabal nvfetcherStatic (drv: { 79 | postInstall = '' 80 | ${drv.postInstall or ""} 81 | remove-references-to -t ${scope.shake} "$out/bin/.nvfetcher-wrapped" 82 | remove-references-to -t ${scope.js-jquery} "$out/bin/.nvfetcher-wrapped" 83 | remove-references-to -t ${scope.js-flot} "$out/bin/.nvfetcher-wrapped" 84 | remove-references-to -t ${scope.js-dgtable} "$out/bin/.nvfetcher-wrapped" 85 | ''; 86 | }); 87 | }; 88 | }; 89 | } 90 | -------------------------------------------------------------------------------- /nix/default.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, aeson, aeson-pretty, async, base, binary 2 | , binary-instances, bytestring, containers, data-default, extra 3 | , free, hspec, hspec-discover, lib, microlens, microlens-th 4 | , neat-interpolation, optparse-simple, parsec, prettyprinter 5 | , regex-tdfa, shake, stm, text, toml-reader, transformers, unliftio 6 | , unordered-containers 7 | }: 8 | mkDerivation { 9 | pname = "nvfetcher"; 10 | version = "0.6.2.0"; 11 | src = ../.; 12 | isLibrary = true; 13 | isExecutable = true; 14 | libraryHaskellDepends = [ 15 | aeson aeson-pretty base binary binary-instances bytestring 16 | containers data-default extra free microlens microlens-th 17 | neat-interpolation optparse-simple parsec prettyprinter regex-tdfa 18 | shake text toml-reader transformers unordered-containers 19 | ]; 20 | executableHaskellDepends = [ 21 | aeson aeson-pretty base binary binary-instances bytestring 22 | containers data-default extra free microlens microlens-th 23 | neat-interpolation optparse-simple parsec prettyprinter regex-tdfa 24 | shake text toml-reader transformers unordered-containers 25 | ]; 26 | testHaskellDepends = [ 27 | aeson aeson-pretty async base binary binary-instances bytestring 28 | containers data-default extra free hspec microlens microlens-th 29 | neat-interpolation optparse-simple parsec prettyprinter regex-tdfa 30 | shake stm text toml-reader transformers unliftio 31 | unordered-containers 32 | ]; 33 | testToolDepends = [ hspec-discover ]; 34 | homepage = "https://github.com/berberman/nvfetcher"; 35 | description = "Generate nix sources expr for the latest version of packages"; 36 | license = lib.licenses.mit; 37 | mainProgram = "nvfetcher"; 38 | } 39 | -------------------------------------------------------------------------------- /nvfetcher.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: nvfetcher 3 | version: 0.7.0.0 4 | synopsis: 5 | Generate nix sources expr for the latest version of packages 6 | 7 | description: 8 | Please see [README](https://github.com/berberman/nvfetcher/blob/master/README.md) 9 | 10 | homepage: https://github.com/berberman/nvfetcher 11 | bug-reports: https://github.com/berberman/nvfetcher/issues 12 | license: MIT 13 | license-file: LICENSE 14 | author: berberman 15 | maintainer: berberman 16 | copyright: 2021-2023 berberman 17 | category: Nix 18 | build-type: Simple 19 | extra-doc-files: 20 | CHANGELOG.md 21 | README.md 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/berberman/nvfetcher.git 26 | 27 | common common-options 28 | build-depends: 29 | , aeson >=1.5.6 && <2.3 30 | , aeson-pretty 31 | , base >=4.8 && <5 32 | , binary 33 | , binary-instances ^>=1.0 34 | , bytestring 35 | , containers 36 | , data-default ^>=0.7.1 37 | , extra ^>=1.7 38 | , free >=5.1 && <5.3 39 | , microlens 40 | , microlens-th 41 | , neat-interpolation ^>=0.5.1 42 | , optparse-simple ^>=0.1.1 43 | , parsec 44 | , prettyprinter 45 | , regex-tdfa ^>=1.3.1 46 | , shake ^>=0.19 47 | , text 48 | , toml-reader ^>=0.2 49 | , transformers 50 | , unordered-containers 51 | 52 | ghc-options: 53 | -Wall -Wcompat -Widentities -Wincomplete-uni-patterns 54 | -Wincomplete-record-updates -Wredundant-constraints 55 | -fhide-source-paths -Wno-name-shadowing 56 | -Wno-unticked-promoted-constructors 57 | 58 | default-language: Haskell2010 59 | 60 | library 61 | import: common-options 62 | hs-source-dirs: src 63 | other-modules: NvFetcher.Utils 64 | exposed-modules: 65 | NvFetcher 66 | NvFetcher.Config 67 | NvFetcher.Core 68 | NvFetcher.ExtractSrc 69 | NvFetcher.FetchRustGitDeps 70 | NvFetcher.GetGitCommitDate 71 | NvFetcher.NixExpr 72 | NvFetcher.NixFetcher 73 | NvFetcher.Nvchecker 74 | NvFetcher.Options 75 | NvFetcher.PackageSet 76 | NvFetcher.Types 77 | NvFetcher.Types.Lens 78 | NvFetcher.Types.ShakeExtras 79 | 80 | other-modules: Paths_nvfetcher 81 | autogen-modules: Paths_nvfetcher 82 | 83 | executable nvfetcher 84 | import: common-options 85 | hs-source-dirs: app 86 | main-is: Main.hs 87 | other-modules: 88 | Config 89 | Config.Common 90 | Config.PackageFetcher 91 | Config.VersionSource 92 | 93 | build-depends: nvfetcher 94 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 95 | 96 | flag build-example 97 | description: Build example executable 98 | manual: True 99 | default: False 100 | 101 | executable example 102 | import: common-options 103 | 104 | if !flag(build-example) 105 | buildable: False 106 | 107 | main-is: Main_example.hs 108 | build-depends: nvfetcher 109 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 110 | 111 | test-suite tests 112 | import: common-options 113 | type: exitcode-stdio-1.0 114 | main-is: Spec.hs 115 | other-modules: 116 | CheckVersionSpec 117 | FetchRustGitDepsSpec 118 | GetGitCommitDateSpec 119 | NixExprSpec 120 | PrefetchSpec 121 | Utils 122 | 123 | hs-source-dirs: test 124 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 125 | build-depends: 126 | , async 127 | , hspec 128 | , nvfetcher 129 | , stm 130 | , unliftio 131 | 132 | build-tool-depends: hspec-discover:hspec-discover 133 | default-language: Haskell2010 134 | -------------------------------------------------------------------------------- /nvfetcher_example.toml: -------------------------------------------------------------------------------- 1 | [feeluown-core] 2 | src.pypi = "feeluown" 3 | fetch.pypi = "feeluown" 4 | 5 | [apple-emoji] 6 | # A fake version, which is unused in the fetcher 7 | src.manual = "0.0.0.20200413" 8 | fetch.url = "https://github.com/samuelngs/apple-emoji-linux/releases/download/alpha-release-v1.0.0/AppleColorEmoji.ttf" 9 | 10 | [nvfetcher-git] 11 | # Follow the latest git commit 12 | src.git = "https://github.com/berberman/nvfetcher" 13 | fetch.github = "berberman/nvfetcher" 14 | 15 | [gcc-10] 16 | # Find a tag by regex 17 | src.github_tag = "gcc-mirror/gcc" 18 | # nvchecker list options, which uses regex to filter out a list of tags 19 | src.include_regex = "releases/gcc-10.*" 20 | fetch.github = "gcc-mirror/gcc" 21 | 22 | # [vim] 23 | # src.webpage = "http://ftp.vim.org/pub/vim/patches/7.3/" 24 | # src.regex = "7\\.3\\.\\d+" 25 | # fetch.github = "vim/vim" 26 | # # nvchecker global options, which adds prefix `v` to the version number 27 | # src.from_pattern = "(.+)" 28 | # src.to_pattern = "v\\1" 29 | 30 | [fd] 31 | src.github = "sharkdp/fd" 32 | fetch.github = "sharkdp/fd" 33 | # Pull the contents of `Cargo.lock` into generated nix expr 34 | extract = ["Cargo.lock"] 35 | 36 | [rust-git-dependency-example] 37 | src.manual = "8a5f37a8f80a3b05290707febf57e88661cee442" 38 | fetch.git = "https://gist.github.com/NickCao/6c4dbc4e15db5da107de6cdb89578375" 39 | # Calculate outputHashes for git dependencies in cargo lock 40 | cargo_locks = ["Cargo.lock"] 41 | 42 | [vscode-LiveServer] 43 | src.openvsx = "ritwickdey.LiveServer" 44 | fetch.openvsx = "ritwickdey.LiveServer" 45 | passthru = { a.b = "example", publisher = "ritwickdey", name = "LiveServer" } 46 | 47 | [cmd-example] 48 | src.cmd = "echo v2.5" 49 | fetch.github = "lilydjwg/nvchecker" 50 | 51 | [nixpkgs] 52 | src.git = "https://github.com/NixOS/nixpkgs" 53 | fetch.tarball = "https://github.com/nixos/nixpkgs/archive/$ver.tar.gz" 54 | 55 | [alpine] 56 | src.container = "library/alpine" 57 | src.include_regex = "3\\..*" 58 | fetch.docker = "library/alpine" 59 | 60 | # To demonstrate package key containing `.` 61 | ["submodule.example"] 62 | src.git = "https://github.com/githubtraining/example-dependency" 63 | fetch.git = "https://github.com/githubtraining/example-dependency" 64 | git.fetchSubmodules = true 65 | 66 | [wallpaper] 67 | fetch.url = "https://files.yande.re/image/3fc51f6a2fb10c96b73dd0fce6ddb9c8/yande.re%201048717%20dress%20garter%20lolita_fashion%20ruo_gan_zhua.jpg" 68 | src.manual = "latest" 69 | # Override the name of the file in the Nix store 70 | url.name = "wallpaper.jpg" 71 | 72 | # To demonstrate how to use `sparseCheckout` option 73 | [noto-fonts-cjk-sans-fix-weight] 74 | src.manual = "Sans2.004" 75 | fetch.github = "notofonts/noto-cjk" 76 | git.sparseCheckout = [ "Sans/OTC" ] 77 | -------------------------------------------------------------------------------- /src/NvFetcher.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE QuasiQuotes #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE TupleSections #-} 6 | {-# LANGUAGE TypeApplications #-} 7 | {-# LANGUAGE ViewPatterns #-} 8 | 9 | -- | Copyright: (c) 2021-2022 berberman 10 | -- SPDX-License-Identifier: MIT 11 | -- Maintainer: berberman 12 | -- Stability: experimental 13 | -- Portability: portable 14 | -- 15 | -- The main module of nvfetcher. If you want to create CLI program with it, it's enough to import only this module. 16 | -- 17 | -- Example: 18 | -- 19 | -- @ 20 | -- module Main where 21 | -- 22 | -- import NvFetcher 23 | -- 24 | -- main :: IO () 25 | -- main = runNvFetcher packageSet 26 | -- 27 | -- packageSet :: PackageSet () 28 | -- packageSet = do 29 | -- define $ package "feeluown-core" `fromPypi` "feeluown" 30 | -- define $ package "qliveplayer" `fromGitHub` ("THMonster", "QLivePlayer") 31 | -- @ 32 | -- 33 | -- You can find more examples of packages in @Main_example.hs@. 34 | -- 35 | -- Running the created program: 36 | -- 37 | -- * @main@ -- abbreviation of @main build@ 38 | -- * @main build@ -- build nix sources expr from given @packageSet@ 39 | -- * @main clean@ -- delete .shake dir and generated nix file 40 | -- 41 | -- All shake options are inherited. 42 | module NvFetcher 43 | ( runNvFetcher, 44 | runNvFetcher', 45 | runNvFetcherNoCLI, 46 | applyCliOptions, 47 | parseLastVersions, 48 | module NvFetcher.PackageSet, 49 | module NvFetcher.Types, 50 | module NvFetcher.Types.ShakeExtras, 51 | ) 52 | where 53 | 54 | import Control.Monad.Extra (forM_, unless, when, whenJust, whenM) 55 | import qualified Data.Aeson as A 56 | import qualified Data.Aeson.Encode.Pretty as A 57 | import qualified Data.Aeson.Types as A 58 | import qualified Data.ByteString.Lazy.Char8 as LBS 59 | import Data.Default 60 | import Data.List (partition, (\\)) 61 | import qualified Data.Map.Strict as Map 62 | import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust) 63 | import Data.Text (Text) 64 | import qualified Data.Text as T 65 | import Development.Shake 66 | import Development.Shake.FilePath 67 | import NeatInterpolation (trimming) 68 | import NvFetcher.Config 69 | import NvFetcher.Core 70 | import NvFetcher.NixExpr (ToNixExpr (toNixExpr)) 71 | import NvFetcher.NixFetcher 72 | import NvFetcher.Nvchecker 73 | import NvFetcher.Options 74 | import NvFetcher.PackageSet 75 | import NvFetcher.Types 76 | import NvFetcher.Types.ShakeExtras 77 | import NvFetcher.Utils (aesonKey, getDataDir) 78 | import qualified System.Directory.Extra as D 79 | import Text.Regex.TDFA ((=~)) 80 | 81 | -- | Run nvfetcher with CLI options 82 | -- 83 | -- This function calls 'runNvFetcherNoCLI', using 'def' 'Config' overridden by 'CLIOptions'. 84 | -- Use this function to create your own Haskell executable program. 85 | runNvFetcher :: PackageSet () -> IO () 86 | runNvFetcher = runNvFetcher' def 87 | 88 | -- | Similar to 'runNvFetcher', but uses custom @config@ instead of 'def' overridden by 'CLIOptions' 89 | runNvFetcher' :: Config -> PackageSet () -> IO () 90 | runNvFetcher' config packageSet = 91 | getCLIOptions cliOptionsParser >>= \cli -> 92 | applyCliOptions config cli >>= \o -> 93 | runNvFetcherNoCLI o (optTarget cli) packageSet 94 | 95 | -- | Apply 'CLIOptions' to 'Config' 96 | applyCliOptions :: Config -> CLIOptions -> IO Config 97 | applyCliOptions config CLIOptions {..} = do 98 | aKeyfile <- case optKeyfile of 99 | Just k -> Just <$> D.makeAbsolute k 100 | _ -> pure Nothing 101 | pure $ 102 | config 103 | { buildDir = optBuildDir, 104 | actionAfterBuild = do 105 | whenJust optLogPath logChangesToFile 106 | when optCommit (commitChanges (fromMaybe "Update" optCommitSummary)) 107 | actionAfterBuild config, 108 | shakeConfig = 109 | (shakeConfig config) 110 | { shakeTimings = optTiming, 111 | shakeVerbosity = if optVerbose then Verbose else Info, 112 | shakeThreads = optThreads 113 | }, 114 | filterRegex = optPkgNameFilter, 115 | retry = optRetry, 116 | keyfile = aKeyfile, 117 | keepOldFiles = optKeepOldFiles, 118 | keepGoing = optKeepGoing 119 | } 120 | 121 | logChangesToFile :: FilePath -> Action () 122 | logChangesToFile fp = do 123 | changes <- getVersionChanges 124 | writeFile' fp $ unlines $ show <$> changes 125 | 126 | commitChanges :: String -> Action () 127 | commitChanges commitSummary = do 128 | changes <- getVersionChanges 129 | let commitMsg = case changes of 130 | [x] -> Just $ show x 131 | xs@(_ : _) -> Just $ commitSummary <> "\n" <> unlines (show <$> xs) 132 | [] -> Nothing 133 | whenJust commitMsg $ \msg -> do 134 | putInfo "Commiting changes" 135 | getBuildDir >>= \dir -> command_ [] "git" ["add", dir] 136 | command_ [] "git" ["commit", "-m", msg] 137 | 138 | -- | @Parse generated.nix@ 139 | parseLastVersions :: FilePath -> IO (Maybe (Map.Map PackageKey Version)) 140 | parseLastVersions jsonFile = 141 | D.doesFileExist jsonFile >>= \case 142 | True -> do 143 | objs <- A.decodeFileStrict' jsonFile 144 | pure $ 145 | flip fmap objs $ 146 | ( \xs -> 147 | Map.fromList 148 | . catMaybes 149 | $ [(PackageKey k,) <$> A.parseMaybe (A..: "version") obj | (k, obj) <- xs] 150 | ) 151 | . Map.toList 152 | _ -> pure mempty 153 | 154 | -- | Entry point of nvfetcher 155 | runNvFetcherNoCLI :: Config -> Target -> PackageSet () -> IO () 156 | runNvFetcherNoCLI config@Config {..} target packageSet = do 157 | pkgs <- Map.map pinIfUnmatch <$> runPackageSet packageSet 158 | lastVersions <- parseLastVersions $ buildDir generatedJsonFileName 159 | shakeDir <- getDataDir 160 | -- Set shakeFiles and shakeVersion 161 | let shakeOptions1 = shakeConfig {shakeFiles = shakeDir, shakeVersion = "2"} 162 | -- shakeConfig in Config will be shakeOptions1 (not including shake extra) 163 | shakeExtras <- initShakeExtras (config {shakeConfig = shakeOptions1}) pkgs $ fromMaybe mempty lastVersions 164 | -- Set shakeExtra 165 | let shakeOptions2 = shakeOptions1 {shakeExtra = addShakeExtra shakeExtras (shakeExtra shakeConfig)} 166 | rules = mainRules config 167 | shake shakeOptions2 $ want [show target] >> rules 168 | where 169 | -- Don't touch already pinned packages 170 | pinIfUnmatch x@Package {..} 171 | | Just regex <- filterRegex = 172 | x 173 | { _ppinned = case _ppinned of 174 | PermanentStale -> PermanentStale 175 | _ -> 176 | if _pname =~ regex 177 | then NoStale 178 | else TemporaryStale 179 | } 180 | | otherwise = x 181 | 182 | -------------------------------------------------------------------------------- 183 | 184 | mainRules :: Config -> Rules () 185 | mainRules Config {..} = do 186 | "clean" ~> do 187 | getBuildDir >>= flip removeFilesAfter ["//*"] 188 | actionAfterClean 189 | 190 | "purge" ~> do 191 | shakeDir <- shakeFiles <$> getShakeOptions 192 | removeFilesAfter shakeDir ["//*"] 193 | 194 | "build" ~> do 195 | -- remove all files in build dir except generated nix and json 196 | -- since core rule has always rerun, any file not generated in this run will be removed 197 | unless keepOldFiles $ 198 | whenM (liftIO $ D.doesDirectoryExist buildDir) $ do 199 | oldFiles <- (\\ [generatedJsonFileName, generatedNixFileName]) <$> liftIO (D.listDirectory buildDir) 200 | putVerbose $ "Removing old files: " <> show oldFiles 201 | liftIO $ removeFiles buildDir oldFiles 202 | allKeys <- getAllPackageKeys 203 | results <- fmap (zip allKeys) $ parallel $ runPackage <$> allKeys 204 | let (fmap (fromJust . snd) -> successResults, fmap fst -> failureKeys) = partition (isJust . snd) results 205 | -- Record removed packages to version changes 206 | -- Failure keys are also considered as removed in this run 207 | getAllOnDiskVersions 208 | >>= \oldPkgs -> forM_ (Map.keys oldPkgs \\ (allKeys \\ failureKeys)) $ 209 | \pkg -> recordVersionChange (coerce pkg) (oldPkgs Map.!? pkg) "∅" 210 | getVersionChanges >>= \changes -> 211 | if null changes 212 | then putInfo "Up to date" 213 | else do 214 | putInfo "Changes:" 215 | putInfo $ unlines $ show <$> changes 216 | buildDir <- getBuildDir 217 | let generatedNixPath = buildDir generatedNixFileName 218 | generatedJSONPath = buildDir generatedJsonFileName 219 | putVerbose $ "Generating " <> generatedNixPath 220 | writeFileChanged generatedNixPath $ T.unpack $ srouces (T.unlines $ toNixExpr <$> successResults) <> "\n" 221 | putVerbose $ "Generating " <> generatedJSONPath 222 | writeFileChanged generatedJSONPath $ LBS.unpack $ A.encodePretty $ A.object [aesonKey (_prname r) A..= r | r <- successResults] 223 | actionAfterBuild 224 | 225 | customRules 226 | coreRules 227 | 228 | srouces :: Text -> Text 229 | srouces body = 230 | [trimming| 231 | # This file was generated by nvfetcher, please do not modify it manually. 232 | { fetchgit, fetchurl, fetchFromGitHub, dockerTools }: 233 | { 234 | $body 235 | } 236 | |] 237 | 238 | generatedNixFileName :: String 239 | generatedNixFileName = "generated.nix" 240 | 241 | generatedJsonFileName :: String 242 | generatedJsonFileName = "generated.json" 243 | -------------------------------------------------------------------------------- /src/NvFetcher/Config.hs: -------------------------------------------------------------------------------- 1 | -- | Copyright: (c) 2021-2022 berberman 2 | -- SPDX-License-Identifier: MIT 3 | -- Maintainer: berberman 4 | -- Stability: experimental 5 | -- Portability: portable 6 | module NvFetcher.Config where 7 | 8 | import Data.Default 9 | import Development.Shake 10 | 11 | -- | Nvfetcher configuration 12 | data Config = Config 13 | { shakeConfig :: ShakeOptions, 14 | buildDir :: FilePath, 15 | customRules :: Rules (), 16 | actionAfterBuild :: Action (), 17 | actionAfterClean :: Action (), 18 | retry :: Int, 19 | filterRegex :: Maybe String, 20 | cacheNvchecker :: Bool, 21 | keepOldFiles :: Bool, 22 | -- | Absolute path 23 | keyfile :: Maybe FilePath, 24 | -- | When set to 'True', nvfetcher will keep going even if some packages failed to /fetch/ 25 | keepGoing :: Bool 26 | } 27 | 28 | instance Default Config where 29 | def = 30 | Config 31 | { shakeConfig = 32 | shakeOptions 33 | { shakeProgress = progressSimple, 34 | shakeThreads = 0 35 | }, 36 | buildDir = "_sources", 37 | customRules = pure (), 38 | actionAfterBuild = pure (), 39 | actionAfterClean = pure (), 40 | retry = 3, 41 | filterRegex = Nothing, 42 | cacheNvchecker = True, 43 | keepOldFiles = False, 44 | keyfile = Nothing, 45 | keepGoing = False 46 | } 47 | -------------------------------------------------------------------------------- /src/NvFetcher/Core.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | -- | Copyright: (c) 2021-2022 berberman 7 | -- SPDX-License-Identifier: MIT 8 | -- Maintainer: berberman 9 | -- Stability: experimental 10 | -- Portability: portable 11 | module NvFetcher.Core 12 | ( Core (..), 13 | coreRules, 14 | runPackage, 15 | ) 16 | where 17 | 18 | import Data.Coerce (coerce) 19 | import qualified Data.HashMap.Strict as HMap 20 | import qualified Data.Text as T 21 | import Development.Shake 22 | import Development.Shake.FilePath 23 | import Development.Shake.Rule 24 | import NvFetcher.ExtractSrc 25 | import NvFetcher.FetchRustGitDeps 26 | import NvFetcher.GetGitCommitDate 27 | import NvFetcher.NixFetcher 28 | import NvFetcher.Nvchecker 29 | import NvFetcher.Types 30 | import NvFetcher.Types.ShakeExtras 31 | 32 | -- | The core rule of nvchecker. 33 | -- all rules are wired here. 34 | coreRules :: Rules () 35 | coreRules = do 36 | nvcheckerRule 37 | prefetchRule 38 | extractSrcRule 39 | fetchRustGitDepsRule 40 | getGitCommitDateRule 41 | addBuiltinRule noLint noIdentity $ \(WithPackageKey (Core, pkg)) _ _ -> do 42 | -- it's important to always rerun 43 | -- since the package definition is not tracked at all 44 | alwaysRerun 45 | lookupPackage pkg >>= \case 46 | Nothing -> fail $ "Unknown package key: " <> show pkg 47 | Just 48 | Package 49 | { _pversion = CheckVersion versionSource options, 50 | _ppassthru = (PackagePassthru passthru), 51 | .. 52 | } -> do 53 | _prversion@(NvcheckerResult version _mOldV _isStale) <- checkVersion versionSource options pkg 54 | _prfetched <- prefetch (_pfetcher version) _pforcefetch 55 | -- If we fail to prefetch, we should fail on this package 56 | case _prfetched of 57 | Just _prfetched -> do 58 | buildDir <- getBuildDir 59 | -- extract src 60 | _prextract <- 61 | case _pextract of 62 | Just (PackageExtractSrc extract) -> do 63 | result <- HMap.toList <$> extractSrcs _prfetched extract 64 | Just . HMap.fromList 65 | <$> sequence 66 | [ do 67 | -- write extracted files to build dir 68 | -- and read them in nix using 'builtins.readFile' 69 | writeFile' (buildDir path) (T.unpack v) 70 | pure (k, T.pack path) 71 | | (k, v) <- result, 72 | let path = 73 | "./" 74 | <> T.unpack _pname 75 | <> "-" 76 | <> T.unpack (coerce version) 77 | k 78 | ] 79 | _ -> pure Nothing 80 | -- cargo locks 81 | _prcargolock <- 82 | case _pcargo of 83 | Just (PackageCargoLockFiles lockPath) -> do 84 | lockFiles <- HMap.toList <$> extractSrcs _prfetched lockPath 85 | result <- parallel $ 86 | flip fmap lockFiles $ \(lockPath, lockData) -> do 87 | result <- fetchRustGitDeps _prfetched lockPath 88 | let lockPath' = 89 | T.unpack _pname 90 | <> "-" 91 | <> T.unpack (coerce version) 92 | lockPath 93 | lockPathNix = "./" <> T.pack lockPath' 94 | -- similar to extract src, write lock file to build dir 95 | writeFile' (buildDir lockPath') $ T.unpack lockData 96 | pure (lockPath, (lockPathNix, result)) 97 | pure . Just $ HMap.fromList result 98 | _ -> pure Nothing 99 | 100 | -- Only git version source supports git commit date 101 | _prgitdate <- case versionSource of 102 | Git {..} -> Just <$> getGitCommitDate _vurl (coerce version) _pgitdateformat 103 | _ -> pure Nothing 104 | 105 | -- update changelog 106 | -- always use on disk version 107 | mOldV <- getLastVersionOnDisk pkg 108 | case mOldV of 109 | Nothing -> 110 | recordVersionChange _pname Nothing version 111 | Just old 112 | | old /= version -> 113 | recordVersionChange _pname (Just old) version 114 | _ -> pure () 115 | 116 | let _prpassthru = if HMap.null passthru then Nothing else Just passthru 117 | _prname = _pname 118 | _prpinned = _ppinned 119 | -- Since we don't save the previous result, we are not able to know if the result changes 120 | -- Depending on this rule leads to RunDependenciesChanged 121 | pure $ RunResult ChangedRecomputeDiff mempty $ Just PackageResult {..} 122 | _ -> pure $ RunResult ChangedRecomputeDiff mempty Nothing 123 | 124 | -- | 'Core' rule take a 'PackageKey', find the corresponding 'Package', and run all needed rules to get 'PackageResult' 125 | runPackage :: PackageKey -> Action (Maybe PackageResult) 126 | runPackage k = apply1 $ WithPackageKey (Core, k) 127 | -------------------------------------------------------------------------------- /src/NvFetcher/ExtractSrc.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TupleSections #-} 5 | 6 | -- | Copyright: (c) 2021-2022 berberman 7 | -- SPDX-License-Identifier: MIT 8 | -- Maintainer: berberman 9 | -- Stability: experimental 10 | -- Portability: portable 11 | -- 12 | -- This module provides function that extracs files contents from package sources. 13 | -- It uses [IFD](https://nixos.wiki/wiki/Import_From_Derivation) under the hood, 14 | -- pulling /textual/ files from source drv. 15 | -- Because we use @nix-instantiate@ to build drv, so @@ (@NIX_PATH@) is required. 16 | module NvFetcher.ExtractSrc 17 | ( -- * Types 18 | ExtractSrcQ (..), 19 | 20 | -- * Rules 21 | extractSrcRule, 22 | 23 | -- * Functions 24 | extractSrc, 25 | extractSrcs, 26 | ) 27 | where 28 | 29 | import Control.Monad (void) 30 | import Control.Monad.Extra (unlessM) 31 | import Data.Binary.Instances () 32 | import Data.HashMap.Strict (HashMap) 33 | import qualified Data.HashMap.Strict as HM 34 | import qualified Data.List.NonEmpty as NE 35 | import Data.Text (Text) 36 | import qualified Data.Text as T 37 | import qualified Data.Text.IO as T 38 | import Development.Shake 39 | import Development.Shake.FilePath (()) 40 | import NvFetcher.NixExpr 41 | import NvFetcher.Types 42 | import NvFetcher.Types.ShakeExtras 43 | import Prettyprinter (pretty, (<+>)) 44 | 45 | -- | Rules of extract source 46 | extractSrcRule :: Rules () 47 | extractSrcRule = void $ 48 | addOracle $ \q@(ExtractSrcQ fetcher files) -> withTempFile $ \fp -> withRetry $ do 49 | putInfo . show $ "#" <+> pretty q 50 | let nixExpr = T.unpack $ fetcherToDrv fetcher "nvfetcher-extract" 51 | putVerbose $ "Generated nix expr:\n" <> nixExpr 52 | writeFile' fp nixExpr 53 | (CmdTime t, StdoutTrim out, CmdLine c, Stdouterr err) <- quietly $ cmd $ "nix-build --no-out-link " <> fp 54 | putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s" 55 | putVerbose $ "Output from stdout: " <> out 56 | putVerbose $ "Output from stderr: " <> err 57 | unlessM (doesDirectoryExist out) $ 58 | fail $ "nix-build output is not a directory: " <> out 59 | HM.fromList <$> sequence [(f,) <$> liftIO (T.readFile $ out f) | f <- NE.toList files] 60 | 61 | -- | Run extract source with many sources 62 | extractSrcs :: 63 | -- | prefetched source 64 | NixFetcher Fetched -> 65 | -- | relative file paths to extract 66 | NE.NonEmpty FilePath -> 67 | Action (HashMap FilePath Text) 68 | extractSrcs fetcher xs = askOracle (ExtractSrcQ fetcher xs) 69 | 70 | -- | Run extract source 71 | extractSrc :: 72 | -- | prefetched source 73 | NixFetcher Fetched -> 74 | -- | relative file path to extract 75 | FilePath -> 76 | Action (HashMap FilePath Text) 77 | extractSrc fetcher fp = extractSrcs fetcher $ NE.fromList [fp] 78 | -------------------------------------------------------------------------------- /src/NvFetcher/FetchRustGitDeps.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | {-# LANGUAGE ViewPatterns #-} 6 | 7 | -- | Copyright: (c) 2021-2022 berberman 8 | -- SPDX-License-Identifier: MIT 9 | -- Maintainer: berberman 10 | -- Stability: experimental 11 | -- Portability: portable 12 | -- 13 | -- This module provides function to calculate @cargoLock@ used in @rustPlatform.buildRustPackage@. 14 | module NvFetcher.FetchRustGitDeps 15 | ( -- * Types 16 | FetchRustGitDepsQ (..), 17 | 18 | -- * Rules 19 | fetchRustGitDepsRule, 20 | 21 | -- * Functions 22 | fetchRustGitDeps, 23 | ) 24 | where 25 | 26 | import Control.Monad (void) 27 | import Control.Monad.Extra (fromMaybeM) 28 | import Data.Binary.Instances () 29 | import Data.Coerce (coerce) 30 | import Data.HashMap.Strict (HashMap) 31 | import qualified Data.HashMap.Strict as HMap 32 | import Data.List.Extra (nubOrdOn) 33 | import Data.Maybe (maybeToList) 34 | import Data.Text (Text) 35 | import qualified Data.Text as T 36 | import Development.Shake 37 | import NvFetcher.ExtractSrc 38 | import NvFetcher.NixFetcher 39 | import NvFetcher.Types 40 | import Prettyprinter (pretty, (<+>)) 41 | import qualified TOML as Toml 42 | import Text.Parsec 43 | import Text.Parsec.Text 44 | 45 | -- | Rules of fetch rust git dependencies 46 | fetchRustGitDepsRule :: Rules () 47 | fetchRustGitDepsRule = void $ 48 | addOracleCache $ \key@(FetchRustGitDepsQ fetcher lockPath) -> do 49 | putInfo . show $ "#" <+> pretty key 50 | cargoLock <- head . HMap.elems <$> extractSrc fetcher lockPath 51 | deps <- case Toml.decodeWith (Toml.getFieldWith (Toml.getArrayOf rustDepDecoder) "package") cargoLock of 52 | Right r -> pure $ nubOrdOn rrawSrc r 53 | Left err -> fail $ "Failed to parse Cargo.lock: " <> T.unpack (Toml.renderTOMLError err) 54 | r <- 55 | parallel 56 | [ case parse gitSrcParser (T.unpack rname) src of 57 | Right ParsedGitSrc {..} -> do 58 | (_sha256 -> sha256) <- fromMaybeM (fail $ "Prefetch failed for " <> T.unpack pgurl) $ prefetch (gitFetcher pgurl pgsha) NoForceFetch 59 | -- @${name}-${version}@ -> sha256 60 | pure (rname <> "-" <> coerce rversion, sha256) 61 | Left err -> fail $ "Failed to parse git source in Cargo.lock: " <> show err 62 | | RustDep {..} <- deps, 63 | -- it's a dependency 64 | src <- maybeToList rrawSrc, 65 | -- it's a git dependency 66 | "git+" `T.isPrefixOf` src 67 | ] 68 | pure $ HMap.fromList r 69 | 70 | -- | Run fetch rust git dependencies 71 | fetchRustGitDeps :: 72 | -- | prefetched source 73 | NixFetcher Fetched -> 74 | -- | relative file path of @Cargo.lock@ 75 | FilePath -> 76 | Action (HashMap Text Checksum) 77 | fetchRustGitDeps fetcher lockPath = askOracle $ FetchRustGitDepsQ fetcher lockPath 78 | 79 | data ParsedGitSrc = ParsedGitSrc 80 | { -- | git url 81 | pgurl :: Text, 82 | pgsha :: Version 83 | } 84 | deriving (Show, Eq, Ord) 85 | 86 | -- | Parse git src in cargo lock file 87 | -- >>> parse gitSrcParser "test" "git+https://github.com/rust-random/rand.git?rev=0.8.3#6ecbe2626b2cc6110a25c97b1702b347574febc7" 88 | -- Right (ParsedGitSrc {pgurl = "https://github.com/rust-random/rand.git", pgsha = "6ecbe2626b2cc6110a25c97b1702b347574febc7"}) 89 | -- 90 | -- >>> parse gitSrcParser "test" "git+https://github.com/rust-random/rand.git#f0e01ee0a7257753cc51b291f62666f4765923ef" 91 | -- Right (ParsedGitSrc {pgurl = "https://github.com/rust-random/rand.git", pgsha = "f0e01ee0a7257753cc51b291f62666f4765923ef"}) 92 | -- 93 | -- >>> parse gitSrcParser "test" "git+https://github.com/rust-lang/cargo?branch=rust-1.53.0#4369396ce7d270972955d876eaa4954bea56bcd9" 94 | -- Right (ParsedGitSrc {pgurl = "https://github.com/rust-lang/cargo", pgsha = "4369396ce7d270972955d876eaa4954bea56bcd9"}) 95 | gitSrcParser :: Parser ParsedGitSrc 96 | gitSrcParser = do 97 | _ <- string "git+" 98 | pgurl <- many1 $ noneOf ['?', '#'] 99 | -- skip things like ?rev and ?branch 100 | skipMany (noneOf ['#']) 101 | _ <- char '#' 102 | pgsha <- manyTill anyChar eof 103 | pure $ ParsedGitSrc (T.pack pgurl) (coerce $ T.pack pgsha) 104 | 105 | data RustDep = RustDep 106 | { rname :: PackageName, 107 | rversion :: Version, 108 | rrawSrc :: Maybe Text 109 | } 110 | deriving (Show, Eq, Ord) 111 | 112 | rustDepDecoder :: Toml.Decoder RustDep 113 | rustDepDecoder = 114 | RustDep 115 | <$> Toml.getField "name" 116 | <*> (coerce @Text <$> Toml.getField "version") 117 | <*> Toml.getFieldOpt "source" 118 | -------------------------------------------------------------------------------- /src/NvFetcher/GetGitCommitDate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | 4 | -- | Copyright: (c) 2021-2022 berberman 5 | -- SPDX-License-Identifier: MIT 6 | -- Maintainer: berberman 7 | -- Stability: experimental 8 | -- Portability: portable 9 | -- 10 | -- This module provides mechanisms for obtaining the git commit date. 11 | -- The cloned repo will not be preserved. 12 | module NvFetcher.GetGitCommitDate 13 | ( -- * Types 14 | DateFormat (..), 15 | GetGitCommitDate (..), 16 | 17 | -- * Rules 18 | getGitCommitDateRule, 19 | 20 | -- * Functions 21 | getGitCommitDate, 22 | ) 23 | where 24 | 25 | import Control.Monad (void) 26 | import Data.Coerce (coerce) 27 | import Data.Maybe (fromMaybe) 28 | import Data.Text (Text) 29 | import qualified Data.Text as T 30 | import Development.Shake 31 | import NvFetcher.Types 32 | import Prettyprinter (pretty, (<+>)) 33 | 34 | getGitCommitDateRule :: Rules () 35 | getGitCommitDateRule = void $ do 36 | addOracleCache $ \q@(GetGitCommitDate (T.unpack -> url) (T.unpack -> rev) format) -> withTempDir $ \repo -> do 37 | putInfo . show $ "#" <+> pretty q 38 | (StdoutTrim out) <- quietly $ do 39 | cmd_ [Cwd repo, EchoStderr False, EchoStdout False] ("git init" :: String) 40 | cmd_ [Cwd repo, EchoStderr False] $ "git remote add origin " <> url 41 | cmd_ [Cwd repo, EchoStderr False] $ "git fetch --depth 1 origin " <> rev 42 | cmd_ [Cwd repo, EchoStderr False] ("git checkout FETCH_HEAD" :: String) 43 | cmd [Cwd repo, Shell] $ "git --no-pager log -1 --format=%cd --date=format:\"" <> T.unpack (fromMaybe "%Y-%m-%d" $ coerce format) <> "\"" 44 | pure $ T.pack out 45 | 46 | getGitCommitDate :: Text -> Text -> DateFormat -> Action Text 47 | getGitCommitDate url rev format = askOracle $ GetGitCommitDate url rev format 48 | -------------------------------------------------------------------------------- /src/NvFetcher/NixExpr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE QuasiQuotes #-} 6 | {-# LANGUAGE RecordWildCards #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE ViewPatterns #-} 9 | 10 | -- | Copyright: (c) 2021-2022 berberman 11 | -- SPDX-License-Identifier: MIT 12 | -- Maintainer: berberman 13 | -- Stability: experimental 14 | -- Portability: portable 15 | -- 16 | -- This module contains a type class 'ToNixExpr' and some its instances associated with either Haskell 17 | -- primitive types or our "NvFetcher.Types". 18 | module NvFetcher.NixExpr 19 | ( NixExpr, 20 | ToNixExpr (..), 21 | fetcherToDrv, 22 | ) 23 | where 24 | 25 | import Data.Coerce (coerce) 26 | import Data.HashMap.Strict (HashMap) 27 | import qualified Data.HashMap.Strict as HMap 28 | import qualified Data.List.NonEmpty as NE 29 | import Data.Maybe (fromMaybe) 30 | import Data.Text (Text) 31 | import qualified Data.Text as T 32 | import NeatInterpolation (trimming) 33 | import NvFetcher.Types 34 | import NvFetcher.Utils (quote, quoteIfNeeds) 35 | 36 | -- | Types can be converted into nix expr 37 | class ToNixExpr a where 38 | toNixExpr :: a -> NixExpr 39 | 40 | instance ToNixExpr (NixFetcher Fetched) where 41 | toNixExpr = nixFetcher 42 | 43 | instance ToNixExpr Bool where 44 | toNixExpr True = "true" 45 | toNixExpr False = "false" 46 | 47 | instance ToNixExpr a => ToNixExpr [a] where 48 | toNixExpr xs = foldl (\acc x -> acc <> " " <> toNixExpr x) "[" xs <> " ]" 49 | 50 | instance ToNixExpr a => ToNixExpr (NE.NonEmpty a) where 51 | toNixExpr = toNixExpr . NE.toList 52 | 53 | instance {-# OVERLAPS #-} ToNixExpr String where 54 | toNixExpr = T.pack . show 55 | 56 | instance ToNixExpr NixExpr where 57 | toNixExpr = id 58 | 59 | instance ToNixExpr Version where 60 | toNixExpr = coerce 61 | 62 | nixFetcher :: NixFetcher Fetched -> NixExpr 63 | nixFetcher = \case 64 | FetchGit 65 | { _sha256 = coerce quote -> sha256, 66 | _rev = quote . toNixExpr -> rev, 67 | _fetchSubmodules = toNixExpr -> fetchSubmodules, 68 | _deepClone = toNixExpr -> deepClone, 69 | _leaveDotGit = toNixExpr -> leaveDotGit, 70 | _sparseCheckout = toNixExpr . map quote -> sparseCheckout, 71 | _furl = quote -> url, 72 | _name = nameField -> n 73 | } -> 74 | [trimming| 75 | fetchgit { 76 | url = $url; 77 | rev = $rev; 78 | fetchSubmodules = $fetchSubmodules; 79 | deepClone = $deepClone; 80 | leaveDotGit = $leaveDotGit; 81 | sparseCheckout = $sparseCheckout;$n 82 | sha256 = $sha256; 83 | } 84 | |] 85 | FetchGitHub 86 | { _sha256 = coerce quote -> sha256, 87 | _rev = quote . toNixExpr -> rev, 88 | _fetchSubmodules = toNixExpr -> fetchSubmodules, 89 | _deepClone = toNixExpr -> deepClone, 90 | _leaveDotGit = toNixExpr -> leaveDotGit, 91 | _sparseCheckout = toNixExpr . map quote -> sparseCheckout, 92 | _fowner = quote -> owner, 93 | _frepo = quote -> repo, 94 | _name = nameField -> n 95 | } -> 96 | -- TODO: fix fetchFromGitHub in Nixpkgs so that deepClone, leaveDotGit 97 | -- and sparseCheckout won't get passed to fetchzip 98 | if (deepClone == "true") || (leaveDotGit == "true") || (sparseCheckout /= "[ ]") 99 | then 100 | [trimming| 101 | fetchFromGitHub { 102 | owner = $owner; 103 | repo = $repo; 104 | rev = $rev; 105 | fetchSubmodules = $fetchSubmodules; 106 | deepClone = $deepClone; 107 | leaveDotGit = $leaveDotGit; 108 | sparseCheckout = $sparseCheckout;$n 109 | sha256 = $sha256; 110 | } 111 | |] 112 | else 113 | [trimming| 114 | fetchFromGitHub { 115 | owner = $owner; 116 | repo = $repo; 117 | rev = $rev; 118 | fetchSubmodules = $fetchSubmodules;$n 119 | sha256 = $sha256; 120 | } 121 | |] 122 | (FetchUrl (quote -> url) (nameField -> n) (coerce quote -> sha256)) -> 123 | [trimming| 124 | fetchurl { 125 | url = $url;$n 126 | sha256 = $sha256; 127 | } 128 | |] 129 | (FetchTarball (quote -> url) (coerce quote -> sha256)) -> 130 | [trimming| 131 | fetchTarball { 132 | url = $url; 133 | sha256 = $sha256; 134 | } 135 | |] 136 | FetchDocker 137 | { _imageName = quote . toNixExpr -> imageName, 138 | _imageTag = quote . toNixExpr -> imageTag, 139 | _imageDigest = ContainerDigest (quote . toNixExpr -> imageDigest), 140 | _sha256 = coerce quote -> sha256, 141 | _fos = optionalStr "os" -> os, 142 | _farch = optionalStr "arch" -> arch, 143 | _finalImageName = optionalStr "finalImageName" -> finalImageName, 144 | _finalImageTag = maybe imageTag (quote . toNixExpr) -> finalImageTag, 145 | _tlsVerify = optionalField "tlsVerify" -> tlsVerify 146 | } -> 147 | [trimming| 148 | dockerTools.pullImage { 149 | imageName = $imageName; 150 | imageDigest = $imageDigest; 151 | sha256 = $sha256; 152 | finalImageTag = $finalImageTag;$os$arch$finalImageName$tlsVerify 153 | } 154 | |] 155 | where 156 | optionalField n = maybe "" (\x -> "\n" <> n <> " = " <> toNixExpr x <> ";") 157 | optionalStr n = optionalField n . fmap quote 158 | nameField = optionalStr "name" 159 | 160 | -- | Create a trivial drv that extracts the source from a fetcher 161 | -- TODO: Avoid using @NIX_PATH@ 162 | fetcherToDrv :: NixFetcher Fetched -> Text -> NixExpr 163 | fetcherToDrv (toNixExpr -> fetcherExpr) (quote -> drvName) = 164 | [trimming| 165 | with import { }; 166 | stdenv.mkDerivation { 167 | name = $drvName; 168 | src = $fetcherExpr; 169 | nativeBuildInputs = [ unzip ]; 170 | dontBuild = true; 171 | installPhase = '' 172 | mkdir $$out 173 | cp -r * $$out 174 | ''; 175 | } 176 | |] 177 | 178 | -- | nix expr snippet like: 179 | -- 180 | -- @ 181 | -- feeluown-core = { 182 | -- pname = "feeluown-core"; 183 | -- version = "3.7.7"; 184 | -- src = fetchurl { 185 | -- sha256 = "06d3j39ff9znqxkhp9ly81lcgajkhg30hyqxy2809yn23xixg3x2"; 186 | -- url = "https://pypi.io/packages/source/f/feeluown/feeluown-3.7.7.tar.gz"; 187 | -- }; 188 | -- a = "B"; 189 | -- }; 190 | -- @ 191 | instance ToNixExpr PackageResult where 192 | toNixExpr PackageResult {..} = 193 | [trimming| 194 | $name = { 195 | pname = $nameString; 196 | version = $version; 197 | src = $src;$appending 198 | }; 199 | |] 200 | where 201 | name = quoteIfNeeds _prname 202 | nameString = quote _prname 203 | version = quote . coerce . nvNow $ _prversion 204 | src = toNixExpr _prfetched 205 | extract = 206 | maybe 207 | "" 208 | ( \ex -> 209 | T.unlines 210 | [ quoteIfNeeds (T.pack name) 211 | <> " = builtins.readFile " 212 | <> fp 213 | <> ";" 214 | | (name, fp) <- HMap.toList ex 215 | ] 216 | ) 217 | _prextract 218 | cargo = fromMaybe "" $ do 219 | cargoLocks <- _prcargolock 220 | let depsSnippet (deps :: HashMap Text Checksum) = 221 | T.unlines 222 | [ quoteIfNeeds name 223 | <> " = " 224 | <> quote (coerce sum) 225 | <> ";" 226 | | (name, sum) <- HMap.toList deps 227 | ] 228 | lockSnippet ((T.pack -> fp) :: FilePath, (nixFP :: NixExpr, deps :: HashMap Text Checksum)) = 229 | let hashes = depsSnippet deps 230 | in [trimming| 231 | cargoLock."$fp" = { 232 | lockFile = $nixFP; 233 | outputHashes = { 234 | $hashes 235 | }; 236 | }; 237 | |] 238 | pure . T.unlines $ lockSnippet <$> HMap.toList cargoLocks 239 | passthru = 240 | maybe 241 | "" 242 | ( \pt -> 243 | T.unlines 244 | [ quoteIfNeeds k 245 | <> " = " 246 | <> v 247 | <> ";" 248 | | (k, quote -> v) <- HMap.toList pt 249 | ] 250 | ) 251 | _prpassthru 252 | date = maybe "" (\d -> "date = " <> quote d <> ";") _prgitdate 253 | joined = extract <> cargo <> passthru <> date 254 | appending = if T.null joined then "" else "\n" <> joined 255 | -------------------------------------------------------------------------------- /src/NvFetcher/NixFetcher.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE DuplicateRecordFields #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE LambdaCase #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE QuasiQuotes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TypeApplications #-} 12 | {-# LANGUAGE ViewPatterns #-} 13 | 14 | -- | Copyright: (c) 2021-2022 berberman 15 | -- SPDX-License-Identifier: MIT 16 | -- Maintainer: berberman 17 | -- Stability: experimental 18 | -- Portability: portable 19 | -- 20 | -- 'NixFetcher' is used to describe how to fetch package sources. 21 | -- 22 | -- There are five types of fetchers overall: 23 | -- 24 | -- 1. 'FetchGit' -- nix-prefetch-git 25 | -- 2. 'FetchGitHub' -- nix-prefetch-git/nix-prefetch-url 26 | -- 3. 'FetchUrl' -- nix-prefetch-url 27 | -- 4. 'FetchTarball' -- nix-prefetch-url 28 | -- 5. 'FetchDocker' -- nix-prefetch-docker 29 | -- 30 | -- As you can see the type signature of 'prefetch': 31 | -- a fetcher will be filled with the fetch result (hash) after the prefetch. 32 | module NvFetcher.NixFetcher 33 | ( -- * Types 34 | RunFetch (..), 35 | ForceFetch (..), 36 | NixFetcher (..), 37 | FetchStatus (..), 38 | FetchResult, 39 | 40 | -- * Rules 41 | prefetchRule, 42 | prefetch, 43 | 44 | -- * Functions 45 | gitHubFetcher, 46 | pypiFetcher, 47 | gitHubReleaseFetcher, 48 | gitHubReleaseFetcher', 49 | gitFetcher, 50 | urlFetcher, 51 | urlFetcher', 52 | openVsxFetcher, 53 | vscodeMarketplaceFetcher, 54 | tarballFetcher, 55 | ) 56 | where 57 | 58 | import Control.Exception (ErrorCall) 59 | import Control.Monad (void, when) 60 | import qualified Data.Aeson as A 61 | import Data.Coerce (coerce) 62 | import Data.Text (Text) 63 | import qualified Data.Text as T 64 | import qualified Data.Text.Encoding as T 65 | import Development.Shake 66 | import GHC.Generics (Generic) 67 | import NeatInterpolation (trimming) 68 | import NvFetcher.Types 69 | import NvFetcher.Types.ShakeExtras 70 | import Prettyprinter (pretty, (<+>)) 71 | 72 | -------------------------------------------------------------------------------- 73 | 74 | sha256ToSri :: Text -> Action Checksum 75 | sha256ToSri sha256 = do 76 | (CmdTime t, Stdout (T.decodeUtf8 -> out), CmdLine c) <- 77 | quietly $ 78 | command [EchoStderr False] "nix" ["hash", "to-sri", "--type", "sha256", T.unpack sha256] 79 | putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s" 80 | case takeWhile (not . T.null) $ reverse $ T.lines out of 81 | [x] -> pure $ coerce x 82 | _ -> fail $ "Failed to parse output from nix hash to-sri: " <> T.unpack out 83 | 84 | runNixPrefetchUrl :: Text -> Bool -> Maybe Text -> Action Checksum 85 | runNixPrefetchUrl url unpack name = do 86 | (CmdTime t, Stdout (T.decodeUtf8 -> out), CmdLine c) <- 87 | quietly $ 88 | command [EchoStderr False] "nix-prefetch-url" $ 89 | [T.unpack url] 90 | <> ["--unpack" | unpack] 91 | <> concat [["--name", T.unpack name] | Just name <- [name]] 92 | putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s" 93 | case takeWhile (not . T.null) $ reverse $ T.lines out of 94 | [x] -> sha256ToSri x 95 | _ -> fail $ "Failed to parse output from nix-prefetch-url: " <> T.unpack out 96 | 97 | newtype FetchedGit = FetchedGit {sha256 :: Text} 98 | deriving (Show, Generic, A.FromJSON) 99 | 100 | runNixPrefetchGit :: Text -> Text -> Bool -> Bool -> Bool -> [Text] -> Action Checksum 101 | runNixPrefetchGit url rev fetchSubmodules deepClone leaveDotGit sparseCheckout = do 102 | (CmdTime t, Stdout out, CmdLine c) <- 103 | quietly $ 104 | command [EchoStderr False] "nix-prefetch-git" $ 105 | ["--url", T.unpack url] 106 | <> ["--rev", T.unpack rev] 107 | <> ["--fetch-submodules" | fetchSubmodules] 108 | <> ["--deepClone" | deepClone] 109 | <> ["--leave-dotGit" | leaveDotGit] 110 | <> if null sparseCheckout then [] else ["--sparse-checkout", T.unpack $ T.intercalate "\n" sparseCheckout] 111 | putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s" 112 | case A.eitherDecode out of 113 | Right (FetchedGit x) -> sha256ToSri x 114 | Left e -> fail $ "Failed to parse output from nix-prefetch-git as JSON: " <> e 115 | 116 | -------------------------------------------------------------------------------- 117 | 118 | runFetcher :: NixFetcher Fresh -> Action (NixFetcher Fetched) 119 | runFetcher = \case 120 | FetchGit {..} -> do 121 | result <- runNixPrefetchGit _furl (coerce _rev) _fetchSubmodules _deepClone _leaveDotGit _sparseCheckout 122 | pure FetchGit {_sha256 = coerce result, ..} 123 | FetchGitHub {..} -> do 124 | let useFetchGit = _fetchSubmodules || _leaveDotGit || _deepClone || not (null _sparseCheckout) 125 | ver = coerce _rev 126 | result <- 127 | if useFetchGit 128 | then runNixPrefetchGit [trimming|https://github.com/$_fowner/$_frepo|] (coerce _rev) _fetchSubmodules _deepClone _leaveDotGit _sparseCheckout 129 | else runNixPrefetchUrl [trimming|https://github.com/$_fowner/$_frepo/archive/$ver.tar.gz|] True mempty 130 | pure FetchGitHub {_sha256 = result, ..} 131 | FetchUrl {..} -> do 132 | result <- runNixPrefetchUrl _furl False _name 133 | pure FetchUrl {_sha256 = result, ..} 134 | FetchTarball {..} -> do 135 | result <- runNixPrefetchUrl _furl True mempty 136 | pure FetchTarball {_sha256 = result, ..} 137 | FetchDocker {..} -> do 138 | (CmdTime t, Stdout out, CmdLine c) <- 139 | quietly $ 140 | command [EchoStderr False] "nix-prefetch-docker" $ 141 | [ "--json", 142 | T.unpack _imageName, 143 | T.unpack _imageTag 144 | ] 145 | <> concat [["--os", T.unpack os] | Just os <- [_fos]] 146 | <> concat [["--arch", T.unpack arch] | Just arch <- [_farch]] 147 | putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s" 148 | case A.eitherDecode out of 149 | Right FetchedContainer {..} -> do 150 | sri <- sha256ToSri sha256 151 | pure FetchDocker {_sha256 = sri, _imageDigest = imageDigest, ..} 152 | Left e -> fail $ "Failed to parse output from nix-prefetch-docker as JSON: " <> e 153 | 154 | data FetchedContainer = FetchedContainer 155 | { imageDigest :: ContainerDigest, 156 | sha256 :: Text 157 | } 158 | deriving (Show, Generic, A.FromJSON) 159 | 160 | pypiUrl :: Text -> Version -> Text 161 | pypiUrl pypi (coerce -> ver) = 162 | let h = T.cons (T.head pypi) "" 163 | in [trimming|https://pypi.org/packages/source/$h/$pypi/$pypi-$ver.tar.gz|] 164 | 165 | -------------------------------------------------------------------------------- 166 | 167 | -- | Rules of nix fetcher 168 | prefetchRule :: Rules () 169 | prefetchRule = void $ 170 | addOracleCache $ \(RunFetch force f) -> do 171 | when (force == ForceFetch) alwaysRerun 172 | putInfo . show $ "#" <+> pretty f 173 | keepGoing <- nvcheckerKeepGoing 174 | if keepGoing 175 | then -- If fetch failed, always rerun and return Nothing 176 | actionCatch (fmap Just <$> withRetry $ runFetcher f) $ \(e :: ErrorCall) -> do 177 | alwaysRerun 178 | putError $ show e <> "\nKeep going..." 179 | pure Nothing 180 | else fmap Just <$> withRetry $ runFetcher f 181 | 182 | -- | Run nix fetcher 183 | prefetch :: NixFetcher Fresh -> ForceFetch -> Action (Maybe (NixFetcher Fetched)) 184 | prefetch f force = askOracle $ RunFetch force f 185 | 186 | -------------------------------------------------------------------------------- 187 | 188 | -- | Create a fetcher from git url 189 | gitFetcher :: Text -> PackageFetcher 190 | gitFetcher furl rev = FetchGit furl rev False True False [] Nothing () 191 | 192 | -- | Create a fetcher from github repo 193 | gitHubFetcher :: 194 | -- | owner and repo 195 | (Text, Text) -> 196 | PackageFetcher 197 | gitHubFetcher (owner, repo) rev = FetchGitHub owner repo rev False False False [] Nothing () 198 | 199 | -- | Create a fetcher from pypi 200 | pypiFetcher :: Text -> PackageFetcher 201 | pypiFetcher p v = urlFetcher $ pypiUrl p v 202 | 203 | -- | Create a fetcher from github release 204 | gitHubReleaseFetcher :: 205 | -- | owner and repo 206 | (Text, Text) -> 207 | -- | file name 208 | Text -> 209 | PackageFetcher 210 | gitHubReleaseFetcher (owner, repo) fp = gitHubReleaseFetcher' (owner, repo) $ const fp 211 | 212 | -- | Create a fetcher from github release 213 | gitHubReleaseFetcher' :: 214 | -- | owner and repo 215 | (Text, Text) -> 216 | -- | file name computed from version 217 | (Version -> Text) -> 218 | PackageFetcher 219 | gitHubReleaseFetcher' (owner, repo) f (coerce -> ver) = 220 | let fp = f $ coerce ver 221 | in urlFetcher 222 | [trimming|https://github.com/$owner/$repo/releases/download/$ver/$fp|] 223 | 224 | -- | Create a fetcher from url 225 | urlFetcher :: Text -> NixFetcher Fresh 226 | urlFetcher url = FetchUrl url Nothing () 227 | 228 | -- | Create a fetcher from url specifying the file name 229 | urlFetcher' :: Text -> Maybe Text -> NixFetcher Fresh 230 | urlFetcher' url name = FetchUrl url name () 231 | 232 | -- | Create a fetcher from openvsx 233 | openVsxFetcher :: 234 | -- | publisher and extension name 235 | (Text, Text) -> 236 | PackageFetcher 237 | openVsxFetcher (publisher, extName) (coerce -> ver) = 238 | FetchUrl 239 | [trimming|https://open-vsx.org/api/$publisher/$extName/$ver/file/$publisher.$extName-$ver.vsix|] 240 | (Just [trimming|$extName-$ver.zip|]) 241 | () 242 | 243 | -- | Create a fetcher from vscode marketplace 244 | vscodeMarketplaceFetcher :: 245 | -- | publisher and extension name 246 | (Text, Text) -> 247 | PackageFetcher 248 | vscodeMarketplaceFetcher (publisher, extName) (coerce -> ver) = 249 | FetchUrl 250 | [trimming|https://$publisher.gallery.vsassets.io/_apis/public/gallery/publisher/$publisher/extension/$extName/$ver/assetbyname/Microsoft.VisualStudio.Services.VSIXPackage|] 251 | (Just [trimming|$extName-$ver.zip|]) 252 | () 253 | 254 | -- | Create a fetcher from url, using fetchTarball 255 | tarballFetcher :: Text -> NixFetcher Fresh 256 | tarballFetcher url = FetchTarball url () 257 | -------------------------------------------------------------------------------- /src/NvFetcher/Nvchecker.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | -- | Copyright: (c) 2021-2022 berberman 7 | -- SPDX-License-Identifier: MIT 8 | -- Maintainer: berberman 9 | -- Stability: experimental 10 | -- Portability: portable 11 | -- 12 | -- [nvchecker](https://github.com/lilydjwg/nvchecker) is a program checking new versions of packages. 13 | -- We encode the checking process into shake build system, generating configuration of nvchecker and calling it externally. 14 | -- Now we call nvchecker for each 'VersionSource', which seems not to be efficient, but it's tolerable when running in parallel. 15 | -- 16 | -- Meanwhile, we lose the capabilities of tracking version updates, i.e. normally nvchecker will help us maintain a list of old versions, 17 | -- so that we are able to know which package's version is updated in this run. Fortunately, we can reimplement this in shake, 18 | -- see 'nvcheckerRule' for details. 19 | module NvFetcher.Nvchecker 20 | ( -- * Types 21 | VersionSortMethod (..), 22 | ListOptions (..), 23 | CheckVersion (..), 24 | NvcheckerOptions (..), 25 | VersionSource (..), 26 | NvcheckerResult (..), 27 | 28 | -- * Rules 29 | nvcheckerRule, 30 | 31 | -- * Functions 32 | checkVersion, 33 | checkVersion', 34 | ) 35 | where 36 | 37 | import Control.Monad (void) 38 | import Control.Monad.Extra (fromMaybeM) 39 | import Control.Monad.Trans.Writer.CPS 40 | import qualified Data.Aeson as A 41 | import qualified Data.ByteString.Char8 as BS 42 | import Data.Coerce (coerce) 43 | import Data.Maybe (fromJust) 44 | import Data.Text (Text) 45 | import qualified Data.Text as T 46 | import Development.Shake 47 | import Development.Shake.Rule 48 | import NvFetcher.Types 49 | import NvFetcher.Types.ShakeExtras 50 | import NvFetcher.Utils 51 | import Prettyprinter (pretty, (<+>)) 52 | 53 | -- | Rules of nvchecker 54 | nvcheckerRule :: Rules () 55 | nvcheckerRule = do 56 | persistedRule 57 | oneShotRule 58 | 59 | -- | Nvchecker rule for packages, which is aware of version changes and supports using stale version. 60 | -- nvchecker will be called at most one time given a package key. Follow-up using of this rule will return cached result. 61 | -- 'PackageKey' is required for caching. 62 | -- Run this rule by calling 'checkVersion' 63 | persistedRule :: Rules () 64 | persistedRule = addBuiltinRule noLint noIdentity $ \(WithPackageKey (key@(CheckVersion versionSource options), pkg)) _old _mode -> do 65 | putInfo . show $ "#" <+> pretty key 66 | oldVer <- getRecentLastVersion pkg 67 | useStaleVersion <- _ppinned . fromJust <$> lookupPackage pkg 68 | let useStale = case useStaleVersion of 69 | PermanentStale -> True 70 | TemporaryStale -> True 71 | _ -> False 72 | case useStale of 73 | True 74 | | Just oldVer' <- oldVer -> do 75 | -- use the stale version if we have 76 | putInfo $ T.unpack $ "Skip running nvchecker, use stale version " <> coerce oldVer' <> " for " <> coerce pkg 77 | let result = NvcheckerResult {nvNow = oldVer', nvOld = oldVer, nvStale = True} 78 | pure $ RunResult ChangedRecomputeSame (encode' result) result 79 | 80 | -- run nvchecker 81 | _ -> do 82 | -- if we already run this rule for a package, we can recover the last result from getLastVersionUpdated 83 | -- (when cacheNvchecker is enabled) 84 | useCache <- nvcheckerCacheEnabled 85 | now <- fromMaybeM (coerce <$> runNvchecker pkg options versionSource) (if useCache then getLastVersionUpdated pkg else pure Nothing) 86 | let runChanged = case oldVer of 87 | Just oldVer' 88 | | oldVer' == now -> ChangedRecomputeSame 89 | _ -> ChangedRecomputeDiff 90 | result = NvcheckerResult {nvNow = now, nvOld = oldVer, nvStale = False} 91 | -- always update 92 | updateLastVersion pkg now 93 | pure $ RunResult runChanged mempty result 94 | 95 | -- | Nvchecker rule without cache 96 | -- Rule this rule by calling 'checkVersion'' 97 | oneShotRule :: Rules () 98 | oneShotRule = void $ 99 | addOracle $ \key@(CheckVersion versionSource options) -> do 100 | putInfo . show $ pretty key 101 | now <- runNvchecker (PackageKey "pkg") options versionSource 102 | pure $ NvcheckerResult now Nothing False 103 | 104 | runNvchecker :: PackageKey -> NvcheckerOptions -> VersionSource -> Action Version 105 | runNvchecker pkg options versionSource = withTempFile $ \config -> withRetry $ do 106 | mKeyfile <- getKeyfilePath 107 | let nvcheckerConfig = T.unpack $ T.unlines $ execWriter $ genNvConfig pkg options mKeyfile versionSource 108 | putVerbose $ "Generated nvchecker config for " <> show pkg <> ":" <> nvcheckerConfig 109 | writeFile' config nvcheckerConfig 110 | (CmdTime t, Stdout out, CmdLine c) <- quietly . cmd $ "nvchecker --logger json -c " <> config 111 | putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s" 112 | case reverse . lines $ out of 113 | (o : _) | Just raw <- A.decodeStrict' $ BS.pack o -> case raw of 114 | NvcheckerSuccess x -> pure x 115 | NvcheckerError err -> fail $ "Failed to run nvchecker: " <> T.unpack err 116 | _ -> fail $ "Failed to parse output from nvchecker: " <> out 117 | 118 | type BuildTOML = Writer [Text] () 119 | 120 | genNvConfig :: PackageKey -> NvcheckerOptions -> Maybe FilePath -> VersionSource -> BuildTOML 121 | genNvConfig pkg options mKeyfile versionSource = 122 | case mKeyfile of 123 | Just keyfile -> do 124 | table "__config__" $ 125 | "keyfile" =: T.pack keyfile 126 | _ -> pure () 127 | >> table 128 | (coerce pkg) 129 | ( do 130 | genVersionSource versionSource 131 | genOptions options 132 | ) 133 | where 134 | key =: x = tell [key <> " = " <> quote x] 135 | key =:? (Just x) = key =: x 136 | _ =:? _ = pure () 137 | table t m = tell ["[" <> quote t <> "]"] >> m >> tell [""] 138 | genVersionSource = \case 139 | GitHubRelease {..} -> do 140 | "source" =: "github" 141 | "github" =: (_owner <> "/" <> _repo) 142 | "use_latest_release" =: "true" 143 | GitHubTag {..} -> do 144 | "source" =: "github" 145 | "github" =: (_owner <> "/" <> _repo) 146 | "use_max_tag" =: "true" 147 | genListOptions _listOptions 148 | Git {..} -> do 149 | "source" =: "git" 150 | "git" =: _vurl 151 | "branch" =:? coerce _vbranch 152 | "use_commit" =: "true" 153 | Aur {..} -> do 154 | "source" =: "aur" 155 | "aur" =: _aur 156 | "strip_release" =: "true" 157 | ArchLinux {..} -> do 158 | "source" =: "archpkg" 159 | "archpkg" =: _archpkg 160 | "strip_release" =: "true" 161 | Pypi {..} -> do 162 | "source" =: "pypi" 163 | "pypi" =: _pypi 164 | Manual {..} -> do 165 | "source" =: "manual" 166 | "manual" =: _manual 167 | Repology {..} -> do 168 | "source" =: "repology" 169 | "repology" =: _repology 170 | "repo" =: _repo 171 | Webpage {..} -> do 172 | "source" =: "regex" 173 | "url" =: _vurl 174 | "regex" =: _regex 175 | genListOptions _listOptions 176 | HttpHeader {..} -> do 177 | "source" =: "httpheader" 178 | "url" =: _vurl 179 | "regex" =: _regex 180 | genListOptions _listOptions 181 | OpenVsx {..} -> do 182 | "source" =: "openvsx" 183 | "openvsx" =: (_ovPublisher <> "." <> _ovExtName) 184 | VscodeMarketplace {..} -> do 185 | "source" =: "vsmarketplace" 186 | "vsmarketplace" =: (_vsmPublisher <> "." <> _vsmExtName) 187 | Cmd {..} -> do 188 | "source" =: "cmd" 189 | "cmd" =: _vcmd 190 | Container {..} -> do 191 | "source" =: "container" 192 | "container" =: _vcontainer 193 | genListOptions _listOptions 194 | genListOptions ListOptions {..} = do 195 | "include_regex" =:? _includeRegex 196 | "exclude_regex" =:? _excludeRegex 197 | "sort_version_key" =:? fmap (T.pack . show) _sortVersionKey 198 | "ignored" =:? _ignored 199 | genOptions NvcheckerOptions {..} = do 200 | "prefix" =:? _stripPrefix 201 | "from_pattern" =:? _fromPattern 202 | "to_pattern" =:? _toPattern 203 | 204 | -- | Run nvchecker given 'PackageKey' 205 | -- Recording version changes and using stale version are available. 206 | checkVersion :: VersionSource -> NvcheckerOptions -> PackageKey -> Action NvcheckerResult 207 | checkVersion v o k = apply1 $ WithPackageKey (CheckVersion v o, k) 208 | 209 | -- | Run nvchecker without cache 210 | checkVersion' :: VersionSource -> NvcheckerOptions -> Action NvcheckerResult 211 | checkVersion' v o = askOracle $ CheckVersion v o 212 | -------------------------------------------------------------------------------- /src/NvFetcher/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | -- | Copyright: (c) 2021-2022 berberman 5 | -- SPDX-License-Identifier: MIT 6 | -- Maintainer: berberman 7 | -- Stability: experimental 8 | -- Portability: portable 9 | -- 10 | -- CLI interface of nvfetcher 11 | module NvFetcher.Options 12 | ( CLIOptions (..), 13 | Target (..), 14 | cliOptionsParser, 15 | getCLIOptions, 16 | ) 17 | where 18 | 19 | import Options.Applicative.Simple 20 | import qualified Paths_nvfetcher as Paths 21 | 22 | data Target = Build | Clean | Purge 23 | deriving (Eq) 24 | 25 | instance Show Target where 26 | show Build = "build" 27 | show Clean = "clean" 28 | show Purge = "purge" 29 | 30 | targetParser :: ReadM Target 31 | targetParser = maybeReader $ \case 32 | "build" -> Just Build 33 | "clean" -> Just Clean 34 | "purge" -> Just Purge 35 | _ -> Nothing 36 | 37 | -- | Options for nvfetcher CLI 38 | data CLIOptions = CLIOptions 39 | { optBuildDir :: FilePath, 40 | optCommit :: Bool, 41 | optCommitSummary :: Maybe String, 42 | optLogPath :: Maybe FilePath, 43 | optThreads :: Int, 44 | optRetry :: Int, 45 | optTiming :: Bool, 46 | optVerbose :: Bool, 47 | optPkgNameFilter :: Maybe String, 48 | optKeyfile :: Maybe FilePath, 49 | optKeepOldFiles :: Bool, 50 | optKeepGoing :: Bool, 51 | optTarget :: Target 52 | } 53 | deriving (Show) 54 | 55 | cliOptionsParser :: Parser CLIOptions 56 | cliOptionsParser = 57 | CLIOptions 58 | <$> strOption 59 | ( long "build-dir" 60 | <> short 'o' 61 | <> metavar "DIR" 62 | <> help "Directory that nvfetcher puts artifacts to" 63 | <> showDefault 64 | <> value "_sources" 65 | <> completer (bashCompleter "directory") 66 | ) 67 | <*> switch 68 | ( long "commit-changes" 69 | <> help "`git commit` build dir with version changes as commit message" 70 | ) 71 | <*> optional 72 | ( strOption 73 | ( long "commit-summary" 74 | <> metavar "SUMMARY" 75 | <> help "Summary to use when committing changes" 76 | ) 77 | ) 78 | <*> optional 79 | ( strOption 80 | ( long "changelog" 81 | <> short 'l' 82 | <> metavar "FILE" 83 | <> help "Dump version changes to a file" 84 | <> completer (bashCompleter "file") 85 | ) 86 | ) 87 | <*> option 88 | auto 89 | ( short 'j' 90 | <> metavar "NUM" 91 | <> help "Number of threads (0: detected number of processors)" 92 | <> value 0 93 | <> showDefault 94 | ) 95 | <*> option 96 | auto 97 | ( short 'r' 98 | <> long "retry" 99 | <> metavar "NUM" 100 | <> help "Times to retry of some rules (nvchecker, prefetch, nix-build, etc.)" 101 | <> value 3 102 | <> showDefault 103 | ) 104 | <*> switch (long "timing" <> short 't' <> help "Show build time") 105 | <*> switch (long "verbose" <> short 'v' <> help "Verbose mode") 106 | <*> optional 107 | ( strOption 108 | ( short 'f' 109 | <> long "filter" 110 | <> metavar "REGEX" 111 | <> help "Regex to filter packages to be updated" 112 | ) 113 | ) 114 | <*> optional 115 | ( strOption 116 | ( short 'k' 117 | <> long "keyfile" 118 | <> metavar "FILE" 119 | <> help "Nvchecker keyfile" 120 | <> completer (bashCompleter "file") 121 | ) 122 | ) 123 | <*> switch (long "keep-old" <> help "Don't remove old files other than generated json and nix before build") 124 | <*> switch (long "keep-going" <> help "Don't stop if some packages failed to be fetched") 125 | <*> argument 126 | targetParser 127 | ( metavar "TARGET" 128 | <> help "Three targets are available: 1.build 2.clean (remove all generated files) 3.purge (remove shake db)" 129 | <> value Build 130 | <> completer (listCompleter [show Build, show Clean, show Purge]) 131 | <> showDefault 132 | ) 133 | 134 | version :: String 135 | version = $(simpleVersion Paths.version) 136 | 137 | -- | Parse nvfetcher CLI options 138 | getCLIOptions :: Parser a -> IO a 139 | getCLIOptions parser = do 140 | (opts, ()) <- 141 | simpleOptions 142 | version 143 | "nvfetcher" 144 | "generate nix sources expr for the latest version of packages" 145 | parser 146 | empty 147 | pure opts 148 | -------------------------------------------------------------------------------- /src/NvFetcher/PackageSet.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE LambdaCase #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE RecordWildCards #-} 10 | {-# LANGUAGE ScopedTypeVariables #-} 11 | {-# LANGUAGE TypeFamilies #-} 12 | {-# LANGUAGE TypeOperators #-} 13 | {-# LANGUAGE UndecidableInstances #-} 14 | {-# LANGUAGE ViewPatterns #-} 15 | 16 | -- | Copyright: (c) 2021-2022 berberman 17 | -- SPDX-License-Identifier: MIT 18 | -- Maintainer: berberman 19 | -- Stability: experimental 20 | -- Portability: portable 21 | -- 22 | -- This module mainly contains two things: 'PackageSet' and 'PkgDSL'. 23 | -- NvFetcher accepts the former one -- a set of packages to produce nix sources expr; 24 | -- the later one is used to construct a single package. 25 | -- 26 | -- There are many combinators for defining packages. See the documentation of 'define' for example. 27 | module NvFetcher.PackageSet 28 | ( -- * Package set 29 | PackageSetF, 30 | PackageSet, 31 | newPackage, 32 | purePackageSet, 33 | runPackageSet, 34 | 35 | -- * Package DSL 36 | 37 | -- ** Primitives 38 | PkgDSL (..), 39 | define, 40 | package, 41 | src, 42 | fetch, 43 | 44 | -- ** Two-in-one functions 45 | fromGitHub, 46 | fromGitHub', 47 | fromGitHubTag, 48 | fromGitHubTag', 49 | fromPypi, 50 | fromOpenVsx, 51 | fromVscodeMarketplace, 52 | 53 | -- ** Version sources 54 | sourceGitHub, 55 | sourceGitHubTag, 56 | sourceGit, 57 | sourceGit', 58 | sourcePypi, 59 | sourceAur, 60 | sourceArchLinux, 61 | sourceManual, 62 | sourceRepology, 63 | sourceWebpage, 64 | sourceHttpHeader, 65 | sourceOpenVsx, 66 | sourceVscodeMarketplace, 67 | sourceCmd, 68 | 69 | -- ** Fetchers 70 | fetchGitHub, 71 | fetchGitHub', 72 | fetchGitHubRelease, 73 | fetchGitHubRelease', 74 | fetchPypi, 75 | fetchGit, 76 | fetchGit', 77 | fetchUrl, 78 | fetchUrl', 79 | fetchOpenVsx, 80 | fetchVscodeMarketplace, 81 | fetchTarball, 82 | 83 | -- * Addons 84 | extractSource, 85 | hasCargoLocks, 86 | tweakVersion, 87 | passthru, 88 | pinned, 89 | gitDateFormat, 90 | forceFetch, 91 | 92 | -- ** Miscellaneous 93 | Prod, 94 | Append, 95 | Member, 96 | OptionalMember, 97 | NotElem, 98 | Members, 99 | OptionalMembers, 100 | Attach, 101 | AttachMany, 102 | coerce, 103 | liftIO, 104 | 105 | -- * Lenses 106 | (&), 107 | (.~), 108 | (%~), 109 | (^.), 110 | (?~), 111 | module NvFetcher.Types.Lens, 112 | ) 113 | where 114 | 115 | import Control.Monad.Free 116 | import Control.Monad.IO.Class 117 | import Data.Coerce (coerce) 118 | import Data.Default (def) 119 | import qualified Data.HashMap.Strict as HMap 120 | import Data.Kind (Constraint, Type) 121 | import qualified Data.List.NonEmpty as NE 122 | import Data.Map.Strict as Map 123 | import Data.Maybe (fromMaybe, isJust) 124 | import Data.Text (Text) 125 | import GHC.TypeLits 126 | import Lens.Micro 127 | import NvFetcher.NixFetcher 128 | import NvFetcher.Types 129 | import NvFetcher.Types.Lens 130 | 131 | -------------------------------------------------------------------------------- 132 | 133 | -- | Atomic terms of package set 134 | data PackageSetF f 135 | = NewPackage !Package f 136 | | forall a. EmbedIO !(IO a) (a -> f) 137 | 138 | instance Functor PackageSetF where 139 | fmap f (NewPackage p g) = NewPackage p $ f g 140 | fmap f (EmbedIO action g) = EmbedIO action $ f <$> g 141 | 142 | -- | Package set is a monad equipped with two capabilities: 143 | -- 144 | -- 1. Carry defined packages 145 | -- 2. Run IO actions 146 | -- 147 | -- Package set is evaluated before shake runs. 148 | -- Use 'newPackage' to add a new package, 'liftIO' to run an IO action. 149 | type PackageSet = Free PackageSetF 150 | 151 | instance MonadIO PackageSet where 152 | liftIO io = liftF $ EmbedIO io id 153 | 154 | -- | Add a package to package set 155 | newPackage :: 156 | PackageName -> 157 | CheckVersion -> 158 | PackageFetcher -> 159 | Maybe PackageExtractSrc -> 160 | Maybe PackageCargoLockFiles -> 161 | PackagePassthru -> 162 | UseStaleVersion -> 163 | DateFormat -> 164 | ForceFetch -> 165 | PackageSet () 166 | newPackage name source fetcher extract cargo pasthru useStale format force = 167 | liftF $ NewPackage (Package name source fetcher extract cargo pasthru useStale format force) () 168 | 169 | -- | Add a list of packages into package set 170 | purePackageSet :: [Package] -> PackageSet () 171 | purePackageSet = mapM_ (liftF . flip NewPackage ()) 172 | 173 | -- | Run package set into a set of packages 174 | -- 175 | -- Throws exception as more then one packages with the same name 176 | -- are defined 177 | runPackageSet :: PackageSet () -> IO (Map PackageKey Package) 178 | runPackageSet = \case 179 | Free (NewPackage p g) -> 180 | runPackageSet g >>= \m -> 181 | if isJust (Map.lookup (PackageKey $ _pname p) m) 182 | then fail $ "Duplicate package name: " <> show (_pname p) 183 | else pure $ Map.insert (PackageKey $ _pname p) p m 184 | Free (EmbedIO action g) -> action >>= runPackageSet . g 185 | Pure _ -> pure mempty 186 | 187 | -------------------------------------------------------------------------------- 188 | 189 | -- | Simple HList 190 | data Prod (r :: [Type]) where 191 | Nil :: Prod '[] 192 | Cons :: !x -> Prod xs -> Prod (x ': xs) 193 | 194 | -- | Project elements from 'Prod' 195 | class Member (a :: Type) (r :: [Type]) where 196 | proj :: Prod r -> a 197 | 198 | instance {-# OVERLAPPING #-} (NotElem x xs) => Member x (x ': xs) where 199 | proj (Cons x _) = x 200 | 201 | instance (Member x xs) => Member x (_y ': xs) where 202 | proj (Cons _ r) = proj r 203 | 204 | instance (TypeError (ShowType x :<>: 'Text " is undefined")) => Member x '[] where 205 | proj = undefined 206 | 207 | -- | Project optional elements from 'Prod' 208 | class OptionalMember (a :: Type) (r :: [Type]) where 209 | projMaybe :: Prod r -> Maybe a 210 | 211 | instance {-# OVERLAPPING #-} (NotElem x xs) => OptionalMember x (x ': xs) where 212 | projMaybe (Cons x _) = Just x 213 | 214 | instance (OptionalMember x xs) => OptionalMember x (_y ': xs) where 215 | projMaybe (Cons _ r) = projMaybe r 216 | 217 | instance OptionalMember x '[] where 218 | projMaybe Nil = Nothing 219 | 220 | -- | Constraint for producing error messages 221 | type family NotElem (x :: Type) (xs :: [Type]) :: Constraint where 222 | NotElem x (x ': xs) = TypeError (ShowType x :<>: 'Text " is defined more than one times") 223 | NotElem x (_ ': xs) = NotElem x xs 224 | NotElem x '[] = () 225 | 226 | -- | A list of 'Member' 227 | type family Members xs r :: Constraint where 228 | Members '[] _ = () 229 | Members (x ': xs) r = (Member x r, Members xs r) 230 | 231 | -- | A list of 'OptionalMember' 232 | type family OptionalMembers xs r :: Constraint where 233 | OptionalMembers '[] _ = () 234 | OptionalMembers (x ': xs) r = (OptionalMember x r, OptionalMembers xs r) 235 | 236 | -- | @xs ++ ys@, at type level 237 | type family Append xs ys where 238 | Append '[] ys = ys 239 | Append (x ': xs) ys = x ': Append xs ys 240 | 241 | -- | Attach members @xs@, with a function argument @arg@ 242 | type AttachMany xs arg = forall r. PackageSet (Prod r) -> arg -> PackageSet (Prod (Append xs r)) 243 | 244 | -- | Attach member @x@, with a function @arg@ 245 | type Attach x arg = AttachMany '[x] arg 246 | 247 | -------------------------------------------------------------------------------- 248 | 249 | -- | A tagless final style DSL for constructing packages 250 | class PkgDSL f where 251 | new :: f PackageName -> f (Prod '[PackageName]) 252 | andThen :: f (Prod r) -> f a -> f (Prod (a ': r)) 253 | end :: 254 | ( Members 255 | '[ PackageName, 256 | VersionSource, 257 | PackageFetcher 258 | ] 259 | r, 260 | OptionalMembers 261 | '[ PackageExtractSrc, 262 | PackageCargoLockFiles, 263 | NvcheckerOptions, 264 | PackagePassthru, 265 | UseStaleVersion, 266 | DateFormat, 267 | ForceFetch 268 | ] 269 | r 270 | ) => 271 | f (Prod r) -> 272 | f () 273 | 274 | instance PkgDSL PackageSet where 275 | new e = do 276 | name <- e 277 | pure $ Cons name Nil 278 | andThen e e' = do 279 | p <- e 280 | x <- e' 281 | pure $ Cons x p 282 | end e = do 283 | p <- e 284 | newPackage 285 | (proj p) 286 | (CheckVersion (proj p) (fromMaybe def (projMaybe p))) 287 | (proj p) 288 | (projMaybe p) 289 | (projMaybe p) 290 | (fromMaybe mempty (projMaybe p)) 291 | (fromMaybe NoStale (projMaybe p)) 292 | (fromMaybe (DateFormat Nothing) (projMaybe p)) 293 | (fromMaybe NoForceFetch (projMaybe p)) 294 | 295 | -- | 'PkgDSL' version of 'newPackage' 296 | -- 297 | -- Example: 298 | -- 299 | -- @ 300 | -- define $ package "nvfetcher-git" `sourceGit` "https://github.com/berberman/nvfetcher" `fetchGitHub` ("berberman", "nvfetcher") 301 | -- @ 302 | define :: 303 | ( Members 304 | '[ PackageName, 305 | VersionSource, 306 | PackageFetcher 307 | ] 308 | r, 309 | OptionalMembers 310 | '[ PackageExtractSrc, 311 | PackageCargoLockFiles, 312 | PackagePassthru, 313 | NvcheckerOptions, 314 | UseStaleVersion, 315 | DateFormat, 316 | ForceFetch 317 | ] 318 | r 319 | ) => 320 | PackageSet (Prod r) -> 321 | PackageSet () 322 | define = end 323 | 324 | -- | Start chaining with the name of package to define 325 | package :: PackageName -> PackageSet (Prod '[PackageName]) 326 | package = new . pure 327 | 328 | -- | Attach version sources 329 | src :: Attach VersionSource VersionSource 330 | src = (. pure) . andThen 331 | 332 | -- | Attach fetchers 333 | fetch :: Attach PackageFetcher PackageFetcher 334 | fetch = (. pure) . andThen 335 | 336 | -------------------------------------------------------------------------------- 337 | 338 | -- | A synonym of 'fetchGitHub' and 'sourceGitHub' 339 | fromGitHub :: AttachMany '[PackageFetcher, VersionSource] (Text, Text) 340 | fromGitHub e (owner, repo) = fromGitHub' e (owner, repo, id) 341 | 342 | -- | A synonym of 'fetchGitHub'' and 'sourceGitHub' 343 | fromGitHub' :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, NixFetcher Fresh -> NixFetcher Fresh) 344 | fromGitHub' e p@(owner, repo, _) = fetchGitHub' (sourceGitHub e (owner, repo)) p 345 | 346 | -- | A synonym of 'fetchGitHub' and 'sourceGitHubTag' 347 | fromGitHubTag :: AttachMany '[PackageFetcher, VersionSource] (Text, Text, ListOptions -> ListOptions) 348 | fromGitHubTag e (owner, repo, f) = fromGitHubTag' e (owner, repo, f, id) 349 | 350 | -- | A synonym of 'fetchGitHub'' and 'sourceGitHubTag' 351 | fromGitHubTag' :: 352 | AttachMany 353 | '[PackageFetcher, VersionSource] 354 | (Text, Text, ListOptions -> ListOptions, NixFetcher Fresh -> NixFetcher Fresh) 355 | fromGitHubTag' e (owner, repo, fv, ff) = fetchGitHub' (sourceGitHubTag e (owner, repo, fv)) (owner, repo, ff) 356 | 357 | -- | A synonym of 'fetchPypi' and 'sourcePypi' 358 | fromPypi :: AttachMany '[PackageFetcher, VersionSource] Text 359 | fromPypi e p = fetchPypi (sourcePypi e p) p 360 | 361 | -- | A synonym of 'fetchOpenVsx', 'sourceOpenVsx', and 'passthru' extension's publisher with name 362 | fromOpenVsx :: AttachMany '[PackagePassthru, PackageFetcher, VersionSource] (Text, Text) 363 | fromOpenVsx e x@(publisher, extName) = 364 | passthru 365 | (fetchOpenVsx (sourceOpenVsx e x) x) 366 | [ ("name", extName), 367 | ("publisher", publisher) 368 | ] 369 | 370 | -- | A synonym of 'fetchVscodeMarketplace', 'sourceVscodeMarketplace', and 'passthru' extension's publisher with name 371 | fromVscodeMarketplace :: AttachMany '[PackagePassthru, PackageFetcher, VersionSource] (Text, Text) 372 | fromVscodeMarketplace e x@(publisher, extName) = 373 | passthru 374 | (fetchVscodeMarketplace (sourceVscodeMarketplace e x) x) 375 | [ ("name", extName), 376 | ("publisher", publisher) 377 | ] 378 | 379 | -------------------------------------------------------------------------------- 380 | 381 | -- | This package follows the latest github release 382 | sourceGitHub :: Attach VersionSource (Text, Text) 383 | sourceGitHub e (owner, repo) = src e $ GitHubRelease owner repo 384 | 385 | -- | This package follows the a tag from github 386 | -- 387 | -- Args are owner, repo, and nvchecker list options to find the target tag 388 | sourceGitHubTag :: Attach VersionSource (Text, Text, ListOptions -> ListOptions) 389 | sourceGitHubTag e (owner, repo, f) = src e $ GitHubTag owner repo $ f def 390 | 391 | -- | This package follows the latest git commit 392 | -- 393 | -- Arg is git url 394 | sourceGit :: Attach VersionSource Text 395 | sourceGit e _vurl = src e $ Git _vurl def 396 | 397 | -- | Similar to 'sourceGit', but allows to specify branch 398 | -- 399 | -- Args are git url and branch 400 | sourceGit' :: Attach VersionSource (Text, Text) 401 | sourceGit' e (_vurl, coerce . Just -> _vbranch) = src e $ Git {..} 402 | 403 | -- | This package follows the latest pypi release 404 | -- 405 | -- Arg is pypi name 406 | sourcePypi :: Attach VersionSource Text 407 | sourcePypi e _pypi = src e Pypi {..} 408 | 409 | -- | This package follows the version of an Arch Linux package 410 | -- 411 | -- Arg is package name in Arch Linux repo 412 | sourceArchLinux :: Attach VersionSource Text 413 | sourceArchLinux e _archpkg = src e ArchLinux {..} 414 | 415 | -- | This package follows the version of an Aur package 416 | -- 417 | -- Arg is package name in Aur 418 | sourceAur :: Attach VersionSource Text 419 | sourceAur e _aur = src e Aur {..} 420 | 421 | -- | This package follows a pinned version 422 | -- 423 | -- Arg is manual version 424 | sourceManual :: Attach VersionSource Text 425 | sourceManual e _manual = src e Manual {..} 426 | 427 | -- | This package follows the version of a repology package 428 | -- 429 | -- Args are repology project name and repo 430 | sourceRepology :: Attach VersionSource (Text, Text) 431 | sourceRepology e (project, repo) = src e $ Repology project repo 432 | 433 | -- | This package follows a version extracted from web page 434 | -- 435 | -- Args are web page url, regex, and list options 436 | sourceWebpage :: Attach VersionSource (Text, Text, ListOptions -> ListOptions) 437 | sourceWebpage e (_vurl, _regex, f) = src e $ Webpage _vurl _regex $ f def 438 | 439 | -- | This package follows a version extracted from http header 440 | -- 441 | -- Args are the url of the http request, regex, and list options 442 | sourceHttpHeader :: Attach VersionSource (Text, Text, ListOptions -> ListOptions) 443 | sourceHttpHeader e (_vurl, _regex, f) = src e $ HttpHeader _vurl _regex $ f def 444 | 445 | -- | This package follows a version in Open VSX 446 | -- 447 | -- Args are publisher and extension name 448 | sourceOpenVsx :: Attach VersionSource (Text, Text) 449 | sourceOpenVsx e (_ovPublisher, _ovExtName) = src e OpenVsx {..} 450 | 451 | -- | This package follows a version in Vscode Marketplace 452 | -- 453 | -- Args are publisher and extension name 454 | sourceVscodeMarketplace :: Attach VersionSource (Text, Text) 455 | sourceVscodeMarketplace e (_vsmPublisher, _vsmExtName) = src e VscodeMarketplace {..} 456 | 457 | -- | This package follows a version from a shell command 458 | -- 459 | -- Arg is the command to run 460 | sourceCmd :: Attach VersionSource Text 461 | sourceCmd e _vcmd = src e Cmd {..} 462 | 463 | -------------------------------------------------------------------------------- 464 | 465 | -- | This package is fetched from a github repo 466 | -- 467 | -- Args are owner and repo 468 | fetchGitHub :: Attach PackageFetcher (Text, Text) 469 | fetchGitHub e (owner, repo) = fetchGitHub' e (owner, repo, id) 470 | 471 | -- | This package is fetched from a github repo 472 | -- 473 | -- Similar to 'fetchGitHub', but allows a modifier to the fetcher. 474 | -- For example, you can enable fetch submodules like: 475 | -- 476 | -- @ 477 | -- define $ package "qliveplayer" `sourceGitHub` ("THMonster", "QLivePlayer") `fetchGitHub'` ("THMonster", "QLivePlayer", fetchSubmodules .~ True) 478 | -- @ 479 | fetchGitHub' :: Attach PackageFetcher (Text, Text, NixFetcher Fresh -> NixFetcher Fresh) 480 | fetchGitHub' e (owner, repo, f) = fetch e $ f . gitHubFetcher (owner, repo) 481 | 482 | -- | This package is fetched from a file in github release 483 | -- 484 | -- Args are owner, repo, and file name 485 | fetchGitHubRelease :: Attach PackageFetcher (Text, Text, Text) 486 | fetchGitHubRelease e (owner, repo, fp) = fetch e $ gitHubReleaseFetcher (owner, repo) fp 487 | 488 | -- | This package is fetched from a file in github release 489 | -- 490 | -- Args are owner, repo, and file name computed from version 491 | fetchGitHubRelease' :: Attach PackageFetcher (Text, Text, Version -> Text) 492 | fetchGitHubRelease' e (owner, repo, f) = fetch e $ gitHubReleaseFetcher' (owner, repo) f 493 | 494 | -- | This package is fetched from pypi 495 | -- 496 | -- Arg is pypi name 497 | fetchPypi :: Attach PackageFetcher Text 498 | fetchPypi e = fetch e . pypiFetcher 499 | 500 | -- | This package is fetched from git 501 | -- 502 | -- Arg is git url 503 | fetchGit :: Attach PackageFetcher Text 504 | fetchGit e u = fetchGit' e (u, id) 505 | 506 | -- | This package is fetched from git 507 | -- 508 | -- Similar to 'fetchGit', but allows a modifier to the fetcher. 509 | -- See 'fetchGitHub'' for a concret example. 510 | fetchGit' :: Attach PackageFetcher (Text, NixFetcher Fresh -> NixFetcher Fresh) 511 | fetchGit' e (u, f) = fetch e $ f . gitFetcher u 512 | 513 | -- | This package is fetched from url 514 | -- 515 | -- Arg is a function which constructs the url from a version 516 | fetchUrl :: Attach PackageFetcher (Version -> Text) 517 | fetchUrl e f = fetch e (urlFetcher . f) 518 | 519 | -- | This package is fetched from url 520 | -- 521 | -- Args are a function which constructs the url from a version and a file name 522 | fetchUrl' :: Attach PackageFetcher (Text, Version -> Text) 523 | fetchUrl' e (name, f) = fetch e (\v -> FetchUrl (f v) (Just name) ()) 524 | 525 | -- | This package is fetched from Open VSX 526 | -- 527 | -- Args are publisher and extension name 528 | fetchOpenVsx :: Attach PackageFetcher (Text, Text) 529 | fetchOpenVsx e = fetch e . vscodeMarketplaceFetcher 530 | 531 | -- | This package is fetched from Vscode Marketplace 532 | -- 533 | -- Args are publisher and extension name 534 | fetchVscodeMarketplace :: Attach PackageFetcher (Text, Text) 535 | fetchVscodeMarketplace e = fetch e . vscodeMarketplaceFetcher 536 | 537 | -- | This package is a tarball, fetched from url 538 | -- 539 | -- Arg is a function which constructs the url from a version 540 | fetchTarball :: Attach PackageFetcher (Version -> Text) 541 | fetchTarball e f = fetch e (tarballFetcher . f) 542 | 543 | -------------------------------------------------------------------------------- 544 | 545 | -- | Extract files from fetched package source 546 | extractSource :: Attach PackageExtractSrc [FilePath] 547 | extractSource = (. pure . PackageExtractSrc . NE.fromList) . andThen 548 | 549 | -- | Run 'FetchRustGitDependencies' given the path to @Cargo.lock@ files 550 | -- 551 | -- The lock files will be extracted as well. 552 | hasCargoLocks :: Attach PackageCargoLockFiles [FilePath] 553 | hasCargoLocks = (. pure . PackageCargoLockFiles . NE.fromList) . andThen 554 | 555 | -- | Set 'NvcheckerOptions' for a package, which can tweak the version number we obtain 556 | tweakVersion :: Attach NvcheckerOptions (NvcheckerOptions -> NvcheckerOptions) 557 | tweakVersion = (. pure . ($ def)) . andThen 558 | 559 | -- | An attrs set to pass through 560 | -- 561 | -- Arg is a list of kv pairs 562 | passthru :: Attach PackagePassthru [(Text, Text)] 563 | passthru = (. pure . PackagePassthru . HMap.fromList) . andThen 564 | 565 | -- | Pin a package 566 | -- 567 | -- new version won't be checked if we have a stale version 568 | pinned :: PackageSet (Prod r) -> PackageSet (Prod (UseStaleVersion : r)) 569 | pinned = flip andThen . pure $ PermanentStale 570 | 571 | -- | Specify the date format for getting git commit date 572 | -- 573 | -- Available only for git version source 574 | gitDateFormat :: Attach DateFormat (Maybe Text) 575 | gitDateFormat = (. pure . DateFormat) . andThen 576 | 577 | -- | Set always fetching regardless of the version changing 578 | forceFetch :: PackageSet (Prod r) -> PackageSet (Prod (ForceFetch : r)) 579 | forceFetch = flip andThen . pure $ ForceFetch 580 | -------------------------------------------------------------------------------- /src/NvFetcher/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DeriveAnyClass #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | {-# LANGUAGE DerivingStrategies #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE FlexibleInstances #-} 8 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 9 | {-# LANGUAGE LambdaCase #-} 10 | {-# LANGUAGE MultiParamTypeClasses #-} 11 | {-# LANGUAGE OverloadedStrings #-} 12 | {-# LANGUAGE RecordWildCards #-} 13 | {-# LANGUAGE StandaloneDeriving #-} 14 | {-# LANGUAGE TypeFamilies #-} 15 | {-# LANGUAGE TypeOperators #-} 16 | {-# LANGUAGE UndecidableInstances #-} 17 | {-# LANGUAGE UndecidableSuperClasses #-} 18 | 19 | -- | Copyright: (c) 2021-2022 berberman 20 | -- SPDX-License-Identifier: MIT 21 | -- Maintainer: berberman 22 | -- Stability: experimental 23 | -- Portability: portable 24 | -- 25 | -- Types used in this program. 26 | module NvFetcher.Types 27 | ( -- * Common types 28 | Version (..), 29 | Checksum (..), 30 | ContainerDigest (..), 31 | Branch (..), 32 | NixExpr, 33 | VersionChange (..), 34 | WithPackageKey (..), 35 | 36 | -- * Nvchecker types 37 | VersionSortMethod (..), 38 | ListOptions (..), 39 | VersionSource (..), 40 | NvcheckerResult (..), 41 | NvcheckerRaw (..), 42 | CheckVersion (..), 43 | NvcheckerOptions (..), 44 | UseStaleVersion (..), 45 | 46 | -- * Nix fetcher types 47 | RunFetch (..), 48 | ForceFetch (..), 49 | NixFetcher (..), 50 | FetchResult, 51 | FetchStatus (..), 52 | 53 | -- * ExtractSrc Types 54 | ExtractSrcQ (..), 55 | 56 | -- * FetchRustGitDeps types 57 | FetchRustGitDepsQ (..), 58 | 59 | -- * GetGitCommitDate types 60 | DateFormat (..), 61 | GetGitCommitDate (..), 62 | 63 | -- * Core types 64 | Core (..), 65 | 66 | -- * Package types 67 | PackageName, 68 | PackageFetcher, 69 | PackageExtractSrc (..), 70 | PackageCargoLockFiles (..), 71 | PackagePassthru (..), 72 | Package (..), 73 | PackageKey (..), 74 | PackageResult (..), 75 | ) 76 | where 77 | 78 | import qualified Data.Aeson as A 79 | import Data.Coerce (coerce) 80 | import Data.Default 81 | import Data.HashMap.Strict (HashMap) 82 | import qualified Data.List.NonEmpty as NE 83 | import Data.Maybe (fromMaybe, isNothing) 84 | import Data.String (IsString) 85 | import Data.Text (Text) 86 | import qualified Data.Text as T 87 | import Development.Shake 88 | import Development.Shake.Classes 89 | import GHC.Generics (Generic) 90 | import Prettyprinter 91 | 92 | -------------------------------------------------------------------------------- 93 | 94 | -- | Package version 95 | newtype Version = Version Text 96 | deriving newtype (Eq, Show, Ord, IsString, Semigroup, Monoid, A.FromJSON, A.ToJSON, Pretty) 97 | deriving stock (Typeable, Generic) 98 | deriving anyclass (Hashable, Binary, NFData) 99 | 100 | -- | Check sum, sha256, sri or base32, etc. 101 | newtype Checksum = Checksum Text 102 | deriving newtype (Show, Eq, Ord, A.FromJSON, A.ToJSON, Pretty) 103 | deriving stock (Typeable, Generic) 104 | deriving anyclass (Hashable, Binary, NFData) 105 | 106 | -- | Digest of a (Docker) container 107 | newtype ContainerDigest = ContainerDigest Text 108 | deriving newtype (Show, Eq, Ord, A.FromJSON, A.ToJSON, Pretty) 109 | deriving stock (Typeable, Generic) 110 | deriving anyclass (Hashable, Binary, NFData) 111 | 112 | -- | Git branch ('Nothing': master) 113 | newtype Branch = Branch (Maybe Text) 114 | deriving newtype (Show, Eq, Ord, Default, Pretty) 115 | deriving stock (Typeable, Generic) 116 | deriving anyclass (Hashable, Binary, NFData) 117 | 118 | -- | Version change of a package 119 | -- 120 | -- >>> VersionChange "foo" Nothing "2.3.3" 121 | -- foo: ∅ → 2.3.3 122 | -- 123 | -- >>> VersionChange "bar" (Just "2.2.2") "2.3.3" 124 | -- bar: 2.2.2 → 2.3.3 125 | data VersionChange = VersionChange 126 | { vcName :: PackageName, 127 | vcOld :: Maybe Version, 128 | vcNew :: Version 129 | } 130 | deriving (Eq) 131 | 132 | instance Show VersionChange where 133 | show VersionChange {..} = 134 | T.unpack $ vcName <> ": " <> fromMaybe "∅" (coerce vcOld) <> " → " <> coerce vcNew 135 | 136 | -- | Nix expression 137 | type NixExpr = Text 138 | 139 | -------------------------------------------------------------------------------- 140 | 141 | data VersionSortMethod = ParseVersion | Vercmp 142 | deriving (Typeable, Eq, Ord, Enum, Generic, Hashable, Binary, NFData) 143 | 144 | instance Show VersionSortMethod where 145 | show = \case 146 | ParseVersion -> "parse_version" 147 | Vercmp -> "vercmp" 148 | 149 | instance Pretty VersionSortMethod where 150 | pretty ParseVersion = "ParseVersion" 151 | pretty Vercmp = "Vercmp" 152 | 153 | instance Default VersionSortMethod where 154 | def = ParseVersion 155 | 156 | -- | Filter-like configuration for some version sources. 157 | -- See for details. 158 | data ListOptions = ListOptions 159 | { _includeRegex :: Maybe Text, 160 | _excludeRegex :: Maybe Text, 161 | _sortVersionKey :: Maybe VersionSortMethod, 162 | _ignored :: Maybe Text 163 | } 164 | deriving (Show, Typeable, Eq, Ord, Generic, Hashable, Binary, NFData, Default) 165 | 166 | isEmptyListOptions :: ListOptions -> Bool 167 | isEmptyListOptions ListOptions {..} = 168 | isNothing _includeRegex 169 | && isNothing _excludeRegex 170 | && isNothing _sortVersionKey 171 | && isNothing _includeRegex 172 | 173 | instance Pretty ListOptions where 174 | pretty ListOptions {..} = 175 | "ListOptions" 176 | <> indent 177 | 2 178 | ( vsep $ 179 | concat 180 | [ ppField "includeRegex" _includeRegex, 181 | ppField "excludeRegex" _excludeRegex, 182 | ppField "sortVersionKey" _sortVersionKey, 183 | ppField "ignored" _includeRegex 184 | ] 185 | ) 186 | 187 | -- | Configuration available for evey version sourece. 188 | -- See for details. 189 | data NvcheckerOptions = NvcheckerOptions 190 | { _stripPrefix :: Maybe Text, 191 | _fromPattern :: Maybe Text, 192 | _toPattern :: Maybe Text 193 | } 194 | deriving (Show, Typeable, Eq, Ord, Generic, Hashable, Binary, NFData, Default) 195 | 196 | isEmptyNvcheckerOptions :: NvcheckerOptions -> Bool 197 | isEmptyNvcheckerOptions NvcheckerOptions {..} = 198 | isNothing _stripPrefix 199 | && isNothing _fromPattern 200 | && isNothing _toPattern 201 | 202 | instance Pretty NvcheckerOptions where 203 | pretty NvcheckerOptions {..} = 204 | "NvcheckerOptions" 205 | <> line 206 | <> indent 207 | 2 208 | ( vsep $ 209 | concat 210 | [ ppField "stripPrefix" _stripPrefix, 211 | ppField "fromPattern" _fromPattern, 212 | ppField "toPattern" _toPattern 213 | ] 214 | ) 215 | 216 | ppField :: Pretty a => Doc ann -> Maybe a -> [Doc ann] 217 | ppField _ Nothing = [] 218 | ppField s (Just x) = [s <> colon <+> pretty x] 219 | 220 | -- | Upstream version source for nvchecker to check 221 | data VersionSource 222 | = GitHubRelease {_owner :: Text, _repo :: Text} 223 | | GitHubTag {_owner :: Text, _repo :: Text, _listOptions :: ListOptions} 224 | | Git {_vurl :: Text, _vbranch :: Branch} 225 | | Pypi {_pypi :: Text} 226 | | ArchLinux {_archpkg :: Text} 227 | | Aur {_aur :: Text} 228 | | Manual {_manual :: Text} 229 | | Repology {_repology :: Text, _repo :: Text} 230 | | Webpage {_vurl :: Text, _regex :: Text, _listOptions :: ListOptions} 231 | | HttpHeader {_vurl :: Text, _regex :: Text, _listOptions :: ListOptions} 232 | | OpenVsx {_ovPublisher :: Text, _ovExtName :: Text} 233 | | VscodeMarketplace {_vsmPublisher :: Text, _vsmExtName :: Text} 234 | | Cmd {_vcmd :: Text} 235 | | Container {_vcontainer :: Text, _listOptions :: ListOptions} 236 | deriving (Show, Typeable, Eq, Ord, Generic, Hashable, Binary, NFData) 237 | 238 | instance Pretty VersionSource where 239 | pretty GitHubRelease {..} = 240 | "CheckGitHubRelease" 241 | <> line 242 | <> indent 243 | 2 244 | ( vsep 245 | [ "owner" <> colon <+> pretty _owner, 246 | "repo" <> colon <+> pretty _repo 247 | ] 248 | ) 249 | pretty GitHubTag {..} = 250 | "CheckGitHubTag" 251 | <> line 252 | <> indent 253 | 2 254 | ( vsep $ 255 | [ "owner" <> colon <+> pretty _owner, 256 | "repo" <> colon <+> pretty _repo 257 | ] 258 | <> ["listOptions" <> colon <+> pretty _listOptions | not $ isEmptyListOptions _listOptions] 259 | ) 260 | pretty Git {..} = 261 | "CheckGit" 262 | <> line 263 | <> indent 264 | 2 265 | ( vsep 266 | [ "url" <> colon <+> pretty _vurl, 267 | "branch" <> colon <+> pretty _vbranch 268 | ] 269 | ) 270 | pretty Pypi {..} = 271 | "CheckPypi" <> colon <+> pretty _pypi 272 | pretty ArchLinux {..} = 273 | "CheckArchLinux" <> colon <+> pretty _archpkg 274 | pretty Aur {..} = 275 | "CheckAur" <> colon <+> pretty _aur 276 | pretty Manual {..} = 277 | "CheckManual" <> colon <+> pretty _manual 278 | pretty Repology {..} = 279 | "CheckRepology" 280 | <> line 281 | <> indent 282 | 2 283 | ( vsep 284 | [ "repology" <> colon <+> pretty _repology, 285 | "repo" <> colon <+> pretty _repo 286 | ] 287 | ) 288 | pretty Webpage {..} = 289 | "CheckWebpage" 290 | <> line 291 | <> indent 292 | 2 293 | ( vsep $ 294 | [ "url" <> colon <+> pretty _vurl, 295 | "regex" <> colon <+> pretty _regex 296 | ] 297 | <> ["listOptions" <> colon <+> pretty _listOptions | not $ isEmptyListOptions _listOptions] 298 | ) 299 | pretty HttpHeader {..} = 300 | "CheckHttpHeader" 301 | <> line 302 | <> indent 303 | 2 304 | ( vsep $ 305 | [ "url" <> colon <+> pretty _vurl, 306 | "regex" <> colon <+> pretty _regex 307 | ] 308 | <> ["listOptions" <> colon <+> pretty _listOptions | not $ isEmptyListOptions _listOptions] 309 | ) 310 | pretty OpenVsx {..} = 311 | "CheckOpenVsx" 312 | <> line 313 | <> indent 314 | 2 315 | ( vsep 316 | [ "publisher" <> colon <+> pretty _ovPublisher, 317 | "extName" <> colon <+> pretty _ovExtName 318 | ] 319 | ) 320 | pretty VscodeMarketplace {..} = 321 | "CheckVscodeMarketplace" 322 | <> line 323 | <> indent 324 | 2 325 | ( vsep 326 | [ "publisher" <> colon <+> pretty _vsmPublisher, 327 | "extName" <> colon <+> pretty _vsmExtName 328 | ] 329 | ) 330 | pretty Cmd {..} = 331 | "CheckCmd" <> colon <+> pretty _vcmd 332 | pretty Container {..} = 333 | "CheckContainer" <> colon <+> pretty _vcontainer 334 | 335 | -- | The input of nvchecker 336 | data CheckVersion = CheckVersion VersionSource NvcheckerOptions 337 | deriving (Show, Typeable, Eq, Ord, Generic, Hashable, Binary, NFData) 338 | 339 | instance Pretty CheckVersion where 340 | pretty (CheckVersion v n) = align (vsep $ [pretty v] <> [pretty n | not $ isEmptyNvcheckerOptions n]) 341 | 342 | -- | The result of nvchecker rule 343 | data NvcheckerResult = NvcheckerResult 344 | { nvNow :: Version, 345 | -- | last result of this nvchecker rule 346 | -- TODO: consider removing this field 347 | nvOld :: Maybe Version, 348 | -- | stale means even 'nvNow' comes from json file (last run) 349 | -- and we actually didn't run nvchecker this time. 'nvOld' will be 'Nothing' in this case. 350 | nvStale :: Bool 351 | } 352 | deriving (Show, Typeable, Eq, Generic, Hashable, Binary, NFData) 353 | 354 | -- | Parsed JSON output from nvchecker 355 | data NvcheckerRaw = NvcheckerSuccess Version | NvcheckerError Text 356 | deriving (Show, Typeable, Eq, Generic) 357 | 358 | instance A.FromJSON NvcheckerRaw where 359 | parseJSON = A.withObject "NvcheckerRaw" $ \o -> do 360 | mVersion <- o A..:? "version" 361 | case mVersion of 362 | Just version -> pure $ NvcheckerSuccess version 363 | _ -> NvcheckerError <$> o A..: "error" 364 | 365 | type instance RuleResult CheckVersion = NvcheckerResult 366 | 367 | -------------------------------------------------------------------------------- 368 | 369 | -- | Whether to cache the fetched sha256 370 | -- 371 | -- @ForceFetch@ indicates @alwaysRerun@ the fetcher rule 372 | data ForceFetch = ForceFetch | NoForceFetch 373 | deriving (Show, Eq, Ord, Hashable, NFData, Binary, Typeable, Generic) 374 | 375 | instance Pretty ForceFetch where 376 | pretty ForceFetch = "ForceFetch" 377 | pretty NoForceFetch = "NoForceFetch" 378 | 379 | instance Default ForceFetch where 380 | def = NoForceFetch 381 | 382 | -- | The input of prefetch rule 383 | data RunFetch = RunFetch ForceFetch (NixFetcher Fresh) 384 | deriving (Show, Eq, Ord, Hashable, NFData, Binary, Typeable, Generic) 385 | 386 | -- Prefetch rule never throws exceptions 387 | type instance RuleResult RunFetch = Maybe (NixFetcher Fetched) 388 | 389 | -- | If the package is prefetched, then we can obtain the SHA256 390 | data NixFetcher (k :: FetchStatus) 391 | = FetchGit 392 | { _furl :: Text, 393 | _rev :: Version, 394 | _deepClone :: Bool, 395 | _fetchSubmodules :: Bool, 396 | _leaveDotGit :: Bool, 397 | _sparseCheckout :: [Text], 398 | _name :: Maybe Text, 399 | _sha256 :: FetchResult Checksum k 400 | } 401 | | FetchGitHub 402 | { _fowner :: Text, 403 | _frepo :: Text, 404 | _rev :: Version, 405 | _deepClone :: Bool, 406 | _fetchSubmodules :: Bool, 407 | _leaveDotGit :: Bool, 408 | _sparseCheckout :: [Text], 409 | _name :: Maybe Text, 410 | _sha256 :: FetchResult Checksum k 411 | } 412 | | FetchUrl 413 | { _furl :: Text, 414 | _name :: Maybe Text, 415 | _sha256 :: FetchResult Checksum k 416 | } 417 | | FetchTarball 418 | { _furl :: Text, 419 | _sha256 :: FetchResult Checksum k 420 | } 421 | | FetchDocker 422 | { _imageName :: Text, 423 | _imageTag :: Text, 424 | _imageDigest :: FetchResult ContainerDigest k, 425 | _sha256 :: FetchResult Checksum k, 426 | _fos :: Maybe Text, 427 | _farch :: Maybe Text, 428 | _finalImageName :: Maybe Text, 429 | _finalImageTag :: Maybe Text, 430 | _tlsVerify :: Maybe Bool 431 | } 432 | deriving (Typeable, Generic) 433 | 434 | class (c (FetchResult Checksum k), c (FetchResult ContainerDigest k)) => ForFetchResult c k 435 | 436 | instance (c (FetchResult Checksum k), c (FetchResult ContainerDigest k)) => ForFetchResult c k 437 | 438 | deriving instance Show `ForFetchResult` k => Show (NixFetcher k) 439 | 440 | deriving instance Eq `ForFetchResult` k => Eq (NixFetcher k) 441 | 442 | deriving instance Ord `ForFetchResult` k => Ord (NixFetcher k) 443 | 444 | deriving instance Hashable `ForFetchResult` k => Hashable (NixFetcher k) 445 | 446 | deriving instance Binary `ForFetchResult` k => Binary (NixFetcher k) 447 | 448 | deriving instance NFData `ForFetchResult` k => NFData (NixFetcher k) 449 | 450 | -- | Fetch status 451 | data FetchStatus = Fresh | Fetched 452 | 453 | -- | Prefetched fetchers hold hashes 454 | type family FetchResult a (k :: FetchStatus) where 455 | FetchResult _ Fresh = () 456 | FetchResult a Fetched = a 457 | 458 | instance A.ToJSON (NixFetcher Fetched) where 459 | toJSON FetchGit {..} = 460 | A.object 461 | [ "url" A..= _furl, 462 | "rev" A..= _rev, 463 | "deepClone" A..= _deepClone, 464 | "fetchSubmodules" A..= _fetchSubmodules, 465 | "leaveDotGit" A..= _leaveDotGit, 466 | "sparseCheckout" A..= _sparseCheckout, 467 | "name" A..= _name, 468 | "sha256" A..= _sha256, 469 | "type" A..= A.String "git" 470 | ] 471 | toJSON FetchGitHub {..} = 472 | A.object 473 | [ "owner" A..= _fowner, 474 | "repo" A..= _frepo, 475 | "rev" A..= _rev, 476 | "deepClone" A..= _deepClone, 477 | "fetchSubmodules" A..= _fetchSubmodules, 478 | "leaveDotGit" A..= _leaveDotGit, 479 | "sparseCheckout" A..= _sparseCheckout, 480 | "name" A..= _name, 481 | "sha256" A..= _sha256, 482 | "type" A..= A.String "github" 483 | ] 484 | toJSON FetchUrl {..} = 485 | A.object 486 | [ "url" A..= _furl, 487 | "name" A..= _name, 488 | "sha256" A..= _sha256, 489 | "type" A..= A.String "url" 490 | ] 491 | toJSON FetchTarball {..} = 492 | A.object 493 | [ "url" A..= _furl, 494 | "sha256" A..= _sha256, 495 | "type" A..= A.String "tarball" 496 | ] 497 | toJSON FetchDocker {..} = 498 | A.object 499 | [ "imageName" A..= _imageName, 500 | "imageTag" A..= _imageTag, 501 | "imageDigest" A..= _imageDigest, 502 | "sha256" A..= _sha256, 503 | "os" A..= _fos, 504 | "arch" A..= _farch, 505 | "finalImageName" A..= _finalImageName, 506 | "finalImageTag" A..= _finalImageTag, 507 | "tlsVerify" A..= _tlsVerify 508 | ] 509 | 510 | instance Pretty (NixFetcher k) where 511 | pretty FetchGit {..} = 512 | "FetchGit" 513 | <> line 514 | <> indent 515 | 2 516 | ( vsep $ 517 | [ "url" <> colon <+> pretty _furl, 518 | "rev" <> colon <+> pretty _rev, 519 | "deepClone" <> colon <+> pretty _deepClone, 520 | "fetchSubmodules" <> colon <+> pretty _fetchSubmodules, 521 | "leaveDotGit" <> colon <+> pretty _leaveDotGit, 522 | "sparseCheckout" <> colon <+> pretty _sparseCheckout 523 | ] 524 | <> ppField "name" _name 525 | ) 526 | pretty FetchGitHub {..} = 527 | "FetchGitHub" 528 | <> line 529 | <> indent 530 | 2 531 | ( vsep $ 532 | [ "owner" <> colon <+> pretty _fowner, 533 | "repo" <> colon <+> pretty _frepo, 534 | "rev" <> colon <+> pretty _rev, 535 | "deepClone" <> colon <+> pretty _deepClone, 536 | "fetchSubmodules" <> colon <+> pretty _fetchSubmodules, 537 | "leaveDotGit" <> colon <+> pretty _leaveDotGit, 538 | "sparseCheckout" <> colon <+> pretty _sparseCheckout 539 | ] 540 | <> ppField "name" _name 541 | ) 542 | pretty FetchUrl {..} = 543 | "FetchUrl" 544 | <> line 545 | <> indent 546 | 2 547 | ( vsep $ 548 | ["url" <> colon <+> pretty _furl] 549 | <> ppField "name" _name 550 | ) 551 | pretty FetchTarball {..} = 552 | "FetchTarball" <> colon <+> pretty _furl 553 | pretty FetchDocker {..} = 554 | "FetchDocker" 555 | <> line 556 | <> indent 557 | 2 558 | ( vsep $ 559 | [ "imageName" <> colon <+> pretty _imageName, 560 | "imageTag" <> colon <+> pretty _finalImageTag 561 | ] 562 | <> ppField "os" _fos 563 | <> ppField "arch" _farch 564 | <> ppField "finalImageName" _finalImageName 565 | <> ppField "finalImageTag" _finalImageTag 566 | <> ppField "tlsVerify" _tlsVerify 567 | ) 568 | 569 | -------------------------------------------------------------------------------- 570 | 571 | -- | Extract file contents from package source 572 | -- e.g. @Cargo.lock@ 573 | data ExtractSrcQ = ExtractSrcQ (NixFetcher Fetched) (NE.NonEmpty FilePath) 574 | deriving (Show, Eq, Ord, Hashable, NFData, Binary, Typeable, Generic) 575 | 576 | type instance RuleResult ExtractSrcQ = HashMap FilePath Text 577 | 578 | instance Pretty ExtractSrcQ where 579 | pretty (ExtractSrcQ f n) = 580 | "ExtractSrc" 581 | <> line 582 | <> indent 583 | 2 584 | ( vsep 585 | [ "fetcher" <> colon <+> pretty f, 586 | "files" <> colon <+> pretty n 587 | ] 588 | ) 589 | 590 | -------------------------------------------------------------------------------- 591 | 592 | -- | Fetch @outputHashes@ for git dependencies in @Cargo.lock@. 593 | -- See for details. 594 | -- We need fetched source and the file path to @Cargo.lock@. 595 | data FetchRustGitDepsQ = FetchRustGitDepsQ (NixFetcher Fetched) FilePath 596 | deriving (Show, Eq, Ord, Hashable, NFData, Binary, Typeable, Generic) 597 | 598 | -- | @outputHashes@, a mapping from nameVer -> output hash 599 | type instance RuleResult FetchRustGitDepsQ = HashMap Text Checksum 600 | 601 | instance Pretty FetchRustGitDepsQ where 602 | pretty (FetchRustGitDepsQ f n) = 603 | "FetchRustGitDeps" 604 | <> line 605 | <> indent 606 | 2 607 | ( vsep 608 | [ "fetcher" <> colon <+> pretty f, 609 | "cargoLock" <> colon <+> pretty n 610 | ] 611 | ) 612 | 613 | -------------------------------------------------------------------------------- 614 | 615 | -- | @strftime@ format 616 | -- 617 | -- Nothing defaults to @%Y-%m-%d@ 618 | newtype DateFormat = DateFormat (Maybe Text) 619 | deriving newtype (Show, Eq, Ord, Default, Pretty) 620 | deriving stock (Typeable, Generic) 621 | deriving anyclass (Hashable, Binary, NFData) 622 | 623 | -- | Get the commit date by using shallow clone 624 | -- 625 | -- @_gformat@ is in. 626 | -- Note: Requires git >= 2.5 627 | data GetGitCommitDate = GetGitCommitDate {_gurl :: Text, _grev :: Text, _gformat :: DateFormat} 628 | deriving (Show, Eq, Ord, Hashable, NFData, Binary, Typeable, Generic) 629 | 630 | type instance RuleResult GetGitCommitDate = Text 631 | 632 | instance Pretty GetGitCommitDate where 633 | pretty GetGitCommitDate {..} = 634 | "GetGitCommitDate" 635 | <> line 636 | <> indent 637 | 2 638 | ( vsep 639 | [ "url" <> colon <+> pretty _gurl, 640 | "rev" <> colon <+> pretty _grev, 641 | "format" <> colon <+> pretty _gformat 642 | ] 643 | ) 644 | 645 | -------------------------------------------------------------------------------- 646 | 647 | -- | Package name, used in generating nix expr 648 | type PackageName = Text 649 | 650 | -- | How to create package source fetcher given a version 651 | type PackageFetcher = Version -> NixFetcher Fresh 652 | 653 | newtype PackageExtractSrc = PackageExtractSrc (NE.NonEmpty FilePath) 654 | 655 | newtype PackageCargoLockFiles = PackageCargoLockFiles (NE.NonEmpty FilePath) 656 | 657 | newtype PackagePassthru = PackagePassthru (HashMap Text Text) 658 | deriving newtype (Semigroup, Monoid) 659 | 660 | -- | Using stale value indicates that we will /NOT/ check for new versions if 661 | -- there is a known version recovered from json file or last use of the rule. 662 | -- Normally you don't want a stale version 663 | -- unless you need pin a package. 664 | data UseStaleVersion 665 | = -- | Specified in configuration file 666 | PermanentStale 667 | | -- | Specified by @--filter@ command 668 | TemporaryStale 669 | | NoStale 670 | deriving stock (Eq, Show, Ord, Typeable, Generic) 671 | deriving anyclass (Hashable, Binary, NFData) 672 | 673 | -- | A package is defined with: 674 | -- 675 | -- 1. its name 676 | -- 2. how to track its version 677 | -- 3. how to fetch it as we have the version 678 | -- 4. optional file paths to extract (dump to build dir) 679 | -- 5. optional @Cargo.lock@ path (if it's a rust package) 680 | -- 6. an optional pass through map 681 | -- 7. if the package version was pinned 682 | -- 8. optional git date format (if the version source is git) 683 | -- 9. whether to always fetch a package regardless of the version changing 684 | -- /INVARIANT: 'Version' passed to 'PackageFetcher' MUST be used textually,/ 685 | -- /i.e. can only be concatenated with other strings,/ 686 | -- /in case we can't check the equality between fetcher functions./ 687 | data Package = Package 688 | { _pname :: PackageName, 689 | _pversion :: CheckVersion, 690 | _pfetcher :: PackageFetcher, 691 | _pextract :: Maybe PackageExtractSrc, 692 | _pcargo :: Maybe PackageCargoLockFiles, 693 | _ppassthru :: PackagePassthru, 694 | _ppinned :: UseStaleVersion, 695 | _pgitdateformat :: DateFormat, 696 | _pforcefetch :: ForceFetch 697 | } 698 | 699 | -- | Package key is the name of a package. 700 | -- We use this type to index packages. 701 | newtype PackageKey = PackageKey PackageName 702 | deriving newtype (Eq, Show, Ord, Pretty) 703 | deriving stock (Typeable, Generic) 704 | deriving anyclass (Hashable, Binary, NFData) 705 | 706 | -------------------------------------------------------------------------------- 707 | 708 | -- | The key type of nvfetcher rule. See "NvFetcher.Core" 709 | data Core = Core 710 | deriving (Eq, Show, Ord, Typeable, Generic, Hashable, Binary, NFData) 711 | 712 | -- If prefetch fails, we don't want to fail the whole build 713 | type instance RuleResult Core = Maybe PackageResult 714 | 715 | -- | Decorate a rule's key with 'PackageKey' 716 | newtype WithPackageKey k = WithPackageKey (k, PackageKey) 717 | deriving newtype (Eq, Hashable, Binary, NFData) 718 | 719 | instance Show k => Show (WithPackageKey k) where 720 | show (WithPackageKey (k, n)) = show k <> " (" <> show n <> ")" 721 | 722 | type instance RuleResult (WithPackageKey k) = RuleResult k 723 | 724 | -- | Result type of 'Core' 725 | data PackageResult = PackageResult 726 | { _prname :: PackageName, 727 | _prversion :: NvcheckerResult, 728 | _prfetched :: NixFetcher 'Fetched, 729 | _prpassthru :: Maybe (HashMap Text Text), 730 | -- | extracted file name -> file path in build dir 731 | _prextract :: Maybe (HashMap FilePath NixExpr), 732 | -- | cargo lock file path in build dir -> (file path in nix, git dependencies) 733 | _prcargolock :: Maybe (HashMap FilePath (NixExpr, HashMap Text Checksum)), 734 | _prpinned :: UseStaleVersion, 735 | _prgitdate :: Maybe Text 736 | } 737 | deriving (Show, Typeable, Generic, NFData) 738 | 739 | instance A.ToJSON PackageResult where 740 | toJSON PackageResult {..} = 741 | A.object 742 | [ "name" A..= _prname, 743 | "version" A..= nvNow _prversion, 744 | "src" A..= _prfetched, 745 | "extract" A..= _prextract, 746 | "passthru" A..= _prpassthru, 747 | "cargoLocks" A..= _prcargolock, 748 | "pinned" A..= case _prpinned of 749 | PermanentStale -> True 750 | _ -> False, 751 | "date" A..= _prgitdate 752 | ] 753 | -------------------------------------------------------------------------------- /src/NvFetcher/Types/Lens.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | -- | Copyright: (c) 2021-2022 berberman 5 | -- SPDX-License-Identifier: MIT 6 | -- Maintainer: berberman 7 | -- Stability: experimental 8 | -- Portability: portable 9 | -- Lenses for "NvFetcher.Types" 10 | module NvFetcher.Types.Lens where 11 | 12 | import Lens.Micro.TH 13 | import NvFetcher.Types 14 | 15 | makeLenses ''ListOptions 16 | 17 | makeLenses ''NvcheckerOptions 18 | 19 | makeLenses ''VersionSource 20 | 21 | makeLenses ''NixFetcher 22 | 23 | makeLenses ''Package 24 | -------------------------------------------------------------------------------- /src/NvFetcher/Types/ShakeExtras.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | -- | Copyright: (c) 2021-2022 berberman 6 | -- SPDX-License-Identifier: MIT 7 | -- Maintainer: berberman 8 | -- Stability: experimental 9 | -- Portability: portable 10 | -- 11 | -- This module is about global information we use in rules. 12 | module NvFetcher.Types.ShakeExtras 13 | ( -- * Types 14 | ShakeExtras (..), 15 | initShakeExtras, 16 | getShakeExtras, 17 | 18 | -- * Packages 19 | lookupPackage, 20 | getAllPackageKeys, 21 | isPackageKeyTarget, 22 | 23 | -- * Version changes 24 | recordVersionChange, 25 | getVersionChanges, 26 | 27 | -- * Retry 28 | withRetry, 29 | 30 | -- * Build dir 31 | getBuildDir, 32 | 33 | -- * Keyfile 34 | getKeyfilePath, 35 | 36 | -- * Last versions 37 | getLastVersionOnDisk, 38 | getRecentLastVersion, 39 | updateLastVersion, 40 | getAllOnDiskVersions, 41 | getLastVersionUpdated, 42 | 43 | -- * Booleans 44 | nvcheckerCacheEnabled, 45 | nvcheckerKeepGoing, 46 | ) 47 | where 48 | 49 | import Control.Concurrent.Extra 50 | import Data.Map.Strict (Map) 51 | import qualified Data.Map.Strict as Map 52 | import Development.Shake 53 | import NvFetcher.Config 54 | import NvFetcher.Types 55 | 56 | data LastVersion 57 | = OnDisk Version 58 | | Updated 59 | (Maybe Version) 60 | -- ^ on disk if has 61 | Version 62 | 63 | -- | Values we use during the build. It's stored in 'shakeExtra' 64 | data ShakeExtras = ShakeExtras 65 | { config :: Config, 66 | versionChanges :: Var [VersionChange], 67 | targetPackages :: Map PackageKey Package, 68 | lastVersions :: Var (Map PackageKey LastVersion) 69 | } 70 | 71 | -- | Get our values from shake 72 | getShakeExtras :: Action ShakeExtras 73 | getShakeExtras = 74 | getShakeExtra @ShakeExtras >>= \case 75 | Just x -> pure x 76 | _ -> fail "ShakeExtras is missing!" 77 | 78 | -- | Create an empty 'ShakeExtras' from packages to build, times to retry for each rule, 79 | -- build dir, and on disk versions 80 | initShakeExtras :: Config -> Map PackageKey Package -> Map PackageKey Version -> IO ShakeExtras 81 | initShakeExtras config targetPackages lv = do 82 | versionChanges <- newVar mempty 83 | lastVersions <- newVar $ Map.map OnDisk lv 84 | pure ShakeExtras {..} 85 | 86 | -- | Get keys of all packages to build 87 | getAllPackageKeys :: Action [PackageKey] 88 | getAllPackageKeys = do 89 | ShakeExtras {..} <- getShakeExtras 90 | pure $ Map.keys targetPackages 91 | 92 | -- | Find a package given its key 93 | lookupPackage :: PackageKey -> Action (Maybe Package) 94 | lookupPackage key = do 95 | ShakeExtras {..} <- getShakeExtras 96 | pure $ Map.lookup key targetPackages 97 | 98 | -- | Check if we need build this package 99 | isPackageKeyTarget :: PackageKey -> Action Bool 100 | isPackageKeyTarget k = Map.member k . targetPackages <$> getShakeExtras 101 | 102 | -- | Record version change of a package 103 | recordVersionChange :: PackageName -> Maybe Version -> Version -> Action () 104 | recordVersionChange vcName vcOld vcNew = do 105 | ShakeExtras {..} <- getShakeExtras 106 | liftIO $ modifyVar_ versionChanges (pure . (++ [VersionChange {..}])) 107 | 108 | -- | Get version changes since the last run 109 | getVersionChanges :: Action [VersionChange] 110 | getVersionChanges = do 111 | ShakeExtras {..} <- getShakeExtras 112 | liftIO $ readVar versionChanges 113 | 114 | -- | Run an action, retry at most 'retry' times (defined in config) if it throws an exception 115 | withRetry :: Action a -> Action a 116 | withRetry a = getShakeExtras >>= \ShakeExtras {..} -> actionRetry (retry config) a 117 | 118 | -- | Get build dir 119 | getBuildDir :: Action FilePath 120 | getBuildDir = buildDir . config <$> getShakeExtras 121 | 122 | -- | Get keyfile path 123 | getKeyfilePath :: Action (Maybe FilePath) 124 | getKeyfilePath = keyfile . config <$> getShakeExtras 125 | 126 | -- | Get initial version of a package 127 | getLastVersionOnDisk :: PackageKey -> Action (Maybe Version) 128 | getLastVersionOnDisk k = do 129 | ShakeExtras {..} <- getShakeExtras 130 | versions <- liftIO $ readVar lastVersions 131 | pure $ case versions Map.!? k of 132 | Just (Updated v _) -> v 133 | Just (OnDisk v) -> Just v 134 | _ -> Nothing 135 | 136 | -- | Get version of a package, no matter it was initial one or rule result 137 | getRecentLastVersion :: PackageKey -> Action (Maybe Version) 138 | getRecentLastVersion k = do 139 | ShakeExtras {..} <- getShakeExtras 140 | versions <- liftIO $ readVar lastVersions 141 | pure $ case versions Map.!? k of 142 | Just (Updated _ v) -> Just v 143 | Just (OnDisk v) -> Just v 144 | _ -> Nothing 145 | 146 | -- | Get updated version of a package 147 | getLastVersionUpdated :: PackageKey -> Action (Maybe Version) 148 | getLastVersionUpdated k = do 149 | ShakeExtras {..} <- getShakeExtras 150 | versions <- liftIO $ readVar lastVersions 151 | pure $ case versions Map.!? k of 152 | Just (Updated _ v) -> Just v 153 | _ -> Nothing 154 | 155 | -- | Add nvchecker result of a package 156 | updateLastVersion :: PackageKey -> Version -> Action () 157 | updateLastVersion k v = do 158 | ShakeExtras {..} <- getShakeExtras 159 | liftIO $ 160 | modifyVar_ lastVersions $ \versions -> pure $ case versions Map.!? k of 161 | Just (Updated o _) -> Map.insert k (Updated o v) versions 162 | Just (OnDisk lv) -> Map.insert k (Updated (Just lv) v) versions 163 | _ -> Map.insert k (Updated Nothing v) versions 164 | 165 | -- | Get all initial versions 166 | getAllOnDiskVersions :: Action (Map PackageKey Version) 167 | getAllOnDiskVersions = do 168 | ShakeExtras {..} <- getShakeExtras 169 | versions <- liftIO $ readVar lastVersions 170 | let xs = Map.toList $ 171 | flip Map.map versions $ \case 172 | OnDisk v -> Just v 173 | Updated v _ -> v 174 | pure $ Map.fromList [(k, v) | (k, Just v) <- xs] 175 | 176 | -- | Get if 'cacheNvchecker' is enabled 177 | nvcheckerCacheEnabled :: Action Bool 178 | nvcheckerCacheEnabled = cacheNvchecker . config <$> getShakeExtras 179 | 180 | -- | Get if 'keepGoing' is enabled 181 | nvcheckerKeepGoing :: Action Bool 182 | nvcheckerKeepGoing = keepGoing . config <$> getShakeExtras 183 | -------------------------------------------------------------------------------- /src/NvFetcher/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- | Copyright: (c) 2021-2022 berberman 4 | -- SPDX-License-Identifier: MIT 5 | -- Maintainer: berberman 6 | -- Stability: experimental 7 | -- Portability: portable 8 | module NvFetcher.Utils where 9 | 10 | import Data.Binary 11 | import qualified Data.ByteString as BS 12 | import qualified Data.ByteString.Lazy as LBS 13 | import Data.Text (Text) 14 | import qualified Data.Text as T 15 | import System.Directory.Extra (XdgDirectory (XdgData), getXdgDirectory) 16 | import Text.Regex.TDFA ((=~)) 17 | #if MIN_VERSION_aeson(2,0,0) 18 | import qualified Data.Aeson.Key as A 19 | #endif 20 | 21 | encode' :: Binary a => a -> BS.ByteString 22 | encode' = BS.concat . LBS.toChunks . encode 23 | 24 | decode' :: Binary a => BS.ByteString -> a 25 | decode' = decode . LBS.fromChunks . pure 26 | 27 | quote :: Text -> Text 28 | quote = T.pack . show 29 | 30 | isLegalNixId :: Text -> Bool 31 | isLegalNixId x = x =~ "^[a-zA-Z_][a-zA-Z0-9_'-]*$" 32 | 33 | quoteIfNeeds :: Text -> Text 34 | quoteIfNeeds x 35 | | isLegalNixId x = x 36 | | otherwise = quote x 37 | 38 | getDataDir :: IO FilePath 39 | getDataDir = getXdgDirectory XdgData "nvfetcher" 40 | 41 | #if MIN_VERSION_aeson(2,0,0) 42 | aesonKey :: Text -> A.Key 43 | aesonKey = A.fromText 44 | #else 45 | aesonKey :: Text -> Text 46 | aesonKey = id 47 | #endif 48 | -------------------------------------------------------------------------------- /test/CheckVersionSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module CheckVersionSpec where 4 | 5 | import Control.Monad.IO.Class (liftIO) 6 | import Control.Monad.Trans.Reader 7 | import Data.Coerce (coerce) 8 | import Data.Default (def) 9 | import qualified Data.Map.Strict as Map 10 | import qualified Data.Text as T 11 | import Lens.Micro 12 | import NvFetcher.Config (Config (cacheNvchecker)) 13 | import NvFetcher.Nvchecker 14 | import NvFetcher.Types 15 | import NvFetcher.Types.Lens 16 | import System.IO.Extra (newTempFile) 17 | import Test.Hspec 18 | import Utils 19 | 20 | spec :: Spec 21 | spec = do 22 | versionSourcesSpec 23 | useStaleSpec 24 | cacheSpec 25 | 26 | versionSourcesSpec :: Spec 27 | versionSourcesSpec = aroundShake $ 28 | describe "nvchecker" $ do 29 | specifyChan "pypi" $ 30 | runNvcheckerRule (Pypi "example") `shouldReturnJust` Version "0.1.0" 31 | 32 | specifyChan "archpkg" $ 33 | runNvcheckerRule (ArchLinux "lib32-libva-vdpau-driver") `shouldReturnJust` Version "0.7.4" 34 | 35 | specifyChan "aur" $ 36 | runNvcheckerRule (Aur "ssed") `shouldReturnJust` Version "3.62" 37 | 38 | specifyChan "git" $ 39 | runNvcheckerRule 40 | (Git "https://gitlab.com/gitlab-org/gitlab-test.git" def) 41 | `shouldReturnJust` Version "ddd0f15ae83993f5cb66a927a28673882e99100b" 42 | 43 | specifyChan "github latest release" $ 44 | runNvcheckerRule (GitHubRelease "harry-sanabria" "ReleaseTestRepo") 45 | `shouldReturnJust` Version "release3" 46 | 47 | specifyChan "github max tag" $ 48 | runNvcheckerRule (GitHubTag "harry-sanabria" "ReleaseTestRepo" def) 49 | `shouldReturnJust` "second_release" 50 | 51 | specifyChan "github max tag with ignored" $ 52 | runNvcheckerRule (GitHubTag "harry-sanabria" "ReleaseTestRepo" $ def & ignored ?~ "second_release release3") 53 | `shouldReturnJust` Version "first_release" 54 | 55 | specifyChan "http header" $ 56 | runNvcheckerRule (HttpHeader "https://www.unifiedremote.com/download/linux-x64-deb" "urserver-([\\d.]+).deb" def) 57 | >>= shouldBeJust 58 | 59 | -- specifyChan "webpage" $ 60 | -- runNvcheckerRule (Webpage "http://ftp.vim.org/pub/vim/patches/7.3/" "7\\.3\\.\\d+" def) 61 | -- `shouldReturnJust` Version "7.3.1314" 62 | 63 | specifyChan "manual" $ 64 | runNvcheckerRule (Manual "Meow") `shouldReturnJust` Version "Meow" 65 | 66 | specifyChan "openvsx" $ 67 | runNvcheckerRule (OpenVsx "usernamehw" "indent-one-space") `shouldReturnJust` Version "0.3.0" 68 | 69 | specifyChan "repology" $ 70 | runNvcheckerRule (Repology "ssed" "aur") `shouldReturnJust` Version "3.62" 71 | 72 | specifyChan "vsmarketplace" $ 73 | runNvcheckerRule (VscodeMarketplace "usernamehw" "indent-one-space") `shouldReturnJust` Version "1.0.0" 74 | 75 | specifyChan "cmd" $ 76 | runNvcheckerRule (Cmd "echo Meow") `shouldReturnJust` Version "Meow" 77 | 78 | specifyChan "container" $ 79 | runNvcheckerRule (Container "testcontainers/helloworld" def) `shouldReturnJust` Version "1.1.0" 80 | 81 | -------------------------------------------------------------------------------- 82 | 83 | -- | We need disable nvchecker cache to see if use stale works 84 | useStaleSpec :: Spec 85 | useStaleSpec = aroundShake' (Map.singleton fakePackageKey fakePinnedPackage) def {cacheNvchecker = False} $ 86 | describe "useStale" $ do 87 | (temp, cleanup) <- runIO newTempFile 88 | 89 | let versionSource = Cmd $ "cat " <> T.pack temp 90 | 91 | specifyChan "needs run" $ do 92 | liftIO $ writeFile temp "Meow" 93 | runNvcheckerRuleOnFakePackage versionSource `shouldReturnJust` NvcheckerResult {nvNow = "Meow", nvOld = Nothing, nvStale = False} 94 | 95 | specifyChan "stale" $ do 96 | liftIO $ writeFile temp "Bark" 97 | runNvcheckerRuleOnFakePackage versionSource `shouldReturnJust` NvcheckerResult {nvNow = "Meow", nvOld = Just "Meow", nvStale = True} 98 | 99 | runIO cleanup 100 | 101 | cacheSpec :: Spec 102 | cacheSpec = aroundShake' (Map.singleton fakePackageKey fakePackage) def {cacheNvchecker = True} $ 103 | describe "cache" $ do 104 | (temp, cleanup) <- runIO newTempFile 105 | 106 | let versionSource = Cmd $ "cat " <> T.pack temp 107 | 108 | specifyChan "needs run" $ do 109 | liftIO $ writeFile temp "Meow" 110 | runNvcheckerRuleOnFakePackage versionSource `shouldReturnJust` NvcheckerResult {nvNow = "Meow", nvOld = Nothing, nvStale = False} 111 | 112 | specifyChan "cache" $ do 113 | liftIO $ writeFile temp "Bark" 114 | runNvcheckerRuleOnFakePackage versionSource `shouldReturnJust` NvcheckerResult {nvNow = "Meow", nvOld = Just "Meow", nvStale = False} 115 | 116 | runIO cleanup 117 | 118 | -------------------------------------------------------------------------------- 119 | 120 | runNvcheckerRule :: VersionSource -> ReaderT ActionQueue IO (Maybe Version) 121 | runNvcheckerRule v = fmap nvNow <$> runActionChan (checkVersion' v def) 122 | 123 | runNvcheckerRuleOnFakePackage :: VersionSource -> ReaderT ActionQueue IO (Maybe NvcheckerResult) 124 | runNvcheckerRuleOnFakePackage v = runActionChan $ checkVersion v def fakePackageKey 125 | 126 | fakePackageKey :: PackageKey 127 | fakePackageKey = PackageKey "a-fake-package" 128 | 129 | fakePackage :: Package 130 | fakePackage = 131 | Package 132 | { _pname = coerce fakePackageKey, 133 | _pversion = undefined, 134 | _pfetcher = undefined, 135 | _pcargo = undefined, 136 | _pextract = undefined, 137 | _ppassthru = undefined, 138 | _ppinned = NoStale, 139 | _pgitdateformat = undefined, 140 | _pforcefetch = undefined 141 | } 142 | 143 | fakePinnedPackage :: Package 144 | fakePinnedPackage = fakePackage {_ppinned = PermanentStale} 145 | -------------------------------------------------------------------------------- /test/FetchRustGitDepsSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module FetchRustGitDepsSpec where 5 | 6 | import Control.Monad (join) 7 | import Control.Monad.Trans.Reader 8 | import Data.HashMap.Strict (HashMap) 9 | import qualified Data.HashMap.Strict as HMap 10 | import Data.Maybe (fromJust) 11 | import Data.Text (Text) 12 | import NvFetcher.FetchRustGitDeps 13 | import NvFetcher.NixFetcher 14 | import NvFetcher.Types 15 | import Test.Hspec 16 | import Utils 17 | 18 | spec :: Spec 19 | spec = aroundShake $ 20 | describe "fetchRustGitDeps" $ 21 | specifyChan "works" $ do 22 | prefetched <- 23 | runPrefetchRule $ 24 | gitFetcher 25 | "https://gist.github.com/NickCao/6c4dbc4e15db5da107de6cdb89578375" 26 | "8a5f37a8f80a3b05290707febf57e88661cee442" 27 | shouldBeJust prefetched 28 | runFetchRustGitDepsRule (fromJust prefetched) "Cargo.lock" 29 | `shouldReturnJust` HMap.fromList 30 | [ ("rand-0.8.3", Checksum "sha256-zHvXCdWuGy4gPDYtis7/7+mEd/IV58sSGq139G0GD84=") 31 | ] 32 | 33 | runPrefetchRule :: NixFetcher Fresh -> ReaderT ActionQueue IO (Maybe (NixFetcher Fetched)) 34 | runPrefetchRule fetcher = fmap join $ runActionChan $ prefetch fetcher NoForceFetch 35 | 36 | runFetchRustGitDepsRule :: NixFetcher Fetched -> FilePath -> ReaderT ActionQueue IO (Maybe (HashMap Text Checksum)) 37 | runFetchRustGitDepsRule fetcher lockPath = runActionChan $ fetchRustGitDeps fetcher lockPath 38 | -------------------------------------------------------------------------------- /test/GetGitCommitDateSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module GetGitCommitDateSpec where 4 | 5 | import Control.Monad.Trans.Reader 6 | import Data.Default (def) 7 | import Data.Text (Text) 8 | import NvFetcher.GetGitCommitDate 9 | import Test.Hspec 10 | import Utils 11 | 12 | spec :: Spec 13 | spec = 14 | aroundShake $ 15 | describe "get git commit date" $ do 16 | specifyChan "default format" $ 17 | runGetGitCommitDateRule repo rev def 18 | `shouldReturnJust` "2021-05-31" 19 | specifyChan "custom format" $ 20 | runGetGitCommitDateRule repo rev (DateFormat $ Just "%Y-%m-%d %H:%M:%S") 21 | `shouldReturnJust` "2021-05-31 18:43:48" 22 | 23 | repo :: Text 24 | repo = "https://gist.github.com/NickCao/6c4dbc4e15db5da107de6cdb89578375" 25 | 26 | rev :: Text 27 | rev = "8a5f37a8f80a3b05290707febf57e88661cee442" 28 | 29 | runGetGitCommitDateRule :: Text -> Text -> DateFormat -> ReaderT ActionQueue IO (Maybe Text) 30 | runGetGitCommitDateRule url rev format = runActionChan $ getGitCommitDate url rev format 31 | -------------------------------------------------------------------------------- /test/NixExprSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE QuasiQuotes #-} 6 | 7 | module NixExprSpec where 8 | 9 | import NeatInterpolation (trimming) 10 | import NvFetcher.NixExpr 11 | import NvFetcher.NixFetcher 12 | import NvFetcher.Types 13 | import PrefetchSpec 14 | import Test.Hspec 15 | 16 | spec :: Spec 17 | spec = describe "toNixExpr" $ do 18 | it "works on bool" $ do 19 | toNixExpr True `shouldBe` "true" 20 | toNixExpr False `shouldBe` "false" 21 | 22 | it "works on string" $ 23 | toNixExpr ("Foo" :: String) `shouldBe` [trimming|"Foo"|] 24 | 25 | it "works on list of strings" $ 26 | toNixExpr ["Alice" :: String, "Bob", "Carol"] `shouldBe` [trimming|[ "Alice" "Bob" "Carol" ]|] 27 | 28 | it "renders fresh gitFetcher" $ 29 | toNixExpr (fakeFetch (gitFetcher "https://example.com" "fake_rev")) 30 | `shouldBe` [trimming| 31 | fetchgit { 32 | url = "https://example.com"; 33 | rev = "fake_rev"; 34 | fetchSubmodules = true; 35 | deepClone = false; 36 | leaveDotGit = false; 37 | sparseCheckout = [ ]; 38 | sha256 = "0000000000000000000000000000000000000000000000000000000000000000"; 39 | } 40 | |] 41 | 42 | it "renders fresh gitHubFetcher" $ 43 | toNixExpr (fakeFetch (gitHubFetcher ("owner", "repo") "fake_rev")) 44 | `shouldBe` [trimming| 45 | fetchFromGitHub { 46 | owner = "owner"; 47 | repo = "repo"; 48 | rev = "fake_rev"; 49 | fetchSubmodules = false; 50 | sha256 = "0000000000000000000000000000000000000000000000000000000000000000"; 51 | } 52 | |] 53 | 54 | it "renders fresh urlFetcher" $ 55 | toNixExpr (fakeFetch (urlFetcher "https://example.com")) 56 | `shouldBe` [trimming| 57 | fetchurl { 58 | url = "https://example.com"; 59 | sha256 = "0000000000000000000000000000000000000000000000000000000000000000"; 60 | } 61 | |] 62 | 63 | it "renders filename for vsc extension" $ 64 | toNixExpr (fakeFetch (openVsxFetcher ("publisher", "extension") "fake_version")) 65 | `shouldBe` [trimming| 66 | fetchurl { 67 | url = "https://open-vsx.org/api/publisher/extension/fake_version/file/publisher.extension-fake_version.vsix"; 68 | name = "extension-fake_version.zip"; 69 | sha256 = "0000000000000000000000000000000000000000000000000000000000000000"; 70 | } 71 | |] 72 | 73 | it "renders fresh FetchDocker" $ do 74 | toNixExpr (fakeFetch testDockerFetcher) 75 | `shouldBe` [trimming| 76 | dockerTools.pullImage { 77 | imageName = "library/alpine"; 78 | imageDigest = "sha256:0000000000000000000000000000000000000000000000000000000000000000"; 79 | sha256 = "0000000000000000000000000000000000000000000000000000000000000000"; 80 | finalImageTag = "3.16.2"; 81 | } 82 | |] 83 | 84 | fakeFetch :: NixFetcher Fresh -> NixFetcher Fetched 85 | fakeFetch = \case 86 | FetchGit {..} -> FetchGit {_sha256 = fakeSha256, ..} 87 | FetchGitHub {..} -> FetchGitHub {_sha256 = fakeSha256, ..} 88 | FetchUrl {..} -> FetchUrl {_sha256 = fakeSha256, ..} 89 | FetchTarball {..} -> FetchTarball {_sha256 = fakeSha256, ..} 90 | FetchDocker {..} -> FetchDocker {_sha256 = fakeSha256, _imageDigest = fakeDigest, ..} 91 | where 92 | fakeSha256 = Checksum "0000000000000000000000000000000000000000000000000000000000000000" 93 | fakeDigest = ContainerDigest "sha256:0000000000000000000000000000000000000000000000000000000000000000" 94 | -------------------------------------------------------------------------------- /test/PrefetchSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module PrefetchSpec where 5 | 6 | import Control.Arrow ((&&&)) 7 | import Control.Monad (join) 8 | import Control.Monad.Trans.Reader 9 | import NvFetcher.NixFetcher 10 | import NvFetcher.Types 11 | import Test.Hspec 12 | import Utils 13 | 14 | spec :: Spec 15 | spec = aroundShake $ 16 | describe "fetchers" $ do 17 | specifyChan "pypi" $ 18 | runPrefetchRule (pypiFetcher "example" "0.1.0") 19 | `shouldReturnJust` Checksum "sha256-9Yc+bshBd2SXwNQqUVP4TC8S+mjqTXe+FGfouan/w7s=" 20 | 21 | specifyChan "openvsx" $ 22 | runPrefetchRule (openVsxFetcher ("usernamehw", "indent-one-space") "0.2.6") 23 | `shouldReturnJust` Checksum "sha256-oS2ERs/uEDJx5J/N67STLaUf/hY2RyErjipAEH45q2o=" 24 | 25 | specifyChan "vsmarketplace" $ 26 | runPrefetchRule (vscodeMarketplaceFetcher ("usernamehw", "indent-one-space") "0.2.6") 27 | `shouldReturnJust` Checksum "sha256-h6dBBlsnl6Q7vHUjrnezmjn3EsZHF+Q35BLt1SARuO4=" 28 | 29 | specifyChan "git" $ 30 | runPrefetchRule (gitFetcher "https://github.com/git-up/test-repo-submodules" "5a1dfa807759c39e3df891b6b46dfb2cf776c6ef") 31 | `shouldReturnJust` Checksum "sha256-wCo1YobyatxSOE85xQNSJw6jvufghFNHlZl4ToQjRHA=" 32 | 33 | specifyChan "github" $ 34 | runPrefetchRule (gitHubFetcher ("harry-sanabria", "ReleaseTestRepo") "release3") 35 | `shouldReturnJust` Checksum "sha256-cSygC4nBg8ChArw+eGSS0PBE5n6Tc0nJLdxEmaDYGKk=" 36 | 37 | specifyChan "tarball" $ 38 | runPrefetchRule (tarballFetcher "https://github.com/nixos/nixpkgs/archive/3d35529a48d3ad50ad959463755b0b7fe392cfa7.tar.gz") 39 | `shouldReturnJust` Checksum "sha256-TwfXEION3DcOivzDqXSKNf1PNTZWF124nOF/UbZGRlE=" 40 | 41 | specifyChan "docker" $ 42 | runPrefetchRule' (_sha256 &&& _imageDigest) testDockerFetcher 43 | `shouldReturnJust` ( Checksum "sha256-uaJxeiRm94tWDBTe51/KwUBKR2vj9i4i3rhotsYPxtM=", 44 | ContainerDigest "sha256:65a2763f593ae85fab3b5406dc9e80f744ec5b449f269b699b5efd37a07ad32e" 45 | ) 46 | 47 | specifyChan "url with name" $ 48 | runPrefetchRule 49 | ( urlFetcher' 50 | "https://files.yande.re/image/3fc51f6a2fb10c96b73dd0fce6ddb9c8/yande.re%201048717%20dress%20garter%20lolita_fashion%20ruo_gan_zhua.jpg" 51 | (Just "foo.jpg") 52 | ) 53 | `shouldReturnJust` Checksum "sha256-wkiXDN6vPFtx88krcQ4szK6dJNjtrDxrsNa3ZvHlfMQ=" 54 | 55 | testDockerFetcher :: NixFetcher Fresh 56 | testDockerFetcher = 57 | FetchDocker 58 | { _imageName = "library/alpine", 59 | _imageTag = "3.16.2", 60 | _imageDigest = (), 61 | _sha256 = (), 62 | _fos = Nothing, 63 | _farch = Nothing, 64 | _finalImageName = Nothing, 65 | _finalImageTag = Nothing, 66 | _tlsVerify = Nothing 67 | } 68 | 69 | -------------------------------------------------------------------------------- 70 | 71 | -- TODO test force fetch 72 | runPrefetchRule :: NixFetcher Fresh -> ReaderT ActionQueue IO (Maybe Checksum) 73 | runPrefetchRule = runPrefetchRule' _sha256 74 | 75 | runPrefetchRule' :: (NixFetcher Fetched -> a) -> NixFetcher Fresh -> ReaderT ActionQueue IO (Maybe a) 76 | runPrefetchRule' g f = fmap join $ runActionChan $ prefetch f NoForceFetch >>= \m -> pure $ g <$> m 77 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /test/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | module Utils where 7 | 8 | import Control.Concurrent.Async 9 | import Control.Concurrent.Extra 10 | import Control.Concurrent.STM 11 | import Control.Exception (Handler (..), SomeException, bracket, catches, throwIO) 12 | import Control.Monad (void) 13 | import Control.Monad.IO.Class 14 | import Control.Monad.Trans.Reader 15 | import Data.Default (def) 16 | import Data.Map (Map) 17 | import Data.Maybe (isJust) 18 | import Development.Shake 19 | import Development.Shake.Database 20 | import NvFetcher.Config 21 | import NvFetcher.Core (coreRules) 22 | import NvFetcher.Types 23 | import NvFetcher.Types.ShakeExtras 24 | import qualified System.IO.Extra as Extra 25 | import System.Time.Extra 26 | import Test.Hspec 27 | import UnliftIO (MonadUnliftIO (withRunInIO)) 28 | 29 | -------------------------------------------------------------------------------- 30 | 31 | runAction :: ActionQueue -> Action a -> IO (Maybe a) 32 | runAction chan x = do 33 | barrier <- newBarrier 34 | atomically $ writeTQueue chan $ x >>= liftIO . signalBarrier barrier 35 | -- TODO 36 | timeout 30 $ waitBarrier barrier 37 | 38 | type ActionQueue = TQueue (Action ()) 39 | 40 | newAsyncActionQueue :: Map PackageKey Package -> Config -> IO (ActionQueue, Async ()) 41 | newAsyncActionQueue pkgs config = Extra.withTempDir $ \dir -> do 42 | shakeExtras <- liftIO $ initShakeExtras config {buildDir = dir} pkgs mempty 43 | chan <- atomically newTQueue 44 | (getShakeDb, _) <- 45 | shakeOpenDatabase 46 | shakeOptions 47 | { shakeExtra = addShakeExtra shakeExtras (shakeExtra shakeOptions), 48 | shakeFiles = dir, 49 | shakeVerbosity = Quiet 50 | } 51 | coreRules 52 | shakeDb <- getShakeDb 53 | 54 | let runner restore = do 55 | -- sequentially 56 | act <- liftIO $ atomically $ readTQueue chan 57 | catches 58 | (restore $ void $ shakeRunDatabase shakeDb [act]) 59 | [ Handler $ \(e :: AsyncCancelled) -> throwIO e, 60 | Handler $ \(e :: SomeException) -> putStrLn $ "an exception arose in action runner: " <> show e 61 | ] 62 | runner restore 63 | 64 | runnerTask <- asyncWithUnmask $ \r -> runner r 65 | pure (chan, runnerTask) 66 | 67 | -------------------------------------------------------------------------------- 68 | 69 | aroundShake :: SpecWith ActionQueue -> Spec 70 | aroundShake = aroundShake' mempty def 71 | 72 | aroundShake' :: Map PackageKey Package -> Config -> SpecWith ActionQueue -> Spec 73 | aroundShake' pkgs config = aroundAll $ \f -> 74 | bracket 75 | (newAsyncActionQueue pkgs config) 76 | (\(_, runnerTask) -> cancel runnerTask) 77 | (\(chan, _) -> f chan) 78 | 79 | shouldReturnJust :: (Show a, Eq a, MonadUnliftIO m) => m (Maybe a) -> a -> m () 80 | shouldReturnJust f x = withRunInIO $ \run -> run f `shouldReturn` Just x 81 | 82 | shouldBeJust :: (MonadIO m, Show a) => Maybe a -> m () 83 | shouldBeJust x = liftIO $ x `shouldSatisfy` isJust 84 | 85 | specifyChan :: HasCallStack => String -> ReaderT ActionQueue IO () -> SpecWith ActionQueue 86 | specifyChan s m = specify s $ \r -> runReaderT m r 87 | 88 | runActionChan :: Action a -> ReaderT ActionQueue IO (Maybe a) 89 | runActionChan m = ask >>= \chan -> liftIO $ runAction chan m 90 | --------------------------------------------------------------------------------