├── .gitattributes ├── .github └── workflows │ └── ci.yml ├── .gitignore ├── Makefile ├── README.md ├── cabal.project ├── cabal.project.ci ├── ghc-tags-core ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── ghc-tags-core.cabal └── lib │ ├── GhcTags.hs │ └── GhcTags │ ├── CTag.hs │ ├── CTag │ ├── Formatter.hs │ ├── Header.hs │ ├── Parser.hs │ └── Utils.hs │ ├── ETag.hs │ ├── ETag │ ├── Formatter.hs │ └── Parser.hs │ ├── Ghc.hs │ ├── Stream.hs │ ├── Tag.hs │ └── Utils.hs ├── ghc-tags-pipes ├── CHANGELOG.md ├── LICENSE ├── README.md ├── ghc-tags-pipes.cabal └── lib │ └── GhcTags │ └── Stream.hs ├── ghc-tags-plugin ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── check.hs ├── ghc-tags-plugin.cabal └── lib │ └── Plugin │ ├── GhcTags.hs │ └── GhcTags │ ├── CTag.hs │ ├── FileLock.hs │ └── Options.hs ├── ghc-tags-test ├── CHANGELOG.md ├── LICENSE ├── bench │ ├── Main.hs │ └── data.tags ├── ghc-tags-test.cabal └── test │ ├── Main.hs │ ├── Test │ ├── CTag.hs │ ├── ETag.hs │ ├── Golden │ │ └── Parser.hs │ ├── Tag.hs │ └── Tag │ │ └── Generators.hs │ └── golden │ ├── ghc.ETAGS │ ├── ghc.ETAGS.posix.golden │ ├── ghc.ETAGS.windows.golden │ ├── ghc.tags │ ├── ghc.tags.posix.golden │ ├── ghc.tags.windows.golden │ ├── idempotent.tags │ ├── io-sim-classes.tags │ ├── io-sim-classes.tags.posix.golden │ ├── io-sim-classes.tags.windows.golden │ ├── ouroboros-consensus.ETAGS │ ├── ouroboros-consensus.ETAGS.posix.golden │ ├── ouroboros-consensus.ETAGS.windows.golden │ ├── ouroboros-consensus.tags │ ├── ouroboros-consensus.tags.posix.golden │ ├── ouroboros-consensus.tags.windows.golden │ ├── ouroboros-network.tags │ ├── ouroboros-network.tags.posix.golden │ ├── ouroboros-network.tags.windows.golden │ ├── test.tags │ ├── test.tags.posix.golden │ ├── test.tags.windows.golden │ ├── typed-protocols.tags │ ├── typed-protocols.tags.posix.golden │ ├── typed-protocols.tags.windows.golden │ ├── vim.ETAGS │ ├── vim.ETAGS.posix.golden │ ├── vim.ETAGS.windows.golden │ ├── vim.tags │ ├── vim.tags.posix.golden │ ├── vim.tags.windows.golden │ └── x.tags └── ghc-tags-vim └── plugin └── ghc-tags.vim /.gitattributes: -------------------------------------------------------------------------------- 1 | test/golden/*.tags* -text 2 | test/golden/*.ETAGS* -text 3 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: Haskell CI 2 | 3 | on: 4 | pull_request: 5 | 6 | jobs: 7 | build: 8 | runs-on: ${{ matrix.os }} 9 | 10 | defaults: 11 | run: 12 | shell: bash 13 | 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | ghc: ["9.6", "9.8", "9.10", "9.12"] 18 | os: [ubuntu-latest, windows-latest, macos-latest] 19 | 20 | steps: 21 | - name: Install Haskell 22 | uses: haskell-actions/setup@v2 23 | id: setup-haskell 24 | with: 25 | ghc-version: ${{ matrix.ghc }} 26 | cabal-version: 3.10.2.0 27 | 28 | - name: Select build directory 29 | run: | 30 | if [ "$RUNNER_OS" == Windows ]; then 31 | CABAL_BUILDDIR="D:\\a\\_temp\\dist" 32 | else 33 | CABAL_BUILDDIR="dist-newstyle" 34 | fi 35 | 36 | echo "CABAL_BUILDDIR=$CABAL_BUILDDIR" 37 | echo "CABAL_BUILDDIR=$CABAL_BUILDDIR" >> $GITHUB_ENV 38 | 39 | - name: Set cache version 40 | run: echo "CACHE_VERSION=9w76Z3R" >> $GITHUB_ENV 41 | 42 | - name: Set up temp directory 43 | env: 44 | RUNNER_TEMP: ${{ runner.temp }} 45 | run: | 46 | echo "TMPDIR=$RUNNER_TEMP" >> $GITHUB_ENV 47 | echo "TMP=$RUNNER_TEMP" >> $GITHUB_ENV 48 | 49 | - uses: actions/checkout@v3 50 | 51 | - name: Use cabal.project.local.ci 52 | run: | 53 | cat ./cabal.project.ci >> ./cabal.project.local 54 | cat ./cabal.project.local 55 | 56 | - name: Record dependencies 57 | id: record-deps 58 | run: | 59 | cabal build all -f+ghc-lib --dry-run 60 | cat dist-newstyle/cache/plan.json | jq -r '."install-plan"[].id' | sort | uniq > dependencies.txt 61 | 62 | - name: Cache `cabal store` 63 | id: cabal-store 64 | uses: actions/cache/restore@v3 65 | with: 66 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 67 | key: cabal-store-${{ env.CACHE_VERSION }}-${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('dependencies.txt') }} 68 | restore-keys: cabal-store-${{ env.CACHE_VERSION }}-${{ runner.os }}-${{ matrix.ghc }} 69 | enableCrossOsArchive: true 70 | 71 | - name: Cache `dist-newstyle` 72 | uses: actions/cache@v3 73 | with: 74 | path: | 75 | dist-newstyle 76 | !dist-newstyle/**/.git 77 | key: cache-dist-${{ env.CACHE_VERSION }}-${{ runner.os }}-${{ matrix.ghc }} 78 | 79 | - name: Build dependencies 80 | run: cabal --builddir="$CABAL_BUILDDIR" build -f-ghc-lib --only-dependencies all 81 | 82 | - name: Build dependencies with `ghc-lib` 83 | run: cabal --builddir="$CABAL_BUILDDIR" build -f+ghc-lib --only-dependencies all 84 | 85 | - name: Save cache 86 | uses: actions/cache/save@v3 87 | if: steps.cabal-store.outputs.cache-hit != 'true' 88 | with: 89 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 90 | key: cabal-store-${{ env.CACHE_VERSION }}-${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('dependencies.txt') }} 91 | enableCrossOsArchive: true 92 | 93 | - name: build ghc-tags-core with `ghc-lib` [build] 94 | run: cabal --builddir="$CABAL_BUILDDIR" build -f+ghc-lib ghc-tags-core 95 | 96 | - name: ghc-tags-test `ghc-lib` [test] 97 | run: cabal --builddir="$CABAL_BUILDDIR" run -f+ghc-lib ghc-tags-test:test 98 | 99 | - name: Build projects [build] 100 | run: cabal --builddir="$CABAL_BUILDDIR" build all 101 | 102 | - name: ghc-tags-test [test] 103 | run: cabal --builddir="$CABAL_BUILDDIR" run ghc-tags-test:test 104 | 105 | - name: ghc-tags-test [benchmarks] 106 | run: cabal build ghc-tags-test:benchmark 107 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | tags 2 | TAGS 3 | .tags.lock 4 | .TAGS.lock 5 | test-porject/tags 6 | /dist.tar.gz 7 | TODO.md 8 | benchmarks.* 9 | .ghc-tags-plugin.env 10 | .ghcid 11 | /ghc-tags-test/**/*.out 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # install, uninstall and friends ghc-tags-plugin in cabal store 3 | # 4 | 5 | GHC_VERSION ?= 9.10.1 6 | GHC_STORE_TAG ?= 7 | 8 | GHC_PKG=ghc-pkg-${GHC_VERSION} 9 | GHC=ghc-${GHC_VERSION} 10 | ifdef GHC_STORE_TAG 11 | GHC_STORE_TAG_PREFIXED = -${GHC_STORE_TAG} 12 | else 13 | GHC_STORE_TAG_PREFIXED = 14 | endif 15 | 16 | ifneq (,$(wildcard ${HOME}/.local/state/cabal/store)) 17 | PACKAGE_DB = ${HOME}/.local/state/cabal/store/ghc-${GHC_VERSION}${GHC_STORE_TAG_PREFIXED}/package.db 18 | else 19 | PACKAGE_DB = ${HOME}/.cabal/store/ghc-${GHC_VERSION}${GHC_STORE_TAG_PREFIXED}/package.db 20 | endif 21 | 22 | # this avoids changing the default environment: 23 | # ~/.ghc/x86_64-linux-8.6.5/environments/default 24 | # file; Unfortunatelly `/dev/null` is not accepted. 25 | # 26 | # THIS FILE WILL BE REMOVED! 27 | ENV=.ghc-tags-plugin.env 28 | 29 | uninstall: 30 | ${GHC_PKG} unregister \ 31 | --package-db=${PACKAGE_DB} \ 32 | --force \ 33 | ghc-tags-plugin 34 | 35 | uninstall-core: 36 | ${GHC_PKG} unregister \ 37 | --package-db=${PACKAGE_DB} \ 38 | --force \ 39 | ghc-tags-core 40 | 41 | install: 42 | # avoid changing the default environment 43 | cabal install --package-db=${PACKAGE_DB} \ 44 | --package-env=${ENV} \ 45 | --with-compiler=${GHC} \ 46 | --disable-documentation \ 47 | --reinstall \ 48 | --lib \ 49 | ghc-tags-plugin 50 | rm ${ENV} 51 | ${GHC_PKG} describe --package-db=${PACKAGE_DB} ghc-tags-plugin | grep -A1 ^id 52 | 53 | prof-install: 54 | # avoid changing the default environment 55 | cabal install --package-db=${PACKAGE_DB} \ 56 | --package-env=${ENV} \ 57 | --with-compiler=${GHC} \ 58 | --lib \ 59 | --disable-documentation \ 60 | --enable-profiling \ 61 | ghc-tags-plugin 62 | rm ${ENV} 63 | ${GHC_PKG} describe --package-db=${PACKAGE_DB} ghc-tags-plugin | grep -A1 ^id 64 | 65 | # reinstall ghc-tags-core and ghc-tags-plugin 66 | reinstall-core: uninstall uninstall-core install 67 | 68 | # reinstall only ghc-tags-plugin 69 | reinstall: uninstall install 70 | 71 | list: 72 | ${GHC_PKG} list --package-db=${PACKAGE_DB} | grep ghc-tags 73 | 74 | latest: 75 | ${GHC_PKG} latest --package-db=${PACKAGE_DB} ghc-tags-plugin 76 | 77 | recache: 78 | ${GHC_PKG} recache --package-db=${PACKAGE_DB} 79 | 80 | check: 81 | ${GHC_PKG} check --package-db=${PACKAGE_DB} 2>&1 | grep ghc-tags 82 | 83 | describe: 84 | ${GHC_PKG} describe --package-db=${PACKAGE_DB} ghc-tags-plugin 85 | 86 | describe-core: 87 | ${GHC_PKG} describe --package-db=${PACKAGE_DB} ghc-tags-core 88 | 89 | .PHONY: install, uninstall, uninstall-core, reinstall, reinstall-core, latest, check 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ghc-tags-plugin/README.md -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | index-state: 2025-03-16T13:55:03Z 2 | 3 | packages: ghc-tags-plugin 4 | ghc-tags-core 5 | ghc-tags-pipes 6 | ghc-tags-test 7 | 8 | allow-newer: pipes-safe:base 9 | 10 | package ghc-tags-core 11 | tests: True 12 | -------------------------------------------------------------------------------- /cabal.project.ci: -------------------------------------------------------------------------------- 1 | documentation: True 2 | tests: True 3 | benchmarks: True 4 | flags: +gtp-check 5 | 6 | package ghc-tags-core 7 | ghc-options: -j2 -Werror 8 | 9 | package ghc-tags-plugin 10 | ghc-options: -j2 -Werror 11 | 12 | package ghc-tags-pipes 13 | ghc-options: -j2 -Werror 14 | 15 | package ghc-tags-test 16 | ghc-options: -j2 -Werror 17 | -------------------------------------------------------------------------------- /ghc-tags-core/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for ghc-tags-core 2 | 3 | ## 0.6.1.1 -- 2024-07-21 4 | 5 | - `GHC-9.10` support. 6 | 7 | ## 0.6.1.0 -- 2024-02-11 8 | 9 | - `GHC-9.8` support; droppped support of `GHC-{8.10, 9.0, 9.2}`. 10 | 11 | ## 0.6.0.0 -- 2023-05-01 12 | 13 | - `GHC-9.6` support; dropped support of `GHC-8.8`. 14 | 15 | ## 0.5.0.0 16 | 17 | - Removed dependency on `pipes` package, some functionality moved to 18 | `ghc-tags-pipes` package. 19 | 20 | ## 0.4.2.2 21 | 22 | - Added `Ord` instances: `TagDefinition`, `TagFields`, `Tag` 23 | 24 | ## 0.4.2.1 25 | 26 | - Changed the `ghc` cabal flag in `ghc-tags-core` into `ghc-lib` flag. 27 | 28 | ## 0.4.2.0 29 | 30 | * Added `ghc` cabal flag, when not set, `ghc-tags-core` will be build with 31 | `ghc-lib` instead of `ghc` library. By default `ghc-tags-core` is built with 32 | `ghc` library. 33 | 34 | ## 0.4.0.0 35 | 36 | * Record tags for instance methods. 37 | * Added instance method tag field which records instance head 38 | * Changed `Semigroup` instance for `TagFields` (a left biased monoid isomorphic 39 | with `Map` monoid instance, rather than the free monoid) 40 | * Added `Semigroup` instance for `Tag` type (a left biased monoid) 41 | * Changed `TagKind` type: not indexed by `TAG_KIND` 42 | * Added `CTagMap` and `ETagMap` with parsers & formatters (for used by 43 | `ghc-tag`) 44 | 45 | ## 0.3.1.1 -- 2022-08-05 46 | 47 | * Support `GHC-9.4` 48 | 49 | ## 0.2.4.0 -- 2020-09-08 50 | 51 | * Type family and data type family kind contains all bound type variables (with 52 | their kind if they are given) 53 | * Type family instances: include the resulting type 54 | * Data type family instances: include the resulting kind 55 | * Data constructor tags cary the contstructor declaration 56 | 57 | ## 0.2.3.0 -- 2020-08-07 58 | 59 | * Added `hsDeclsToGhcTags`. 60 | * Type signatures for class method. 61 | 62 | ## 0.2.0.0 -- 2020-04-12 63 | 64 | * Use `Text` to represent file names; Parsers are using `ByteString` as input 65 | rather than `Text`, which allows to normalise `FilePath` when parsing data 66 | using `filepath-bytestring` library. 67 | 68 | ## 0.1.0.0 -- 2020-03-24 69 | 70 | * Normalise 'tagFilePath' for tags which are returned by the parsers. 71 | * Added `GhcTag`, some of the constructor contains type level information which 72 | is used to form `CTagFields`. 73 | * Added ctag [pseudo header](https://docs.ctags.io/en/latest/man/ctags-client-tools.7.html#pseudo-tags) parser 74 | 75 | ## 0.2.4.1 -- 2021-03-15 76 | 77 | * Support `GHC-9.0` 78 | * vim-plugin: better parser of ghc-pkg output 79 | -------------------------------------------------------------------------------- /ghc-tags-core/LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /ghc-tags-core/README.md: -------------------------------------------------------------------------------- 1 | Create and work with CTAGS and ETAGS files 2 | ========================================== 3 | ![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-8D82AC.svg?style=for-the-badge) 4 | ![MPL-2.0 License](http://img.shields.io/badge/license-MPL20-brightgreen.svg?style=for-the-badge) 5 | [![Haskell CI](https://img.shields.io/github/actions/workflow/status/coot/ghc-tags-plugin/ci.yml?branch=master&label=Build&style=for-the-badge)](https://github.com/coot/ghc-tags-plugin/actions/workflows/ci.yml) 6 | [![](https://matrix.hackage.haskell.org/api/v2/packages/ghc-tags-core/badge)](https://matrix.hackage.haskell.org/#/package/ghc-tags-core) 7 | 8 | Library scope 9 | ------------- 10 | 11 | `ghc-tags-core` library provides: 12 | 13 | * a function to extract /tag/ information from @'HsModule' 'GhcPs'@ parsed tree representation of Haskell code, 14 | * parsers for __ctag__ and __etag__ style tag files (/vim/ \/ /emacs/), 15 | * formatting tags into __ctag__ and __etag__ files, 16 | * tries to be compatible with [universal-ctags](https://github.com/universal-ctags/ctags). 17 | 18 | Projects using this library 19 | --------------------------- 20 | Check out these projects: 21 | 22 | * [ghc-tags] or its [fork][ghc-tags-fork] which is using the most recent 23 | `ghc-tags-core`; 24 | * [ghc-tags-plugin] - a ghc [compiler plugin] which extracts tags during 25 | @GHC@'s parser pass and also from TH splices. 26 | 27 | [ghc-tags-fork]: https://github.com/coot/ghc-tags 28 | [ghc-tags]: https://hackage.haskell.org/package/ghc-tags 29 | [ghc-tags-plugin]: https://hackage.haskell.org/package/ghc-tags-plugin 30 | [compiler plugin]: https://ghc.gitlab.haskell.org/ghc/doc/users_guide/extending_ghc.html?highlight=compiler%20plugin#compiler-plugins 31 | -------------------------------------------------------------------------------- /ghc-tags-core/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ghc-tags-core/ghc-tags-core.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: ghc-tags-core 3 | version: 0.6.1.1 4 | synopsis: CTags and ETags from Haskell syntax tree. 5 | description: A library to work with tags created from GHC syntax tree. 6 | license: MPL-2.0 7 | license-file: LICENSE 8 | author: Marcin Szamotulski 9 | maintainer: coot@coot.me 10 | copyright: (c) 2020-2025, Marcin Szamotulski 11 | category: Development 12 | stability: experimental 13 | extra-source-files: CHANGELOG.md 14 | README.md 15 | homepage: https://github.com/coot/ghc-tags-plugin#readme 16 | bug-reports: https://github.com/coot/ghc-tags-plugin/issues 17 | tested-with: GHC == { 9.6, 9.8, 9.10, 9.12 } 18 | 19 | flag ghc-lib 20 | default: False 21 | manual: True 22 | description: Use ghc-lib rather than ghc 23 | 24 | common warnings 25 | ghc-options: -Wall 26 | -Wno-unticked-promoted-constructors 27 | -Wcompat 28 | -- the following three warnings are enabled by -Wall in 29 | -- ghc-9.2 30 | -Wno-incomplete-uni-patterns 31 | -Wno-incomplete-record-updates 32 | -Wpartial-fields 33 | -Widentities 34 | -Wredundant-constraints 35 | if impl(ghc >= 9) 36 | ghc-options: -Wunused-packages 37 | 38 | library 39 | import: warnings 40 | hs-source-dirs: lib 41 | exposed-modules: GhcTags 42 | GhcTags.Ghc 43 | GhcTags.Tag 44 | GhcTags.CTag 45 | GhcTags.CTag.Header 46 | GhcTags.CTag.Parser 47 | GhcTags.CTag.Formatter 48 | GhcTags.CTag.Utils 49 | GhcTags.ETag 50 | GhcTags.ETag.Parser 51 | GhcTags.ETag.Formatter 52 | GhcTags.Utils 53 | build-depends: attoparsec >=0.14.4, 54 | base >=4.12.0.0 && <4.22, 55 | bytestring >=0.10, 56 | containers, 57 | deepseq, 58 | text >=1.2 && <2.2 59 | 60 | if impl(ghc >= 9.6) 61 | build-depends: filepath ^>= 1.4.100.1 || ^>= 1.5 62 | else 63 | build-depends: filepath-bytestring ^>= 1.4 64 | 65 | if flag(ghc-lib) 66 | build-depends: ghc-lib 67 | else 68 | build-depends: ghc 69 | 70 | if flag(ghc-lib) 71 | cpp-options: -DMIN_VERSION_GHC(x,y)=MIN_VERSION_ghc_lib(x,y,0) 72 | else 73 | cpp-options: -DMIN_VERSION_GHC(x,y)=MIN_VERSION_GLASGOW_HASKELL(x,y,0,0) 74 | 75 | default-language: Haskell2010 76 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags.hs: -------------------------------------------------------------------------------- 1 | module GhcTags 2 | ( module GhcTags.Ghc 3 | , module GhcTags.Tag 4 | ) where 5 | 6 | 7 | import GhcTags.Ghc 8 | import GhcTags.Tag 9 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/CTag.hs: -------------------------------------------------------------------------------- 1 | module GhcTags.CTag 2 | ( module X 3 | , compareTags 4 | ) where 5 | 6 | import GhcTags.CTag.Header as X 7 | import GhcTags.CTag.Parser as X 8 | import GhcTags.CTag.Formatter as X 9 | import GhcTags.CTag.Utils as X 10 | 11 | import GhcTags.Tag (CTag) 12 | import qualified GhcTags.Tag as Tag 13 | 14 | -- | A specialisation of 'GhcTags.Tag.compareTags' to 'CTag's. 15 | -- 16 | compareTags :: CTag -> CTag -> Ordering 17 | compareTags = Tag.compareTags 18 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/CTag/Formatter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | -- | 'bytestring''s 'Builder' for a 'Tag' 6 | -- 7 | module GhcTags.CTag.Formatter 8 | ( formatTagsFile 9 | , formatTagsFileMap 10 | -- * format a ctag 11 | , formatTag 12 | -- * format a pseudo-ctag 13 | , formatHeader 14 | ) where 15 | 16 | import Control.Arrow ((|||)) 17 | import Data.ByteString.Builder (Builder) 18 | import qualified Data.ByteString.Builder as BS 19 | import Data.Char (isAscii) 20 | import Data.List (sortBy) 21 | import qualified Data.Map.Strict as Map 22 | import Data.Text (Text) 23 | import qualified Data.Text.Encoding as Text 24 | 25 | import GhcTags.Tag 26 | import GhcTags.Utils (endOfLine) 27 | import GhcTags.CTag.Header 28 | import GhcTags.CTag.Utils 29 | 30 | 31 | -- | 'ByteString' 'Builder' for a single line. 32 | -- 33 | formatTag :: CTag -> Builder 34 | formatTag Tag { tagName, tagFilePath, tagAddr, tagKind, tagFields = TagFields tagFields } = 35 | 36 | (BS.byteString . Text.encodeUtf8 . getTagName $ tagName) 37 | <> BS.charUtf8 '\t' 38 | 39 | <> BS.byteString (Text.encodeUtf8 . getRawFilePath $ tagFilePath) 40 | <> BS.charUtf8 '\t' 41 | 42 | <> formatTagAddress tagAddr 43 | -- we are using extended format: '_TAG_FILE_FROMAT 2' 44 | <> BS.stringUtf8 ";\"" 45 | 46 | -- tag kind: we are encoding them using field syntax: this is because vim 47 | -- is using them in the right way: https://github.com/vim/vim/issues/5724 48 | <> formatKindChar tagKind 49 | 50 | -- tag fields 51 | <> foldMap ((BS.charUtf8 '\t' <>) . formatField) tagFields 52 | 53 | <> BS.stringUtf8 endOfLine 54 | 55 | where 56 | 57 | formatTagAddress :: CTagAddress -> Builder 58 | formatTagAddress (TagLineCol lineNo _colNo) = 59 | BS.intDec lineNo -- Vim only allows to use ranges; there's no way to 60 | -- specify column (`c|` command is not allowed) 61 | formatTagAddress (TagLine lineNo) = 62 | BS.intDec lineNo 63 | formatTagAddress (TagCommand exCommand) = 64 | BS.byteString . Text.encodeUtf8 . getExCommand $ exCommand 65 | 66 | formatKindChar :: TagKind -> Builder 67 | formatKindChar tk = 68 | case tagKindToChar tk of 69 | Nothing -> mempty 70 | Just c | isAscii c -> BS.charUtf8 '\t' <> BS.charUtf8 c 71 | | otherwise -> BS.stringUtf8 "\tkind:" <> BS.charUtf8 c 72 | 73 | 74 | formatField :: TagField -> Builder 75 | formatField TagField { fieldName, fieldValue } = 76 | BS.byteString (Text.encodeUtf8 fieldName) 77 | <> BS.charUtf8 ':' 78 | <> BS.byteString (Text.encodeUtf8 fieldValue) 79 | 80 | 81 | formatHeader :: Header -> Builder 82 | formatHeader Header { headerType, headerLanguage, headerArg, headerComment } = 83 | case headerType of 84 | FileEncoding -> 85 | formatTextHeaderArgs "FILE_ENCODING" headerLanguage headerArg headerComment 86 | FileFormat -> 87 | formatIntHeaderArgs "FILE_FORMAT" headerLanguage headerArg headerComment 88 | FileSorted -> 89 | formatIntHeaderArgs "FILE_SORTED" headerLanguage headerArg headerComment 90 | OutputMode -> 91 | formatTextHeaderArgs "OUTPUT_MODE" headerLanguage headerArg headerComment 92 | KindDescription -> 93 | formatTextHeaderArgs "KIND_DESCRIPTION" headerLanguage headerArg headerComment 94 | KindSeparator -> 95 | formatTextHeaderArgs "KIND_SEPARATOR" headerLanguage headerArg headerComment 96 | ProgramAuthor -> 97 | formatTextHeaderArgs "PROGRAM_AUTHOR" headerLanguage headerArg headerComment 98 | ProgramName -> 99 | formatTextHeaderArgs "PROGRAM_NAME" headerLanguage headerArg headerComment 100 | ProgramUrl -> 101 | formatTextHeaderArgs "PROGRAM_URL" headerLanguage headerArg headerComment 102 | ProgramVersion -> 103 | formatTextHeaderArgs "PROGRAM_VERSION" headerLanguage headerArg headerComment 104 | ExtraDescription -> 105 | formatTextHeaderArgs "EXTRA_DESCRIPTION" headerLanguage headerArg headerComment 106 | FieldDescription -> 107 | formatTextHeaderArgs "FIELD_DESCRIPTION" headerLanguage headerArg headerComment 108 | PseudoTag name -> 109 | formatHeaderArgs (BS.byteString . Text.encodeUtf8) 110 | "!_" name headerLanguage headerArg headerComment 111 | where 112 | formatHeaderArgs :: (ty -> Builder) 113 | -> String 114 | -> Text 115 | -> Maybe Text 116 | -> ty 117 | -> Text 118 | -> Builder 119 | formatHeaderArgs formatArg prefix headerName language arg comment = 120 | BS.stringUtf8 prefix 121 | <> BS.byteString (Text.encodeUtf8 headerName) 122 | <> foldMap ((BS.charUtf8 '!' <>) . BS.byteString . Text.encodeUtf8) language 123 | <> BS.charUtf8 '\t' 124 | <> formatArg arg 125 | <> BS.stringUtf8 "\t/" 126 | <> BS.byteString (Text.encodeUtf8 comment) 127 | <> BS.charUtf8 '/' 128 | <> BS.stringUtf8 endOfLine 129 | 130 | formatTextHeaderArgs = formatHeaderArgs (BS.byteString . Text.encodeUtf8) "!_TAG_" 131 | formatIntHeaderArgs = formatHeaderArgs BS.intDec "!_TAG_" 132 | 133 | 134 | -- | 'ByteString' 'Builder' for vim 'Tag' file. 135 | -- 136 | formatTagsFile :: [Either Header CTag] -- ^ 'CTag's 137 | -> Builder 138 | formatTagsFile tags = 139 | foldMap (formatHeader ||| formatTag) tags 140 | 141 | 142 | -- | 'ByteString' 'Builder' for vim 'Tag' file. 143 | -- 144 | formatTagsFileMap :: [Header] -- ^ Headers 145 | -> CTagMap -- ^ 'CTag's 146 | -> Builder 147 | formatTagsFileMap headers tags = 148 | foldMap formatHeader headers 149 | <> foldMap formatTag (sortBy compareTags . concat $ Map.elems tags) 150 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/CTag/Header.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE NamedFieldPuns #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE StandaloneDeriving #-} 7 | 8 | module GhcTags.CTag.Header 9 | ( Header (..) 10 | , HeaderType (..) 11 | , SomeHeaderType (..) 12 | -- * Utils 13 | , SingHeaderType (..) 14 | , headerTypeSing 15 | ) where 16 | 17 | import Control.DeepSeq (NFData (..)) 18 | import Data.Text (Text) 19 | 20 | 21 | -- | A type safe representation of a /ctag/ header. 22 | -- 23 | data Header where 24 | Header :: forall ty. (NFData ty, Show ty) => 25 | { headerType :: HeaderType ty 26 | , headerLanguage :: Maybe Text 27 | , headerArg :: ty 28 | , headerComment :: Text 29 | } 30 | -> Header 31 | 32 | instance Eq Header where 33 | Header { headerType = headerType0 34 | , headerLanguage = headerLanguage0 35 | , headerArg = headerArg0 36 | , headerComment = headerComment0 37 | } 38 | == 39 | Header { headerType = headerType1 40 | , headerLanguage = headerLanguage1 41 | , headerArg = headerArg1 42 | , headerComment = headerComment1 43 | } = 44 | case (headerType0, headerType1) of 45 | (FileEncoding, FileEncoding) -> 46 | headerArg0 == headerArg1 && 47 | headerLanguage0 == headerLanguage1 && 48 | headerComment0 == headerComment1 49 | (FileFormat, FileFormat) -> 50 | headerArg0 == headerArg1 && 51 | headerLanguage0 == headerLanguage1 && 52 | headerComment0 == headerComment1 53 | (FileSorted, FileSorted) -> 54 | headerArg0 == headerArg1 && 55 | headerLanguage0 == headerLanguage1 && 56 | headerComment0 == headerComment1 57 | (OutputMode, OutputMode) -> 58 | headerArg0 == headerArg1 && 59 | headerLanguage0 == headerLanguage1 && 60 | headerComment0 == headerComment1 61 | (KindDescription, KindDescription) -> 62 | headerArg0 == headerArg1 && 63 | headerLanguage0 == headerLanguage1 && 64 | headerComment0 == headerComment1 65 | (KindSeparator, KindSeparator) -> 66 | headerArg0 == headerArg1 && 67 | headerLanguage0 == headerLanguage1 && 68 | headerComment0 == headerComment1 69 | (ProgramAuthor, ProgramAuthor) -> 70 | headerArg0 == headerArg1 && 71 | headerLanguage0 == headerLanguage1 && 72 | headerComment0 == headerComment1 73 | (ProgramName, ProgramName) -> 74 | headerArg0 == headerArg1 && 75 | headerLanguage0 == headerLanguage1 && 76 | headerComment0 == headerComment1 77 | (ProgramUrl, ProgramUrl) -> 78 | headerArg0 == headerArg1 && 79 | headerLanguage0 == headerLanguage1 && 80 | headerComment0 == headerComment1 81 | (ProgramVersion, ProgramVersion) -> 82 | headerArg0 == headerArg1 && 83 | headerLanguage0 == headerLanguage1 && 84 | headerComment0 == headerComment1 85 | (ExtraDescription, ExtraDescription) -> 86 | headerArg0 == headerArg1 && 87 | headerLanguage0 == headerLanguage1 && 88 | headerComment0 == headerComment1 89 | (FieldDescription, FieldDescription) -> 90 | headerArg0 == headerArg1 && 91 | headerLanguage0 == headerLanguage1 && 92 | headerComment0 == headerComment1 93 | (PseudoTag name0, PseudoTag name1) -> 94 | name0 == name1 && 95 | headerLanguage0 == headerLanguage1 && 96 | headerArg0 == headerArg1 && 97 | headerComment0 == headerComment1 98 | _ -> False 99 | 100 | deriving instance Show Header 101 | 102 | instance NFData Header where 103 | rnf Header {..} = rnf headerType 104 | `seq` rnf headerLanguage 105 | `seq` rnf headerArg 106 | `seq` rnf headerComment 107 | 108 | -- | Enumeration of header type and values of their corresponding argument 109 | -- 110 | data HeaderType ty where 111 | FileEncoding :: HeaderType Text 112 | FileFormat :: HeaderType Int 113 | FileSorted :: HeaderType Int 114 | OutputMode :: HeaderType Text 115 | KindDescription :: HeaderType Text 116 | KindSeparator :: HeaderType Text 117 | ProgramAuthor :: HeaderType Text 118 | ProgramName :: HeaderType Text 119 | ProgramUrl :: HeaderType Text 120 | ProgramVersion :: HeaderType Text 121 | 122 | ExtraDescription :: HeaderType Text 123 | FieldDescription :: HeaderType Text 124 | PseudoTag :: Text -> HeaderType Text 125 | 126 | deriving instance Eq (HeaderType ty) 127 | deriving instance Ord (HeaderType ty) 128 | deriving instance Show (HeaderType ty) 129 | instance NFData (HeaderType ty) where 130 | rnf a = a `seq` () 131 | 132 | -- | Existential wrapper. 133 | -- 134 | data SomeHeaderType where 135 | SomeHeaderType :: forall ty. HeaderType ty -> SomeHeaderType 136 | 137 | 138 | -- | Singletons which makes it easier to work with 'HeaderType' 139 | -- 140 | data SingHeaderType ty where 141 | SingHeaderTypeText :: SingHeaderType Text 142 | SingHeaderTypeInt :: SingHeaderType Int 143 | 144 | headerTypeSing :: HeaderType ty -> SingHeaderType ty 145 | headerTypeSing = \case 146 | FileEncoding -> SingHeaderTypeText 147 | FileFormat -> SingHeaderTypeInt 148 | FileSorted -> SingHeaderTypeInt 149 | OutputMode -> SingHeaderTypeText 150 | KindDescription -> SingHeaderTypeText 151 | KindSeparator -> SingHeaderTypeText 152 | ProgramAuthor -> SingHeaderTypeText 153 | ProgramName -> SingHeaderTypeText 154 | ProgramUrl -> SingHeaderTypeText 155 | ProgramVersion -> SingHeaderTypeText 156 | 157 | ExtraDescription -> SingHeaderTypeText 158 | FieldDescription -> SingHeaderTypeText 159 | PseudoTag {} -> SingHeaderTypeText 160 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/CTag/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE NamedFieldPuns #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | 8 | -- | Parser combinators for vim style tags (ctags) 9 | -- 10 | module GhcTags.CTag.Parser 11 | ( parseTagsFile 12 | , parseTagsFileMap 13 | , parseTagLine 14 | -- * parse a ctag 15 | , parseTag 16 | -- * parse a pseudo-ctag 17 | , parseHeader 18 | ) where 19 | 20 | import Control.Arrow ((***)) 21 | import Control.Applicative (many, (<|>)) 22 | import Control.DeepSeq (NFData) 23 | import Control.Monad (guard) 24 | import Data.ByteString (ByteString) 25 | import qualified Data.ByteString as BS 26 | import Data.Attoparsec.ByteString (Parser, ()) 27 | import qualified Data.Attoparsec.ByteString as AB 28 | import qualified Data.Attoparsec.ByteString.Char8 as AChar 29 | import Data.Either (partitionEithers) 30 | import Data.Functor (void, ($>)) 31 | import Data.Function (on) 32 | import qualified Data.Map.Strict as Map 33 | import Data.Text (Text) 34 | import qualified Data.Text as Text 35 | import qualified Data.Text.Encoding as Text 36 | 37 | import GhcTags.Tag 38 | import qualified GhcTags.Utils as Utils 39 | import GhcTags.CTag.Header 40 | import GhcTags.CTag.Utils 41 | 42 | 43 | -- | Parser for a 'CTag' from a single text line. 44 | -- 45 | parseTag :: Parser CTag 46 | parseTag = 47 | (\tagName tagFilePath tagAddr (tagKind, tagFields) 48 | -> Tag { tagName 49 | , tagFilePath 50 | , tagAddr 51 | , tagKind 52 | , tagFields 53 | , tagDefinition = NoTagDefinition 54 | }) 55 | <$> parseTagName 56 | <* separator 57 | 58 | <*> parseTagFileName 59 | <* separator 60 | 61 | -- includes an optional ';"' separator 62 | <*> parseTagAddress 63 | 64 | <*> ( -- kind field followed by list of fields or end of line, e.g. 65 | -- '(TagField, CTagFields)'. 66 | ((,) <$> ( separator *> parseKindField ) 67 | <*> ( separator *> parseFields <* endOfLine 68 | <|> 69 | endOfLine $> mempty) 70 | ) 71 | 72 | -- list of fields (kind field might be later, but don't check it, we 73 | -- always format it as the first field) or end of line. 74 | <|> curry id NoKind 75 | <$> ( separator *> parseFields <* endOfLine 76 | <|> 77 | endOfLine $> mempty 78 | ) 79 | 80 | -- kind encoded as a single letter, followed by a list 81 | -- of fields or end of line. 82 | <|> curry (charToTagKind *** id) 83 | <$> ( separator *> AChar.satisfy notTabOrNewLine ) 84 | <*> ( separator *> parseFields <* endOfLine 85 | <|> 86 | endOfLine $> mempty 87 | ) 88 | <|> endOfLine $> (NoKind, mempty) 89 | ) 90 | 91 | where 92 | separator :: Parser Char 93 | separator = AChar.char '\t' 94 | 95 | parseTagName :: Parser TagName 96 | parseTagName = TagName . Text.decodeUtf8 97 | <$> AChar.takeWhile (/= '\t') 98 | "parsing tag name failed" 99 | 100 | parseTagFileName :: Parser TagFilePath 101 | parseTagFileName = 102 | TagFilePath . Text.decodeUtf8 103 | . rawFilePathToBS 104 | . normaliseRawFilePath 105 | . rawFilePathFromBS 106 | <$> AChar.takeWhile (/= '\t') 107 | 108 | parseExCommand :: Parser ExCommand 109 | parseExCommand = (\x -> ExCommand $ Text.decodeUtf8 $ BS.take (BS.length x - 1) x) 110 | <$> AChar.scan "" go 111 | <* AChar.anyChar 112 | where 113 | -- go until either eol or ';"' sequence is found. 114 | go :: String -> Char -> Maybe String 115 | 116 | go !s c | -- eol 117 | take (length Utils.endOfLine) (c : s) 118 | == reverse Utils.endOfLine 119 | = Nothing 120 | 121 | | -- ';"' sequence 122 | l == "\";" = Nothing 123 | 124 | | otherwise = Just l 125 | where 126 | l = take 2 (c : s) 127 | 128 | -- We only parse `TagLine` or `TagCommand`. 129 | parseTagAddress :: Parser CTagAddress 130 | parseTagAddress = 131 | TagLine <$> AChar.decimal <* (endOfLine <|> void (AB.string ";\"")) 132 | <|> 133 | TagCommand <$> parseExCommand 134 | 135 | parseKindField :: Parser TagKind 136 | parseKindField = do 137 | x <- 138 | Text.decodeUtf8 139 | <$> (AB.string "kind:" *> AChar.takeWhile notTabOrNewLine) 140 | guard (Text.length x == 1) 141 | pure $ charToTagKind (Text.head x) 142 | 143 | parseFields :: Parser CTagFields 144 | parseFields = TagFields <$> AChar.sepBy parseField separator 145 | 146 | 147 | parseField :: Parser TagField 148 | parseField = 149 | on TagField Text.decodeUtf8 150 | <$> AChar.takeWhile (\x -> x /= ':' && notTabOrNewLine x) 151 | <* AChar.char ':' 152 | <*> AChar.takeWhile notTabOrNewLine 153 | 154 | 155 | -- | A vim-style tag file parser. 156 | -- 157 | parseTags :: Parser [Either Header CTag] 158 | parseTags = many parseTagLine 159 | 160 | 161 | -- | Parse either a header line ot a 'CTag'. 162 | -- 163 | parseTagLine :: Parser (Either Header CTag) 164 | parseTagLine = 165 | AChar.eitherP 166 | (parseHeader "failed parsing tag") 167 | (parseTag "failed parsing header") 168 | 169 | 170 | parseHeader :: Parser Header 171 | parseHeader = do 172 | e <- AB.string "!_TAG_" $> False 173 | <|> 174 | AB.string "!_" $> True 175 | if e then flip parsePseudoTagArgs (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 176 | . PseudoTag 177 | . Text.decodeUtf8 178 | =<< AChar.takeWhile (\x -> notTabOrNewLine x && x /= '!') 179 | else do 180 | headerType <- 181 | AB.string "FILE_ENCODING" $> SomeHeaderType FileEncoding 182 | <|> AB.string "FILE_FORMAT" $> SomeHeaderType FileFormat 183 | <|> AB.string "FILE_SORTED" $> SomeHeaderType FileSorted 184 | <|> AB.string "OUTPUT_MODE" $> SomeHeaderType OutputMode 185 | <|> AB.string "KIND_DESCRIPTION" $> SomeHeaderType KindDescription 186 | <|> AB.string "KIND_SEPARATOR" $> SomeHeaderType KindSeparator 187 | <|> AB.string "PROGRAM_AUTHOR" $> SomeHeaderType ProgramAuthor 188 | <|> AB.string "PROGRAM_NAME" $> SomeHeaderType ProgramName 189 | <|> AB.string "PROGRAM_URL" $> SomeHeaderType ProgramUrl 190 | <|> AB.string "PROGRAM_VERSION" $> SomeHeaderType ProgramVersion 191 | <|> AB.string "EXTRA_DESCRIPTION" $> SomeHeaderType ExtraDescription 192 | <|> AB.string "FIELD_DESCRIPTION" $> SomeHeaderType FieldDescription 193 | case headerType of 194 | SomeHeaderType ht@FileEncoding -> 195 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 196 | SomeHeaderType ht@FileFormat -> 197 | parsePseudoTagArgs ht AChar.decimal 198 | SomeHeaderType ht@FileSorted -> 199 | parsePseudoTagArgs ht AChar.decimal 200 | SomeHeaderType ht@OutputMode -> 201 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 202 | SomeHeaderType ht@KindDescription -> 203 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 204 | SomeHeaderType ht@KindSeparator -> 205 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 206 | SomeHeaderType ht@ProgramAuthor -> 207 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 208 | SomeHeaderType ht@ProgramName -> 209 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 210 | SomeHeaderType ht@ProgramUrl -> 211 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 212 | SomeHeaderType ht@ProgramVersion -> 213 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 214 | SomeHeaderType ht@ExtraDescription -> 215 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 216 | SomeHeaderType ht@FieldDescription -> 217 | parsePseudoTagArgs ht (Text.decodeUtf8 <$> AChar.takeWhile notTabOrNewLine) 218 | SomeHeaderType PseudoTag {} -> 219 | error "parseHeader: impossible happened" 220 | 221 | where 222 | parsePseudoTagArgs :: NFData ty 223 | => Show ty 224 | => HeaderType ty 225 | -> Parser ty 226 | -> Parser Header 227 | parsePseudoTagArgs ht parseArg = 228 | Header ht 229 | <$> ( (Just . Text.decodeUtf8 <$> (AChar.char '!' *> AChar.takeWhile notTabOrNewLine)) 230 | <|> pure Nothing 231 | ) 232 | <*> (AChar.char '\t' *> parseArg) 233 | <*> (AChar.char '\t' *> parseComment) 234 | 235 | parseComment :: Parser Text 236 | parseComment = 237 | AChar.char '/' 238 | *> (Text.init . Text.decodeUtf8 <$> AChar.takeWhile Utils.notNewLine) 239 | <* endOfLine 240 | 241 | 242 | 243 | -- | Parse a vim-style tag file. 244 | -- 245 | parseTagsFile :: ByteString 246 | -> IO (Either String [Either Header CTag]) 247 | parseTagsFile = 248 | fmap AChar.eitherResult 249 | . AChar.parseWith (pure mempty) parseTags 250 | 251 | 252 | 253 | -- | Parse a vim-style tag file. 254 | -- 255 | parseTagsFileMap :: ByteString 256 | -> IO (Either String ([Header], CTagMap)) 257 | parseTagsFileMap = 258 | fmap (fmap f) . parseTagsFile 259 | where 260 | f :: [Either Header CTag] -> ([Header], CTagMap) 261 | f as = case partitionEithers as of 262 | (headers, tags) -> 263 | (headers, Map.fromListWith (++) [(tagFilePath tag, [tag]) | tag <- tags]) 264 | 265 | -- 266 | -- Utils 267 | -- 268 | 269 | 270 | -- | Unlike 'AChar.endOfLine', it also matches for a single '\r' characters (which 271 | -- marks end of lines on darwin). 272 | -- 273 | endOfLine :: Parser () 274 | endOfLine = AB.string "\r\n" $> () 275 | <|> AChar.char '\r' $> () 276 | <|> AChar.char '\n' $> () 277 | 278 | 279 | notTabOrNewLine :: Char -> Bool 280 | notTabOrNewLine = \x -> x /= '\t' && Utils.notNewLine x 281 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/CTag/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | 3 | module GhcTags.CTag.Utils 4 | ( tagKindToChar 5 | , charToTagKind 6 | ) where 7 | 8 | import GhcTags.Tag 9 | 10 | tagKindToChar :: TagKind -> Maybe Char 11 | tagKindToChar tk = case tk of 12 | TkModule -> Just 'M' 13 | TkTerm -> Just '`' 14 | TkFunction -> Just 'λ' 15 | TkTypeConstructor -> Just 'Λ' 16 | TkDataConstructor -> Just 'c' 17 | TkGADTConstructor -> Just 'g' 18 | TkRecordField -> Just 'r' 19 | TkTypeSynonym -> Just '≡' 20 | TkTypeSignature -> Just '⊢' 21 | TkPatternSynonym -> Just 'p' 22 | TkTypeClass -> Just 'C' 23 | TkTypeClassMember -> Just 'm' 24 | TkTypeClassInstance -> Just 'i' 25 | TkTypeClassInstanceMember -> Just 'x' 26 | TkTypeFamily -> Just 'f' 27 | TkTypeFamilyInstance -> Just 'F' 28 | TkDataTypeFamily -> Just 'd' 29 | TkDataTypeFamilyInstance -> Just 'D' 30 | TkForeignImport -> Just 'I' 31 | TkForeignExport -> Just 'E' 32 | 33 | CharKind c -> Just c 34 | NoKind -> Nothing 35 | 36 | 37 | charToTagKind :: Char -> TagKind 38 | charToTagKind c = case c of 39 | 'M' -> TkModule 40 | '`' -> TkTerm 41 | 'λ' -> TkFunction 42 | 'Λ' -> TkTypeConstructor 43 | 'c' -> TkDataConstructor 44 | 'g' -> TkGADTConstructor 45 | 'r' -> TkRecordField 46 | '≡' -> TkTypeSynonym 47 | '⊢' -> TkTypeSignature 48 | 'p' -> TkPatternSynonym 49 | 'C' -> TkTypeClass 50 | 'm' -> TkTypeClassMember 51 | 'i' -> TkTypeClassInstance 52 | 'x' -> TkTypeClassInstanceMember 53 | 'f' -> TkTypeFamily 54 | 'F' -> TkTypeFamilyInstance 55 | 'd' -> TkDataTypeFamily 56 | 'D' -> TkDataTypeFamilyInstance 57 | 'I' -> TkForeignImport 58 | 'E' -> TkForeignExport 59 | 60 | _ -> CharKind c 61 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/ETag.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | 4 | module GhcTags.ETag 5 | ( module X 6 | , compareTags 7 | ) where 8 | 9 | import Data.Function (on) 10 | 11 | import GhcTags.ETag.Formatter as X 12 | import GhcTags.ETag.Parser as X 13 | 14 | import GhcTags.Tag ( Tag (..) 15 | , ETag 16 | , TagAddress (..) 17 | , tagFilePath 18 | ) 19 | 20 | 21 | -- | Order 'ETag's according to filename & byteOffset 22 | -- 23 | compareTags :: ETag -> ETag -> Ordering 24 | compareTags t0 t1 = 25 | on compare tagFilePath t0 t1 26 | <> on compare (\Tag {tagAddr} -> 27 | case tagAddr of 28 | TagLineCol line _ -> line 29 | TagLine line -> line 30 | NoAddress -> 0 31 | ) t0 t1 32 | <> on compare tagName t0 t1 33 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/ETag/Formatter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE NamedFieldPuns #-} 4 | 5 | -- | Simple etags formatter. See 6 | -- 7 | module GhcTags.ETag.Formatter 8 | ( formatETagsFile 9 | , formatTagsFileMap 10 | , formatTagsFile 11 | , formatTag 12 | , BuilderWithSize (..) 13 | ) where 14 | 15 | import qualified Data.ByteString as BS 16 | import qualified Data.ByteString.Char8 as BS.Char8 17 | import Data.ByteString.Builder (Builder) 18 | import qualified Data.ByteString.Builder as BB 19 | import Data.List (groupBy) 20 | import Data.Function (on) 21 | -- import Data.Foldable (foldl') 22 | import qualified Data.Text.Encoding as Text 23 | 24 | import GhcTags.Tag 25 | 26 | 27 | -- | A product of two monoids: 'Builder' and 'Sum'. 28 | -- 29 | data BuilderWithSize = BuilderWithSize { 30 | builder :: Builder, 31 | builderSize :: !Int 32 | } 33 | 34 | instance Semigroup BuilderWithSize where 35 | BuilderWithSize b0 s0 <> BuilderWithSize b1 s1 = 36 | BuilderWithSize (b0 <> b1) (s0 + s1) 37 | 38 | instance Monoid BuilderWithSize where 39 | mempty = BuilderWithSize mempty 0 40 | 41 | formatTag :: ETag -> BuilderWithSize 42 | formatTag Tag {tagName, tagAddr, tagDefinition} = 43 | flip BuilderWithSize tagSize $ 44 | -- TODO: get access to the original line or pretty print original 45 | -- declaration 46 | BB.byteString tagDefinitionBS 47 | <> BB.charUtf8 '\DEL' -- or '\x7f' 48 | <> BB.byteString tagNameBS 49 | <> BB.charUtf8 '\SOH' -- or '\x01' 50 | <> BB.byteString tagAddressBS 51 | <> BB.stringUtf8 endOfLine 52 | where 53 | tagNameBS :: BS.ByteString 54 | tagNameBS = Text.encodeUtf8 . getTagName $ tagName 55 | tagNameSize = BS.length tagNameBS 56 | 57 | tagDefinitionBS :: BS.ByteString 58 | tagDefinitionBS = case tagDefinition of 59 | NoTagDefinition -> mempty 60 | TagDefinition def -> Text.encodeUtf8 def 61 | tagDefinitionSize = BS.length tagDefinitionBS 62 | 63 | tagAddressBS :: BS.ByteString 64 | tagAddressBS = case tagAddr of 65 | TagLine lineNo -> 66 | BS.Char8.pack (show lineNo) 67 | <> BS.Char8.singleton ',' 68 | TagLineCol lineNo offset -> 69 | BS.Char8.pack (show lineNo) 70 | <> BS.Char8.singleton ',' 71 | <> BS.Char8.pack (show offset) 72 | NoAddress -> 73 | BS.Char8.singleton ',' 74 | tagAddressSize = BS.length tagAddressBS 75 | 76 | tagSize = 77 | 2 -- delimiters: '\DEL', '\SOH' 78 | + tagDefinitionSize 79 | + tagNameSize 80 | + tagAddressSize 81 | + length endOfLine 82 | 83 | 84 | -- | The precondition is that all the tags come frome the same file. 85 | -- 86 | formatTagsFile :: [ETag] -> Builder 87 | formatTagsFile [] = mempty 88 | formatTagsFile ts@(Tag {tagFilePath} : _) = 89 | case foldMap formatTag ts of 90 | BuilderWithSize {builder, builderSize} -> 91 | if builderSize > 0 92 | then BB.charUtf8 '\x0c' 93 | <> BB.stringUtf8 endOfLine 94 | <> BB.byteString (Text.encodeUtf8 $ getRawFilePath tagFilePath) 95 | <> BB.charUtf8 ',' 96 | <> BB.intDec builderSize 97 | <> BB.stringUtf8 endOfLine 98 | <> builder 99 | else mempty 100 | 101 | 102 | -- | Format a list of tags as etags file. Tags from the same file must be 103 | -- grouped together. 104 | -- 105 | formatETagsFile :: [ETag] -> Builder 106 | formatETagsFile = 107 | foldMap formatTagsFile 108 | . groupBy (on (==) tagFilePath) 109 | 110 | formatTagsFileMap :: ETagMap -> Builder 111 | formatTagsFileMap = foldMap formatTagsFile 112 | 113 | endOfLine :: String 114 | endOfLine = "\n" 115 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/ETag/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE BangPatterns #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | {-# LANGUAGE DerivingStrategies #-} 7 | {-# LANGUAGE NamedFieldPuns #-} 8 | {-# LANGUAGE OverloadedStrings #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | {-# LANGUAGE TupleSections #-} 11 | 12 | -- | Parser combinators for etags file format 13 | -- 14 | module GhcTags.ETag.Parser 15 | ( parseTagsFile 16 | , parseTagsFileMap 17 | , parseTagFileSection 18 | , parseTag 19 | ) where 20 | 21 | import Control.Applicative (many, (<|>)) 22 | import Data.ByteString (ByteString) 23 | import Data.Attoparsec.ByteString (Parser, ()) 24 | import qualified Data.Attoparsec.ByteString as AB 25 | import qualified Data.Attoparsec.ByteString.Char8 as AChar 26 | import Data.Functor (($>)) 27 | import qualified Data.Map.Strict as Map 28 | import qualified Data.Text as Text 29 | import qualified Data.Text.Encoding as Text 30 | 31 | import GhcTags.Tag 32 | import qualified GhcTags.Utils as Utils 33 | 34 | 35 | -- | Parse whole etags file 36 | -- 37 | parseTagsFile :: ByteString 38 | -> IO (Either String [ETag]) 39 | parseTagsFile = 40 | fmap AB.eitherResult 41 | . AB.parseWith (pure mempty) 42 | (concat . map snd <$> many parseTagFileSection) 43 | 44 | -- | Parse whole etags file 45 | -- 46 | parseTagsFileMap :: ByteString 47 | -> IO (Either String ETagMap) 48 | parseTagsFileMap = 49 | fmap AB.eitherResult 50 | . AB.parseWith (pure mempty) 51 | (Map.fromList <$> many parseTagFileSection) 52 | 53 | -- | Parse tags from a single file (a single section in etags file). 54 | -- 55 | parseTagFileSection :: Parser (TagFilePath, [ETag]) 56 | parseTagFileSection = do 57 | tagFilePath <- 58 | AChar.char '\x0c' *> endOfLine 59 | *> parseTagFilePath 60 | (tagFilePath,) <$> many (parseTag tagFilePath) 61 | 62 | parseTagFilePath :: Parser TagFilePath 63 | parseTagFilePath = 64 | TagFilePath . Text.decodeUtf8 65 | . rawFilePathToBS 66 | . normaliseRawFilePath 67 | . rawFilePathFromBS 68 | <$> AChar.takeWhile (\x -> x /= ',' && Utils.notNewLine x) 69 | <* AChar.char ',' 70 | <* (AChar.decimal :: Parser Int) 71 | <* endOfLine 72 | "parsing tag file name failed" 73 | 74 | 75 | -- | Parse an 'ETag' from a single line. 76 | -- 77 | parseTag :: TagFilePath -> Parser ETag 78 | parseTag tagFilePath = 79 | mkTag 80 | <$> parseTagDefinition 81 | <*> parseTagName 82 | <*> parseAddress 83 | "parsing tag failed" 84 | where 85 | parseAddress :: Parser ETagAddress 86 | parseAddress = 87 | TagLine <$> AChar.decimal 88 | <* AChar.char ',' 89 | <* endOfLine 90 | <|> TagLineCol <$> AChar.decimal 91 | <* AChar.char ',' 92 | <*> AChar.decimal 93 | <* endOfLine 94 | <|> NoAddress <$ AChar.char ',' 95 | <* endOfLine 96 | 97 | mkTag :: TagDefinition ETAG -> TagName -> ETagAddress -> ETag 98 | mkTag tagDefinition tagName tagAddr = 99 | Tag { tagName = tagName 100 | , tagKind = NoKind 101 | , tagFilePath 102 | , tagAddr 103 | , tagDefinition 104 | , tagFields = NoTagFields 105 | } 106 | 107 | parseTagName :: Parser TagName 108 | parseTagName = 109 | TagName . Text.decodeUtf8 110 | <$> AChar.takeWhile (\x -> x /= '\SOH' && Utils.notNewLine x) 111 | <* AChar.char '\SOH' 112 | "parsing tag name failed" 113 | 114 | parseTagDefinition :: Parser (TagDefinition ETAG) 115 | parseTagDefinition = 116 | (\t -> if Text.null t 117 | then NoTagDefinition 118 | else TagDefinition t) 119 | . Text.decodeUtf8 120 | <$> AChar.takeWhile (\x -> x /= '\DEL' && Utils.notNewLine x) 121 | <* AChar.char '\DEL' 122 | "parsing tag definition failed" 123 | 124 | endOfLine :: Parser () 125 | endOfLine = AChar.string "\r\n" $> () 126 | <|> AChar.char '\r' $> () 127 | <|> AChar.char '\n' $> () 128 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/Stream.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE KindSignatures #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | {-# LANGUAGE TupleSections #-} 7 | 8 | -- | Parse and combine a stream of tags. 9 | -- 10 | module GhcTags.Stream 11 | ( tagParser 12 | , combineTagsPipe 13 | , runCombineTagsPipe 14 | ) where 15 | 16 | import Control.Monad.State.Strict 17 | import Data.ByteString (ByteString) 18 | import Data.Attoparsec.ByteString (Parser) 19 | import qualified Data.ByteString as BS 20 | import Data.ByteString.Builder (Builder) 21 | import qualified Data.ByteString.Builder as BS 22 | import Data.Functor (($>)) 23 | import qualified Data.Text.Encoding as Text 24 | import System.IO 25 | import System.FilePath.ByteString (RawFilePath) 26 | 27 | import Pipes ((>->), (~>)) 28 | import qualified Pipes 29 | import qualified Pipes.Lift as Pipes 30 | import qualified Pipes.Attoparsec as Pipes.AP 31 | import qualified Pipes.ByteString as Pipes.BS 32 | 33 | import GhcTags.Tag 34 | 35 | 36 | -- | Parse a stream of tags, coming from a 'Text' producer. 37 | -- 38 | tagParser :: MonadIO m 39 | => Parser (Maybe (Tag tk)) 40 | -- ^ Parse a single tag. For Vim this returns should parse a single 41 | -- line and return the tag, e.g 'parseTagLine'. 42 | -> Pipes.Producer ByteString m () 43 | -> Pipes.Producer (Tag tk) m () 44 | tagParser parser producer = 45 | Pipes.for_ 46 | (Pipes.AP.parsed parser producer) 47 | $ \case 48 | -- ignore header lines 49 | Just tag -> Pipes.yield tag 50 | Nothing -> pure () 51 | 52 | 53 | -- | Streaming version of 'GhcTags.Tag.combineTags'. 54 | -- 55 | combineTagsPipe 56 | :: forall m (tk :: TAG_KIND). Applicative m 57 | => (Tag tk -> Tag tk -> Ordering) 58 | -> RawFilePath -- ^ file path from which the new tags were obtained, it should be normalised 59 | -> Tag tk -- ^ tag read from disc 60 | -> [Tag tk] -- ^ new tags 61 | -> Pipes.Producer (Tag tk) m [Tag tk] 62 | combineTagsPipe compareFn modPath = go 63 | where 64 | go :: Tag tk -> [Tag tk] 65 | -> Pipes.Producer (Tag tk) m [Tag tk] 66 | 67 | -- note: we check that 'tagFilePath' ends with 'modPath', which is 68 | -- a relative path from the corresponding cabal file. 69 | go tag as 70 | | modPath `BS.isSuffixOf` Text.encodeUtf8 (getRawFilePath (tagFilePath tag)) 71 | = pure as 72 | 73 | go tag as@(a : as') 74 | = case a `compareFn` tag of 75 | LT -> Pipes.yield a >> go tag as' 76 | EQ -> Pipes.yield a $> as' 77 | GT -> Pipes.yield tag $> as 78 | 79 | go tag [] = Pipes.yield tag $> [] 80 | 81 | 82 | -- | run 'combineTagsPipe' taking care of the state. 83 | -- 84 | runCombineTagsPipe 85 | :: MonadIO m 86 | => Handle 87 | -> (Tag tk -> Tag tk -> Ordering) 88 | -> (Tag tk -> Builder) 89 | -> RawFilePath 90 | -> Tag tk 91 | -> Pipes.Effect (StateT [Tag tk] m) () 92 | runCombineTagsPipe writeHandle compareFn formatTag modPath = 93 | (\tag -> Pipes.stateP $ fmap ((),) . combineTagsPipe compareFn modPath tag) 94 | ~> Pipes.yield . BS.toLazyByteString . formatTag 95 | ~> Pipes.BS.fromLazy 96 | ~> (\bs -> Pipes.yield bs >-> Pipes.BS.toHandle writeHandle) 97 | -------------------------------------------------------------------------------- /ghc-tags-core/lib/GhcTags/Utils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module GhcTags.Utils 4 | ( endOfLine 5 | , notNewLine 6 | ) where 7 | 8 | -- | Platform dependent eol: 9 | -- 10 | -- * Windows "CRNL" 11 | -- * MacOS "CR" 12 | -- * Linux (unit) "NL" 13 | -- 14 | endOfLine :: String 15 | #if defined(mingw32_HOST_OS) 16 | endOfLine = "\r\n" 17 | #elif defined(darwin_HIST_OS) 18 | endOfLine = "\r" 19 | #else 20 | endOfLine = "\n" 21 | #endif 22 | 23 | 24 | notNewLine :: Char -> Bool 25 | notNewLine = \x -> x /= '\n' && x /= '\r' 26 | -------------------------------------------------------------------------------- /ghc-tags-pipes/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for ghc-tags-pipes 2 | 3 | ## 0.1.1.0 -- 2023-05-01 4 | 5 | * `GHC-9.6` support. 6 | 7 | ## 0.1.0.0 -- YYYY-mm-dd 8 | 9 | * First version. Released on an unsuspecting world. 10 | -------------------------------------------------------------------------------- /ghc-tags-pipes/LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /ghc-tags-pipes/README.md: -------------------------------------------------------------------------------- 1 | ghc-tags-pipes 2 | ============== 3 | 4 | ![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-8D82AC.svg?style=for-the-badge) 5 | ![MPL-2.0 License](http://img.shields.io/badge/license-MPL20-brightgreen.svg?style=for-the-badge) 6 | [![Haskell CI](https://img.shields.io/github/actions/workflow/status/coot/ghc-tags-plugin/ci.yml?branch=master&label=Build&style=for-the-badge)](https://github.com/coot/ghc-tags-plugin/actions/workflows/ci.yml) 7 | 8 | Using `pipes` to stream tags to parse them with `ghc-tags-core`. 9 | -------------------------------------------------------------------------------- /ghc-tags-pipes/ghc-tags-pipes.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: ghc-tags-pipes 3 | version: 0.1.1.0 4 | synopsis: Streaming interface for ghc-tags-core 5 | description: Interface to stream tags using `pipes` library. 6 | homepage: https://github.com/coot/ghc-tags-plugin#readme 7 | bug-reports: https://github.com/coot/ghc-tags-plugin/issues 8 | license: MPL-2.0 9 | license-file: LICENSE 10 | author: Marcin Szamotulski 11 | maintainer: coot@coot.me 12 | copyright: (c) 2022-2025, Marcin Szamotulski 13 | category: Development 14 | build-type: Simple 15 | extra-doc-files: CHANGELOG.md 16 | README.md 17 | 18 | common warnings 19 | ghc-options: -Wall 20 | -Wno-unticked-promoted-constructors 21 | -Wcompat 22 | -- the following three warnings are enabled by -Wall in 23 | -- ghc-9.2 24 | -Wno-incomplete-uni-patterns 25 | -Wno-incomplete-record-updates 26 | -Wpartial-fields 27 | -Widentities 28 | -Wredundant-constraints 29 | if impl(ghc >= 9) 30 | ghc-options: -Wunused-packages 31 | 32 | library 33 | import: warnings 34 | hs-source-dirs: lib 35 | exposed-modules: GhcTags.Stream 36 | build-depends: attoparsec >=0.13, 37 | base >=4.12 && <4.22, 38 | bytestring >=0.10, 39 | mtl, 40 | pipes ^>=4.3, 41 | pipes-attoparsec ^>=0.6, 42 | pipes-bytestring ^>=2.1, 43 | text >=1.2 && <2.2, 44 | ghc-tags-core 45 | default-language: Haskell2010 46 | -------------------------------------------------------------------------------- /ghc-tags-pipes/lib/GhcTags/Stream.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE KindSignatures #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE TupleSections #-} 8 | 9 | -- | Parse and combine a stream of tags. 10 | -- 11 | module GhcTags.Stream 12 | ( tagParser 13 | , combineTagsPipe 14 | , runCombineTagsPipe 15 | ) where 16 | 17 | #if __GLASGOW_HASKELL__ >= 906 18 | import Control.Monad.State.Strict 19 | #else 20 | import Control.Monad.State.Strict hiding (void) 21 | #endif 22 | import Data.ByteString (ByteString) 23 | import Data.Attoparsec.ByteString (Parser) 24 | import qualified Data.ByteString as BS 25 | import Data.ByteString.Builder (Builder) 26 | import qualified Data.ByteString.Builder as BS 27 | import Data.Functor (void, ($>)) 28 | import qualified Data.Text.Encoding as Text 29 | import System.IO 30 | 31 | import Pipes ((>->), (~>)) 32 | import qualified Pipes as Pipes 33 | import qualified Pipes.Lift as Pipes 34 | import qualified Pipes.Attoparsec as Pipes.AP 35 | import qualified Pipes.ByteString as Pipes.BS 36 | 37 | import GhcTags.Tag 38 | 39 | 40 | -- | Parse a stream of tags, coming from a 'Text' producer. 41 | -- 42 | tagParser :: MonadIO m 43 | => Parser (Maybe (Tag tk)) 44 | -- ^ Parse a single tag. For Vim this returns should parse a single 45 | -- line and return the tag, e.g 'parseTagLine'. 46 | -> Pipes.Producer ByteString m () 47 | -> Pipes.Producer (Tag tk) m () 48 | tagParser parser producer = void $ 49 | Pipes.for 50 | (Pipes.AP.parsed parser producer) 51 | $ \case 52 | -- ignore header lines 53 | Just tag -> Pipes.yield tag 54 | Nothing -> pure () 55 | 56 | 57 | -- | Streaming version of 'GhcTags.Tag.combineTags'. 58 | -- 59 | combineTagsPipe 60 | :: forall m (tk :: TAG_KIND). Applicative m 61 | => (Tag tk -> Tag tk -> Ordering) 62 | -> RawFilePath -- ^ file path from which the new tags were obtained, it should be normalised 63 | -> Tag tk -- ^ tag read from disc 64 | -> [Tag tk] -- ^ new tags 65 | -> Pipes.Producer (Tag tk) m [Tag tk] 66 | combineTagsPipe compareFn modPath = go 67 | where 68 | modPath' = rawFilePathToBS modPath 69 | go :: Tag tk -> [Tag tk] 70 | -> Pipes.Producer (Tag tk) m [Tag tk] 71 | 72 | -- omitt all the tags which point to 'modPath' 73 | -- 74 | -- note: we check that 'tagFilePath' ends with 'modPath', which is 75 | -- a relative path from the corresponding cabal file. 76 | go tag as 77 | | modPath' `BS.isSuffixOf` Text.encodeUtf8 (getRawFilePath (tagFilePath tag)) 78 | = pure as 79 | 80 | go tag as@(a : as') 81 | | otherwise = case a `compareFn` tag of 82 | LT -> Pipes.yield a >> go tag as' 83 | EQ -> Pipes.yield a $> as' 84 | GT -> Pipes.yield tag $> as 85 | 86 | go tag [] = Pipes.yield tag $> [] 87 | 88 | 89 | -- | run 'combineTagsPipe' taking care of the state. 90 | -- 91 | runCombineTagsPipe 92 | :: MonadIO m 93 | => Handle 94 | -> (Tag tk -> Tag tk -> Ordering) 95 | -> (Tag tk -> Builder) 96 | -> RawFilePath 97 | -> Tag tk 98 | -> Pipes.Effect (StateT [Tag tk] m) () 99 | runCombineTagsPipe writeHandle compareFn formatTag modPath = 100 | (\tag -> Pipes.stateP $ fmap ((),) . combineTagsPipe compareFn modPath tag) 101 | ~> Pipes.yield . BS.toLazyByteString . formatTag 102 | ~> (\bs -> Pipes.BS.fromLazy bs) 103 | ~> (\bs -> Pipes.yield bs >-> Pipes.BS.toHandle writeHandle) 104 | -------------------------------------------------------------------------------- /ghc-tags-plugin/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for ghctags 2 | 3 | ## 0.6.1.1 -- 2024-07-21 4 | 5 | - `GHC-9.10` support. 6 | 7 | ## 0.6.0.0 -- 2023-05-01 8 | 9 | - `GHC-9.6` support; dropped support of `GHC-8.8`. 10 | 11 | ## 0.5.1.0 12 | 13 | - tags for local bindings (from `where` clauses) 14 | - tags for modules 15 | 16 | ## 0.5.0.0 17 | 18 | - tags of instance methods & signatures 19 | - fixed a case in which generated ctags where missing headers 20 | 21 | ## 0.4.0.2 22 | 23 | * Fixed a bug: no headers for ctag file when `--stream` option was not set. 24 | 25 | ## 0.4.0.1 26 | 27 | * `ghc-tags-plugin` is now compatible with `GHC-9.4`. 28 | **NOTE**: `GHC-9.4` includes a [fix][ghc-issue-20417], which makes `cabal` 29 | cache mechanism work properly when plugins are enabled. 30 | 31 | ## 0.4.0.0 -- 2022-01-09 32 | 33 | * `ghc-tags-plugin` is now compatible with `GHC-9.2` 34 | * `--stream` option, only effective for `ctags`; When enabled, 35 | `ghc-tags-plugin` streams existing tags when adding the tags found in a new 36 | module. Without this option the tags file is read at once into memory. 37 | 38 | ## 0.3.0.0 -- 2021-05-01 39 | 40 | * filter adjacents tags: preserve only type signatures (filter out adjacent 41 | terms) or data constructors (filter out adjacent type constructors). 42 | * fix emacs support: ghc-tags-plugin can now correctly display multiple tags 43 | (e.g. instance declarations). Thanks to @nfrisby for finding out how to do 44 | that. 45 | 46 | ## 0.2.4.0 -- 2020-09-08 47 | 48 | * `ghc-tags-vim` a vim plugin which helps to maintain a `cabal.project.local` file. 49 | * better tag info 50 | 51 | ## 0.2.3.0 -- 2020-08-07 52 | 53 | * Generate tags for template haskell splices (requires at least `GHC-8.10`). 54 | * Include types of class methods. 55 | 56 | ## 0.2.0.0 -- 2020-04-12 57 | 58 | * Fixed bug [#37][issue-37] 59 | * Added `--debug` flag 60 | 61 | ## 0.1.6.0 -- 2020-03-24 62 | 63 | * support etags files 64 | * various bug fixes 65 | * type level information (not type checked!), from the parsed tree, including: 66 | type of instances (instance context & instance head), types of `GADTs` 67 | constructors, rhs of type synonyms, kinds of type or data families. 68 | * expanded ctags pseudo tags with descriptions of fields and tag kinds 69 | 70 | ## 0.1.5.0 -- 2020-03-13 71 | 72 | * concurrency safety - protection `tags` file using a file lock 73 | 74 | ## 0.1.4.0 -- 2020-03-11 75 | 76 | * Tags for default instances of associated (data) type familes. 77 | * Added path argument, can be passed using `-fplugin-opt=Plugin.GhcTags:../tags`. 78 | * Wrapped `IOExceptions`, so when it will happen it will be obvious that the 79 | plugin failed not `ghc` 80 | * Fixed the tag ordering function to be fullfil the transitivness property. 81 | 82 | ## 0.1.3.0 -- 2020-03-08 83 | 84 | * Change order of tags: type classes, type families and data type families are 85 | sorted before their instances. If one is using multipe tags (the default), 86 | the order of them also matters (i.e. in the vim `tags` option). 87 | 88 | ## 0.1.2.0 -- 2020-03-05 89 | 90 | * Preserve tag information in ctags generated files 91 | * Support `file:` tags (exported / not exported terms) 92 | * Added a test-suite (golden tests and property tests) 93 | 94 | ## 0.1.1.0 -- 2020-03-03 95 | 96 | * Added support for tag's kinds. 97 | * Added various file headers 98 | 99 | ## 0.1.0.0 -- YYYY-mm-dd 100 | 101 | * First version. Released on an unsuspecting world. 102 | 103 | [ghc-issue-20417]: https://gitlab.haskell.org/ghc/ghc/-/issues/20417 104 | [issue-37]: https://github.com/coot/ghc-tags-plugin/issues/37 105 | -------------------------------------------------------------------------------- /ghc-tags-plugin/LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /ghc-tags-plugin/README.md: -------------------------------------------------------------------------------- 1 | Ghc Tags Compiler Plugin 2 | ======================== 3 | [![Haskell](https://img.shields.io/badge/language-Haskell-8D82AC.svg?style=for-the-badge)](https://haskell.org) 4 | [![MPL-2.0 License](http://img.shields.io/badge/license-MPL20-brightgreen.svg?style=for-the-badge)](https://github.com/coot/ghc-tags-plugin/blob/master/ghc-tags-core/LICENSE) 5 | [![Haskell CI](https://img.shields.io/github/actions/workflow/status/coot/ghc-tags-plugin/ci.yml?branch=master&label=Build&style=for-the-badge)](https://github.com/coot/ghc-tags-plugin/actions/workflows/ci.yml) 6 | 7 | A library and a [GHC compiler 8 | plugin](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/extending_ghc.html#compiler-plugins) 9 | which generates tags for each compiled module or component. 10 | 11 | 12 | ● Requirements 13 | -------------- 14 | 15 | The plugin requires at least: `ghc >= 9.6`. 16 | 17 | ● Plugin options 18 | ---------------- 19 | 20 | ``` 21 | Usage: [-e|--etags] [--stream] [--debug] [file_path] 22 | write tags from ghc abstract syntax tree 23 | 24 | Available options: 25 | -e,--etags produce emacs etags file 26 | --stream stream existing tags (ctags only) 27 | file_path tags file: default tags or TAGS (when --etags is 28 | specified) 29 | --debug debugging output 30 | ``` 31 | 32 | It can be an absolute path or relative (to the `*.cabal` package file rather 33 | than `cabal.project` file), for example: 34 | ``` 35 | -fplugin-opt=Plugin.GhcTags:../tags 36 | ``` 37 | This is useful if for *cabal packages* which are located in subdirectories. 38 | 39 | ## ● Emacs support 40 | 41 | To produce `etags` file you will need to pass the following option 42 | ``` 43 | -fplugin-opt=Plugin.GhcTags:--etags 44 | ``` 45 | 46 | ## ● Editor configuration 47 | 48 | By default each generated tags file is put next to the corresponding `*.cabal` 49 | package file. If you just have a repo with a cabal file in the main directory 50 | `vim` default `tags` setting will work, if you have some modules in 51 | subdirectories you will either need to set: 52 | ``` 53 | :set tags+=*/tags 54 | ``` 55 | or pass an option to modify where tags are written, see below. 56 | 57 | ● Configuration: Ghc / Cabal / Stack 58 | ------------------------------------ 59 | 60 | Configuration of this plugin requires some familiarity with `ghc` packages. 61 | Check out 62 | [documentation](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/packages.html#packages) 63 | to use `-plugin-package` or `-plugin-package-id`. In the examples below we 64 | use `-plugin-package=ghc-tags-plugin` but specifying version 65 | `-package=ghc-tags-plugin-0.0.0.0` (where `0.0.0.0` is the version you 66 | installed), might work better. You can use `ghc-pkg latest ghc-tags-plugin` 67 | (likely with appropriate `--package-db` flag) to check which version is 68 | available. 69 | 70 | ## ● Ghc 71 | 72 | ``` 73 | ghc -plugin-package=ghc-tags-plugin -fplugin=Plugin.GhcTags 74 | ``` 75 | 76 | You might also need to pass `-package-db` in which you installed the plugin. 77 | 78 | ## ● Cabal 79 | 80 | Install the `ghc-tags-plugin` to cabal store with: 81 | ``` 82 | cabal install --lib ghc-tags-plugin 83 | ``` 84 | 85 | In `cabal.project.local` file add `package` stanza for every local package : 86 | ``` 87 | project some-project 88 | ghc-options: -package-db=PACKAGE_DB 89 | -plugin-package=ghc-tags-plugin 90 | -fplugin=Plugin.GhcTags 91 | ``` 92 | 93 | `PACKAGE_DB` is likely to be something like (for `ghc-8.6.5`) 94 | (all environment variables must be expanded): 95 | ``` 96 | ${HOME}/.cabal/store/ghc-8.6.5/package.db 97 | ``` 98 | or on Windows (note the `""` syntax) 99 | ``` 100 | "C:\\Users\\USER_NAME\\AppData\\Roaming\\cabal\\store\\ghc-8.6.5\\package.db 101 | ``` 102 | 103 | Note that you can also configure in this way non-local projects. You will 104 | likely want to pass `-fplugin-opt=Plugin.GhcTags=PATH` where `PATH` is *an 105 | absolute* path to your `tags` file. 106 | 107 | 108 | ## ● Stack 109 | 110 | This is alternative method, which also could be modified for `cabal` (but it is 111 | not as nice as the previous method where you don't need to modify any files 112 | checked in a VCS). 113 | 114 | Add `ghc-tags-plugin` to `build-depends` in your `*.cabal` files. (You should 115 | hide it behind a cabal flag). And add these lines to `stack.yaml` file: 116 | 117 | ``` 118 | extra-deps: 119 | - git: https://github.com/coot/ghc-tags-plugin 120 | commit: a841dae7fb9c335101f7fa4187d02687d306f972 121 | 122 | test-project: -plugin-package=ghc-tags-plugin 123 | -fplugin=Plugin.GhcTags 124 | ``` 125 | 126 | ## ● Ghcid 127 | 128 | If you follow the cabal configuration as above (using `stack` should work too) 129 | ``` 130 | ghcid --comaand "cabal repl project" 131 | ``` 132 | will update `tags` file as you modify your project. 133 | 134 | 135 | ## ● Makefile 136 | 137 | The [Makefile](https://github.com/coot/ghc-tags-plugin/blob/master/Makefile) 138 | contains some useful commands, e.g. `install`, `uninstall` or `reinstall` the 139 | package in a `package.db` (by default into `cabal` store). This is mostly for 140 | development, but it could be useful in other scenarios as well. 141 | 142 | ● Exceptions 143 | ------------ 144 | 145 | If a `GHC` plugin throws an exception, `GHC` stops. This plugin wraps 146 | `IOException`s, to make it obvious that it filed rather than `GHC`. This 147 | might mean you misconfigured the plugin (by passing wrong options). The 148 | result might look like this: 149 | 150 | ``` 151 | ghc: panic! (the 'impossible' happened) 152 | (GHC version 8.6.5 for x86_64-unknown-linux): 153 | GhcTagsPluginIOException ../: openFile: inappropriate type (Is a directory) 154 | 155 | ``` 156 | 157 | ● Tips 158 | ------ 159 | 160 | - If you're getting installation problems when running 161 | `cabal install --lib ghc-tags-plugin`; you may need to 162 | 163 | * remove the installed version from 164 | `~/.ghc/x86_64-linux-8.6.5/environments/default` 165 | (or whatever is your default environment) 166 | 167 | * unregister the installed version from cabal store (you can check what is 168 | installed in your store with `ghc-pkg --package=PACKAGE_DB list | grep ghc-tags` 169 | for the following command): 170 | 171 | ``` 172 | ghc-pkg --package-db=PACKAGE_DB unregister z-ghc-tags-plugin-z-ghc-tags-library ghc-tags-plugin 173 | ``` 174 | 175 | - The plugin is safe for concurrent compilation, i.e. setting `jobs: $ncpus` is 176 | safe. The plugin holds an exclusive (advisory) lock on a lock file. This 177 | will create synchronisation between threads / process which are using 178 | the same `tags` file. 179 | 180 | - If you are working on a larger project, it might be better to not collect all 181 | tags in a single `tags` file, since at every compilation step one will need 182 | to parse a large `tags` file. Working with tag files of size 10000 tags (or 183 | ~1.5MB) is ok - though this will depend on the hardware. 184 | 185 | - If you're working on a project that is using `safe-haskell`, you will likely 186 | need to pass 187 | [-fplugin-trustworthy](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/extending_ghc.html?highlight=plugin#ghc-flag--fplugin-trustworthy) 188 | `ghc` flag. 189 | 190 | 191 | ● Security implications of compiler plugins 192 | ------------------------------------------- 193 | 194 | Such plugins can: 195 | 196 | * run arbitrary `IO`; 197 | * modify abstract syntax tree in some way; a malicious plugin could change 198 | some security parameter in your code exposing a security hole. 199 | 200 | This plugin only reads & writes to `tags` file (and updates a shared mutable 201 | state) as of `IO`, and does not 202 | [modify/](https://github.com/coot/ghc-tags-plugin/blob/master/src/Plugin/GhcTags.hs#L95) 203 | the syntax tree. 204 | 205 | ● ghc-tags - standalone program 206 | ------------------------------- 207 | 208 | [`ghc-tags-fork`] is a fork of [`ghc-tags-hackage`]. Both provide a standalone 209 | `ghc-tags` command. Unlike the `hackage` version [ghc-tags-fork] is using the 210 | latest [`ghc-tags-core`] version. 211 | 212 | [ghc-issue-20417]: https://gitlab.haskell.org/ghc/ghc/-/issues/20417 213 | [`ghc-tags-fork`]: https://github.com/coot/ghc-tags 214 | [`ghc-tags-hackage`]: https://hackage.haskell.org/package/ghc-tags 215 | [`ghc-tags-core`]: https//hackage.haskell.org/package/ghc-tags-core 216 | -------------------------------------------------------------------------------- /ghc-tags-plugin/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /ghc-tags-plugin/app/check.hs: -------------------------------------------------------------------------------- 1 | -- | Utility program which checks the size of tags file. 2 | -- 3 | -- It's a like `wc` but using `lock` file, so we don't get intermediate 4 | -- results. 5 | -- 6 | module Main where 7 | 8 | import qualified Data.ByteString as BS 9 | import qualified Data.ByteString.Char8 as BSC 10 | import System.FilePath 11 | import System.IO 12 | import System.Environment 13 | 14 | import Plugin.GhcTags.FileLock 15 | 16 | 17 | main :: IO () 18 | main = do 19 | file :_ <- getArgs 20 | withFileLock False (lockFile file) ExclusiveLock $ \_h -> do 21 | numOfLines <- length . BSC.lines <$> BS.readFile file 22 | putStrLn (show numOfLines) 23 | where 24 | lockFile file = case splitFileName file of 25 | (dir, name) -> dir "." ++ name ++ ".lock" 26 | -------------------------------------------------------------------------------- /ghc-tags-plugin/ghc-tags-plugin.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: ghc-tags-plugin 3 | version: 0.6.1.1 4 | synopsis: A compiler plugin which generates tags file from GHC parsed syntax tree. 5 | description: 6 | __etags__ format. For a standalone `ghc-tags` command look for or 7 | [ghc-tags](https://hackage.haskell.org/package/ghc-tags) or its 8 | [fork](https://github.com/coot/ghc-tags) (the fork is using 9 | [ghc-tags-core](https://hackage.haskell.org/package/ghc-tags-core), 10 | the same library which `ghc-tags-plugin` is using). 11 | license: MPL-2.0 12 | license-file: LICENSE 13 | author: Marcin Szamotulski 14 | maintainer: coot@coot.me 15 | copyright: (c) 2020-2025, Marcin Szamotulski 16 | category: Development 17 | stability: alpha 18 | extra-source-files: CHANGELOG.md 19 | README.md 20 | homepage: https://github.com/coot/ghc-tags-plugin#readme 21 | bug-reports: https://github.com/coot/ghc-tags-plugin/issues 22 | tested-with: GHC == { 9.6, 9.8, 9.10, 9.12 } 23 | 24 | -- Don't build gtp-check command by default; it's a development tool. 25 | flag gtp-check 26 | default: False 27 | manual: False 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/coot/ghc-tags-plugin 32 | 33 | common warnings 34 | ghc-options: -Wall 35 | -Wno-unticked-promoted-constructors 36 | -Wcompat 37 | -- the following three warnings are enabled by -Wall in 38 | -- ghc-9.2 39 | -Wno-incomplete-uni-patterns 40 | -Wno-incomplete-record-updates 41 | -Wpartial-fields 42 | -Widentities 43 | -Wredundant-constraints 44 | if impl(ghc >= 9) 45 | ghc-options: -Wunused-packages 46 | 47 | library 48 | import: warnings 49 | hs-source-dirs: lib 50 | exposed-modules: Plugin.GhcTags 51 | Plugin.GhcTags.Options 52 | Plugin.GhcTags.FileLock 53 | other-modules: Plugin.GhcTags.CTag 54 | Paths_ghc_tags_plugin 55 | autogen-modules: Paths_ghc_tags_plugin 56 | build-depends: base >=4.12 && < 4.22, 57 | bytestring >=0.10 && < 0.13, 58 | directory ^>=1.3, 59 | filepath ^>=1.4 || ^>= 1.5, 60 | ghc >=8.4 && <10, 61 | lukko ^>=0.1, 62 | mtl >=2.2 && <2.4, 63 | optparse-applicative 64 | >=0.15.1 && < 0.19, 65 | pipes ^>=4.3, 66 | pipes-bytestring ^>=2.1, 67 | pipes-safe ^>=2.3, 68 | text >=1.2 && <2.2, 69 | 70 | ghc-tags-core ^>=0.6, 71 | ghc-tags-pipes ^>=0.1.1 72 | default-language: Haskell2010 73 | 74 | 75 | executable gtp-check 76 | if flag(gtp-check) 77 | buildable: True 78 | else 79 | buildable: False 80 | hs-source-dirs: app 81 | main-is: check.hs 82 | default-language: Haskell2010 83 | build-depends: base 84 | , bytestring 85 | , directory 86 | , filepath 87 | 88 | , ghc-tags-plugin 89 | -------------------------------------------------------------------------------- /ghc-tags-plugin/lib/Plugin/GhcTags/CTag.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Plugin.GhcTags.CTag where 4 | 5 | import qualified Data.Text as Text 6 | import Data.Version 7 | 8 | import Paths_ghc_tags_plugin 9 | 10 | import GhcTags.CTag.Header 11 | 12 | 13 | headers :: [Header] 14 | headers = 15 | [ Header FileFormat Nothing 2 "" 16 | , Header FileSorted Nothing 1 "" 17 | , Header FileEncoding Nothing "utf-8" "" 18 | , Header ProgramAuthor Nothing "Marcin Szamotulski" "" 19 | , Header ProgramName Nothing "ghc-tags-plugin" "" 20 | , Header ProgramUrl Nothing "https://hackage.haskell.org/package/ghc-tags-plugin" "" 21 | , Header ProgramVersion Nothing (Text.pack $ showVersion version) "" 22 | 23 | , Header FieldDescription haskellLang "type" "type of expression" 24 | , Header FieldDescription haskellLang "ffi" "foreign object name" 25 | , Header FieldDescription haskellLang "file" "not exported term" 26 | , Header FieldDescription haskellLang "instance" "class, type or data type instance" 27 | , Header FieldDescription haskellLang "Kind" "kind of a type" 28 | 29 | , Header KindDescription haskellLang "M" "module name" 30 | , Header KindDescription haskellLang "`" "module top level term, but not a function" 31 | , Header KindDescription haskellLang "λ" "module top level function term" 32 | , Header KindDescription haskellLang "Λ" "type constructor" 33 | , Header KindDescription haskellLang "c" "data constructor" 34 | , Header KindDescription haskellLang "g" "gadt constructor" 35 | , Header KindDescription haskellLang "r" "record field" 36 | , Header KindDescription haskellLang "≡" "type synonym" 37 | , Header KindDescription haskellLang "~" "type signature" 38 | , Header KindDescription haskellLang "p" "pattern synonym" 39 | , Header KindDescription haskellLang "C" "type class" 40 | , Header KindDescription haskellLang "m" "type class member" 41 | , Header KindDescription haskellLang "i" "type class instance" 42 | , Header KindDescription haskellLang "x" "type class instance member" 43 | , Header KindDescription haskellLang "F" "type family" 44 | , Header KindDescription haskellLang "f" "type family instance" 45 | , Header KindDescription haskellLang "D" "data type family" 46 | , Header KindDescription haskellLang "d" "data type family instance" 47 | , Header KindDescription haskellLang "I" "foreign import" 48 | , Header KindDescription haskellLang "E" "foreign export" 49 | ] 50 | where 51 | haskellLang = Just "Haskell" 52 | -------------------------------------------------------------------------------- /ghc-tags-plugin/lib/Plugin/GhcTags/FileLock.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Plugin.GhcTags.FileLock 4 | ( withFileLock 5 | , LockMode (..) 6 | ) where 7 | 8 | import Control.Exception 9 | import Control.Monad (when) 10 | 11 | #if !defined(mingw32_HOST_OS) 12 | import Lukko.FLock 13 | #else 14 | import Lukko.Windows 15 | #endif 16 | 17 | -- | 'flock' base lock (on posix) or `LockFileEx` on Windows. 18 | -- 19 | withFileLock :: Bool -- ^ debug option 20 | -> FilePath -> LockMode -> (FD -> IO x) -> IO x 21 | withFileLock debug path mode k = 22 | bracket 23 | (fdOpen path) 24 | (\h -> fdClose h) 25 | $ \h -> 26 | bracket 27 | (do fdLock h mode 28 | when debug (putStrLn "lock: taken")) 29 | (\_ -> 30 | do when debug (putStrLn "lock: releasing") 31 | fdUnlock h) 32 | (\_ -> k h) 33 | -------------------------------------------------------------------------------- /ghc-tags-plugin/lib/Plugin/GhcTags/Options.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | 5 | module Plugin.GhcTags.Options 6 | ( Options (..) 7 | , ParserResult (..) 8 | , runOptionParser 9 | ) where 10 | 11 | import Data.Bool (bool) 12 | import Data.Monoid (Last (..)) 13 | import Data.Functor.Identity (Identity (..)) 14 | import Options.Applicative 15 | 16 | 17 | etagsParser :: Parser Bool 18 | etagsParser = switch $ 19 | short 'e' 20 | <> long "etags" 21 | <> showDefault 22 | <> help "produce emacs etags file" 23 | 24 | streamParser :: Parser Bool 25 | streamParser = switch $ 26 | short 's' 27 | <> long "stream" 28 | <> showDefault 29 | <> help ( "stream tags from the tags file when updating its contents" 30 | ++ " with the tags found in the current module" ) 31 | 32 | filePathParser :: Parser FilePath 33 | filePathParser = 34 | strArgument $ 35 | help "tags file: default tags or TAGS (when --etags is specified)" 36 | <> metavar "file_path" 37 | 38 | debugParser :: Parser Bool 39 | debugParser = switch $ 40 | long "debug" 41 | <> showDefault 42 | <> help "debug" 43 | 44 | -- | /ghc-tags-plugin/ options 45 | -- 46 | data Options f = Options 47 | { etags :: Bool 48 | -- ^ if 'True' use emacs tags file format, the default is 'False'. 49 | 50 | , stream :: Bool 51 | -- ^ be default we read the tags file and overwrite it. When this option 52 | -- is on, we stream tags from it while interleaving the tags found in the 53 | -- current module to a new destination, which is then moved to the tags 54 | -- file destination. 55 | 56 | , filePath :: f FilePath 57 | -- ^ file path to the tags file (relative to the @*.cabal@ file). The 58 | -- default is either 'tags' (if 'etags' if 'False') or 'TAGS' otherwise. 59 | 60 | , debug :: Bool 61 | } 62 | 63 | deriving instance Show (Options Identity) 64 | 65 | 66 | parseOtions :: Parser (Options Last) 67 | parseOtions = Options 68 | <$> etagsParser 69 | -- allow to pass the argument multiple times 70 | <*> streamParser 71 | <*> (foldMap (Last . Just) <$> many filePathParser) 72 | <*> debugParser 73 | 74 | 75 | parserInfo :: ParserInfo (Options Last) 76 | parserInfo = info (parseOtions <**> helper) $ 77 | progDesc "write tags from ghc abstract syntax tree" 78 | <> fullDesc 79 | 80 | 81 | runOptionParser :: [String] 82 | -> ParserResult (Options Identity) 83 | runOptionParser = fmap defaultOptions . execParserPure defaultPrefs parserInfo 84 | where 85 | defaultOptions :: Options Last -> Options Identity 86 | defaultOptions Options { etags, stream, filePath, debug } = 87 | Options { 88 | etags, 89 | stream, 90 | filePath = Identity filePath', 91 | debug 92 | } 93 | where 94 | filePath' = 95 | case filePath of 96 | Last Nothing -> bool "tags" "TAGS" etags 97 | Last (Just fp) -> fp 98 | -------------------------------------------------------------------------------- /ghc-tags-test/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for ghc-tags-test 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /ghc-tags-test/bench/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# OPTIONS -Wno-orphans #-} 4 | #if __GLASGOW_HASKELL__ >= 908 5 | {-# OPTIONS -Wno-x-partial #-} 6 | #endif 7 | 8 | module Main (main) where 9 | 10 | import Control.Exception 11 | import Control.DeepSeq 12 | #if __GLASGOW_HASKELL__ >= 906 13 | import Control.Monad.State.Strict 14 | #else 15 | import Control.Monad.State.Strict hiding (void) 16 | #endif 17 | import Data.ByteString (ByteString) 18 | import qualified Data.ByteString as BS 19 | import qualified Data.ByteString.Lazy as BSL 20 | import qualified Data.ByteString.Builder as BB 21 | import Data.Either (rights) 22 | import Data.Foldable (traverse_) 23 | import Data.Functor (void) 24 | import Data.Maybe (mapMaybe) 25 | import qualified Data.Text.Encoding as Text 26 | import System.IO 27 | 28 | import qualified Pipes as Pipes 29 | import qualified Pipes.Attoparsec as Pipes.AP 30 | import qualified Pipes.ByteString as Pipes.BS 31 | 32 | import Criterion 33 | import Criterion.Main 34 | 35 | import GhcTags.Tag 36 | import GhcTags.Stream 37 | import qualified GhcTags.CTag as CTag 38 | 39 | evalListWith :: (forall b. a -> b -> b) -> [a] -> () 40 | evalListWith _seq_ [] = () 41 | evalListWith seq_ (a : as) = a `seq_` (evalListWith seq_ as) `seq` () 42 | 43 | evalEither :: Either a b -> x -> x 44 | evalEither (Left a) x = a `seq` x 45 | evalEither (Right b) x = b `seq` x 46 | 47 | evalTags :: Either String [Either CTag.Header CTag] -> () 48 | evalTags = either (`seq` ()) (evalListWith evalEither) 49 | 50 | newtype TagsNF = TagsNF [CTag] 51 | 52 | instance NFData TagsNF where 53 | rnf (TagsNF tags) = evalListWith seq tags 54 | 55 | main :: IO () 56 | main = defaultMain 57 | [ bgroup "Parse tags" 58 | [ -- 381 tags 59 | env (BS.readFile "ghc-tags-test/test/golden/io-sim-classes.tags") $ \bs -> 60 | bench "parse io-sim-classes.tags" $ 61 | whnfAppIO (fmap evalTags . CTag.parseTagsFile) bs 62 | 63 | , -- 6767 tags 64 | env (BS.readFile "ghc-tags-test/test/golden/ouroboros-consensus.tags") $ \bs -> 65 | bench "parse ouroboros-consensus.tags" $ 66 | whnfAppIO (fmap evalTags . CTag.parseTagsFile) bs 67 | 68 | , -- 12549 tags 69 | env (BS.readFile "ghc-tags-test/bench/data.tags") $ \bs -> 70 | bench "data.tags" $ 71 | whnfAppIO (fmap evalTags . CTag.parseTagsFile) bs 72 | 73 | , -- 23741 tags 74 | env (BS.readFile "ghc-tags-test/test/golden/vim.tags") $ \bs -> 75 | bench "parse vim.tags" $ 76 | whnfAppIO (fmap evalTags . CTag.parseTagsFile) bs 77 | ] 78 | , bgroup "read parse & format" 79 | [ bench "io-sim-classes.tags" $ 80 | nfIO $ benchReadParseFormat "ghc-tags-test/test/golden/io-sim-classes.tags" 81 | , bench "ouroboros-consensus.tags" $ 82 | nfIO $ benchReadParseFormat "ghc-tags-test/test/golden/ouroboros-consensus.tags" 83 | , bench "data.tags" $ 84 | nfIO $ benchReadParseFormat "ghc-tags-test/bench/data.tags" 85 | , bench "vim.tags" $ 86 | nfIO $ benchReadParseFormat "ghc-tags-test/test/golden/vim.tags" 87 | ] 88 | , bgroup "stream parse & format" 89 | [ bench "io-sim-classes.tags" $ 90 | nfIO $ benchStreamParseFormat "ghc-tags-test/test/golden/io-sim-classes.tags" 91 | , bench "ouroboros-consensus.tags" $ 92 | nfIO $ benchStreamParseFormat "ghc-tags-test/test/golden/ouroboros-consensus.tags" 93 | , bench "data.tags" $ 94 | nfIO $ benchStreamParseFormat "ghc-tags-test/bench/data.tags" 95 | , bench "vim.tags" $ 96 | nfIO $ benchStreamParseFormat "ghc-tags-test/test/golden/vim.tags" 97 | ] 98 | , bgroup "end-to-end" 99 | [ env 100 | (do 101 | bs <- BS.readFile "ghc-tags-test/test/golden/io-sim-classes.tags" 102 | Right tags <- fmap (mapMaybe (either (const Nothing) Just)) 103 | <$> CTag.parseTagsFile bs 104 | return (encodeTagFilePath (tagFilePath (head tags)), TagsNF tags) 105 | ) 106 | $ \ ~(modPath, TagsNF tags) -> 107 | bgroup "small" 108 | [ bench "streamTags" (whnfAppIO (benchStreamTags "ghc-tags-test/test/golden/vim.tags" modPath) tags) 109 | 110 | , bench "readTags" (whnfAppIO (benchReadTags "ghc-tags-test/test/golden/vim.tags" modPath) tags) 111 | ] 112 | , env 113 | (do 114 | bs <- BS.readFile "ghc-tags-test/test/golden/ouroboros-network.tags" 115 | Right tags <- fmap (mapMaybe (either (const Nothing) Just)) 116 | <$> CTag.parseTagsFile bs 117 | return (encodeTagFilePath (tagFilePath (head tags)), TagsNF tags) 118 | ) 119 | $ \ ~(modPath, TagsNF tags) -> 120 | bgroup "medium" 121 | [ bench "streamTags" (whnfAppIO (benchStreamTags "ghc-tags-test/test/golden/vim.tags" modPath) tags) 122 | 123 | , bench "readTags" (whnfAppIO (benchReadTags "ghc-tags-test/test/golden/vim.tags" modPath) tags) 124 | ] 125 | ] 126 | 127 | 128 | ] 129 | 130 | 131 | benchReadParseFormat :: FilePath -> IO BSL.ByteString 132 | benchReadParseFormat path = do 133 | bs <- BS.readFile path 134 | res <- CTag.parseTagsFile bs 135 | case res of 136 | Left err -> throwIO (userError err) 137 | Right tags -> pure $ BB.toLazyByteString (CTag.formatTagsFile tags) 138 | 139 | 140 | benchStreamParseFormat :: FilePath -> IO () 141 | benchStreamParseFormat fp = 142 | withFile "/dev/null" WriteMode $ \devNull -> 143 | withFile fp ReadMode $ \h -> 144 | Pipes.void $ Pipes.runEffect $ Pipes.for 145 | (Pipes.AP.parsed 146 | CTag.parseTag 147 | (Pipes.BS.fromHandle h `Pipes.for` Pipes.yield)) 148 | (\tag -> 149 | (Pipes.BS.fromLazy (BB.toLazyByteString (CTag.formatTag tag))) 150 | Pipes.>-> 151 | Pipes.BS.toHandle devNull) 152 | 153 | 154 | benchStreamTags :: FilePath -> RawFilePath -> [CTag] -> IO () 155 | benchStreamTags filePath modPath tags = 156 | withFile filePath ReadMode $ \readHandle -> 157 | withFile "/tmp/bench.stream.tags" WriteMode $ \writeHandle -> do 158 | let producer :: Pipes.Producer ByteString IO () 159 | producer = void (Pipes.BS.fromHandle readHandle) 160 | 161 | -- gags pipe 162 | pipe :: Pipes.Effect (StateT [CTag] IO) () 163 | pipe = 164 | Pipes.for 165 | (Pipes.hoist Pipes.lift 166 | $ tagParser 167 | (either (const Nothing) Just <$> CTag.parseTagLine) 168 | producer) 169 | (runCombineTagsPipe writeHandle CTag.compareTags CTag.formatTag modPath) 170 | tags' <- execStateT (Pipes.runEffect pipe) tags 171 | traverse_ (BSL.hPut writeHandle . BB.toLazyByteString . CTag.formatTag) tags' 172 | 173 | 174 | benchReadTags :: FilePath -> RawFilePath -> [CTag] -> IO () 175 | benchReadTags filePath modPath tags = do 176 | withFile filePath ReadMode $ \readHandle -> 177 | withFile "/tmp/bench.stream.tags" WriteMode $ \writeHandle -> do 178 | Right tags' <- 179 | BS.hGetContents readHandle >>= CTag.parseTagsFile 180 | let tags'' = combineTags CTag.compareTags modPath tags (rights tags') 181 | BB.hPutBuilder writeHandle (CTag.formatTagsFile (Right `map` tags'')) 182 | 183 | encodeTagFilePath :: TagFilePath -> RawFilePath 184 | encodeTagFilePath = rawFilePathFromBS . Text.encodeUtf8 . getRawFilePath 185 | -------------------------------------------------------------------------------- /ghc-tags-test/ghc-tags-test.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: ghc-tags-test 3 | version: 0.1.0.0 4 | synopsis: ghc-tags-core test suite 5 | -- description: 6 | homepage: https://github.com/coot/ghc-tags-plugin 7 | license: MPL-2.0 8 | license-file: LICENSE 9 | author: Marcin Szamotulski 10 | copyright: (c) 2020-2024, Marcin Szamotulski 11 | maintainer: coot@coot.me 12 | -- copyright: 13 | category: Development 14 | build-type: Simple 15 | extra-doc-files: CHANGELOG.md 16 | -- extra-source-files: 17 | 18 | common warnings 19 | ghc-options: -Wall 20 | -Wno-unticked-promoted-constructors 21 | -Wno-incomplete-uni-patterns 22 | -Wno-incomplete-record-updates 23 | -Wpartial-fields 24 | -Widentities 25 | -Wredundant-constraints 26 | if impl(ghc >= 9) 27 | ghc-options: -Wunused-packages 28 | 29 | test-suite test 30 | import: warnings 31 | type: exitcode-stdio-1.0 32 | hs-source-dirs: test 33 | main-is: Main.hs 34 | other-modules: Test.Golden.Parser 35 | Test.Tag 36 | Test.Tag.Generators 37 | Test.CTag 38 | Test.ETag 39 | default-language: Haskell2010 40 | build-depends: attoparsec, 41 | base, 42 | bytestring, 43 | directory, 44 | filepath, 45 | lattices, 46 | mtl, 47 | pipes, 48 | QuickCheck, 49 | quickcheck-instances, 50 | tasty, 51 | tasty-golden, 52 | tasty-quickcheck, 53 | text, 54 | 55 | ghc-tags-core, 56 | ghc-tags-pipes 57 | 58 | benchmark benchmark 59 | hs-source-dirs: bench 60 | main-is: Main.hs 61 | type: exitcode-stdio-1.0 62 | default-language: Haskell2010 63 | build-depends: base 64 | , bytestring 65 | , criterion 66 | , deepseq 67 | , ghc-tags-core 68 | , ghc-tags-pipes 69 | , mtl 70 | , pipes 71 | , pipes-attoparsec 72 | , pipes-bytestring 73 | , text 74 | ghc-options: -Wall -rtsopts 75 | if impl(ghc >= 9.6) 76 | build-depends: filepath ^>= 1.4.1 || ^>= 1.5 77 | -------------------------------------------------------------------------------- /ghc-tags-test/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Exception 4 | import Data.Bool 5 | import Data.Monoid 6 | import System.FilePath (normalise) 7 | 8 | import Test.Tasty 9 | 10 | import qualified Test.Golden.Parser (tests) 11 | import qualified Test.Tag (tests) 12 | import qualified Test.CTag (tests) 13 | import qualified Test.ETag (tests) 14 | 15 | import System.Directory 16 | 17 | 18 | main ::IO () 19 | main = do 20 | -- using 'IO' 'Monoid' instance 21 | mGoldenDir 22 | <- doesGoldenDirectoryExist (normalise "test/golden") 23 | <> doesGoldenDirectoryExist (normalise "ghc-tags-test/test/golden") 24 | 25 | case mGoldenDir :: First FilePath of 26 | First Nothing -> 27 | throwIO $ userError "no 'test/golden' directory found" 28 | 29 | First (Just goldenDir) -> 30 | defaultMain (tests goldenDir) 31 | where 32 | fromBool :: FilePath -> Bool -> First FilePath 33 | fromBool = bool mempty . First . Just 34 | 35 | doesGoldenDirectoryExist :: FilePath -> IO (First FilePath) 36 | doesGoldenDirectoryExist fp = fromBool fp <$> doesDirectoryExist fp 37 | 38 | 39 | tests :: FilePath -> TestTree 40 | tests goldenTestDir = 41 | testGroup "GhcTags" 42 | [ Test.Golden.Parser.tests goldenTestDir 43 | , Test.Tag.tests 44 | , Test.CTag.tests 45 | , Test.ETag.tests 46 | ] 47 | -------------------------------------------------------------------------------- /ghc-tags-test/test/Test/CTag.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Test.CTag (tests) where 6 | 7 | import qualified Data.Attoparsec.ByteString.Char8 as AChar 8 | import qualified Data.ByteString.Builder as BB 9 | import qualified Data.ByteString.Char8 as BS.Char8 10 | import qualified Data.ByteString.Lazy as BL 11 | import Data.Text (Text) 12 | import qualified Data.Text as Text 13 | import qualified Data.Text.Encoding as Text 14 | 15 | import Test.Tasty (TestTree, testGroup) 16 | import Test.Tasty.QuickCheck (testProperty) 17 | import Test.QuickCheck 18 | import Test.QuickCheck.Instances.Text () 19 | 20 | import GhcTags.Tag 21 | import qualified GhcTags.CTag as CTag 22 | 23 | import Test.Tag.Generators 24 | 25 | 26 | tests :: TestTree 27 | tests = testGroup "CTag" 28 | [ testGroup "CTag ByteString codec" 29 | [ testProperty "parseTag . formatTag" roundTripCTagProp 30 | , testProperty "parseHeader . formatHeader" roundTripHeaderProp 31 | ] 32 | , testGroup "TagKind to Char converstion" 33 | [ testProperty "tagKindToChar . charToTagKind" tagKindCharToCharProp 34 | , testProperty "charToTagKind . tagKindToChar" tagKindTagKindToTagKindProp 35 | ] 36 | ] 37 | 38 | -- 39 | -- CTag generator 40 | -- 41 | 42 | newtype ArbCTag = ArbCTag { getArbCTag :: CTag } 43 | deriving Show 44 | 45 | instance Arbitrary ArbCTag where 46 | arbitrary = fmap ArbCTag $ 47 | Tag 48 | <$> (TagName <$> genTextNonEmpty) 49 | <*> genTagKind SingCTag 50 | -- the 'roundTripProp' property holds only for normalised paths 51 | <*> genTagFilePath -- TODO normalise 52 | <*> frequency 53 | [ (2, TagLine . getPositive <$> arbitrary) 54 | -- we are generating `TagLineCol` even though they are not present 55 | -- in ctag files; The roundTrip property will check if the address 56 | -- was projected to `TagLine`. 57 | , (2, TagLineCol <$> (getPositive <$> arbitrary) <*> (getPositive <$> arbitrary)) 58 | , (1, TagCommand . ExCommand . (wrap '/' . fixAddr) <$> genTextNonEmpty) 59 | , (1, TagCommand . ExCommand . (wrap '?' . fixAddr) <$> genTextNonEmpty) 60 | ] 61 | <*> pure NoTagDefinition 62 | <*> (TagFields <$> listOf genField) 63 | shrink = map ArbCTag . shrinkTag . getArbCTag 64 | 65 | 66 | roundTripCTagProp :: ArbCTag -> Property 67 | roundTripCTagProp (ArbCTag tag) = 68 | let bs = BL.toStrict 69 | . BB.toLazyByteString 70 | . CTag.formatTag 71 | $ tag 72 | mtag = AChar.parseOnly CTag.parseTag 73 | $ bs 74 | in case mtag of 75 | Left err -> counterexample 76 | ("parser error: " ++ err ++ " bs: " ++ BS.Char8.unpack bs) 77 | (property False) 78 | Right tag' -> counterexample 79 | (show $ Text.decodeUtf8 bs) 80 | (projectTag tag === tag') 81 | where 82 | projectTag :: CTag -> CTag 83 | projectTag t@Tag {tagFilePath = TagFilePath path, tagAddr} = 84 | t { tagFilePath = TagFilePath 85 | . Text.decodeUtf8 86 | . rawFilePathToBS 87 | . normaliseRawFilePath 88 | . rawFilePathFromBS 89 | . Text.encodeUtf8 90 | $ path 91 | , tagAddr = case tagAddr of 92 | TagLineCol line _ -> TagLine line 93 | _ -> tagAddr 94 | } 95 | 96 | 97 | 98 | -- 99 | -- Header generator 100 | -- 101 | 102 | data ArbHeader = ArbHeader { getArgHeader :: CTag.Header } 103 | deriving Show 104 | 105 | instance Arbitrary ArbHeader where 106 | arbitrary = 107 | ArbHeader 108 | <$> oneof 109 | [ CTag.Header CTag.FileEncoding 110 | <$> genLanguageText 111 | <*> genTextNonEmpty 112 | <*> genComment 113 | , CTag.Header CTag.FileEncoding 114 | <$> genLanguageText 115 | <*> genTextNonEmpty 116 | <*> genComment 117 | , CTag.Header CTag.FileFormat 118 | <$> genLanguageText 119 | <*> (getPositive <$> arbitrary) 120 | <*> genComment 121 | , CTag.Header CTag.FileSorted 122 | <$> genLanguageText 123 | <*> (getPositive <$> arbitrary) 124 | <*> genComment 125 | , CTag.Header CTag.OutputMode 126 | <$> genLanguageText 127 | <*> genTextNonEmpty 128 | <*> genComment 129 | , CTag.Header CTag.KindDescription 130 | <$> genLanguageText 131 | <*> genTextNonEmpty 132 | <*> genComment 133 | , CTag.Header CTag.KindSeparator 134 | <$> genLanguageText 135 | <*> genComment 136 | <*> genTextNonEmpty 137 | , CTag.Header CTag.ProgramAuthor 138 | <$> genLanguageText 139 | <*> genTextNonEmpty 140 | <*> genComment 141 | , CTag.Header CTag.ProgramName 142 | <$> genLanguageText 143 | <*> genTextNonEmpty 144 | <*> genComment 145 | , CTag.Header CTag.ProgramUrl 146 | <$> genLanguageText 147 | <*> genTextNonEmpty 148 | <*> genComment 149 | , CTag.Header CTag.ProgramVersion 150 | <$> genLanguageText 151 | <*> genTextNonEmpty 152 | <*> genComment 153 | , CTag.Header CTag.ExtraDescription 154 | <$> genLanguageText 155 | <*> genTextNonEmpty 156 | <*> genComment 157 | , CTag.Header CTag.FieldDescription 158 | <$> genLanguageText 159 | <*> genTextNonEmpty 160 | <*> genComment 161 | , CTag.Header 162 | <$> (CTag.PseudoTag <$> genPseudoTagName) 163 | <*> genLanguageText 164 | <*> genTextNonEmpty 165 | <*> genComment 166 | ] 167 | 168 | shrink (ArbHeader CTag.Header { CTag.headerType, CTag.headerLanguage, CTag.headerArg, CTag.headerComment}) = 169 | [ ArbHeader $ CTag.Header headerType headerLanguage' headerArg headerComment 170 | | lang <- shrink headerLanguage 171 | , let headerLanguage' = 172 | lang >>= (\x -> if Text.null x then Nothing else Just x) 173 | ] 174 | ++ 175 | [ ArbHeader $ CTag.Header headerType headerLanguage headerArg' headerComment 176 | | headerArg' <- 177 | case CTag.headerTypeSing headerType of 178 | CTag.SingHeaderTypeText -> filter (not . Text.null) (shrink headerArg) 179 | CTag.SingHeaderTypeInt -> shrink headerArg 180 | ] 181 | ++ 182 | [ ArbHeader $ CTag.Header headerType headerLanguage headerArg headerComment' 183 | | headerComment' <- fixText `map` shrink headerComment 184 | ] 185 | 186 | 187 | genPseudoTagName :: Gen Text 188 | genPseudoTagName = 189 | suchThat (Text.filter (/= '!') . fixText <$> arbitrary) 190 | (not . Text.null) 191 | 192 | genLanguageText :: Gen (Maybe Text) 193 | genLanguageText = oneof 194 | [ pure Nothing 195 | , Just <$> genTextNonEmpty 196 | ] 197 | 198 | genComment :: Gen Text 199 | genComment = fixText <$> arbitrary 200 | 201 | roundTripHeaderProp :: ArbHeader -> Property 202 | roundTripHeaderProp (ArbHeader h) = 203 | let bs = BL.toStrict 204 | . BB.toLazyByteString 205 | . CTag.formatHeader 206 | $ h 207 | mh = AChar.parseOnly CTag.parseHeader 208 | $ bs 209 | in case mh of 210 | Left err -> counterexample 211 | ("parser error: " ++ err ++ " bs: " ++ BS.Char8.unpack bs) 212 | (property False) 213 | Right h' -> counterexample 214 | (show $ Text.decodeUtf8 bs) 215 | (h === h') 216 | 217 | -- 218 | -- 219 | -- 220 | 221 | tagKindCharToCharProp :: Char -> Bool 222 | tagKindCharToCharProp c = Just c == CTag.tagKindToChar (CTag.charToTagKind c) 223 | 224 | newtype ArbCTagKind = ArbCTagKind { getArbCTagKind :: TagKind } 225 | deriving Show 226 | 227 | instance Arbitrary ArbCTagKind where 228 | arbitrary = ArbCTagKind <$> genTagKind SingCTag 229 | 230 | 231 | tagKindTagKindToTagKindProp :: ArbCTagKind -> Property 232 | tagKindTagKindToTagKindProp (ArbCTagKind tk) = 233 | (case tk of 234 | NoKind -> Nothing 235 | _ -> Just tk) 236 | === 237 | (CTag.charToTagKind <$> CTag.tagKindToChar tk) 238 | -------------------------------------------------------------------------------- /ghc-tags-test/test/Test/ETag.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | 3 | module Test.ETag (tests) where 4 | 5 | import qualified Data.ByteString.Builder as BB 6 | import qualified Data.ByteString.Lazy as BL 7 | -- import qualified Data.Text as Text 8 | -- import qualified Data.Text.Encoding as Text 9 | 10 | import Test.Tasty (TestTree, testGroup) 11 | import Test.Tasty.QuickCheck (testProperty) 12 | import Test.QuickCheck 13 | import Test.QuickCheck.Instances.Text () 14 | 15 | import GhcTags.Tag 16 | import GhcTags.ETag.Formatter 17 | 18 | import Test.Tag.Generators 19 | 20 | 21 | tests :: TestTree 22 | tests = testGroup "ETag" 23 | [ testProperty "etag size" eTagsBuilderSizeProp 24 | ] 25 | 26 | 27 | -- 28 | -- Generators 29 | -- 30 | 31 | 32 | newtype ArbETag = ArbETag { getArbETag :: ETag } 33 | deriving Show 34 | 35 | instance Arbitrary ArbETag where 36 | arbitrary = fmap ArbETag $ 37 | Tag 38 | <$> (TagName <$> genTextNonEmpty) 39 | <*> genTagKind SingETag 40 | <*> genTagFilePath 41 | <*> oneof [ TagLine <$> (getPositive <$> arbitrary) 42 | , TagLineCol <$> (getPositive <$> arbitrary) 43 | <*> (getPositive <$> arbitrary) 44 | , return NoAddress 45 | ] 46 | <*> (TagDefinition <$> genTextNonEmpty) 47 | <*> pure NoTagFields 48 | shrink = map ArbETag . shrinkTag . getArbETag 49 | 50 | 51 | -- 52 | -- Properties 53 | -- 54 | 55 | eTagsBuilderSizeProp :: ArbETag -> Bool 56 | eTagsBuilderSizeProp (ArbETag ts) = 57 | case formatTag ts of 58 | BuilderWithSize {builder, builderSize} -> 59 | BL.length (BB.toLazyByteString builder) == fromIntegral builderSize 60 | -------------------------------------------------------------------------------- /ghc-tags-test/test/Test/Golden/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {-# OPTIONS_GHC -Wno-unused-imports #-} 5 | 6 | module Test.Golden.Parser (tests) where 7 | 8 | import Control.Arrow 9 | import Control.Exception 10 | import Control.Monad ((>=>)) 11 | 12 | import qualified Data.ByteString as BS 13 | import qualified Data.ByteString.Builder as BS 14 | import qualified Data.ByteString.Lazy as LBS 15 | import qualified Data.ByteString.Lazy.Char8 as LBS.Char8 16 | import System.IO 17 | import System.Directory 18 | import System.FilePath 19 | 20 | import qualified GhcTags.CTag as CTag 21 | import qualified GhcTags.ETag as ETag 22 | 23 | import Test.Tasty 24 | import Test.Tasty.Golden 25 | import Test.Tasty.Golden.Advanced 26 | 27 | ext :: String 28 | #if !defined(mingw32_HOST_OS) 29 | ext = "posix" 30 | #else 31 | ext = "windows" 32 | #endif 33 | 34 | 35 | tests :: FilePath -> TestTree 36 | tests goldenTestDir = 37 | testGroup "Golden.Parser" $ 38 | [ testGroup "CTag" 39 | [ let input = goldenTestDir "test.tags" 40 | golden = goldenTestDir "test.tags" <.> ext <.> "golden" 41 | output = goldenTestDir "test.tags.out" 42 | in goldenVsFile 43 | "test tags" 44 | golden 45 | output 46 | (parseGoldenCTagsFile input output) 47 | 48 | , let input = goldenTestDir "vim.tags" 49 | golden = goldenTestDir "vim.tags" <.> ext <.> "golden" 50 | output = goldenTestDir "vim.tags.out" 51 | in goldenVsFile 52 | "vim tags" 53 | golden 54 | output 55 | (parseGoldenCTagsFile input output) 56 | 57 | , let input = goldenTestDir "typed-protocols.tags" 58 | golden = goldenTestDir "typed-protocols.tags" <.> ext <.> "golden" 59 | output = goldenTestDir "typed-protocols.tags.out" 60 | in goldenVsFile 61 | "typed-protocols tags" 62 | golden 63 | output 64 | (parseGoldenCTagsFile input output) 65 | 66 | , let input = goldenTestDir "io-sim-classes.tags" 67 | golden = goldenTestDir "io-sim-classes.tags" <.> ext <.> "golden" 68 | output = goldenTestDir "io-sim-classes.tags.out" 69 | in goldenVsFile 70 | "io-sim-classes tags" 71 | golden 72 | output 73 | (parseGoldenCTagsFile input output) 74 | 75 | , let input = goldenTestDir "ouroboros-network.tags" 76 | golden = goldenTestDir "ouroboros-network.tags" <.> ext <.> "golden" 77 | output = goldenTestDir "ouroboros-network.tags.out" 78 | in goldenVsFile 79 | "ouroboros-network tags" 80 | golden 81 | output 82 | (parseGoldenCTagsFile input output) 83 | 84 | , let input = goldenTestDir "ouroboros-consensus.tags" 85 | golden = goldenTestDir "ouroboros-consensus.tags" <.> ext <.> "golden" 86 | output = goldenTestDir "ouroboros-consensus.tags.out" 87 | in goldenVsFile 88 | "ouroboros-consensus tags" 89 | golden 90 | output 91 | (parseGoldenCTagsFile input output) 92 | 93 | , let input = goldenTestDir "ghc.tags" 94 | golden = goldenTestDir "ghc.tags" <.> ext <.> "golden" 95 | output = goldenTestDir "ghc.tags.out" 96 | in goldenVsFile 97 | "ghc tags" 98 | golden 99 | output 100 | (parseGoldenCTagsFile input output) 101 | ] 102 | 103 | , testGroup "ETag" 104 | #if MIN_VERSION_tasty_golden(2,3,4) 105 | [ let input = goldenTestDir "ouroboros-consensus.ETAGS" 106 | golden = goldenTestDir "ouroboros-consensus.ETAGS" <.> ext <.> "golden" 107 | output = goldenTestDir "ouroboros-consensus.ETAGS.out" 108 | in localOption (SizeCutoff maxBound) $ 109 | goldenVsFileVerbose 110 | "ouroboros-consensus TAGS" 111 | golden 112 | output 113 | (parseGoldenETagsFile input output) 114 | 115 | , 116 | #else 117 | [ 118 | #endif 119 | let input = goldenTestDir "vim.ETAGS" 120 | golden = goldenTestDir "vim.ETAGS" <.> ext <.> "golden" 121 | output = goldenTestDir "vim.ETAGS.out" 122 | in goldenVsFile 123 | "vim tags" 124 | golden 125 | output 126 | (parseGoldenETagsFile input output) 127 | 128 | , let input = goldenTestDir "ghc.ETAGS" 129 | golden = goldenTestDir "ghc.ETAGS" <.> ext <.> "golden" 130 | output = goldenTestDir "ghc.ETAGS.out" 131 | in goldenVsFile 132 | "ghc tags" 133 | golden 134 | output 135 | (parseGoldenETagsFile input output) 136 | ] 137 | ] 138 | 139 | 140 | parseGoldenCTagsFile 141 | :: FilePath -- input file 142 | -> FilePath -- output file 143 | -> IO () 144 | parseGoldenCTagsFile input output = do 145 | res <- withBinaryFile input ReadMode 146 | (BS.hGetContents >=> CTag.parseTagsFile) 147 | case res of 148 | Left err -> throwIO (userError err) 149 | Right tags -> 150 | withBinaryFile output WriteMode 151 | $ flip BS.hPutBuilder (foldMap (CTag.formatHeader ||| CTag.formatTag) tags) 152 | 153 | 154 | parseGoldenETagsFile 155 | :: FilePath -- ^ input file 156 | -> FilePath -- ^ output file 157 | -> IO () 158 | parseGoldenETagsFile input output = do 159 | res <- withBinaryFile input ReadMode 160 | (BS.hGetContents >=> ETag.parseTagsFile) 161 | case res of 162 | Left err -> throwIO (userError err) 163 | Right tags -> 164 | withBinaryFile output WriteMode 165 | $ flip BS.hPutBuilder (ETag.formatETagsFile tags) 166 | 167 | 168 | #if MIN_VERSION_tasty_golden(2,3,4) 169 | goldenVsFileVerbose 170 | :: TestName -- ^ test name 171 | -> FilePath -- ^ path to the «golden» file (the file that contains correct output) 172 | -> FilePath -- ^ path to the output file 173 | -> IO () -- ^ action that creates the output file 174 | -> TestTree -- ^ the test verifies that the output file contents is the same as the golden file contents 175 | goldenVsFileVerbose name ref new act = 176 | goldenTest2 177 | name 178 | (LBS.readFile ref) 179 | (act >> LBS.readFile new) 180 | cmp 181 | upd 182 | del 183 | where 184 | cmp :: LBS.ByteString -> LBS.ByteString -> IO (Maybe String) 185 | cmp refBS newBS | refBS == newBS 186 | = return Nothing 187 | cmp _refBS newBS = return (Just $ LBS.Char8.unpack newBS) 188 | 189 | upd = createDirectoriesAndWriteFile ref 190 | del = removeFile new 191 | #endif 192 | -------------------------------------------------------------------------------- /ghc-tags-test/test/Test/Tag.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE MultiWayIf #-} 4 | {-# LANGUAGE NamedFieldPuns #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE TupleSections #-} 8 | {-# LANGUAGE TypeApplications #-} 9 | {-# LANGUAGE UnicodeSyntax #-} 10 | 11 | module Test.Tag (tests) where 12 | 13 | import Control.Monad.State.Strict 14 | import Data.Function (on) 15 | import Data.Functor.Identity 16 | import Data.Foldable (traverse_) 17 | import Data.List (nub, sortBy) 18 | import qualified Data.Text as Text 19 | import qualified Data.Text.Encoding as Text 20 | 21 | import Test.Tasty (TestTree, testGroup) 22 | import Test.Tasty.QuickCheck (testProperty) 23 | import Test.QuickCheck 24 | import Test.QuickCheck.Instances.Text () 25 | 26 | import qualified Pipes 27 | import qualified Pipes.Prelude as Pipes 28 | import qualified Pipes.Lift as Pipes 29 | 30 | import GhcTags.Tag 31 | import GhcTags.Stream 32 | import qualified GhcTags.CTag as CTag 33 | 34 | import Test.Tag.Generators 35 | 36 | 37 | -- TODO add ETags test 38 | tests :: TestTree 39 | tests = testGroup "Tag" 40 | [ testGroup "compareTags" 41 | [ testProperty "antisymmetry" ordAntiSymmetryProp 42 | , testProperty "reflexivity" (on ordReflexivityyProp getArbOrdTag) 43 | , testProperty "transitivity" (\a b c -> 44 | ordTransitiveProp 45 | (getArbOrdTag a) 46 | (getArbOrdTag b) 47 | (getArbOrdTag c)) 48 | , testProperty "Eq:consistency" (weakConsistency . getArbOrdTag) 49 | , testProperty "sort:idempotent" sortIdempotentProp 50 | ] 51 | , testGroup "combineTags" 52 | [ testProperty "subset" combineTags_subset 53 | , testProperty "idempotent" combineTags_idempotent 54 | , testProperty "identity" combineTags_identity 55 | , testProperty "preserve" combineTags_preserve 56 | , testProperty "substitution" combineTags_substitution 57 | , testProperty "order" combineTags_order 58 | ] 59 | , testGroup "combineTagsPipe" 60 | [ testProperty "model test" combineTagsPipeProp 61 | ] 62 | ] 63 | 64 | 65 | -- | 'Tag' generator 66 | -- 67 | newtype ArbTag = ArbTag { getArbTag :: CTag } 68 | deriving Show 69 | 70 | genTagAddrLine :: Gen CTag 71 | genTagAddrLine = 72 | Tag 73 | <$> (TagName <$> resize 5 genTextNonEmpty) 74 | <*> genTagKind SingCTag 75 | <*> genSmallFilePath 76 | <*> frequency 77 | [ (8, TagLine . getPositive <$> arbitrary) 78 | , (1, TagCommand . ExCommand . (wrap '/' . fixAddr) <$> genTextNonEmpty) 79 | , (1, TagCommand . ExCommand . (wrap '?' . fixAddr) <$> genTextNonEmpty) 80 | ] 81 | <*> pure NoTagDefinition 82 | <*> (TagFields <$> listOf genField) 83 | 84 | genTagAddrLineCol :: Gen CTag 85 | genTagAddrLineCol = 86 | Tag 87 | <$> (TagName <$> resize 5 genTextNonEmpty) 88 | <*> genTagKind SingCTag 89 | <*> genSmallFilePath 90 | <*> frequency 91 | [ (8, TagLineCol <$> (getPositive <$> arbitrary) <*> (getPositive <$> arbitrary)) 92 | , (1, TagCommand . ExCommand . (wrap '/' . fixAddr) <$> genTextNonEmpty) 93 | , (1, TagCommand . ExCommand . (wrap '?' . fixAddr) <$> genTextNonEmpty) 94 | ] 95 | <*> pure NoTagDefinition 96 | <*> (TagFields <$> listOf genField) 97 | 98 | instance Arbitrary ArbTag where 99 | arbitrary = oneof 100 | [ ArbTag <$> genTagAddrLine 101 | , ArbTag <$> genTagAddrLineCol 102 | ] 103 | 104 | shrink = map ArbTag . shrinkTag . getArbTag 105 | 106 | 107 | -- | Arbitrary instance with a high probability of gettings the same tags or files. 108 | -- 109 | newtype ArbOrdTag = ArbOrdTag { getArbOrdTag :: CTag } 110 | deriving Show 111 | 112 | 113 | instance Arbitrary ArbOrdTag where 114 | arbitrary = fmap ArbOrdTag 115 | $ Tag 116 | <$> elements 117 | (TagName `map` 118 | [ "find" 119 | , "Ord" 120 | , "Eq" 121 | ]) 122 | <*> genTagKind SingCTag 123 | <*> elements 124 | [ TagFilePath "Main.hs" 125 | , TagFilePath "Lib.hs" 126 | ] 127 | <*> frequency 128 | [ (8, TagLine . getPositive <$> arbitrary) 129 | , (1, TagCommand . ExCommand . (wrap '/' . fixAddr) <$> genTextNonEmpty) 130 | , (1, TagCommand . ExCommand . (wrap '?' . fixAddr) <$> genTextNonEmpty) 131 | ] 132 | <*> pure NoTagDefinition 133 | <*> pure (TagFields []) 134 | 135 | shrink = map ArbOrdTag . shrinkTag . getArbOrdTag 136 | 137 | 138 | -- | Generate pairs of tags which are equal in the sense of `compare`. 139 | -- 140 | data EqTags = EqTags CTag CTag 141 | deriving Show 142 | 143 | instance Arbitrary EqTags where 144 | arbitrary = do 145 | x <- getArbOrdTag <$> arbitrary 146 | fieldsA <- listOf genField 147 | fieldsB <- listOf genField 148 | pure $ EqTags x { tagFields = TagFields fieldsA } 149 | x { tagFields = TagFields fieldsB } 150 | 151 | 152 | -- | Note that this property is weaker than required. There are unequal `Tag`s 153 | -- in the sense of `==`, which are considered equal by `compare`. 154 | -- 155 | ordAntiSymmetryProp :: EqTags -> Bool 156 | ordAntiSymmetryProp (EqTags a b) = a `compareTags` b == EQ 157 | 158 | 159 | -- We don't provide 'Ord' instance, since it's not compatible with 'compare', 160 | -- see 'weakConsistency'. 161 | -- 162 | (≤), (≥) :: Tag tk -> Tag tk -> Bool 163 | a ≤ b = a `compareTags` b /= GT 164 | a ≥ b = a `compareTags` b /= LT 165 | 166 | ordReflexivityyProp :: Tag tk -> Tag tk -> Bool 167 | ordReflexivityyProp a b = a ≤ b || a ≥ b 168 | 169 | ordTransitiveProp :: Tag tk -> Tag tk -> Tag tk -> Property 170 | ordTransitiveProp a b c = 171 | a ≤ b && b ≤ c 172 | || a ≥ b && b ≥ c ==> 173 | if | a ≤ b && b ≤ c -> a ≤ c 174 | | a ≥ b && b ≥ c -> a ≥ c 175 | | otherwise -> error "impossible happened" 176 | where 177 | 178 | sortIdempotentProp :: [ArbTag] -> Bool 179 | sortIdempotentProp ts = 180 | let ts' = getArbTag `map` ts 181 | ts'' = sortBy compareTags ts' 182 | in sortBy compareTags ts'' == ts'' 183 | 184 | 185 | -- | The 186 | -- 187 | -- prop> a == b ==> a `compare` b == EQ` 188 | -- 189 | -- But since 'Tag' is using derived 'Eq' instance, it is equivalent to 190 | weakConsistency :: Tag tk -> Bool 191 | weakConsistency a = a `compareTags` a == EQ 192 | 193 | 194 | -- 195 | -- combineTags properties 196 | -- 197 | 198 | genSmallFilePath :: Gen TagFilePath 199 | genSmallFilePath = TagFilePath <$> suchThat (resize 3 arbitrary) (not . Text.null) 200 | 201 | 202 | -- | sorted list of Tags 203 | newtype ArbTagList = ArbTagList { getArbTagList :: [CTag] } 204 | deriving Show 205 | 206 | instance Arbitrary ArbTagList where 207 | arbitrary = (ArbTagList . nub . sortBy CTag.compareTags . map getArbTag) 208 | <$> listOf arbitrary 209 | shrink (ArbTagList ts) = 210 | (ArbTagList . sortBy compareTags) `map` shrinkList shrinkTag ts 211 | 212 | 213 | -- | List of tags from the same file 214 | -- 215 | data ArbTagsFromFile = ArbTagsFromFile TagFilePath [CTag] 216 | deriving Show 217 | 218 | instance Arbitrary ArbTagsFromFile where 219 | arbitrary = do 220 | filePath <- genSmallFilePath 221 | ArbTagList tags <- arbitrary 222 | let tags' = (\t -> t { tagFilePath = filePath, tagFields = mempty }) `map` tags 223 | pure $ ArbTagsFromFile filePath (sortBy compareTags tags') 224 | 225 | shrink (ArbTagsFromFile fp@(TagFilePath rawPath) tags) = 226 | [ ArbTagsFromFile fp (sortBy compareTags tags') 227 | -- Don't shrink file name! 228 | | tags' <- shrinkList shrinkTag' tags 229 | ] 230 | ++ 231 | [ ArbTagsFromFile (TagFilePath rawPath') ((\t -> t { tagFilePath = TagFilePath rawPath' }) `map` tags) 232 | | rawPath' <- shrink rawPath 233 | , not (Text.null rawPath') 234 | ] 235 | 236 | 237 | -- 238 | -- Utils 239 | -- 240 | 241 | encodeTagFilePath :: TagFilePath -> RawFilePath 242 | encodeTagFilePath = rawFilePathFromBS . Text.encodeUtf8 . getRawFilePath 243 | 244 | -- properties 245 | 246 | combineTags_subset :: ArbTagsFromFile 247 | -> [ArbTag] 248 | -> Bool 249 | combineTags_subset (ArbTagsFromFile fp as) bs = 250 | let bs' = getArbTag `map` bs 251 | cs = combineTags CTag.compareTags (encodeTagFilePath fp) as bs' 252 | in all (`elem` cs) as 253 | 254 | 255 | -- | The tag list be ordered for this property to hold. 256 | -- 257 | combineTags_idempotent :: ArbTagsFromFile 258 | -> ArbTagList 259 | -> Bool 260 | combineTags_idempotent (ArbTagsFromFile fp as) (ArbTagList bs) = 261 | combineTags CTag.compareTags fp' as bs 262 | == combineTags CTag.compareTags fp' as 263 | (combineTags CTag.compareTags fp' as bs) 264 | where 265 | fp' = encodeTagFilePath fp 266 | 267 | 268 | -- | The tag list cannot cannot contain duplicates for this property to hold. 269 | -- 270 | combineTags_identity :: ArbTagsFromFile 271 | -> Bool 272 | combineTags_identity (ArbTagsFromFile fp as) = 273 | combineTags CTag.compareTags (encodeTagFilePath fp) as as == as 274 | 275 | 276 | -- | Does not modify tags outside of the module. 277 | -- 278 | combineTags_preserve :: ArbTagsFromFile -> ArbTagList -> Bool 279 | combineTags_preserve (ArbTagsFromFile fp as) (ArbTagList bs) = 280 | filter (\t -> not $ (getRawFilePath fp) 281 | `Text.isSuffixOf` 282 | (getRawFilePath $ tagFilePath t)) 283 | (combineTags CTag.compareTags (encodeTagFilePath fp) as bs) 284 | == 285 | filter (\t -> not $ (getRawFilePath fp) 286 | `Text.isSuffixOf` 287 | (getRawFilePath $ tagFilePath t)) 288 | bs 289 | 290 | 291 | -- | Substitutes all tags of the current file. 292 | -- 293 | combineTags_substitution :: ArbTagsFromFile -> ArbTagList -> Bool 294 | combineTags_substitution (ArbTagsFromFile fp as) (ArbTagList bs) = 295 | filter (\t -> tagFilePath t == fp) (combineTags CTag.compareTags (encodeTagFilePath fp) as bs) 296 | == 297 | as 298 | 299 | -- | 'combineTags' must preserver order of tags. 300 | -- 301 | combineTags_order :: ArbTagsFromFile -> ArbTagList -> Bool 302 | combineTags_order (ArbTagsFromFile fp as) (ArbTagList bs) = 303 | let cs = combineTags CTag.compareTags (encodeTagFilePath fp) as bs 304 | in sortBy compareTags cs == cs 305 | 306 | 307 | -- 308 | -- combineTagsPipe model test 309 | -- 310 | 311 | -- | We need a special generator; the property holds only for list of tags 312 | -- which have the same address: `TagLine` or `TagLineCol` but not mixed. 313 | -- 314 | -- The reason for that is that the piped `combineTagsPipe` needs to compare 315 | -- tags, and the `Eq` instance cannot distinquishe a tag with address 316 | -- `TagLine 10` with `TagLine 10 3`, even if they are the same tags. The crux 317 | -- of the problem is that `ctags` have no way of representing a column number. 318 | -- 319 | data ArbTagsFromFileAndTagList = ArbTagsFromFileAndTagList TagFilePath [CTag] [CTag] 320 | deriving (Eq, Show) 321 | 322 | -- | Make addresses monotonic 323 | -- 324 | fixAddresses :: [CTag] -> [CTag] 325 | fixAddresses = snd . foldr f (TagLineCol 0 0, []) 326 | where 327 | next :: CTagAddress -> CTagAddress 328 | next (TagLineCol l c) = TagLineCol l (succ c) 329 | next (TagLine l) = TagLine (succ l) 330 | next addr = addr 331 | 332 | f :: CTag -> (CTagAddress, [CTag]) -> (CTagAddress, [CTag]) 333 | f tag@Tag {tagAddr} (addr, ts) | tagAddr > addr = (tagAddr, tag : ts) 334 | | otherwise = 335 | let nextAddr = next addr 336 | in (nextAddr, tag { tagAddr = nextAddr } : ts) 337 | 338 | 339 | instance Arbitrary ArbTagsFromFileAndTagList where 340 | arbitrary = do 341 | filePath <- genSmallFilePath 342 | bool <- arbitrary 343 | let tagGen = 344 | if bool 345 | then genTagAddrLine 346 | else genTagAddrLineCol 347 | tagsFromFile <- 348 | fixAddresses 349 | . map (fixFile filePath) 350 | . nub 351 | . sortBy compareTags 352 | <$> listOf tagGen 353 | tags <- nub 354 | . sortBy compareTags 355 | <$> listOf tagGen 356 | pure $ ArbTagsFromFileAndTagList filePath tagsFromFile tags 357 | where 358 | fixFile p t = t { tagFilePath = p 359 | , tagFields = mempty 360 | } 361 | 362 | -- A very basic shrinker 363 | shrink (ArbTagsFromFileAndTagList filePath@(TagFilePath rawPath) as bs) = 364 | [ ArbTagsFromFileAndTagList (TagFilePath rawPath') 365 | ((\t -> t { tagFilePath = TagFilePath rawPath' }) `map` as) 366 | bs 367 | | rawPath' <- shrink rawPath 368 | , not (Text.null rawPath') 369 | ] 370 | ++ 371 | [ ArbTagsFromFileAndTagList filePath 372 | ((\t -> t { tagFilePath = filePath }) `map` as') 373 | bs 374 | | as' <- shrinkList shrinkTag as 375 | ] 376 | ++ 377 | [ ArbTagsFromFileAndTagList filePath as bs' 378 | | bs' <- shrinkList shrinkTag bs 379 | ] 380 | 381 | 382 | -- | Check, that the `combineTagsPipe` and agree with it's non-stream version 383 | -- 'combineTags' 384 | -- 385 | -- This is an example of a model test (where `combineTags` is regarded a model 386 | -- of `combeinTagsPipe`). 387 | -- 388 | combineTagsPipeProp :: ArbTagsFromFileAndTagList -> Property 389 | combineTagsPipeProp (ArbTagsFromFileAndTagList modPath as bs) = 390 | combineTags CTag.compareTags modPath' as bs 391 | === 392 | case 393 | runStateT 394 | (Pipes.toListM @(StateT [CTag] Identity) 395 | (Pipes.for 396 | -- yield all `bs` 397 | (traverse_ Pipes.yield bs) 398 | (\tag -> Pipes.stateP $ fmap ((),) . combineTagsPipe CTag.compareTags modPath' tag))) 399 | -- take 'as' a state 400 | as of 401 | Identity (tags, rest) -> tags ++ rest 402 | where 403 | modPath' = encodeTagFilePath modPath 404 | -------------------------------------------------------------------------------- /ghc-tags-test/test/Test/Tag/Generators.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Test.Tag.Generators where 6 | 7 | import qualified Data.Char as Char 8 | import Data.Text (Text) 9 | import qualified Data.Text as Text 10 | 11 | import Algebra.Lattice 12 | 13 | import Test.QuickCheck 14 | import Test.QuickCheck.Instances.Text () 15 | 16 | import GhcTags.Tag 17 | 18 | -- 19 | -- Generators 20 | -- 21 | 22 | -- a quick hack 23 | genTextNonEmpty :: Gen Text 24 | genTextNonEmpty = 25 | suchThat 26 | (fixText <$> arbitrary) 27 | (not . Text.null) 28 | 29 | -- filter only printable characters, removing tabs and newlines which have 30 | -- special role in vim tag syntax 31 | fixText :: Text -> Text 32 | fixText = Text.filter ( ((/= Char.Control) . Char.generalCategory) 33 | /\ Char.isPrint) 34 | 35 | fixFilePath :: TagFilePath -> TagFilePath 36 | fixFilePath = TagFilePath 37 | . Text.filter ( ((/= Char.Control) . Char.generalCategory) 38 | /\ Char.isPrint) 39 | . getRawFilePath 40 | 41 | genTagFilePath :: Gen TagFilePath 42 | genTagFilePath = 43 | suchThat 44 | (fixFilePath . TagFilePath . Text.pack <$> arbitrary) 45 | (not . Text.null . getRawFilePath) 46 | 47 | genField :: Gen TagField 48 | genField = 49 | TagField 50 | <$> suchThat g (not . Text.null) 51 | <*> g 52 | where 53 | g :: Gen Text 54 | g = fixFieldText <$> arbitrary 55 | 56 | -- filter only printable characters, removing tabs, newlines and colons which 57 | -- have special role in vim field syntax 58 | fixFieldText :: Text -> Text 59 | fixFieldText = Text.filter ( (/= ':') 60 | /\ ((/= Char.Control) . Char.generalCategory) 61 | /\ Char.isPrint) 62 | 63 | 64 | -- address cannot contain ";\"" sequence 65 | fixAddr :: Text -> Text 66 | fixAddr = fixText . Text.replace ";\"" "" 67 | 68 | wrap :: Char -> Text -> Text 69 | wrap c = Text.cons c . flip Text.snoc c 70 | 71 | genTagKind :: SingTagKind tk -> Gen TagKind 72 | genTagKind SingETag = pure NoKind 73 | genTagKind SingCTag = oneof 74 | [ pure TkModule 75 | , pure TkTerm 76 | , pure TkFunction 77 | , pure TkTypeConstructor 78 | , pure TkDataConstructor 79 | , pure TkGADTConstructor 80 | , pure TkRecordField 81 | , pure TkTypeSynonym 82 | , pure TkTypeSignature 83 | , pure TkPatternSynonym 84 | , pure TkTypeClass 85 | , pure TkTypeClassMember 86 | , pure TkTypeClassInstance 87 | , pure TkTypeClassInstanceMember 88 | , pure TkTypeFamily 89 | , pure TkTypeFamilyInstance 90 | , pure TkDataTypeFamily 91 | , pure TkDataTypeFamilyInstance 92 | , pure TkForeignImport 93 | , pure TkForeignExport 94 | , CharKind <$> genChar 95 | , pure NoKind 96 | ] 97 | where 98 | genChar = suchThat arbitrary 99 | ( ((/= Char.Control) . Char.generalCategory) 100 | /\ (/= ':') 101 | /\ (not . flip elem ("`λΛcgr≡⊢pCmifFdDIExM" :: String)) 102 | ) 103 | 104 | shrinkTag' :: Tag tk -> [Tag tk] 105 | shrinkTag' tag@Tag {tagName, tagAddr, tagFields} = 106 | [ tag { tagName = TagName x } 107 | | x <- fixText `map` shrink (getTagName tagName) 108 | , not (Text.null x) 109 | ] 110 | ++ [ tag { tagAddr = addr } 111 | | addr <- case tagAddr of 112 | TagLineCol line col -> 113 | [ TagLineCol line col' 114 | | col' <- shrink col 115 | ] 116 | ++ 117 | [ TagLineCol line' col 118 | | line' <- shrink line 119 | ] 120 | TagLine addr -> TagLine `map` shrink addr 121 | TagCommand (ExCommand addr) -> 122 | TagLine 0 123 | : (TagCommand . ExCommand . wrap '/' . fixAddr) 124 | `map` (shrink . stripEnds) addr 125 | NoAddress -> [] 126 | , addr /= tagAddr -- wrap might restore the same address! 127 | ] 128 | ++ case tagFields of 129 | TagFields fields -> 130 | [ tag { tagFields = TagFields fields' } 131 | | fields' <- shrinkList (const []) fields 132 | ] 133 | NoTagFields -> 134 | [] 135 | where 136 | stripEnds :: Text -> Text 137 | stripEnds addr = case Text.uncons addr of 138 | Nothing -> error "impossible happend" 139 | Just (_, addr') -> case Text.unsnoc addr' of 140 | Nothing -> error "impossible happend" 141 | Just (addr'', _) -> addr'' 142 | 143 | 144 | shrinkTag :: Tag tk -> [Tag tk] 145 | shrinkTag tag@Tag {tagFilePath = TagFilePath tagFilePath} = 146 | shrinkTag' tag 147 | ++ [ tag { tagFilePath = tagFilePath' } 148 | | tagFilePath' <- (fixFilePath . TagFilePath . Text.pack) `map` shrink (Text.unpack tagFilePath) 149 | , not (Text.null $ getRawFilePath tagFilePath') 150 | ] 151 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/idempotent.tags: -------------------------------------------------------------------------------- 1 | Category Control/Category.hs 5892;" C 2 | 3 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/test.tags: -------------------------------------------------------------------------------- 1 | free Foreign/Marschall/Alloc.hs 324;" kind:λ ffi:free type:Ptr a -> IO () 2 | id Data/Function.hs 28;" kind:λ type:a -> a 3 | alloca Foreign/Marschall/Alloc.hs 20;" kind:λ type:forall a b. Storable -> (Ptr a -> IO b) ) -> IO b 4 | <> Data/Semigroup.hs 10;" kind:λ type:Semigroup a => a -> a -> a class:Semigroup 5 | mempty Data/Monoid.hs 15;" kind:λ class:Monoid type:Moind a => a 6 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/test.tags.posix.golden: -------------------------------------------------------------------------------- 1 | free Foreign/Marschall/Alloc.hs 324;" kind:λ ffi:free type:Ptr a -> IO () 2 | id Data/Function.hs 28;" kind:λ type:a -> a 3 | alloca Foreign/Marschall/Alloc.hs 20;" kind:λ type:forall a b. Storable -> (Ptr a -> IO b) ) -> IO b 4 | <> Data/Semigroup.hs 10;" kind:λ type:Semigroup a => a -> a -> a class:Semigroup 5 | mempty Data/Monoid.hs 15;" kind:λ class:Monoid type:Moind a => a 6 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/test.tags.windows.golden: -------------------------------------------------------------------------------- 1 | free Foreign\Marschall\Alloc.hs 324;" kind:λ ffi:free type:Ptr a -> IO () 2 | id Data\Function.hs 28;" kind:λ type:a -> a 3 | alloca Foreign\Marschall\Alloc.hs 20;" kind:λ type:forall a b. Storable -> (Ptr a -> IO b) ) -> IO b 4 | <> Data\Semigroup.hs 10;" kind:λ type:Semigroup a => a -> a -> a class:Semigroup 5 | mempty Data\Monoid.hs 15;" kind:λ class:Monoid type:Moind a => a 6 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/typed-protocols.tags: -------------------------------------------------------------------------------- 1 | !_TAG_FILE_FORMAT 2 // 2 | !_TAG_FILE_SORTED 1 // 3 | !_TAG_FILE_ENCODING utf-8 // 4 | !_TAG_PROGRAM_AUTHOR Marcin Szamotulski // 5 | !_TAG_PROGRAM_NAME ghc-tags-plugin // 6 | !_TAG_PROGRAM_URL https://hackage.haskell.org/package/ghc-tags-plugin // 7 | !_TAG_PROGRAM_VERSION 0.1.6.0 // 8 | !_TAG_FIELD_DESCRIPTION!Haskell type /type of expression/ 9 | !_TAG_FIELD_DESCRIPTION!Haskell ffi /foreign object name/ 10 | !_TAG_FIELD_DESCRIPTION!Haskell file /not exported term/ 11 | !_TAG_FIELD_DESCRIPTION!Haskell instance /class, type or data type instance/ 12 | !_TAG_FIELD_DESCRIPTION!Haskell Kind /kind of a type/ 13 | !_TAG_KIND_DESCRIPTION!Haskell ` /module top level term, but not a function/ 14 | !_TAG_KIND_DESCRIPTION!Haskell λ /module top level function term/ 15 | !_TAG_KIND_DESCRIPTION!Haskell Λ /type constructor/ 16 | !_TAG_KIND_DESCRIPTION!Haskell c /data constructor/ 17 | !_TAG_KIND_DESCRIPTION!Haskell g /gadt constructor/ 18 | !_TAG_KIND_DESCRIPTION!Haskell r /record field/ 19 | !_TAG_KIND_DESCRIPTION!Haskell ≡ /type synonym/ 20 | !_TAG_KIND_DESCRIPTION!Haskell ~ /type signature/ 21 | !_TAG_KIND_DESCRIPTION!Haskell p /pattern synonym/ 22 | !_TAG_KIND_DESCRIPTION!Haskell C /type class/ 23 | !_TAG_KIND_DESCRIPTION!Haskell m /type class member/ 24 | !_TAG_KIND_DESCRIPTION!Haskell i /type class instance/ 25 | !_TAG_KIND_DESCRIPTION!Haskell F /type family/ 26 | !_TAG_KIND_DESCRIPTION!Haskell f /type family instance/ 27 | !_TAG_KIND_DESCRIPTION!Haskell D /data type family/ 28 | !_TAG_KIND_DESCRIPTION!Haskell d /data type family instance/ 29 | !_TAG_KIND_DESCRIPTION!Haskell I /foreign import/ 30 | !_TAG_KIND_DESCRIPTION!Haskell E /foreign export/ 31 | AsClient src/Network/TypedProtocol/Core.hs 319;" c 32 | AsServer src/Network/TypedProtocol/Core.hs 319;" c 33 | Await src/Network/TypedProtocol/Core.hs 458;" g 34 | ClientAgency src/Network/TypedProtocol/Core.hs 326;" g 35 | ClientHasAgency src/Network/TypedProtocol/Core.hs 273;" d 36 | ConsQ src/Network/TypedProtocol/Proofs.hs 318;" g 37 | Done src/Network/TypedProtocol/Core.hs 424;" g 38 | Driver src/Network/TypedProtocol/Driver.hs 66;" kind:Λ file: 39 | Driver src/Network/TypedProtocol/Driver.hs 67;" c 40 | Effect src/Network/TypedProtocol/Core.hs 411;" g 41 | EmptyQ src/Network/TypedProtocol/Proofs.hs 317;" g 42 | FlipAgency src/Network/TypedProtocol/Core.hs 355;" f file: 43 | HasDState src/Network/TypedProtocol/Driver.hs 220;" g 44 | IsNat src/Network/TypedProtocol/Pipelined.hs 155;" kind:Λ 45 | IsSucc src/Network/TypedProtocol/Pipelined.hs 157;" g 46 | IsZero src/Network/TypedProtocol/Pipelined.hs 156;" g 47 | MaybeDState src/Network/TypedProtocol/Driver.hs 219;" kind:Λ 48 | Message src/Network/TypedProtocol/Core.hs 269;" d 49 | N src/Network/TypedProtocol/Pipelined.hs 144;" kind:Λ file: 50 | Nat src/Network/TypedProtocol/Pipelined.hs 153;" kind:Λ file: 51 | NoDState src/Network/TypedProtocol/Driver.hs 221;" g 52 | NobodyHasAgency src/Network/TypedProtocol/Core.hs 282;" d 53 | Outstanding src/Network/TypedProtocol/Pipelined.hs 141;" kind:≡ file: 54 | Peer src/Network/TypedProtocol/Core.hs 401;" kind:Λ file: 55 | PeerHasAgency src/Network/TypedProtocol/Core.hs 325;" kind:Λ file: 56 | PeerPipelined src/Network/TypedProtocol/Pipelined.hs 32;" kind:Λ file: 57 | PeerPipelined src/Network/TypedProtocol/Pipelined.hs 33;" g 58 | PeerReceiver src/Network/TypedProtocol/Pipelined.hs 122;" kind:Λ file: 59 | PeerRole src/Network/TypedProtocol/Core.hs 319;" kind:Λ file: 60 | PeerSender src/Network/TypedProtocol/Pipelined.hs 47;" kind:Λ file: 61 | Protocol src/Network/TypedProtocol/Core.hs 262;" C file: 62 | Queue src/Network/TypedProtocol/Proofs.hs 316;" kind:Λ file: 63 | ReceiveHandler src/Network/TypedProtocol/Driver.hs 173;" kind:Λ 64 | ReceiveHandler src/Network/TypedProtocol/Driver.hs 174;" g 65 | ReceiverAwait src/Network/TypedProtocol/Pipelined.hs 129;" g 66 | ReceiverDone src/Network/TypedProtocol/Pipelined.hs 127;" g 67 | ReceiverEffect src/Network/TypedProtocol/Pipelined.hs 124;" g 68 | S src/Network/TypedProtocol/Pipelined.hs 144;" c 69 | SenderAwait src/Network/TypedProtocol/Pipelined.hs 79;" g 70 | SenderCollect src/Network/TypedProtocol/Pipelined.hs 118;" g 71 | SenderDone src/Network/TypedProtocol/Pipelined.hs 54;" g 72 | SenderEffect src/Network/TypedProtocol/Pipelined.hs 50;" g 73 | SenderPipeline src/Network/TypedProtocol/Pipelined.hs 94;" g 74 | SenderYield src/Network/TypedProtocol/Pipelined.hs 66;" g 75 | ServerAgency src/Network/TypedProtocol/Core.hs 327;" g 76 | ServerHasAgency src/Network/TypedProtocol/Core.hs 277;" d 77 | Show src/Network/TypedProtocol/Core.hs 331;" i 78 | SomeMessage src/Network/TypedProtocol/Driver.hs 86;" kind:Λ file: 79 | SomeMessage src/Network/TypedProtocol/Driver.hs 87;" g 80 | Succ src/Network/TypedProtocol/Pipelined.hs 167;" p 81 | Succ src/Network/TypedProtocol/Pipelined.hs 168;" p 82 | TerminalStates src/Network/TypedProtocol/Proofs.hs 141;" kind:Λ file: 83 | TerminalStates src/Network/TypedProtocol/Proofs.hs 142;" g 84 | TheyHaveAgency src/Network/TypedProtocol/Core.hs 351;" kind:≡ file: 85 | UnsafeInt src/Network/TypedProtocol/Pipelined.hs 153;" c 86 | WeHaveAgency src/Network/TypedProtocol/Core.hs 342;" kind:≡ file: 87 | Yield src/Network/TypedProtocol/Core.hs 436;" g 88 | Z src/Network/TypedProtocol/Pipelined.hs 144;" c 89 | Zero src/Network/TypedProtocol/Pipelined.hs 163;" p 90 | Zero src/Network/TypedProtocol/Pipelined.hs 164;" p 91 | connect src/Network/TypedProtocol/Proofs.hs 82;" kind:⊢ file: 92 | connect src/Network/TypedProtocol/Proofs.hs 87;" kind:λ file: 93 | connectPipelined src/Network/TypedProtocol/Proofs.hs 158;" kind:⊢ file: 94 | connectPipelined src/Network/TypedProtocol/Proofs.hs 165;" kind:λ file: 95 | enqueue src/Network/TypedProtocol/Proofs.hs 323;" kind:⊢ file: 96 | enqueue src/Network/TypedProtocol/Proofs.hs 324;" kind:λ file: 97 | exclusionLemma_ClientAndServerHaveAgency src/Network/TypedProtocol/Core.hs 287;" m 98 | exclusionLemma_NobodyAndClientHaveAgency src/Network/TypedProtocol/Core.hs 296;" m 99 | exclusionLemma_NobodyAndServerHaveAgency src/Network/TypedProtocol/Core.hs 305;" m 100 | forgetPipelined src/Network/TypedProtocol/Proofs.hs 279;" kind:⊢ file: 101 | forgetPipelined src/Network/TypedProtocol/Proofs.hs 284;" kind:λ file: 102 | natToInt src/Network/TypedProtocol/Pipelined.hs 173;" kind:⊢ file: 103 | natToInt src/Network/TypedProtocol/Pipelined.hs 174;" kind:λ file: 104 | pipelineInterleaving src/Network/TypedProtocol/Proofs.hs 335;" kind:⊢ file: 105 | pipelineInterleaving src/Network/TypedProtocol/Proofs.hs 338;" kind:λ file: 106 | recvMessage src/Network/TypedProtocol/Driver.hs 73;" r 107 | runPeerWithDriver src/Network/TypedProtocol/Driver.hs 98;" kind:⊢ file: 108 | runPeerWithDriver src/Network/TypedProtocol/Driver.hs 105;" kind:λ file: 109 | runPipelinedPeerReceiver src/Network/TypedProtocol/Driver.hs 298;" kind:⊢ 110 | runPipelinedPeerReceiver src/Network/TypedProtocol/Driver.hs 305;" kind:λ 111 | runPipelinedPeerReceiverQueue src/Network/TypedProtocol/Driver.hs 275;" kind:⊢ 112 | runPipelinedPeerReceiverQueue src/Network/TypedProtocol/Driver.hs 282;" kind:λ 113 | runPipelinedPeerSender src/Network/TypedProtocol/Driver.hs 224;" kind:⊢ 114 | runPipelinedPeerSender src/Network/TypedProtocol/Driver.hs 233;" kind:λ 115 | runPipelinedPeerWithDriver src/Network/TypedProtocol/Driver.hs 148;" kind:⊢ file: 116 | runPipelinedPeerWithDriver src/Network/TypedProtocol/Driver.hs 155;" kind:λ file: 117 | sendMessage src/Network/TypedProtocol/Driver.hs 68;" r 118 | startDState src/Network/TypedProtocol/Driver.hs 78;" r 119 | toIsNat src/Network/TypedProtocol/Pipelined.hs 159;" kind:⊢ 120 | toIsNat src/Network/TypedProtocol/Pipelined.hs 160;" kind:λ 121 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/typed-protocols.tags.posix.golden: -------------------------------------------------------------------------------- 1 | !_TAG_FILE_FORMAT 2 // 2 | !_TAG_FILE_SORTED 1 // 3 | !_TAG_FILE_ENCODING utf-8 // 4 | !_TAG_PROGRAM_AUTHOR Marcin Szamotulski // 5 | !_TAG_PROGRAM_NAME ghc-tags-plugin // 6 | !_TAG_PROGRAM_URL https://hackage.haskell.org/package/ghc-tags-plugin // 7 | !_TAG_PROGRAM_VERSION 0.1.6.0 // 8 | !_TAG_FIELD_DESCRIPTION!Haskell type /type of expression/ 9 | !_TAG_FIELD_DESCRIPTION!Haskell ffi /foreign object name/ 10 | !_TAG_FIELD_DESCRIPTION!Haskell file /not exported term/ 11 | !_TAG_FIELD_DESCRIPTION!Haskell instance /class, type or data type instance/ 12 | !_TAG_FIELD_DESCRIPTION!Haskell Kind /kind of a type/ 13 | !_TAG_KIND_DESCRIPTION!Haskell ` /module top level term, but not a function/ 14 | !_TAG_KIND_DESCRIPTION!Haskell λ /module top level function term/ 15 | !_TAG_KIND_DESCRIPTION!Haskell Λ /type constructor/ 16 | !_TAG_KIND_DESCRIPTION!Haskell c /data constructor/ 17 | !_TAG_KIND_DESCRIPTION!Haskell g /gadt constructor/ 18 | !_TAG_KIND_DESCRIPTION!Haskell r /record field/ 19 | !_TAG_KIND_DESCRIPTION!Haskell ≡ /type synonym/ 20 | !_TAG_KIND_DESCRIPTION!Haskell ~ /type signature/ 21 | !_TAG_KIND_DESCRIPTION!Haskell p /pattern synonym/ 22 | !_TAG_KIND_DESCRIPTION!Haskell C /type class/ 23 | !_TAG_KIND_DESCRIPTION!Haskell m /type class member/ 24 | !_TAG_KIND_DESCRIPTION!Haskell i /type class instance/ 25 | !_TAG_KIND_DESCRIPTION!Haskell F /type family/ 26 | !_TAG_KIND_DESCRIPTION!Haskell f /type family instance/ 27 | !_TAG_KIND_DESCRIPTION!Haskell D /data type family/ 28 | !_TAG_KIND_DESCRIPTION!Haskell d /data type family instance/ 29 | !_TAG_KIND_DESCRIPTION!Haskell I /foreign import/ 30 | !_TAG_KIND_DESCRIPTION!Haskell E /foreign export/ 31 | AsClient src/Network/TypedProtocol/Core.hs 319;" c 32 | AsServer src/Network/TypedProtocol/Core.hs 319;" c 33 | Await src/Network/TypedProtocol/Core.hs 458;" g 34 | ClientAgency src/Network/TypedProtocol/Core.hs 326;" g 35 | ClientHasAgency src/Network/TypedProtocol/Core.hs 273;" d 36 | ConsQ src/Network/TypedProtocol/Proofs.hs 318;" g 37 | Done src/Network/TypedProtocol/Core.hs 424;" g 38 | Driver src/Network/TypedProtocol/Driver.hs 66;" kind:Λ file: 39 | Driver src/Network/TypedProtocol/Driver.hs 67;" c 40 | Effect src/Network/TypedProtocol/Core.hs 411;" g 41 | EmptyQ src/Network/TypedProtocol/Proofs.hs 317;" g 42 | FlipAgency src/Network/TypedProtocol/Core.hs 355;" f file: 43 | HasDState src/Network/TypedProtocol/Driver.hs 220;" g 44 | IsNat src/Network/TypedProtocol/Pipelined.hs 155;" kind:Λ 45 | IsSucc src/Network/TypedProtocol/Pipelined.hs 157;" g 46 | IsZero src/Network/TypedProtocol/Pipelined.hs 156;" g 47 | MaybeDState src/Network/TypedProtocol/Driver.hs 219;" kind:Λ 48 | Message src/Network/TypedProtocol/Core.hs 269;" d 49 | N src/Network/TypedProtocol/Pipelined.hs 144;" kind:Λ file: 50 | Nat src/Network/TypedProtocol/Pipelined.hs 153;" kind:Λ file: 51 | NoDState src/Network/TypedProtocol/Driver.hs 221;" g 52 | NobodyHasAgency src/Network/TypedProtocol/Core.hs 282;" d 53 | Outstanding src/Network/TypedProtocol/Pipelined.hs 141;" kind:≡ file: 54 | Peer src/Network/TypedProtocol/Core.hs 401;" kind:Λ file: 55 | PeerHasAgency src/Network/TypedProtocol/Core.hs 325;" kind:Λ file: 56 | PeerPipelined src/Network/TypedProtocol/Pipelined.hs 32;" kind:Λ file: 57 | PeerPipelined src/Network/TypedProtocol/Pipelined.hs 33;" g 58 | PeerReceiver src/Network/TypedProtocol/Pipelined.hs 122;" kind:Λ file: 59 | PeerRole src/Network/TypedProtocol/Core.hs 319;" kind:Λ file: 60 | PeerSender src/Network/TypedProtocol/Pipelined.hs 47;" kind:Λ file: 61 | Protocol src/Network/TypedProtocol/Core.hs 262;" C file: 62 | Queue src/Network/TypedProtocol/Proofs.hs 316;" kind:Λ file: 63 | ReceiveHandler src/Network/TypedProtocol/Driver.hs 173;" kind:Λ 64 | ReceiveHandler src/Network/TypedProtocol/Driver.hs 174;" g 65 | ReceiverAwait src/Network/TypedProtocol/Pipelined.hs 129;" g 66 | ReceiverDone src/Network/TypedProtocol/Pipelined.hs 127;" g 67 | ReceiverEffect src/Network/TypedProtocol/Pipelined.hs 124;" g 68 | S src/Network/TypedProtocol/Pipelined.hs 144;" c 69 | SenderAwait src/Network/TypedProtocol/Pipelined.hs 79;" g 70 | SenderCollect src/Network/TypedProtocol/Pipelined.hs 118;" g 71 | SenderDone src/Network/TypedProtocol/Pipelined.hs 54;" g 72 | SenderEffect src/Network/TypedProtocol/Pipelined.hs 50;" g 73 | SenderPipeline src/Network/TypedProtocol/Pipelined.hs 94;" g 74 | SenderYield src/Network/TypedProtocol/Pipelined.hs 66;" g 75 | ServerAgency src/Network/TypedProtocol/Core.hs 327;" g 76 | ServerHasAgency src/Network/TypedProtocol/Core.hs 277;" d 77 | Show src/Network/TypedProtocol/Core.hs 331;" i 78 | SomeMessage src/Network/TypedProtocol/Driver.hs 86;" kind:Λ file: 79 | SomeMessage src/Network/TypedProtocol/Driver.hs 87;" g 80 | Succ src/Network/TypedProtocol/Pipelined.hs 167;" p 81 | Succ src/Network/TypedProtocol/Pipelined.hs 168;" p 82 | TerminalStates src/Network/TypedProtocol/Proofs.hs 141;" kind:Λ file: 83 | TerminalStates src/Network/TypedProtocol/Proofs.hs 142;" g 84 | TheyHaveAgency src/Network/TypedProtocol/Core.hs 351;" kind:≡ file: 85 | UnsafeInt src/Network/TypedProtocol/Pipelined.hs 153;" c 86 | WeHaveAgency src/Network/TypedProtocol/Core.hs 342;" kind:≡ file: 87 | Yield src/Network/TypedProtocol/Core.hs 436;" g 88 | Z src/Network/TypedProtocol/Pipelined.hs 144;" c 89 | Zero src/Network/TypedProtocol/Pipelined.hs 163;" p 90 | Zero src/Network/TypedProtocol/Pipelined.hs 164;" p 91 | connect src/Network/TypedProtocol/Proofs.hs 82;" kind:⊢ file: 92 | connect src/Network/TypedProtocol/Proofs.hs 87;" kind:λ file: 93 | connectPipelined src/Network/TypedProtocol/Proofs.hs 158;" kind:⊢ file: 94 | connectPipelined src/Network/TypedProtocol/Proofs.hs 165;" kind:λ file: 95 | enqueue src/Network/TypedProtocol/Proofs.hs 323;" kind:⊢ file: 96 | enqueue src/Network/TypedProtocol/Proofs.hs 324;" kind:λ file: 97 | exclusionLemma_ClientAndServerHaveAgency src/Network/TypedProtocol/Core.hs 287;" m 98 | exclusionLemma_NobodyAndClientHaveAgency src/Network/TypedProtocol/Core.hs 296;" m 99 | exclusionLemma_NobodyAndServerHaveAgency src/Network/TypedProtocol/Core.hs 305;" m 100 | forgetPipelined src/Network/TypedProtocol/Proofs.hs 279;" kind:⊢ file: 101 | forgetPipelined src/Network/TypedProtocol/Proofs.hs 284;" kind:λ file: 102 | natToInt src/Network/TypedProtocol/Pipelined.hs 173;" kind:⊢ file: 103 | natToInt src/Network/TypedProtocol/Pipelined.hs 174;" kind:λ file: 104 | pipelineInterleaving src/Network/TypedProtocol/Proofs.hs 335;" kind:⊢ file: 105 | pipelineInterleaving src/Network/TypedProtocol/Proofs.hs 338;" kind:λ file: 106 | recvMessage src/Network/TypedProtocol/Driver.hs 73;" r 107 | runPeerWithDriver src/Network/TypedProtocol/Driver.hs 98;" kind:⊢ file: 108 | runPeerWithDriver src/Network/TypedProtocol/Driver.hs 105;" kind:λ file: 109 | runPipelinedPeerReceiver src/Network/TypedProtocol/Driver.hs 298;" kind:⊢ 110 | runPipelinedPeerReceiver src/Network/TypedProtocol/Driver.hs 305;" kind:λ 111 | runPipelinedPeerReceiverQueue src/Network/TypedProtocol/Driver.hs 275;" kind:⊢ 112 | runPipelinedPeerReceiverQueue src/Network/TypedProtocol/Driver.hs 282;" kind:λ 113 | runPipelinedPeerSender src/Network/TypedProtocol/Driver.hs 224;" kind:⊢ 114 | runPipelinedPeerSender src/Network/TypedProtocol/Driver.hs 233;" kind:λ 115 | runPipelinedPeerWithDriver src/Network/TypedProtocol/Driver.hs 148;" kind:⊢ file: 116 | runPipelinedPeerWithDriver src/Network/TypedProtocol/Driver.hs 155;" kind:λ file: 117 | sendMessage src/Network/TypedProtocol/Driver.hs 68;" r 118 | startDState src/Network/TypedProtocol/Driver.hs 78;" r 119 | toIsNat src/Network/TypedProtocol/Pipelined.hs 159;" kind:⊢ 120 | toIsNat src/Network/TypedProtocol/Pipelined.hs 160;" kind:λ 121 | -------------------------------------------------------------------------------- /ghc-tags-test/test/golden/typed-protocols.tags.windows.golden: -------------------------------------------------------------------------------- 1 | !_TAG_FILE_FORMAT 2 // 2 | !_TAG_FILE_SORTED 1 // 3 | !_TAG_FILE_ENCODING utf-8 // 4 | !_TAG_PROGRAM_AUTHOR Marcin Szamotulski // 5 | !_TAG_PROGRAM_NAME ghc-tags-plugin // 6 | !_TAG_PROGRAM_URL https://hackage.haskell.org/package/ghc-tags-plugin // 7 | !_TAG_PROGRAM_VERSION 0.1.6.0 // 8 | !_TAG_FIELD_DESCRIPTION!Haskell type /type of expression/ 9 | !_TAG_FIELD_DESCRIPTION!Haskell ffi /foreign object name/ 10 | !_TAG_FIELD_DESCRIPTION!Haskell file /not exported term/ 11 | !_TAG_FIELD_DESCRIPTION!Haskell instance /class, type or data type instance/ 12 | !_TAG_FIELD_DESCRIPTION!Haskell Kind /kind of a type/ 13 | !_TAG_KIND_DESCRIPTION!Haskell ` /module top level term, but not a function/ 14 | !_TAG_KIND_DESCRIPTION!Haskell λ /module top level function term/ 15 | !_TAG_KIND_DESCRIPTION!Haskell Λ /type constructor/ 16 | !_TAG_KIND_DESCRIPTION!Haskell c /data constructor/ 17 | !_TAG_KIND_DESCRIPTION!Haskell g /gadt constructor/ 18 | !_TAG_KIND_DESCRIPTION!Haskell r /record field/ 19 | !_TAG_KIND_DESCRIPTION!Haskell ≡ /type synonym/ 20 | !_TAG_KIND_DESCRIPTION!Haskell ~ /type signature/ 21 | !_TAG_KIND_DESCRIPTION!Haskell p /pattern synonym/ 22 | !_TAG_KIND_DESCRIPTION!Haskell C /type class/ 23 | !_TAG_KIND_DESCRIPTION!Haskell m /type class member/ 24 | !_TAG_KIND_DESCRIPTION!Haskell i /type class instance/ 25 | !_TAG_KIND_DESCRIPTION!Haskell F /type family/ 26 | !_TAG_KIND_DESCRIPTION!Haskell f /type family instance/ 27 | !_TAG_KIND_DESCRIPTION!Haskell D /data type family/ 28 | !_TAG_KIND_DESCRIPTION!Haskell d /data type family instance/ 29 | !_TAG_KIND_DESCRIPTION!Haskell I /foreign import/ 30 | !_TAG_KIND_DESCRIPTION!Haskell E /foreign export/ 31 | AsClient src\Network\TypedProtocol\Core.hs 319;" c 32 | AsServer src\Network\TypedProtocol\Core.hs 319;" c 33 | Await src\Network\TypedProtocol\Core.hs 458;" g 34 | ClientAgency src\Network\TypedProtocol\Core.hs 326;" g 35 | ClientHasAgency src\Network\TypedProtocol\Core.hs 273;" d 36 | ConsQ src\Network\TypedProtocol\Proofs.hs 318;" g 37 | Done src\Network\TypedProtocol\Core.hs 424;" g 38 | Driver src\Network\TypedProtocol\Driver.hs 66;" kind:Λ file: 39 | Driver src\Network\TypedProtocol\Driver.hs 67;" c 40 | Effect src\Network\TypedProtocol\Core.hs 411;" g 41 | EmptyQ src\Network\TypedProtocol\Proofs.hs 317;" g 42 | FlipAgency src\Network\TypedProtocol\Core.hs 355;" f file: 43 | HasDState src\Network\TypedProtocol\Driver.hs 220;" g 44 | IsNat src\Network\TypedProtocol\Pipelined.hs 155;" kind:Λ 45 | IsSucc src\Network\TypedProtocol\Pipelined.hs 157;" g 46 | IsZero src\Network\TypedProtocol\Pipelined.hs 156;" g 47 | MaybeDState src\Network\TypedProtocol\Driver.hs 219;" kind:Λ 48 | Message src\Network\TypedProtocol\Core.hs 269;" d 49 | N src\Network\TypedProtocol\Pipelined.hs 144;" kind:Λ file: 50 | Nat src\Network\TypedProtocol\Pipelined.hs 153;" kind:Λ file: 51 | NoDState src\Network\TypedProtocol\Driver.hs 221;" g 52 | NobodyHasAgency src\Network\TypedProtocol\Core.hs 282;" d 53 | Outstanding src\Network\TypedProtocol\Pipelined.hs 141;" kind:≡ file: 54 | Peer src\Network\TypedProtocol\Core.hs 401;" kind:Λ file: 55 | PeerHasAgency src\Network\TypedProtocol\Core.hs 325;" kind:Λ file: 56 | PeerPipelined src\Network\TypedProtocol\Pipelined.hs 32;" kind:Λ file: 57 | PeerPipelined src\Network\TypedProtocol\Pipelined.hs 33;" g 58 | PeerReceiver src\Network\TypedProtocol\Pipelined.hs 122;" kind:Λ file: 59 | PeerRole src\Network\TypedProtocol\Core.hs 319;" kind:Λ file: 60 | PeerSender src\Network\TypedProtocol\Pipelined.hs 47;" kind:Λ file: 61 | Protocol src\Network\TypedProtocol\Core.hs 262;" C file: 62 | Queue src\Network\TypedProtocol\Proofs.hs 316;" kind:Λ file: 63 | ReceiveHandler src\Network\TypedProtocol\Driver.hs 173;" kind:Λ 64 | ReceiveHandler src\Network\TypedProtocol\Driver.hs 174;" g 65 | ReceiverAwait src\Network\TypedProtocol\Pipelined.hs 129;" g 66 | ReceiverDone src\Network\TypedProtocol\Pipelined.hs 127;" g 67 | ReceiverEffect src\Network\TypedProtocol\Pipelined.hs 124;" g 68 | S src\Network\TypedProtocol\Pipelined.hs 144;" c 69 | SenderAwait src\Network\TypedProtocol\Pipelined.hs 79;" g 70 | SenderCollect src\Network\TypedProtocol\Pipelined.hs 118;" g 71 | SenderDone src\Network\TypedProtocol\Pipelined.hs 54;" g 72 | SenderEffect src\Network\TypedProtocol\Pipelined.hs 50;" g 73 | SenderPipeline src\Network\TypedProtocol\Pipelined.hs 94;" g 74 | SenderYield src\Network\TypedProtocol\Pipelined.hs 66;" g 75 | ServerAgency src\Network\TypedProtocol\Core.hs 327;" g 76 | ServerHasAgency src\Network\TypedProtocol\Core.hs 277;" d 77 | Show src\Network\TypedProtocol\Core.hs 331;" i 78 | SomeMessage src\Network\TypedProtocol\Driver.hs 86;" kind:Λ file: 79 | SomeMessage src\Network\TypedProtocol\Driver.hs 87;" g 80 | Succ src\Network\TypedProtocol\Pipelined.hs 167;" p 81 | Succ src\Network\TypedProtocol\Pipelined.hs 168;" p 82 | TerminalStates src\Network\TypedProtocol\Proofs.hs 141;" kind:Λ file: 83 | TerminalStates src\Network\TypedProtocol\Proofs.hs 142;" g 84 | TheyHaveAgency src\Network\TypedProtocol\Core.hs 351;" kind:≡ file: 85 | UnsafeInt src\Network\TypedProtocol\Pipelined.hs 153;" c 86 | WeHaveAgency src\Network\TypedProtocol\Core.hs 342;" kind:≡ file: 87 | Yield src\Network\TypedProtocol\Core.hs 436;" g 88 | Z src\Network\TypedProtocol\Pipelined.hs 144;" c 89 | Zero src\Network\TypedProtocol\Pipelined.hs 163;" p 90 | Zero src\Network\TypedProtocol\Pipelined.hs 164;" p 91 | connect src\Network\TypedProtocol\Proofs.hs 82;" kind:⊢ file: 92 | connect src\Network\TypedProtocol\Proofs.hs 87;" kind:λ file: 93 | connectPipelined src\Network\TypedProtocol\Proofs.hs 158;" kind:⊢ file: 94 | connectPipelined src\Network\TypedProtocol\Proofs.hs 165;" kind:λ file: 95 | enqueue src\Network\TypedProtocol\Proofs.hs 323;" kind:⊢ file: 96 | enqueue src\Network\TypedProtocol\Proofs.hs 324;" kind:λ file: 97 | exclusionLemma_ClientAndServerHaveAgency src\Network\TypedProtocol\Core.hs 287;" m 98 | exclusionLemma_NobodyAndClientHaveAgency src\Network\TypedProtocol\Core.hs 296;" m 99 | exclusionLemma_NobodyAndServerHaveAgency src\Network\TypedProtocol\Core.hs 305;" m 100 | forgetPipelined src\Network\TypedProtocol\Proofs.hs 279;" kind:⊢ file: 101 | forgetPipelined src\Network\TypedProtocol\Proofs.hs 284;" kind:λ file: 102 | natToInt src\Network\TypedProtocol\Pipelined.hs 173;" kind:⊢ file: 103 | natToInt src\Network\TypedProtocol\Pipelined.hs 174;" kind:λ file: 104 | pipelineInterleaving src\Network\TypedProtocol\Proofs.hs 335;" kind:⊢ file: 105 | pipelineInterleaving src\Network\TypedProtocol\Proofs.hs 338;" kind:λ file: 106 | recvMessage src\Network\TypedProtocol\Driver.hs 73;" r 107 | runPeerWithDriver src\Network\TypedProtocol\Driver.hs 98;" kind:⊢ file: 108 | runPeerWithDriver src\Network\TypedProtocol\Driver.hs 105;" kind:λ file: 109 | runPipelinedPeerReceiver src\Network\TypedProtocol\Driver.hs 298;" kind:⊢ 110 | runPipelinedPeerReceiver src\Network\TypedProtocol\Driver.hs 305;" kind:λ 111 | runPipelinedPeerReceiverQueue src\Network\TypedProtocol\Driver.hs 275;" kind:⊢ 112 | runPipelinedPeerReceiverQueue src\Network\TypedProtocol\Driver.hs 282;" kind:λ 113 | runPipelinedPeerSender src\Network\TypedProtocol\Driver.hs 224;" kind:⊢ 114 | runPipelinedPeerSender src\Network\TypedProtocol\Driver.hs 233;" kind:λ 115 | runPipelinedPeerWithDriver src\Network\TypedProtocol\Driver.hs 148;" kind:⊢ file: 116 | runPipelinedPeerWithDriver src\Network\TypedProtocol\Driver.hs 155;" kind:λ file: 117 | sendMessage src\Network\TypedProtocol\Driver.hs 68;" r 118 | startDState src\Network\TypedProtocol\Driver.hs 78;" r 119 | toIsNat src\Network\TypedProtocol\Pipelined.hs 159;" kind:⊢ 120 | toIsNat src\Network\TypedProtocol\Pipelined.hs 160;" kind:λ 121 | -------------------------------------------------------------------------------- /ghc-tags-vim/plugin/ghc-tags.vim: -------------------------------------------------------------------------------- 1 | " Update `ghc-tags-plugin` version in a `cabal.project` file 2 | " 3 | fun! UpdateGhcTagsPlugin(ghcVersion) abort 4 | let view = winsaveview() 5 | if empty(a:ghcVersion) 6 | let ghcVersion = matchstr(system("ghc --numeric-version"), '[0-9.]*') 7 | else 8 | let ghcVersion = a:ghcVersion 9 | endif 10 | 11 | let output = system("ghc-pkg-".ghcVersion." --package-db=".$HOME."/.cabal/store/ghc-".ghcVersion."/package.db describe ghc-tags-plugin") 12 | let ghcTagsPluginIds = filter(matchlist(output, 'id:\_s*\zs\(.\{-}\)\n')[:1], {id, v -> !empty(v)}) 13 | if !empty(ghcTagsPluginIds) 14 | let v = sort(ghcTagsPluginIds, "GTPCompareIds")[0] 15 | try 16 | exe ":%s/\\(-plugin-package-id\\s*=\\s*\\)\\@<=ghc-tags-plugin.*/".escape(v, "./") 17 | catch /E486:/ 18 | endtry 19 | endif 20 | let latest = substitute(system("ghc-pkg --package-db=".$HOME."/.cabal/store/ghc-".ghcVersion."/package.db latest ghc-tags-plugin"), '\_s*$', "", "") 21 | if !empty(latest) 22 | try 23 | exe ':%s/\(-plugin-package\s*=\s*\)\@<=ghc-tags-plugin.*/'.escape(latest, "./") 24 | catch /E486:/ 25 | endtry 26 | endif 27 | call winrestview(view) 28 | endfun 29 | 30 | fun! GTPExtractVersion(id) 31 | return map(split(split(substitute(a:id, '^ghc-tags-plugin-', '', ''), "-")[0], '\.'), {_, val -> str2nr(val) }) 32 | endfun 33 | 34 | fun! GTPCompareIds(id_0, id_1) 35 | let ver_0 = GTPExtractVersion(a:id_0) 36 | let ver_1 = GTPExtractVersion(a:id_1) 37 | if [ver_0, ver_1] == sort([ver_0, ver_1]) 38 | return 1 39 | else 40 | return -1 41 | endif 42 | endfun 43 | 44 | com! -nargs=? UpdateGhcTagsPlugin :call UpdateGhcTagsPlugin() 45 | --------------------------------------------------------------------------------